/[lmdze]/trunk/dyn3d/advn.f
ViewVC logotype

Diff of /trunk/dyn3d/advn.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC revision 32 by guez, Tue Apr 6 17:52:58 2010 UTC
# Line 29  c   Arguments: Line 29  c   Arguments:
29  c   ----------  c   ----------
30        integer mode        integer mode
31        real masse(ip1jmp1,llm)        real masse(ip1jmp1,llm)
32        REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)        REAL, intent(in):: pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
33        REAL q(ip1jmp1,llm)        REAL q(ip1jmp1,llm)
34        REAL w(ip1jmp1,llm),pdt        REAL w(ip1jmp1,llm),pdt
35  c  c
# Line 509  c Line 509  c
509        do l=1,llm        do l=1,llm
510              do ij=iip2,ip1jm              do ij=iip2,ip1jm
511                 zdq=qd(ij,l)-qg(ij,l)                 zdq=qd(ij,l)-qg(ij,l)
 c              if((qd(ij,l)-q(ij,l))*(q(ij,l)-qg(ij,l)).lt.0.) then  
 c                 print*,'probleme au point ij=',ij,'  l=',l  
 c                 print*,qd(ij,l),q(ij,l),qg(ij,l)  
 c                 qd(ij,l)=q(ij,l)  
 c                 qg(ij,l)=q(ij,l)  
 c              endif  
512                 if(abs(zdq).gt.prec) then                 if(abs(zdq).gt.prec) then
513                    zsigd(ij,l)=(q(ij,l)-qg(ij,l))/zdq                    zsigd(ij,l)=(q(ij,l)-qg(ij,l))/zdq
514                    zsigg(ij,l)=1.-zsigd(ij,l)                    zsigg(ij,l)=1.-zsigd(ij,l)
 c                 if(.not.(zsigd(ij,l).ge.0..and.zsigd(ij,l).le.1. .and.  
 c    s               zsigg(ij,l).ge.0..or.zsigg(ij,l).le.1.) ) then  
 c                    print*,'probleme au point ij=',ij,'  l=',l  
 c                    print*,'sigg=',zsigg(ij,l),'  sigd=',zsigd(ij,l)  
 c                    print*,'q d,c,g ',qd(ij,l),q(ij,l),qg(ij,l),zdq  
 c                    stop  
 c                 endif  
515                 else                 else
516                    zsigd(ij,l)=0.5                    zsigd(ij,l)=0.5
517                    zsigg(ij,l)=0.5                    zsigg(ij,l)=0.5
# Line 573  c   calcul de la pente maximum dans la m Line 560  c   calcul de la pente maximum dans la m
560       s          +(zsig-zsigp)*(zq+zz*(zqm-zq)) )       s          +(zsig-zsigp)*(zq+zz*(zqm-zq)) )
561               endif               endif
562            endif            endif
 c         if(zsig.lt.0.) then  
 c            print*,'au point ij=',ij,'  l=',l,'  sig=',zsig  
 c            stop  
 c         endif  
563        enddo        enddo
564        enddo        enddo
565    
# Line 604  c   tris des regions a traiter Line 587  c   tris des regions a traiter
587        enddo        enddo
588    
589        if(n0.gt.1) then        if(n0.gt.1) then
590        IF (prt_level > 9) WRITE(lunout,*)        IF (prt_level > 9) print *,
591       & 'Nombre de points pour lesquels on advect plus que le'       & 'Nombre de points pour lesquels on advect plus que le'
592       &       ,'contenu de la maille : ',n0       &       ,'contenu de la maille : ',n0
593    
# Line 619  c   indicage des mailles concernees par Line 602  c   indicage des mailles concernees par
602                    endif                    endif
603                 enddo                 enddo
604                 niju=iju                 niju=iju
 c              print*,'niju,nl',niju,nl(l)  
