source: LMDZ6/trunk/libf/dyn3d_common/advxp.F @ 3830

Last change on this file since 3830 was 2600, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn comvert.h into module comvert_mod.F90
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 18.1 KB
Line 
1!
2! $Header$
3!
4       SUBROUTINE ADVXP(LIMIT,DTX,PBARU,SM,S0,SSX,SY,SZ
5     .                ,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra)
6       IMPLICIT NONE
7CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8C                                                                 C
9C  second-order moments (SOM) advection of tracer in X direction  C
10C                                                                 C
11CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
12C
13C  parametres principaux du modele
14C
15      include "dimensions.h"
16      include "paramet.h"
17
18       INTEGER ntra
19c      PARAMETER (ntra = 1)
20C
21C  definition de la grille du modele
22C
23      REAL dtx
24      REAL pbaru ( iip1,jjp1,llm )
25C
26C  moments: SM  total mass in each grid box
27C           S0  mass of tracer in each grid box
28C           Si  1rst order moment in i direction
29C           Sij 2nd  order moment in i and j directions
30C
31      REAL SM(iip1,jjp1,llm)
32     +    ,S0(iip1,jjp1,llm,ntra)
33      REAL SSX(iip1,jjp1,llm,ntra)
34     +    ,SY(iip1,jjp1,llm,ntra)
35     +    ,SZ(iip1,jjp1,llm,ntra)
36      REAL SSXX(iip1,jjp1,llm,ntra)
37     +    ,SSXY(iip1,jjp1,llm,ntra)
38     +    ,SSXZ(iip1,jjp1,llm,ntra)
39     +    ,SYY(iip1,jjp1,llm,ntra)
40     +    ,SYZ(iip1,jjp1,llm,ntra)
41     +    ,SZZ(iip1,jjp1,llm,ntra)
42
43C  Local :
44C  -------
45
46C  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
47C  mass fluxes in kg
48C  declaration :
49
50       REAL UGRI(iip1,jjp1,llm)
51
52C  Rem : VGRI et WGRI ne sont pas utilises dans
53C  cette subroutine ( advection en x uniquement )
54C
55C
56C  Tij are the moments for the current latitude and level
57C
58      REAL TM (iim)
59      REAL T0 (iim,NTRA),TX (iim,NTRA)
60      REAL TY (iim,NTRA),TZ (iim,NTRA)
61      REAL TXX(iim,NTRA),TXY(iim,NTRA)
62      REAL TXZ(iim,NTRA),TYY(iim,NTRA)
63      REAL TYZ(iim,NTRA),TZZ(iim,NTRA)
64C
65C  the moments F are similarly defined and used as temporary
66C  storage for portions of the grid boxes in transit
67C
68      REAL FM (iim)
69      REAL F0 (iim,NTRA),FX (iim,NTRA)
70      REAL FY (iim,NTRA),FZ (iim,NTRA)
71      REAL FXX(iim,NTRA),FXY(iim,NTRA)
72      REAL FXZ(iim,NTRA),FYY(iim,NTRA)
73      REAL FYZ(iim,NTRA),FZZ(iim,NTRA)
74C
75C  work arrays
76C
77      REAL ALF (iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
78      REAL ALF2(iim),ALF3(iim),ALF4(iim)
79C
80      REAL SMNEW(iim),UEXT(iim)
81      REAL sqi,sqf
82      REAL TEMPTM
83      REAL SLPMAX
84      REAL S1MAX,S1NEW,S2NEW
85
86      LOGICAL LIMIT
87      INTEGER NUM(jjp1),LONK,NUMK
88      INTEGER lon,lati,latf,niv
89      INTEGER i,i2,i3,j,jv,l,k,iter
90
91      lon = iim
92      lati=2
93      latf = jjm
94      niv = llm
95
96C *** Test de passage d'arguments ******
97
98c      DO 399 l = 1, llm
99c       DO 399 j = 1, jjp1
100c        DO 399 i = 1, iip1
101c         IF (S0(i,j,l,ntra) .lt. 0. ) THEN
102c         PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
103c             print*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
104c         print*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
105c         print*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
106c         PRINT*, 'AIE !! debut ADVXP - pbl arg. passage dans ADVXP'
107cc            STOP
108c         ENDIF
109c  399 CONTINUE
110
111C *** Test : diagnostique de la qtite totale de traceur
112C            dans l'atmosphere avant l'advection
113c
114      sqi =0.
115      sqf =0.
116c
117      DO l = 1, llm
118      DO j = 1, jjp1
119      DO i = 1, iim
120         sqi = sqi + S0(i,j,l,ntra)
121      END DO
122      END DO
123      END DO
124      PRINT*,'------ DIAG DANS ADVX2 - ENTREE -----'
125      PRINT*,'sqi=',sqi
126c test
127c  -------------------------------------
128        DO 300 j =1,jjp1
129         NUM(j) =1
130 300  CONTINUE
131c       DO l=1,llm
132c      NUM(2,l)=6
133c      NUM(3,l)=6
134c      NUM(jjm-1,l)=6 
135c      NUM(jjm,l)=6
136c      ENDDO
137c        DO j=2,6
138c       NUM(j)=12
139c       ENDDO
140c       DO j=jjm-5,jjm-1
141c       NUM(j)=12
142c       ENDDO
143
144C  Interface : adaptation nouveau modele
145C  -------------------------------------
146C
147C  ---------------------------------------------------------
148C  Conversion des flux de masses en kg/s
149C  pbaru est en N/s d'ou :
150C  ugri est en kg/s
151
152       DO 500 l = 1,llm
153       DO 500 j = 1,jjp1
154       DO 500 i = 1,iip1
155       ugri (i,j,llm+1-l) =pbaru (i,j,l)
156 500   CONTINUE
157
158C  ---------------------------------------------------------
159C  start here
160C
161C  boucle principale sur les niveaux et les latitudes
162C     
163      DO 1 L=1,NIV
164      DO 1 K=lati,latf
165
166C
167C  initialisation
168C
169C  program assumes periodic boundaries in X
170C
171      DO 10 I=2,LON
172         SMNEW(I)=SM(I,K,L)+(UGRI(I-1,K,L)-UGRI(I,K,L))*DTX
173 10   CONTINUE
174      SMNEW(1)=SM(1,K,L)+(UGRI(LON,K,L)-UGRI(1,K,L))*DTX
175C
176C  modifications for extended polar zones
177C
178      NUMK=NUM(K)
179      LONK=LON/NUMK
180C
181      IF(NUMK.GT.1) THEN
182C
183      DO 111 I=1,LON
184         TM(I)=0.
185 111  CONTINUE
186      DO 112 JV=1,NTRA
187      DO 1120 I=1,LON
188         T0 (I,JV)=0.
189         TX (I,JV)=0.
190         TY (I,JV)=0.
191         TZ (I,JV)=0.
192         TXX(I,JV)=0.
193         TXY(I,JV)=0.
194         TXZ(I,JV)=0.
195         TYY(I,JV)=0.
196         TYZ(I,JV)=0.
197         TZZ(I,JV)=0.
198 1120 CONTINUE
199 112  CONTINUE
200C
201      DO 11 I2=1,NUMK
202C
203         DO 113 I=1,LONK
204            I3=(I-1)*NUMK+I2
205            TM(I)=TM(I)+SM(I3,K,L)
206            ALF(I)=SM(I3,K,L)/TM(I)
207            ALF1(I)=1.-ALF(I)
208            ALFQ(I)=ALF(I)*ALF(I)
209            ALF1Q(I)=ALF1(I)*ALF1(I)
210            ALF2(I)=ALF1(I)-ALF(I)
211            ALF3(I)=ALF(I)*ALF1(I)
212 113     CONTINUE
213C
214         DO 114 JV=1,NTRA
215         DO 1140 I=1,LONK
216            I3=(I-1)*NUMK+I2
217            TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*S0(I3,K,L,JV)
218            T0 (I,JV)=T0(I,JV)+S0(I3,K,L,JV)
219            TXX(I,JV)=ALFQ(I)*SSXX(I3,K,L,JV)+ALF1Q(I)*TXX(I,JV)
220     +        +5.*( ALF3(I)*(SSX(I3,K,L,JV)-TX(I,JV))+ALF2(I)*TEMPTM )
221            TX (I,JV)=ALF(I)*SSX(I3,K,L,JV)+ALF1(I)*TX(I,JV)+3.*TEMPTM
222            TXY(I,JV)=ALF (I)*SSXY(I3,K,L,JV)+ALF1(I)*TXY(I,JV)
223     +           +3.*(ALF1(I)*SY (I3,K,L,JV)-ALF (I)*TY (I,JV))
224            TXZ(I,JV)=ALF (I)*SSXZ(I3,K,L,JV)+ALF1(I)*TXZ(I,JV)
225     +           +3.*(ALF1(I)*SZ (I3,K,L,JV)-ALF (I)*TZ (I,JV))
226            TY (I,JV)=TY (I,JV)+SY (I3,K,L,JV)
227            TZ (I,JV)=TZ (I,JV)+SZ (I3,K,L,JV)
228            TYY(I,JV)=TYY(I,JV)+SYY(I3,K,L,JV)
229            TYZ(I,JV)=TYZ(I,JV)+SYZ(I3,K,L,JV)
230            TZZ(I,JV)=TZZ(I,JV)+SZZ(I3,K,L,JV)
231 1140    CONTINUE
232 114     CONTINUE
233C
234 11   CONTINUE
235C
236      ELSE
237C
238      DO 115 I=1,LON
239         TM(I)=SM(I,K,L)
240 115  CONTINUE
241      DO 116 JV=1,NTRA
242      DO 1160 I=1,LON
243         T0 (I,JV)=S0 (I,K,L,JV)
244         TX (I,JV)=SSX (I,K,L,JV)
245         TY (I,JV)=SY (I,K,L,JV)
246         TZ (I,JV)=SZ (I,K,L,JV)
247         TXX(I,JV)=SSXX(I,K,L,JV)
248         TXY(I,JV)=SSXY(I,K,L,JV)
249         TXZ(I,JV)=SSXZ(I,K,L,JV)
250         TYY(I,JV)=SYY(I,K,L,JV)
251         TYZ(I,JV)=SYZ(I,K,L,JV)
252         TZZ(I,JV)=SZZ(I,K,L,JV)
253 1160 CONTINUE
254 116  CONTINUE
255C
256      ENDIF
257C
258      DO 117 I=1,LONK
259         UEXT(I)=UGRI(I*NUMK,K,L)
260 117  CONTINUE
261C
262C  place limits on appropriate moments before transport
263C      (if flux-limiting is to be applied)
264C
265      IF(.NOT.LIMIT) GO TO 13
266C
267      DO 12 JV=1,NTRA
268      DO 120 I=1,LONK
269        IF(T0(I,JV).GT.0.) THEN
270          SLPMAX=T0(I,JV)
271          S1MAX=1.5*SLPMAX
272          S1NEW=AMIN1(S1MAX,AMAX1(-S1MAX,TX(I,JV)))
273          S2NEW=AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. ,
274     +                 AMAX1(ABS(S1NEW)-SLPMAX,TXX(I,JV)) )
275          TX (I,JV)=S1NEW
276          TXX(I,JV)=S2NEW
277          TXY(I,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,TXY(I,JV)))
278          TXZ(I,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,TXZ(I,JV)))
279        ELSE
280          TX (I,JV)=0.
281          TXX(I,JV)=0.
282          TXY(I,JV)=0.
283          TXZ(I,JV)=0.
284        ENDIF
285 120  CONTINUE
286 12   CONTINUE
287C
288 13   CONTINUE
289C
290C  calculate flux and moments between adjacent boxes
291C  1- create temporary moments/masses for partial boxes in transit
292C  2- reajusts moments remaining in the box
293C
294C  flux from IP to I if U(I).lt.0
295C
296      DO 140 I=1,LONK-1
297         IF(UEXT(I).LT.0.) THEN
298           FM(I)=-UEXT(I)*DTX
299           ALF(I)=FM(I)/TM(I+1)
300           TM(I+1)=TM(I+1)-FM(I)
301         ENDIF
302 140  CONTINUE
303C
304      I=LONK
305      IF(UEXT(I).LT.0.) THEN
306        FM(I)=-UEXT(I)*DTX
307        ALF(I)=FM(I)/TM(1)
308        TM(1)=TM(1)-FM(I)
309      ENDIF
310C
311C  flux from I to IP if U(I).gt.0
312C
313      DO 141 I=1,LONK
314         IF(UEXT(I).GE.0.) THEN
315           FM(I)=UEXT(I)*DTX
316           ALF(I)=FM(I)/TM(I)
317           TM(I)=TM(I)-FM(I)
318         ENDIF
319 141  CONTINUE
320C
321      DO 142 I=1,LONK
322         ALFQ(I)=ALF(I)*ALF(I)
323         ALF1(I)=1.-ALF(I)
324         ALF1Q(I)=ALF1(I)*ALF1(I)
325         ALF2(I)=ALF1(I)-ALF(I)
326         ALF3(I)=ALF(I)*ALFQ(I)
327         ALF4(I)=ALF1(I)*ALF1Q(I)
328 142  CONTINUE
329C
330      DO 150 JV=1,NTRA
331      DO 1500 I=1,LONK-1
332C
333         IF(UEXT(I).LT.0.) THEN
334C
335           F0 (I,JV)=ALF (I)* ( T0(I+1,JV)-ALF1(I)*
336     +             ( TX(I+1,JV)-ALF2(I)*TXX(I+1,JV) ) )
337           FX (I,JV)=ALFQ(I)*(TX(I+1,JV)-3.*ALF1(I)*TXX(I+1,JV))
338           FXX(I,JV)=ALF3(I)*TXX(I+1,JV)
339           FY (I,JV)=ALF (I)*(TY(I+1,JV)-ALF1(I)*TXY(I+1,JV))
340           FZ (I,JV)=ALF (I)*(TZ(I+1,JV)-ALF1(I)*TXZ(I+1,JV))
341           FXY(I,JV)=ALFQ(I)*TXY(I+1,JV)
342           FXZ(I,JV)=ALFQ(I)*TXZ(I+1,JV)
343           FYY(I,JV)=ALF (I)*TYY(I+1,JV)
344           FYZ(I,JV)=ALF (I)*TYZ(I+1,JV)
345           FZZ(I,JV)=ALF (I)*TZZ(I+1,JV)
346C
347           T0 (I+1,JV)=T0(I+1,JV)-F0(I,JV)
348           TX (I+1,JV)=ALF1Q(I)*(TX(I+1,JV)+3.*ALF(I)*TXX(I+1,JV))
349           TXX(I+1,JV)=ALF4(I)*TXX(I+1,JV)
350           TY (I+1,JV)=TY (I+1,JV)-FY (I,JV)
351           TZ (I+1,JV)=TZ (I+1,JV)-FZ (I,JV)
352           TYY(I+1,JV)=TYY(I+1,JV)-FYY(I,JV)
353           TYZ(I+1,JV)=TYZ(I+1,JV)-FYZ(I,JV)
354           TZZ(I+1,JV)=TZZ(I+1,JV)-FZZ(I,JV)
355           TXY(I+1,JV)=ALF1Q(I)*TXY(I+1,JV)
356           TXZ(I+1,JV)=ALF1Q(I)*TXZ(I+1,JV)
357C
358         ENDIF
359C
360 1500 CONTINUE
361 150  CONTINUE
362C
363      I=LONK
364      IF(UEXT(I).LT.0.) THEN
365C
366        DO 151 JV=1,NTRA
367C
368           F0 (I,JV)=ALF (I)* ( T0(1,JV)-ALF1(I)*
369     +             ( TX(1,JV)-ALF2(I)*TXX(1,JV) ) )
370           FX (I,JV)=ALFQ(I)*(TX(1,JV)-3.*ALF1(I)*TXX(1,JV))
371           FXX(I,JV)=ALF3(I)*TXX(1,JV)
372           FY (I,JV)=ALF (I)*(TY(1,JV)-ALF1(I)*TXY(1,JV))
373           FZ (I,JV)=ALF (I)*(TZ(1,JV)-ALF1(I)*TXZ(1,JV))
374           FXY(I,JV)=ALFQ(I)*TXY(1,JV)
375           FXZ(I,JV)=ALFQ(I)*TXZ(1,JV)
376           FYY(I,JV)=ALF (I)*TYY(1,JV)
377           FYZ(I,JV)=ALF (I)*TYZ(1,JV)
378           FZZ(I,JV)=ALF (I)*TZZ(1,JV)
379C
380           T0 (1,JV)=T0(1,JV)-F0(I,JV)
381           TX (1,JV)=ALF1Q(I)*(TX(1,JV)+3.*ALF(I)*TXX(1,JV))
382           TXX(1,JV)=ALF4(I)*TXX(1,JV)
383           TY (1,JV)=TY (1,JV)-FY (I,JV)
384           TZ (1,JV)=TZ (1,JV)-FZ (I,JV)
385           TYY(1,JV)=TYY(1,JV)-FYY(I,JV)
386           TYZ(1,JV)=TYZ(1,JV)-FYZ(I,JV)
387           TZZ(1,JV)=TZZ(1,JV)-FZZ(I,JV)
388           TXY(1,JV)=ALF1Q(I)*TXY(1,JV)
389           TXZ(1,JV)=ALF1Q(I)*TXZ(1,JV)
390C
391 151    CONTINUE
392C
393      ENDIF
394C
395      DO 152 JV=1,NTRA
396      DO 1520 I=1,LONK
397C
398         IF(UEXT(I).GE.0.) THEN
399C
400           F0 (I,JV)=ALF (I)* ( T0(I,JV)+ALF1(I)*
401     +             ( TX(I,JV)+ALF2(I)*TXX(I,JV) ) )
402           FX (I,JV)=ALFQ(I)*(TX(I,JV)+3.*ALF1(I)*TXX(I,JV))
403           FXX(I,JV)=ALF3(I)*TXX(I,JV)
404           FY (I,JV)=ALF (I)*(TY(I,JV)+ALF1(I)*TXY(I,JV))
405           FZ (I,JV)=ALF (I)*(TZ(I,JV)+ALF1(I)*TXZ(I,JV))
406           FXY(I,JV)=ALFQ(I)*TXY(I,JV)
407           FXZ(I,JV)=ALFQ(I)*TXZ(I,JV)
408           FYY(I,JV)=ALF (I)*TYY(I,JV)
409           FYZ(I,JV)=ALF (I)*TYZ(I,JV)
410           FZZ(I,JV)=ALF (I)*TZZ(I,JV)
411C
412           T0 (I,JV)=T0(I,JV)-F0(I,JV)
413           TX (I,JV)=ALF1Q(I)*(TX(I,JV)-3.*ALF(I)*TXX(I,JV))
414           TXX(I,JV)=ALF4(I)*TXX(I,JV)
415           TY (I,JV)=TY (I,JV)-FY (I,JV)
416           TZ (I,JV)=TZ (I,JV)-FZ (I,JV)
417           TYY(I,JV)=TYY(I,JV)-FYY(I,JV)
418           TYZ(I,JV)=TYZ(I,JV)-FYZ(I,JV)
419           TZZ(I,JV)=TZZ(I,JV)-FZZ(I,JV)
420           TXY(I,JV)=ALF1Q(I)*TXY(I,JV)
421           TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
422C
423         ENDIF
424C
425 1520 CONTINUE
426 152  CONTINUE
427C
428C  puts the temporary moments Fi into appropriate neighboring boxes
429C
430      DO 160 I=1,LONK
431         IF(UEXT(I).LT.0.) THEN
432           TM(I)=TM(I)+FM(I)
433           ALF(I)=FM(I)/TM(I)
434         ENDIF
435 160  CONTINUE
436C
437      DO 161 I=1,LONK-1
438         IF(UEXT(I).GE.0.) THEN
439           TM(I+1)=TM(I+1)+FM(I)
440           ALF(I)=FM(I)/TM(I+1)
441         ENDIF
442 161  CONTINUE
443C
444      I=LONK
445      IF(UEXT(I).GE.0.) THEN
446        TM(1)=TM(1)+FM(I)
447        ALF(I)=FM(I)/TM(1)
448      ENDIF
449C
450      DO 162 I=1,LONK
451         ALF1(I)=1.-ALF(I)
452         ALFQ(I)=ALF(I)*ALF(I)
453         ALF1Q(I)=ALF1(I)*ALF1(I)
454         ALF2(I)=ALF1(I)-ALF(I)
455         ALF3(I)=ALF(I)*ALF1(I)
456 162  CONTINUE
457C
458      DO 170 JV=1,NTRA
459      DO 1700 I=1,LONK
460C
461         IF(UEXT(I).LT.0.) THEN
462C
463           TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*F0(I,JV)
464           T0 (I,JV)=T0(I,JV)+F0(I,JV)
465           TXX(I,JV)=ALFQ(I)*FXX(I,JV)+ALF1Q(I)*TXX(I,JV)
466     +          +5.*( ALF3(I)*(FX(I,JV)-TX(I,JV))+ALF2(I)*TEMPTM )
467           TX (I,JV)=ALF (I)*FX (I,JV)+ALF1(I)*TX (I,JV)+3.*TEMPTM
468           TXY(I,JV)=ALF (I)*FXY(I,JV)+ALF1(I)*TXY(I,JV)
469     +          +3.*(ALF1(I)*FY (I,JV)-ALF (I)*TY (I,JV))
470           TXZ(I,JV)=ALF (I)*FXZ(I,JV)+ALF1(I)*TXZ(I,JV)
471     +          +3.*(ALF1(I)*FZ (I,JV)-ALF (I)*TZ (I,JV))
472           TY (I,JV)=TY (I,JV)+FY (I,JV)
473           TZ (I,JV)=TZ (I,JV)+FZ (I,JV)
474           TYY(I,JV)=TYY(I,JV)+FYY(I,JV)
475           TYZ(I,JV)=TYZ(I,JV)+FYZ(I,JV)
476           TZZ(I,JV)=TZZ(I,JV)+FZZ(I,JV)
477C
478         ENDIF
479C
480 1700 CONTINUE
481 170  CONTINUE
482C
483      DO 171 JV=1,NTRA
484      DO 1710 I=1,LONK-1
485C
486         IF(UEXT(I).GE.0.) THEN
487C
488           TEMPTM=ALF(I)*T0(I+1,JV)-ALF1(I)*F0(I,JV)
489           T0 (I+1,JV)=T0(I+1,JV)+F0(I,JV)
490           TXX(I+1,JV)=ALFQ(I)*FXX(I,JV)+ALF1Q(I)*TXX(I+1,JV)
491     +           +5.*( ALF3(I)*(TX(I+1,JV)-FX(I,JV))-ALF2(I)*TEMPTM )
492           TX (I+1,JV)=ALF(I)*FX (I  ,JV)+ALF1(I)*TX (I+1,JV)+3.*TEMPTM
493           TXY(I+1,JV)=ALF(I)*FXY(I  ,JV)+ALF1(I)*TXY(I+1,JV)
494     +            +3.*(ALF(I)*TY (I+1,JV)-ALF1(I)*FY (I  ,JV))
495           TXZ(I+1,JV)=ALF(I)*FXZ(I  ,JV)+ALF1(I)*TXZ(I+1,JV)
496     +            +3.*(ALF(I)*TZ (I+1,JV)-ALF1(I)*FZ (I  ,JV))
497           TY (I+1,JV)=TY (I+1,JV)+FY (I,JV)
498           TZ (I+1,JV)=TZ (I+1,JV)+FZ (I,JV)
499           TYY(I+1,JV)=TYY(I+1,JV)+FYY(I,JV)
500           TYZ(I+1,JV)=TYZ(I+1,JV)+FYZ(I,JV)
501           TZZ(I+1,JV)=TZZ(I+1,JV)+FZZ(I,JV)
502C
503         ENDIF
504C
505 1710 CONTINUE
506 171  CONTINUE
507C
508      I=LONK
509      IF(UEXT(I).GE.0.) THEN
510        DO 172 JV=1,NTRA
511           TEMPTM=ALF(I)*T0(1,JV)-ALF1(I)*F0(I,JV)
512           T0 (1,JV)=T0(1,JV)+F0(I,JV)
513           TXX(1,JV)=ALFQ(I)*FXX(I,JV)+ALF1Q(I)*TXX(1,JV)
514     +         +5.*( ALF3(I)*(TX(1,JV)-FX(I,JV))-ALF2(I)*TEMPTM )
515           TX (1,JV)=ALF(I)*FX(I,JV)+ALF1(I)*TX(1,JV)+3.*TEMPTM
516           TXY(1,JV)=ALF(I)*FXY(I,JV)+ALF1(I)*TXY(1,JV)
517     +          +3.*(ALF(I)*TY (1,JV)-ALF1(I)*FY (I,JV))
518           TXZ(1,JV)=ALF(I)*FXZ(I,JV)+ALF1(I)*TXZ(1,JV)
519     +          +3.*(ALF(I)*TZ (1,JV)-ALF1(I)*FZ (I,JV))
520           TY (1,JV)=TY (1,JV)+FY (I,JV)
521           TZ (1,JV)=TZ (1,JV)+FZ (I,JV)
522           TYY(1,JV)=TYY(1,JV)+FYY(I,JV)
523           TYZ(1,JV)=TYZ(1,JV)+FYZ(I,JV)
524           TZZ(1,JV)=TZZ(1,JV)+FZZ(I,JV)
525 172    CONTINUE
526      ENDIF
527C
528C  retour aux mailles d'origine (passage des Tij aux Sij)
529C
530      IF(NUMK.GT.1) THEN
531C
532      DO 18 I2=1,NUMK
533C
534         DO 180 I=1,LONK
535C
536            I3=I2+(I-1)*NUMK
537            SM(I3,K,L)=SMNEW(I3)
538            ALF(I)=SMNEW(I3)/TM(I)
539            TM(I)=TM(I)-SMNEW(I3)
540C
541            ALFQ(I)=ALF(I)*ALF(I)
542            ALF1(I)=1.-ALF(I)
543            ALF1Q(I)=ALF1(I)*ALF1(I)
544            ALF2(I)=ALF1(I)-ALF(I)
545            ALF3(I)=ALF(I)*ALFQ(I)
546            ALF4(I)=ALF1(I)*ALF1Q(I)
547C
548 180     CONTINUE
549C
550         DO 181 JV=1,NTRA
551         DO 181 I=1,LONK
552C
553            I3=I2+(I-1)*NUMK
554            S0 (I3,K,L,JV)=ALF (I)* ( T0(I,JV)-ALF1(I)*
555     +              ( TX(I,JV)-ALF2(I)*TXX(I,JV) ) )
556            SSX (I3,K,L,JV)=ALFQ(I)*(TX(I,JV)-3.*ALF1(I)*TXX(I,JV))
557            SSXX(I3,K,L,JV)=ALF3(I)*TXX(I,JV)
558            SY (I3,K,L,JV)=ALF (I)*(TY(I,JV)-ALF1(I)*TXY(I,JV))
559            SZ (I3,K,L,JV)=ALF (I)*(TZ(I,JV)-ALF1(I)*TXZ(I,JV))
560            SSXY(I3,K,L,JV)=ALFQ(I)*TXY(I,JV)
561            SSXZ(I3,K,L,JV)=ALFQ(I)*TXZ(I,JV)
562            SYY(I3,K,L,JV)=ALF (I)*TYY(I,JV)
563            SYZ(I3,K,L,JV)=ALF (I)*TYZ(I,JV)
564            SZZ(I3,K,L,JV)=ALF (I)*TZZ(I,JV)
565C
566C   reajusts moments remaining in the box
567C
568            T0 (I,JV)=T0(I,JV)-S0(I3,K,L,JV)
569            TX (I,JV)=ALF1Q(I)*(TX(I,JV)+3.*ALF(I)*TXX(I,JV))
570            TXX(I,JV)=ALF4 (I)*TXX(I,JV)
571            TY (I,JV)=TY (I,JV)-SY (I3,K,L,JV)
572            TZ (I,JV)=TZ (I,JV)-SZ (I3,K,L,JV)
573            TYY(I,JV)=TYY(I,JV)-SYY(I3,K,L,JV)
574            TYZ(I,JV)=TYZ(I,JV)-SYZ(I3,K,L,JV)
575            TZZ(I,JV)=TZZ(I,JV)-SZZ(I3,K,L,JV)
576            TXY(I,JV)=ALF1Q(I)*TXY(I,JV)
577            TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
578C
579 181     CONTINUE
580C
581 18   CONTINUE
582C
583      ELSE
584C
585      DO 190 I=1,LON
586         SM(I,K,L)=TM(I)
587 190  CONTINUE
588      DO 191 JV=1,NTRA
589      DO 1910 I=1,LON
590         S0 (I,K,L,JV)=T0 (I,JV)
591         SSX (I,K,L,JV)=TX (I,JV)
592         SY (I,K,L,JV)=TY (I,JV)
593         SZ (I,K,L,JV)=TZ (I,JV)
594         SSXX(I,K,L,JV)=TXX(I,JV)
595         SSXY(I,K,L,JV)=TXY(I,JV)
596         SSXZ(I,K,L,JV)=TXZ(I,JV)
597         SYY(I,K,L,JV)=TYY(I,JV)
598         SYZ(I,K,L,JV)=TYZ(I,JV)
599         SZZ(I,K,L,JV)=TZZ(I,JV)
600 1910 CONTINUE
601 191  CONTINUE
602C
603      ENDIF
604C
605 1    CONTINUE
606C
607C ----------- AA Test en fin de ADVX ------ Controle des S*
608
609c      DO 9999 l = 1, llm
610c      DO 9999 j = 1, jjp1
611c      DO 9999 i = 1, iip1
612c           IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN
613c           PRINT*, '-------------------'
614c                PRINT*, 'En fin de ADVXP'
615c           PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
616c                print*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
617c           print*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
618c               print*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
619c            WRITE (*,*) 'On arrete !! - pbl en fin de ADVXP'
620c            STOP
621c           ENDIF
622c 9999 CONTINUE
623c ---------- bouclage cyclique
624
625      DO l = 1,llm
626      DO j = 1,jjp1
627         SM(iip1,j,l) = SM(1,j,l)
628         S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
629              SSX(iip1,j,l,ntra) = SSX(1,j,l,ntra)
630             SY(iip1,j,l,ntra) = SY(1,j,l,ntra)
631             SZ(iip1,j,l,ntra) = SZ(1,j,l,ntra)
632      END DO
633      END DO
634
635C ----------- qqtite totale de traceur dans tte l'atmosphere
636      DO l = 1, llm
637      DO j = 1, jjp1
638      DO i = 1, iim
639        sqf = sqf + S0(i,j,l,ntra)
640      END DO
641      END DO
642      END DO
643
644      PRINT*,'------ DIAG DANS ADVX2 - SORTIE -----'
645      PRINT*,'sqf=',sqf
646c-------------------------------------------------------------
647      RETURN
648      END
Note: See TracBrowser for help on using the repository browser.