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

Diff of /trunk/dyn3d/pentes_ini.f

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

revision 31 by guez, Thu Apr 1 14:59:19 2010 UTC revision 39 by guez, Tue Jan 25 15:11:05 2011 UTC
# Line 7  Line 7 
7        use comconst        use comconst
8        use comvert        use comvert
9        use comgeom        use comgeom
10          USE nr_util, ONLY : pi
11        IMPLICIT NONE        IMPLICIT NONE
12    
13  c=======================================================================  c=======================================================================
# Line 109  c     if (mode.eq.1) then Line 110  c     if (mode.eq.1) then
110          ENDDO          ENDDO
111                    
112        endif        endif
 c   Fin modif Fred  
113    
114  c *** q contient les qqtes de traceur avant l'advection  c *** q contient les qqtes de traceur avant l'advection
115    
# Line 127  c *** Rem : utilisation de SCOPY ulterie Line 127  c *** Rem : utilisation de SCOPY ulterie
127          ENDDO          ENDDO
128         ENDDO         ENDDO
129    
 c      PRINT*,'----- S0 just before conversion -------'  
 c      PRINT*,'S0(16,12,1)=',s0(16,12,1)  
 c      PRINT*,'Q(16,12,1,4)=',q(16,12,1,4)  
   
130  c *** On calcule la masse d'air en kg  c *** On calcule la masse d'air en kg
131    
132         DO  l = 1,llm         DO  l = 1,llm
# Line 157  c *** A optimiser !!! Line 153  c *** A optimiser !!!
153           ENDDO           ENDDO
154         ENDDO         ENDDO
155    
 c       ss0 = 0.  
 c       DO l = 1,llm  
 c        DO j = 1,jjp1  
 c         DO i = 1,iim  
 c            ss0 = ss0 + s0 ( i,j,l )  
 c         ENDDO  
 c        ENDDO  
 c       ENDDO  
 c       PRINT*, 'valeur tot s0 avant advection=',ss0  
   
156  c *** Appel des subroutines d'advection en X, en Y et en Z  c *** Appel des subroutines d'advection en X, en Y et en Z
157  c *** Advection avec "time-splitting"  c *** Advection avec "time-splitting"
158                
 c-----------------------------------------------------------  
 c      PRINT*,'----- S0 just before ADVX -------'  
 c      PRINT*,'S0(16,12,1)=',s0(16,12,1)  
   
 c-----------------------------------------------------------  
 c      do l=1,llm  
 c         do j=1,jjp1  
 c          do i=1,iip1  
 c             zq=s0(i,j,l)/sm(i,j,l)  
 c            if(zq.lt.qmin)  
 c    ,       print*,'avant advx1, s0(',i,',',j,',',l,')=',zq  
 c          enddo  
 c         enddo  
 c      enddo  
 CCC  
159         if(mode.eq.2) then         if(mode.eq.2) then
160            do l=1,llm            do l=1,llm
161              s0s=0.              s0s=0.
# Line 256  c   on rerentre les masses Line 227  c   on rerentre les masses
227           enddo           enddo
228        endif        endif
229        call limx(s0,sx,sm,pente_max)        call limx(s0,sx,sm,pente_max)
 c     call minmaxq(zq,1.e33,-1.e33,'avant advx     ')  
230         call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)         call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
 c     call minmaxq(zq,1.e33,-1.e33,'avant advy     ')  
231        if (mode.eq.4) then        if (mode.eq.4) then
232           do l=1,llm           do l=1,llm
233              do i=1,iip1              do i=1,iip1
# Line 271  c     call minmaxq(zq,1.e33,-1.e33,'avan Line 240  c     call minmaxq(zq,1.e33,-1.e33,'avan
240        endif        endif
241         call   limy(s0,sy,sm,pente_max)         call   limy(s0,sy,sm,pente_max)
242         call advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )         call advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )
 c     call minmaxq(zq,1.e33,-1.e33,'avant advz     ')  
243         do j=1,jjp1         do j=1,jjp1
244            do i=1,iip1            do i=1,iip1
245               sz(i,j,1)=0.               sz(i,j,1)=0.
# Line 303  c     call minmaxq(zq,1.e33,-1.e33,'avan Line 271  c     call minmaxq(zq,1.e33,-1.e33,'avan
271         enddo         enddo
272    
273    
 c     call minmaxq(zq,1.e33,-1.e33,'avant advx     ')  
274        if (mode.eq.4) then        if (mode.eq.4) then
275           do l=1,llm           do l=1,llm
276              do i=1,iip1              do i=1,iip1
# Line 316  c     call minmaxq(zq,1.e33,-1.e33,'avan Line 283  c     call minmaxq(zq,1.e33,-1.e33,'avan
283        endif        endif
284         call limx(s0,sx,sm,pente_max)         call limx(s0,sx,sm,pente_max)
285         call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)         call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
 c     call minmaxq(zq,1.e33,-1.e33,'apres advx     ')  
 c      do l=1,llm  
 c         do j=1,jjp1  
 c          do i=1,iip1  
 c             zq=s0(i,j,l)/sm(i,j,l)  
 c            if(zq.lt.qmin)  
 c    ,       print*,'apres advx2, s0(',i,',',j,',',l,')=',zq  
 c          enddo  
 c         enddo  
 c      enddo  
286  c ***   On repasse les S dans la variable q directement 14/10/94  c ***   On repasse les S dans la variable q directement 14/10/94
287  c   On revient a des rapports de melange en divisant par la masse  c   On revient a des rapports de melange en divisant par la masse
288    
# Line 433  c bouclage en longitude Line 390  c bouclage en longitude
390           enddo           enddo
391        enddo        enddo
392    
 c       PRINT*, ' SORTIE DE PENTES ---  ca peut glisser ....'  
   
393          DO l = 1,llm          DO l = 1,llm
394           DO j = 1,jjp1           DO j = 1,jjp1
395            DO i = 1,iip1            DO i = 1,iip1
396                  IF (q(i,j,l,0).lt.0.)  THEN                  IF (q(i,j,l,0).lt.0.)  THEN
 c                    PRINT*,'------------ BIP-----------'  
 c                    PRINT*,'Q0(',i,j,l,')=',q(i,j,l,0)  
 c                    PRINT*,'QX(',i,j,l,')=',q(i,j,l,1)  
 c                    PRINT*,'QY(',i,j,l,')=',q(i,j,l,2)  
 c                    PRINT*,'QZ(',i,j,l,')=',q(i,j,l,3)  
 c                            PRINT*,' PBL EN SORTIE DE PENTES'  
397                       q(i,j,l,0)=0.                       q(i,j,l,0)=0.
 c                    STOP  
398                   ENDIF                   ENDIF
399            ENDDO            ENDDO
400           ENDDO           ENDDO
401          ENDDO          ENDDO
402    
 c       PRINT*, '-------------------------------------------'  
           
403         do l=1,llm         do l=1,llm
404            do j=1,jjp1            do j=1,jjp1
405             do i=1,iip1             do i=1,iip1
# Line 464  c       PRINT*, '----------------------- Line 410  c       PRINT*, '-----------------------
410         enddo         enddo
411        RETURN        RETURN
412        END        END
   
   
   
   
   
   
   
   
   
   
   
   
Legend:
Removed from v.31  
changed lines
  Added in v.39
  ViewVC Help
Powered by ViewVC 1.1.21