605    
606  c  traitement des mailles  c  traitement des mailles
607                 do iju=1,niju                 do iju=1,niju
# Line 648  c               u_mq(ij,l)=u_mq(ij,l)+zu Line 630  c               u_mq(ij,l)=u_mq(ij,l)+zu
630  c         goto 8888  c         goto 8888
631                  zz=0.5*(zsig-zsigd(ijq,l))/zsigg(ijq,l)                  zz=0.5*(zsig-zsigd(ijq,l))/zsigg(ijq,l)
632                  if(.not.(zz.gt.0..and.zz.le.0.5)) then                  if(.not.(zz.gt.0..and.zz.le.0.5)) then
633                       WRITE(lunout,*)'probleme2 au point ij=',ij,                       print *,'probleme2 au point ij=',ij,
634       s               '  l=',l       s               '  l=',l
635                       WRITE(lunout,*)'zz=',zz                       print *,'zz=',zz
636                       stop                       stop
637                  endif                  endif
638                  u_mq(ij,l)=u_mq(ij,l)+masse(ijq,l)*(                  u_mq(ij,l)=u_mq(ij,l)+masse(ijq,l)*(
# Line 678  c               u_mq(ij,l)=u_mq(ij,l)+zu Line 660  c               u_mq(ij,l)=u_mq(ij,l)+zu
660  c           goto 9999  c           goto 9999
661                  zz=0.5*(zsig-zsigg(ijq,l))/zsigd(ijq,l)                  zz=0.5*(zsig-zsigg(ijq,l))/zsigd(ijq,l)
662                  if(.not.(zz.gt.0..and.zz.le.0.5)) then                  if(.not.(zz.gt.0..and.zz.le.0.5)) then
663                       WRITE(lunout,*)'probleme22 au point ij=',ij                       print *,'probleme22 au point ij=',ij
664       s               ,'  l=',l       s               ,'  l=',l
665                       WRITE(lunout,*)'zz=',zz                       print *,'zz=',zz
666                       stop                       stop
667                  endif                  endif
668                  u_mq(ij,l)=u_mq(ij,l)-masse(ijq,l)*(                  u_mq(ij,l)=u_mq(ij,l)-masse(ijq,l)*(
# Line 766  c Line 748  c
748        do l=1,llm        do l=1,llm
749              do ij=1,ip1jmp1              do ij=1,ip1jmp1
750                 zdq=qn(ij,l)-qs(ij,l)                 zdq=qn(ij,l)-qs(ij,l)
 c              if((qn(ij,l)-q(ij,l))*(q(ij,l)-qs(ij,l)).lt.0.) then  
 c                 print*,'probleme au point ij=',ij,'  l=',l,'  advnqx'  
 c                 print*,qn(ij,l),q(ij,l),qs(ij,l)  
 c                 qn(ij,l)=q(ij,l)  
 c                 qs(ij,l)=q(ij,l)  
 c              endif  
751                 if(abs(zdq).gt.prec) then                 if(abs(zdq).gt.prec) then
752                    zsign(ij)=(q(ij,l)-qs(ij,l))/zdq                    zsign(ij)=(q(ij,l)-qs(ij,l))/zdq
753                    zsigs(ij)=1.-zsign(ij)                    zsigs(ij)=1.-zsign(ij)
 c                 if(.not.(zsign(ij).ge.0..and.zsign(ij).le.1. .and.  
 c    s               zsigs(ij).ge.0..or.zsigs(ij).le.1.) ) then  
 c                    print*,'probleme au point ij=',ij,'  l=',l  
 c                    print*,'sigs=',zsigs(ij),'  sign=',zsign(ij)  
 c                    stop  
 c                 endif  
754                 else                 else
755                    zsign(ij)=0.5                    zsign(ij)=0.5
756                    zsigs(ij)=0.5                    zsigs(ij)=0.5
# Line 893  c Line 863  c
863        do l=1,llm        do l=1,llm
864              do ij=1,ip1jmp1              do ij=1,ip1jmp1
865                 zdq=qb(ij,l)-qh(ij,l)                 zdq=qb(ij,l)-qh(ij,l)
 c              if((qh(ij,l)-q(ij,l))*(q(ij,l)-qb(ij,l)).lt.0.) then  
 c                 print*,'probleme au point ij=',ij,'  l=',l  
 c                 print*,qh(ij,l),q(ij,l),qb(ij,l)  
 c                 qh(ij,l)=q(ij,l)  
 c                 qb(ij,l)=q(ij,l)  
 c              endif  
   
866                 if(abs(zdq).gt.prec) then                 if(abs(zdq).gt.prec) then
867                    zsigb(ij,l)=(q(ij,l)-qh(ij,l))/zdq                    zsigb(ij,l)=(q(ij,l)-qh(ij,l))/zdq
868                    zsigh(ij,l)=1.-zsigb(ij,l)                    zsigh(ij,l)=1.-zsigb(ij,l)
# Line 911  c              endif Line 874  c              endif
874              enddo              enddo
875         enddo         enddo
876    
 c      print*,'ok1'  
877  c   calcul de la pente maximum dans la maille en valeur absolue  c   calcul de la pente maximum dans la maille en valeur absolue
878         do l=2,llm         do l=2,llm
879         do ij=1,ip1jmp1         do ij=1,ip1jmp1
# Line 955  c   calcul de la pente maximum dans la m Line 917  c   calcul de la pente maximum dans la m
917              masse(ij,l)=new_m              masse(ij,l)=new_m
918           enddo           enddo
919        enddo        enddo
920  c     print*,'ok3'  
       RETURN  
921        END        END
Legend:
Removed from v.3  
changed lines
  Added in v.32
  ViewVC Help
Powered by ViewVC 1.1.21