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

Last change on this file since 5348 was 5285, checked in by abarral, 5 weeks ago

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