source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/config/ppsrc/dyn3d_common/advzp.f @ 224

Last change on this file since 224 was 224, checked in by ymipsl, 10 years ago
File size: 18.9 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE ADVZP(LIMIT,DTZ,W,SM,S0,SSX,SY,SZ
5     .                 ,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra )
6
7      IMPLICIT NONE
8
9CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10C                                                                 C
11C  second-order moments (SOM) advection of tracer in Z direction  C
12C                                                                 C
13CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
14C                                                                 C
15C  Source : Pascal Simon ( Meteo, CNRM )                          C
16C  Adaptation : A.A. (LGGE)                                       C
17C  Derniere Modif : 19/11/95 LAST                                 C
18C                                                                 C
19C  sont les arguments d'entree pour le s-pg                       C
20C                                                                 C
21C  argument de sortie du s-pg                                     C
22C                                                                 C
23CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
24CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
25C
26C Rem : Probleme aux poles il faut reecrire ce cas specifique
27C        Attention au sens de l'indexation
28C
29
30C
31C  parametres principaux du modele
32C
33!-----------------------------------------------------------------------
34!   INCLUDE 'dimensions.h'
35!
36!   dimensions.h contient les dimensions du modele
37!   ndm est tel que iim=2**ndm
38!-----------------------------------------------------------------------
39
40      INTEGER iim,jjm,llm,ndm
41
42      PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
43
44!-----------------------------------------------------------------------
45!
46! $Header$
47!
48!
49!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
50!                 veillez  n'utiliser que des ! pour les commentaires
51!                 et  bien positionner les & des lignes de continuation
52!                 (les placer en colonne 6 et en colonne 73)
53!
54!
55!-----------------------------------------------------------------------
56!   INCLUDE 'paramet.h'
57
58      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
59      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
60      INTEGER  ijmllm,mvar
61      INTEGER jcfil,jcfllm
62
63      PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3                       &
64     &    ,jjp1=jjm+1-1/jjm)
65      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
66      PARAMETER( kftd  = iim/2 -ndm )
67      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
68      PARAMETER( ip1jmi1= ip1jm - iip1 )
69      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
70      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
71      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
72
73!-----------------------------------------------------------------------
74!
75! $Id: comconst.h 1437 2010-09-30 08:29:10Z emillour $
76!
77!-----------------------------------------------------------------------
78! INCLUDE comconst.h
79
80      COMMON/comconsti/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,          &
81     &                 iflag_top_bound,mode_top_bound
82      COMMON/comconstr/dtvr,daysec,                                     &
83     & pi,dtphys,dtdiss,rad,r,kappa,cotot,unsim,g,omeg                  &
84     & ,dissip_fac_mid,dissip_fac_up,dissip_deltaz,dissip_hdelta        &
85     & ,dissip_pupstart  ,tau_top_bound,                                &
86     & daylen,molmass, ihf
87      COMMON/cpdetvenus/cpp,nu_venus,t0_venus
88
89      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
90      REAL dtvr ! dynamical time step (in s)
91      REAL daysec !length (in s) of a standard day
92      REAL pi    ! something like 3.14159....
93      REAL dtphys ! (s) time step for the physics
94      REAL dtdiss ! (s) time step for the dissipation
95      REAL rad ! (m) radius of the planet
96      REAL r ! Reduced Gas constant r=R/mu
97             ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol)
98      REAL cpp   ! Cp
99      REAL kappa ! kappa=R/Cp
100      REAL cotot
101      REAL unsim ! = 1./iim
102      REAL g ! (m/s2) gravity
103      REAL omeg ! (rad/s) rotation rate of the planet
104! Dissipation factors, for Earth model:
105      REAL dissip_factz,dissip_zref !dissip_deltaz
106! Dissipation factors, for other planets:
107      REAL dissip_fac_mid,dissip_fac_up,dissip_deltaz,dissip_hdelta
108      REAL dissip_pupstart
109      INTEGER iflag_top_bound,mode_top_bound
110      REAL tau_top_bound
111      REAL daylen ! length of solar day, in 'standard' day length
112      REAL molmass ! (g/mol) molar mass of the atmosphere
113
114      REAL nu_venus,t0_venus ! coeffs needed for Cp(T), Venus atmosphere
115      REAL ihf  ! (W/m2) intrinsic heat flux for giant planets
116
117
118!-----------------------------------------------------------------------
119!
120! $Id: comvert.h 1654 2012-09-24 15:07:18Z aslmd $
121!
122!-----------------------------------------------------------------------
123!   INCLUDE 'comvert.h'
124
125      COMMON/comvertr/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),     &
126     &               pa,preff,nivsigs(llm),nivsig(llm+1),               &
127     &               aps(llm),bps(llm),scaleheight,pseudoalt(llm)
128
129      common/comverti/disvert_type, pressure_exner
130
131      real ap     ! hybrid pressure contribution at interlayers
132      real bp     ! hybrid sigma contribution at interlayer
133      real presnivs ! (reference) pressure at mid-layers
134      real dpres
135      real pa     ! reference pressure (Pa) at which hybrid coordinates
136                  ! become purely pressure
137      real preff  ! reference surface pressure (Pa)
138      real nivsigs
139      real nivsig
140      real aps    ! hybrid pressure contribution at mid-layers
141      real bps    ! hybrid sigma contribution at mid-layers
142      real scaleheight ! atmospheric (reference) scale height (km)
143      real pseudoalt ! pseudo-altitude of model levels (km), based on presnivs(),
144                     ! preff and scaleheight
145
146      integer disvert_type ! type of vertical discretization:
147                           ! 1: Earth (default for planet_type==earth),
148                           !     automatic generation
149                           ! 2: Planets (default for planet_type!=earth),
150                           !     using 'z2sig.def' (or 'esasig.def) file
151
152      logical pressure_exner
153!     compute pressure inside layers using Exner function, else use mean
154!     of pressure values at interfaces
155
156 !-----------------------------------------------------------------------
157!
158! $Header$
159!
160!CDK comgeom
161      COMMON/comgeom/                                                   &
162     & cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),             &
163     & aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),                  &
164     & airev(ip1jm),unsaire(ip1jmp1),apoln,apols,                       &
165     & unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),                 &
166     & aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),              &
167     & aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),                &
168     & alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),               &
169     & alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),           &
170     & fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),            &
171     & rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),         &
172     & cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),           &
173     & cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),                           &
174     & cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),         &
175     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,                 &
176     & unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),    &
177     & aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
178
179!
180        REAL                                                            &
181     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,&
182     & apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,&
183     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
184     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
185     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2&
186     & ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,&
187     & aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu&
188     & , xprimv
189!
190C
191C  Arguments :
192C  ----------
193C  dty : frequence fictive d'appel du transport
194C  parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
195c
196        INTEGER lon,lat,niv
197        INTEGER i,j,jv,k,kp,l,lp
198        INTEGER ntra
199c        PARAMETER (ntra = 1)
200c
201        REAL dtz
202        REAL w ( iip1,jjp1,llm )
203c
204C  moments: SM  total mass in each grid box
205C           S0  mass of tracer in each grid box
206C           Si  1rst order moment in i direction
207C
208      REAL SM(iip1,jjp1,llm)
209     +    ,S0(iip1,jjp1,llm,ntra)
210      REAL SSX(iip1,jjp1,llm,ntra)
211     +    ,SY(iip1,jjp1,llm,ntra)
212     +    ,SZ(iip1,jjp1,llm,ntra)
213     +    ,SSXX(iip1,jjp1,llm,ntra)
214     +    ,SSXY(iip1,jjp1,llm,ntra)
215     +    ,SSXZ(iip1,jjp1,llm,ntra)
216     +    ,SYY(iip1,jjp1,llm,ntra)
217     +    ,SYZ(iip1,jjp1,llm,ntra)
218     +    ,SZZ(iip1,jjp1,llm,ntra)
219C
220C  Local :
221C  -------
222C
223C  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
224C  mass fluxes in kg
225C  declaration :
226C
227      REAL WGRI(iip1,jjp1,0:llm)
228
229C Rem : UGRI et VGRI ne sont pas utilises dans
230C  cette subroutine ( advection en z uniquement )
231C  Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
232C         attention a celui de WGRI
233C
234C  the moments F are similarly defined and used as temporary
235C  storage for portions of the grid boxes in transit
236C
237C  the moments Fij are used as temporary storage for
238C  portions of the grid boxes in transit at the current level
239C
240C  work arrays
241C
242C
243      REAL F0(iim,llm,ntra),FM(iim,llm)
244      REAL FX(iim,llm,ntra),FY(iim,llm,ntra)
245      REAL FZ(iim,llm,ntra)
246      REAL FXX(iim,llm,ntra),FXY(iim,llm,ntra)
247      REAL FXZ(iim,llm,ntra),FYY(iim,llm,ntra)
248      REAL FYZ(iim,llm,ntra),FZZ(iim,llm,ntra)
249      REAL S00(ntra)
250      REAL SM0             ! Just temporal variable
251C
252C  work arrays
253C
254      REAL ALF(iim),ALF1(iim)
255      REAL ALFQ(iim),ALF1Q(iim)
256      REAL ALF2(iim),ALF3(iim)
257      REAL ALF4(iim)
258      REAL TEMPTM          ! Just temporal variable
259      REAL SLPMAX,S1MAX,S1NEW,S2NEW
260c
261      REAL sqi,sqf
262      LOGICAL LIMIT
263
264      lon = iim         ! rem : Il est possible qu'un pbl. arrive ici
265      lat = jjp1        ! a cause des dim. differentes entre les
266      niv = llm         !       tab. S et VGRI
267                   
268c-----------------------------------------------------------------
269C *** Test : diag de la qtite totale de traceur dans
270C            l'atmosphere avant l'advection en Y
271c 
272      sqi = 0.
273      sqf = 0.
274c
275      DO l = 1,llm
276         DO j = 1,jjp1
277           DO i = 1,iim
278              sqi = sqi + S0(i,j,l,ntra)
279           END DO
280         END DO
281      END DO
282      PRINT*,'---------- DIAG DANS ADVZP - ENTREE --------'
283      PRINT*,'sqi=',sqi
284
285c-----------------------------------------------------------------
286C  Interface : adaptation nouveau modele
287C  -------------------------------------
288C
289C  Conversion des flux de masses en kg
290
291      DO 500 l = 1,llm
292         DO 500 j = 1,jjp1
293            DO 500 i = 1,iip1 
294            wgri (i,j,llm+1-l) = w (i,j,l) 
295  500 CONTINUE
296      do j=1,jjp1
297         do i=1,iip1
298            wgri(i,j,0)=0.
299         enddo
300      enddo
301c
302cAA rem : Je ne suis pas sur du signe 
303cAA       Je ne suis pas sur pour le 0:llm
304c
305c-----------------------------------------------------------------
306C---------------------- START HERE -------------------------------
307C
308C  boucle sur les latitudes
309C
310      DO 1 K=1,LAT
311C
312C  place limits on appropriate moments before transport
313C      (if flux-limiting is to be applied)
314C
315      IF(.NOT.LIMIT) GO TO 101
316C
317      DO 10 JV=1,NTRA
318      DO 10 L=1,NIV
319         DO 100 I=1,LON
320            IF(S0(I,K,L,JV).GT.0.) THEN
321              SLPMAX=S0(I,K,L,JV)
322              S1MAX =1.5*SLPMAX
323              S1NEW =AMIN1(S1MAX,AMAX1(-S1MAX,SZ(I,K,L,JV)))
324              S2NEW =AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. ,
325     +                     AMAX1(ABS(S1NEW)-SLPMAX,SZZ(I,K,L,JV)) )
326              SZ (I,K,L,JV)=S1NEW
327              SZZ(I,K,L,JV)=S2NEW
328              SSXZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SSXZ(I,K,L,JV)))
329              SYZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SYZ(I,K,L,JV)))
330            ELSE
331              SZ (I,K,L,JV)=0.
332              SZZ(I,K,L,JV)=0.
333              SSXZ(I,K,L,JV)=0.
334              SYZ(I,K,L,JV)=0.
335            ENDIF
336 100     CONTINUE
337 10   CONTINUE
338C
339 101  CONTINUE
340C
341C  boucle sur les niveaux intercouches de 1 a NIV-1
342C   (flux nul au sommet L=0 et a la base L=NIV)
343C
344C  calculate flux and moments between adjacent boxes
345C     (flux from LP to L if WGRI(L).lt.0, from L to LP if WGRI(L).gt.0)
346C  1- create temporary moments/masses for partial boxes in transit
347C  2- reajusts moments remaining in the box
348C
349      DO 11 L=1,NIV-1
350      LP=L+1
351C
352      DO 110 I=1,LON
353C
354         IF(WGRI(I,K,L).LT.0.) THEN
355           FM(I,L)=-WGRI(I,K,L)*DTZ
356           ALF(I)=FM(I,L)/SM(I,K,LP)
357           SM(I,K,LP)=SM(I,K,LP)-FM(I,L)
358         ELSE
359           FM(I,L)=WGRI(I,K,L)*DTZ
360           ALF(I)=FM(I,L)/SM(I,K,L)
361           SM(I,K,L)=SM(I,K,L)-FM(I,L)
362         ENDIF
363C
364         ALFQ (I)=ALF(I)*ALF(I)
365         ALF1 (I)=1.-ALF(I)
366         ALF1Q(I)=ALF1(I)*ALF1(I)
367         ALF2 (I)=ALF1(I)-ALF(I)
368         ALF3 (I)=ALF(I)*ALFQ(I)
369         ALF4 (I)=ALF1(I)*ALF1Q(I)
370C
371 110  CONTINUE
372C
373      DO 111 JV=1,NTRA
374      DO 1110 I=1,LON
375C
376         IF(WGRI(I,K,L).LT.0.) THEN
377C
378           F0 (I,L,JV)=ALF (I)* ( S0(I,K,LP,JV)-ALF1(I)*
379     +          ( SZ(I,K,LP,JV)-ALF2(I)*SZZ(I,K,LP,JV) ) )
380           FZ (I,L,JV)=ALFQ(I)*(SZ(I,K,LP,JV)-3.*ALF1(I)*SZZ(I,K,LP,JV))
381           FZZ(I,L,JV)=ALF3(I)*SZZ(I,K,LP,JV)
382           FXZ(I,L,JV)=ALFQ(I)*SSXZ(I,K,LP,JV)
383           FYZ(I,L,JV)=ALFQ(I)*SYZ(I,K,LP,JV)
384           FX (I,L,JV)=ALF (I)*(SSX(I,K,LP,JV)-ALF1(I)*SSXZ(I,K,LP,JV))
385           FY (I,L,JV)=ALF (I)*(SY(I,K,LP,JV)-ALF1(I)*SYZ(I,K,LP,JV))
386           FXX(I,L,JV)=ALF (I)*SSXX(I,K,LP,JV)
387           FXY(I,L,JV)=ALF (I)*SSXY(I,K,LP,JV)
388           FYY(I,L,JV)=ALF (I)*SYY(I,K,LP,JV)
389C
390           S0 (I,K,LP,JV)=S0 (I,K,LP,JV)-F0 (I,L,JV)
391           SZ (I,K,LP,JV)=ALF1Q(I)
392     +                   *(SZ(I,K,LP,JV)+3.*ALF(I)*SZZ(I,K,LP,JV))
393           SZZ(I,K,LP,JV)=ALF4 (I)*SZZ(I,K,LP,JV)
394           SSXZ(I,K,LP,JV)=ALF1Q(I)*SSXZ(I,K,LP,JV)
395           SYZ(I,K,LP,JV)=ALF1Q(I)*SYZ(I,K,LP,JV)
396           SSX (I,K,LP,JV)=SSX (I,K,LP,JV)-FX (I,L,JV)
397           SY (I,K,LP,JV)=SY (I,K,LP,JV)-FY (I,L,JV)
398           SSXX(I,K,LP,JV)=SSXX(I,K,LP,JV)-FXX(I,L,JV)
399           SSXY(I,K,LP,JV)=SSXY(I,K,LP,JV)-FXY(I,L,JV)
400           SYY(I,K,LP,JV)=SYY(I,K,LP,JV)-FYY(I,L,JV)
401C
402         ELSE
403C
404           F0 (I,L,JV)=ALF (I)*(S0(I,K,L,JV)
405     +           +ALF1(I) * (SZ(I,K,L,JV)+ALF2(I)*SZZ(I,K,L,JV)) )
406           FZ (I,L,JV)=ALFQ(I)*(SZ(I,K,L,JV)+3.*ALF1(I)*SZZ(I,K,L,JV))
407           FZZ(I,L,JV)=ALF3(I)*SZZ(I,K,L,JV)
408           FXZ(I,L,JV)=ALFQ(I)*SSXZ(I,K,L,JV)
409           FYZ(I,L,JV)=ALFQ(I)*SYZ(I,K,L,JV)
410           FX (I,L,JV)=ALF (I)*(SSX(I,K,L,JV)+ALF1(I)*SSXZ(I,K,L,JV))
411           FY (I,L,JV)=ALF (I)*(SY(I,K,L,JV)+ALF1(I)*SYZ(I,K,L,JV))
412           FXX(I,L,JV)=ALF (I)*SSXX(I,K,L,JV)
413           FXY(I,L,JV)=ALF (I)*SSXY(I,K,L,JV)
414           FYY(I,L,JV)=ALF (I)*SYY(I,K,L,JV)
415C
416           S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0(I,L,JV)
417           SZ (I,K,L,JV)=ALF1Q(I)*(SZ(I,K,L,JV)-3.*ALF(I)*SZZ(I,K,L,JV))
418           SZZ(I,K,L,JV)=ALF4 (I)*SZZ(I,K,L,JV)
419           SSXZ(I,K,L,JV)=ALF1Q(I)*SSXZ(I,K,L,JV)
420           SYZ(I,K,L,JV)=ALF1Q(I)*SYZ(I,K,L,JV)
421           SSX (I,K,L,JV)=SSX (I,K,L,JV)-FX (I,L,JV)
422           SY (I,K,L,JV)=SY (I,K,L,JV)-FY (I,L,JV)
423           SSXX(I,K,L,JV)=SSXX(I,K,L,JV)-FXX(I,L,JV)
424           SSXY(I,K,L,JV)=SSXY(I,K,L,JV)-FXY(I,L,JV)
425           SYY(I,K,L,JV)=SYY(I,K,L,JV)-FYY(I,L,JV)
426C
427         ENDIF
428C
429 1110 CONTINUE
430 111  CONTINUE
431C
432 11   CONTINUE
433C
434C  puts the temporary moments Fi into appropriate neighboring boxes
435C
436      DO 12 L=1,NIV-1
437      LP=L+1
438C
439      DO 120 I=1,LON
440C
441         IF(WGRI(I,K,L).LT.0.) THEN
442           SM(I,K,L)=SM(I,K,L)+FM(I,L)
443           ALF(I)=FM(I,L)/SM(I,K,L)
444         ELSE
445           SM(I,K,LP)=SM(I,K,LP)+FM(I,L)
446           ALF(I)=FM(I,L)/SM(I,K,LP)
447         ENDIF
448C
449         ALF1(I)=1.-ALF(I)
450         ALFQ(I)=ALF(I)*ALF(I)
451         ALF1Q(I)=ALF1(I)*ALF1(I)
452         ALF2(I)=ALF(I)*ALF1(I)
453         ALF3(I)=ALF1(I)-ALF(I)
454C
455 120  CONTINUE
456C
457      DO 121 JV=1,NTRA
458      DO 1210 I=1,LON
459C
460         IF(WGRI(I,K,L).LT.0.) THEN
461C
462           TEMPTM=-ALF(I)*S0(I,K,L,JV)+ALF1(I)*F0(I,L,JV)
463           S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,L,JV)
464           SZZ(I,K,L,JV)=ALFQ(I)*FZZ(I,L,JV)+ALF1Q(I)*SZZ(I,K,L,JV)
465     +        +5.*( ALF2(I)*(FZ(I,L,JV)-SZ(I,K,L,JV))+ALF3(I)*TEMPTM )
466           SZ (I,K,L,JV)=ALF (I)*FZ (I,L,JV)+ALF1 (I)*SZ (I,K,L,JV)
467     +                  +3.*TEMPTM
468           SSXZ(I,K,L,JV)=ALF (I)*FXZ(I,L,JV)+ALF1 (I)*SSXZ(I,K,L,JV)
469     +              +3.*(ALF1(I)*FX (I,L,JV)-ALF  (I)*SSX (I,K,L,JV))
470           SYZ(I,K,L,JV)=ALF (I)*FYZ(I,L,JV)+ALF1 (I)*SYZ(I,K,L,JV)
471     +              +3.*(ALF1(I)*FY (I,L,JV)-ALF  (I)*SY (I,K,L,JV))
472           SSX (I,K,L,JV)=SSX (I,K,L,JV)+FX (I,L,JV)
473           SY (I,K,L,JV)=SY (I,K,L,JV)+FY (I,L,JV)
474           SSXX(I,K,L,JV)=SSXX(I,K,L,JV)+FXX(I,L,JV)
475           SSXY(I,K,L,JV)=SSXY(I,K,L,JV)+FXY(I,L,JV)
476           SYY(I,K,L,JV)=SYY(I,K,L,JV)+FYY(I,L,JV)
477C
478         ELSE
479C
480           TEMPTM=ALF(I)*S0(I,K,LP,JV)-ALF1(I)*F0(I,L,JV)
481           S0 (I,K,LP,JV)=S0(I,K,LP,JV)+F0(I,L,JV)
482           SZZ(I,K,LP,JV)=ALFQ(I)*FZZ(I,L,JV)+ALF1Q(I)*SZZ(I,K,LP,JV)
483     +        +5.*( ALF2(I)*(SZ(I,K,LP,JV)-FZ(I,L,JV))-ALF3(I)*TEMPTM )
484           SZ (I,K,LP,JV)=ALF (I)*FZ(I,L,JV)+ALF1(I)*SZ(I,K,LP,JV)
485     +                   +3.*TEMPTM
486           SSXZ(I,K,LP,JV)=ALF(I)*FXZ(I,L,JV)+ALF1(I)*SSXZ(I,K,LP,JV)
487     +                   +3.*(ALF(I)*SSX(I,K,LP,JV)-ALF1(I)*FX(I,L,JV))
488           SYZ(I,K,LP,JV)=ALF(I)*FYZ(I,L,JV)+ALF1(I)*SYZ(I,K,LP,JV)
489     +                   +3.*(ALF(I)*SY(I,K,LP,JV)-ALF1(I)*FY(I,L,JV))
490           SSX (I,K,LP,JV)=SSX (I,K,LP,JV)+FX (I,L,JV)
491           SY (I,K,LP,JV)=SY (I,K,LP,JV)+FY (I,L,JV)
492           SSXX(I,K,LP,JV)=SSXX(I,K,LP,JV)+FXX(I,L,JV)
493           SSXY(I,K,LP,JV)=SSXY(I,K,LP,JV)+FXY(I,L,JV)
494           SYY(I,K,LP,JV)=SYY(I,K,LP,JV)+FYY(I,L,JV)
495C
496         ENDIF
497C
498 1210 CONTINUE
499 121  CONTINUE
500C
501 12   CONTINUE
502C
503C  fin de la boucle principale sur les latitudes
504C
505 1    CONTINUE
506C
507      DO l = 1,llm
508      DO j = 1,jjp1
509          SM(iip1,j,l) = SM(1,j,l)
510          S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
511          SSX(iip1,j,l,ntra) = SSX(1,j,l,ntra)
512          SY(iip1,j,l,ntra) = SY(1,j,l,ntra)
513          SZ(iip1,j,l,ntra) = SZ(1,j,l,ntra)
514      ENDDO
515      ENDDO
516c                                                                               C-------------------------------------------------------------
517C *** Test : diag de la qqtite totale de tarceur
518C            dans l'atmosphere avant l'advection en z
519       DO l = 1,llm
520       DO j = 1,jjp1
521       DO i = 1,iim
522          sqf = sqf + S0(i,j,l,ntra)
523       ENDDO
524       ENDDO
525       ENDDO
526       PRINT*,'-------- DIAG DANS ADVZ - SORTIE ---------'
527       PRINT*,'sqf=', sqf
528
529      RETURN
530      END
Note: See TracBrowser for help on using the repository browser.