source: LMDZ6/trunk/libf/dyn3d_common/advxp.f90 @ 5272

Last change on this file since 5272 was 5272, checked in by abarral, 23 hours ago

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