LMDZ
advxp.F
Go to the documentation of this file.
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
7 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
8 c c
9 c second-order moments(som) advection of tracer in x direction c
10 c c
11 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
12 c
13 c parametres principaux du modele
14 c
15 #include "dimensions.h"
16 #include "paramet.h"
17 #include "comconst.h"
18 #include "comvert.h"
19 
20  INTEGER ntra
21 c parameter(ntra = 1)
22 c
23 c definition de la grille du modele
24 c
25  REAL dtx
26  REAL pbaru ( iip1,jjp1,llm )
27 c
28 c moments: sm total mass in each grid box
29 c s0 mass of tracer in each grid box
30 c si 1rst order moment in i direction
31 c sij 2nd order moment in i and j directions
32 c
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 c local :
46 c -------
47 
48 c mass fluxes across the boundaries(ugri,vgri,wgri)
49 c mass fluxes in kg
50 c declaration :
51 
52  REAL ugri(iip1,jjp1,llm)
53 
54 c rem : vgri et wgri ne sont pas utilises dans
55 c cette subroutine ( advection en x uniquement )
56 c
57 c
58 c tij are the moments for the current latitude and level
59 c
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 c
67 c the moments f are similarly defined and used as temporary
68 c storage for portions of the grid boxes in transit
69 c
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 c
77 c work arrays
78 c
79  REAL alf (iim),alf1(iim),alfq(iim),alf1q(iim)
80  REAL alf2(iim),alf3(iim),alf4(iim)
81 c
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 c *** test de passage d'arguments ******
99 
100 c DO 399 l = 1, llm
101 c DO 399 j = 1, jjp1
102 c DO 399 i = 1, iip1
103 .lt.c IF (S0(i,j,l,ntra) 0. ) THEN
104 c PRINT*,'s0(',i,j,l,')=',S0(i,j,l,ntra)
105 c print*, 'ssx(',i,j,l,')=',SSX(i,j,l,ntra)
106 c print*, 'sy(',i,j,l,')=',SY(i,j,l,ntra)
107 c print*, 'sz(',i,j,l,')=',SZ(i,j,l,ntra)
108 c PRINT*, 'aie !! debut ADVXP - pbl arg. passage dans ADVXP'
109 cc stop
110 c ENDIF
111 c 399 CONTINUE
112 
113 c *** test : diagnostique de la qtite totale de traceur
114 c dans l'atmosphere avant l'advection
115 c
116  sqi =0.
117  sqf =0.
118 c
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 c test
129 c -------------------------------------
130  DO 300 j =1,jjp1
131  num(j) =1
132  300 CONTINUE
133 c DO l=1,llm
134 c num(2,l)=6
135 c num(3,l)=6
136 c num(jjm-1,l)=6
137 c num(jjm,l)=6
138 c ENDDO
139 c DO j=2,6
140 c num(j)=12
141 c ENDDO
142 c DO j=jjm-5,jjm-1
143 c num(j)=12
144 c ENDDO
145 
146 c Interface : adaptation nouveau modele
147 c -------------------------------------
148 c
149 c ---------------------------------------------------------
150 c conversion des flux de masses en kg/s
151 c pbaru est en n/s d'ou :
152 C ugri est en kg/s
153 
154  DO 500 l = 1,llm
155  DO 500 j = 1,jjp1
156  DO 500 i = 1,iip1
157  ugri (i,j,llm+1-l) =pbaru (i,j,l)
158  500 CONTINUE
159 
160 C ---------------------------------------------------------
161 C start here
162 C
163 C boucle principale sur les niveaux et les latitudes
164 C
165  DO 1 L=1,NIV
166  DO 1 K=lati,latf
167 
168 C
169 C initialisation
170 C
171 C program assumes periodic boundaries in X
172 C
173  DO 10 I=2,LON
174  SMNEW(I)=SM(I,K,L)+(UGRI(I-1,K,L)-UGRI(I,K,L))*DTX
175  10 CONTINUE
176  SMNEW(1)=SM(1,K,L)+(UGRI(LON,K,L)-UGRI(1,K,L))*DTX
177 C
178 C modifications for extended polar zones
179 C
180  NUMK=NUM(K)
181  LONK=LON/NUMK
182 C
183 .GT. IF(NUMK1) THEN
184 C
185  DO 111 I=1,LON
186  TM(I)=0.
187  111 CONTINUE
188  DO 112 JV=1,NTRA
189  DO 1120 I=1,LON
190  T0 (I,JV)=0.
191  TX (I,JV)=0.
192  TY (I,JV)=0.
193  TZ (I,JV)=0.
194  TXX(I,JV)=0.
195  TXY(I,JV)=0.
196  TXZ(I,JV)=0.
197  TYY(I,JV)=0.
198  TYZ(I,JV)=0.
199  TZZ(I,JV)=0.
200  1120 CONTINUE
201  112 CONTINUE
202 C
203  DO 11 I2=1,NUMK
204 C
205  DO 113 I=1,LONK
206  I3=(I-1)*NUMK+I2
207  TM(I)=TM(I)+SM(I3,K,L)
208  ALF(I)=SM(I3,K,L)/TM(I)
209  ALF1(I)=1.-ALF(I)
210  ALFQ(I)=ALF(I)*ALF(I)
211  ALF1Q(I)=ALF1(I)*ALF1(I)
212  ALF2(I)=ALF1(I)-ALF(I)
213  ALF3(I)=ALF(I)*ALF1(I)
214  113 CONTINUE
215 C
216  DO 114 JV=1,NTRA
217  DO 1140 I=1,LONK
218  I3=(I-1)*NUMK+I2
219  TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*S0(I3,K,L,JV)
220  T0 (I,JV)=T0(I,JV)+S0(I3,K,L,JV)
221  TXX(I,JV)=ALFQ(I)*SSXX(I3,K,L,JV)+ALF1Q(I)*TXX(I,JV)
222  + +5.*( ALF3(I)*(SSX(I3,K,L,JV)-TX(I,JV))+ALF2(I)*TEMPTM )
223  TX (I,JV)=ALF(I)*SSX(I3,K,L,JV)+ALF1(I)*TX(I,JV)+3.*TEMPTM
224  TXY(I,JV)=ALF (I)*SSXY(I3,K,L,JV)+ALF1(I)*TXY(I,JV)
225  + +3.*(ALF1(I)*SY (I3,K,L,JV)-ALF (I)*TY (I,JV))
226  TXZ(I,JV)=ALF (I)*SSXZ(I3,K,L,JV)+ALF1(I)*TXZ(I,JV)
227  + +3.*(ALF1(I)*SZ (I3,K,L,JV)-ALF (I)*TZ (I,JV))
228  TY (I,JV)=TY (I,JV)+SY (I3,K,L,JV)
229  TZ (I,JV)=TZ (I,JV)+SZ (I3,K,L,JV)
230  TYY(I,JV)=TYY(I,JV)+SYY(I3,K,L,JV)
231  TYZ(I,JV)=TYZ(I,JV)+SYZ(I3,K,L,JV)
232  TZZ(I,JV)=TZZ(I,JV)+SZZ(I3,K,L,JV)
233  1140 CONTINUE
234  114 CONTINUE
235 C
236  11 CONTINUE
237 C
238  ELSE
239 C
240  DO 115 I=1,LON
241  TM(I)=SM(I,K,L)
242  115 CONTINUE
243  DO 116 JV=1,NTRA
244  DO 1160 I=1,LON
245  T0 (I,JV)=S0 (I,K,L,JV)
246  TX (I,JV)=SSX (I,K,L,JV)
247  TY (I,JV)=SY (I,K,L,JV)
248  TZ (I,JV)=SZ (I,K,L,JV)
249  TXX(I,JV)=SSXX(I,K,L,JV)
250  TXY(I,JV)=SSXY(I,K,L,JV)
251  TXZ(I,JV)=SSXZ(I,K,L,JV)
252  TYY(I,JV)=SYY(I,K,L,JV)
253  TYZ(I,JV)=SYZ(I,K,L,JV)
254  TZZ(I,JV)=SZZ(I,K,L,JV)
255  1160 CONTINUE
256  116 CONTINUE
257 C
258  ENDIF
259 C
260  DO 117 I=1,LONK
261  UEXT(I)=UGRI(I*NUMK,K,L)
262  117 CONTINUE
263 C
264 C place limits on appropriate moments before transport
265 C (if flux-limiting is to be applied)
266 C
267 .NOT. IF(LIMIT) GO TO 13
268 C
269  DO 12 JV=1,NTRA
270  DO 120 I=1,LONK
271 .GT. IF(T0(I,JV)0.) THEN
272  SLPMAX=T0(I,JV)
273  S1MAX=1.5*SLPMAX
274  S1NEW=AMIN1(S1MAX,AMAX1(-S1MAX,TX(I,JV)))
275  S2NEW=AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. ,
276  + AMAX1(ABS(S1NEW)-SLPMAX,TXX(I,JV)) )
277  TX (I,JV)=S1NEW
278  TXX(I,JV)=S2NEW
279  TXY(I,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,TXY(I,JV)))
280  TXZ(I,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,TXZ(I,JV)))
281  ELSE
282  TX (I,JV)=0.
283  TXX(I,JV)=0.
284  TXY(I,JV)=0.
285  TXZ(I,JV)=0.
286  ENDIF
287  120 CONTINUE
288  12 CONTINUE
289 C
290  13 CONTINUE
291 C
292 C calculate flux and moments between adjacent boxes
293 C 1- create temporary moments/masses for partial boxes in transit
294 C 2- reajusts moments remaining in the box
295 C
296 .lt.C flux from IP to I if U(I)0
297 C
298  DO 140 I=1,LONK-1
299 .LT. IF(UEXT(I)0.) THEN
300  FM(I)=-UEXT(I)*DTX
301  ALF(I)=FM(I)/TM(I+1)
302  TM(I+1)=TM(I+1)-FM(I)
303  ENDIF
304  140 CONTINUE
305 C
306  I=LONK
307 .LT. IF(UEXT(I)0.) THEN
308  FM(I)=-UEXT(I)*DTX
309  ALF(I)=FM(I)/TM(1)
310  TM(1)=TM(1)-FM(I)
311  ENDIF
312 C
313 .gt.C flux from I to IP if U(I)0
314 C
315  DO 141 I=1,LONK
316 .GE. IF(UEXT(I)0.) THEN
317  FM(I)=UEXT(I)*DTX
318  ALF(I)=FM(I)/TM(I)
319  TM(I)=TM(I)-FM(I)
320  ENDIF
321  141 CONTINUE
322 C
323  DO 142 I=1,LONK
324  ALFQ(I)=ALF(I)*ALF(I)
325  ALF1(I)=1.-ALF(I)
326  ALF1Q(I)=ALF1(I)*ALF1(I)
327  ALF2(I)=ALF1(I)-ALF(I)
328  ALF3(I)=ALF(I)*ALFQ(I)
329  ALF4(I)=ALF1(I)*ALF1Q(I)
330  142 CONTINUE
331 C
332  DO 150 JV=1,NTRA
333  DO 1500 I=1,LONK-1
334 C
335 .LT. IF(UEXT(I)0.) THEN
336 C
337  F0 (I,JV)=ALF (I)* ( T0(I+1,JV)-ALF1(I)*
338  + ( TX(I+1,JV)-ALF2(I)*TXX(I+1,JV) ) )
339  FX (I,JV)=ALFQ(I)*(TX(I+1,JV)-3.*ALF1(I)*TXX(I+1,JV))
340  FXX(I,JV)=ALF3(I)*TXX(I+1,JV)
341  FY (I,JV)=ALF (I)*(TY(I+1,JV)-ALF1(I)*TXY(I+1,JV))
342  FZ (I,JV)=ALF (I)*(TZ(I+1,JV)-ALF1(I)*TXZ(I+1,JV))
343  FXY(I,JV)=ALFQ(I)*TXY(I+1,JV)
344  FXZ(I,JV)=ALFQ(I)*TXZ(I+1,JV)
345  FYY(I,JV)=ALF (I)*TYY(I+1,JV)
346  FYZ(I,JV)=ALF (I)*TYZ(I+1,JV)
347  FZZ(I,JV)=ALF (I)*TZZ(I+1,JV)
348 C
349  T0 (I+1,JV)=T0(I+1,JV)-F0(I,JV)
350  TX (I+1,JV)=ALF1Q(I)*(TX(I+1,JV)+3.*ALF(I)*TXX(I+1,JV))
351  TXX(I+1,JV)=ALF4(I)*TXX(I+1,JV)
352  TY (I+1,JV)=TY (I+1,JV)-FY (I,JV)
353  TZ (I+1,JV)=TZ (I+1,JV)-FZ (I,JV)
354  TYY(I+1,JV)=TYY(I+1,JV)-FYY(I,JV)
355  TYZ(I+1,JV)=TYZ(I+1,JV)-FYZ(I,JV)
356  TZZ(I+1,JV)=TZZ(I+1,JV)-FZZ(I,JV)
357  TXY(I+1,JV)=ALF1Q(I)*TXY(I+1,JV)
358  TXZ(I+1,JV)=ALF1Q(I)*TXZ(I+1,JV)
359 C
360  ENDIF
361 C
362  1500 CONTINUE
363  150 CONTINUE
364 C
365  I=LONK
366 .LT. IF(UEXT(I)0.) THEN
367 C
368  DO 151 JV=1,NTRA
369 C
370  F0 (I,JV)=ALF (I)* ( T0(1,JV)-ALF1(I)*
371  + ( TX(1,JV)-ALF2(I)*TXX(1,JV) ) )
372  FX (I,JV)=ALFQ(I)*(TX(1,JV)-3.*ALF1(I)*TXX(1,JV))
373  FXX(I,JV)=ALF3(I)*TXX(1,JV)
374  FY (I,JV)=ALF (I)*(TY(1,JV)-ALF1(I)*TXY(1,JV))
375  FZ (I,JV)=ALF (I)*(TZ(1,JV)-ALF1(I)*TXZ(1,JV))
376  FXY(I,JV)=ALFQ(I)*TXY(1,JV)
377  FXZ(I,JV)=ALFQ(I)*TXZ(1,JV)
378  FYY(I,JV)=ALF (I)*TYY(1,JV)
379  FYZ(I,JV)=ALF (I)*TYZ(1,JV)
380  FZZ(I,JV)=ALF (I)*TZZ(1,JV)
381 C
382  T0 (1,JV)=T0(1,JV)-F0(I,JV)
383  TX (1,JV)=ALF1Q(I)*(TX(1,JV)+3.*ALF(I)*TXX(1,JV))
384  TXX(1,JV)=ALF4(I)*TXX(1,JV)
385  TY (1,JV)=TY (1,JV)-FY (I,JV)
386  TZ (1,JV)=TZ (1,JV)-FZ (I,JV)
387  TYY(1,JV)=TYY(1,JV)-FYY(I,JV)
388  TYZ(1,JV)=TYZ(1,JV)-FYZ(I,JV)
389  TZZ(1,JV)=TZZ(1,JV)-FZZ(I,JV)
390  TXY(1,JV)=ALF1Q(I)*TXY(1,JV)
391  TXZ(1,JV)=ALF1Q(I)*TXZ(1,JV)
392 C
393  151 CONTINUE
394 C
395  ENDIF
396 C
397  DO 152 JV=1,NTRA
398  DO 1520 I=1,LONK
399 C
400 .GE. IF(UEXT(I)0.) THEN
401 C
402  F0 (I,JV)=ALF (I)* ( T0(I,JV)+ALF1(I)*
403  + ( TX(I,JV)+ALF2(I)*TXX(I,JV) ) )
404  FX (I,JV)=ALFQ(I)*(TX(I,JV)+3.*ALF1(I)*TXX(I,JV))
405  FXX(I,JV)=ALF3(I)*TXX(I,JV)
406  FY (I,JV)=ALF (I)*(TY(I,JV)+ALF1(I)*TXY(I,JV))
407  FZ (I,JV)=ALF (I)*(TZ(I,JV)+ALF1(I)*TXZ(I,JV))
408  FXY(I,JV)=ALFQ(I)*TXY(I,JV)
409  FXZ(I,JV)=ALFQ(I)*TXZ(I,JV)
410  FYY(I,JV)=ALF (I)*TYY(I,JV)
411  FYZ(I,JV)=ALF (I)*TYZ(I,JV)
412  FZZ(I,JV)=ALF (I)*TZZ(I,JV)
413 C
414  T0 (I,JV)=T0(I,JV)-F0(I,JV)
415  TX (I,JV)=ALF1Q(I)*(TX(I,JV)-3.*ALF(I)*TXX(I,JV))
416  TXX(I,JV)=ALF4(I)*TXX(I,JV)
417  TY (I,JV)=TY (I,JV)-FY (I,JV)
418  TZ (I,JV)=TZ (I,JV)-FZ (I,JV)
419  TYY(I,JV)=TYY(I,JV)-FYY(I,JV)
420  TYZ(I,JV)=TYZ(I,JV)-FYZ(I,JV)
421  TZZ(I,JV)=TZZ(I,JV)-FZZ(I,JV)
422  TXY(I,JV)=ALF1Q(I)*TXY(I,JV)
423  TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
424 C
425  ENDIF
426 C
427  1520 CONTINUE
428  152 CONTINUE
429 C
430 C puts the temporary moments Fi into appropriate neighboring boxes
431 C
432  DO 160 I=1,LONK
433 .LT. IF(UEXT(I)0.) THEN
434  TM(I)=TM(I)+FM(I)
435  ALF(I)=FM(I)/TM(I)
436  ENDIF
437  160 CONTINUE
438 C
439  DO 161 I=1,LONK-1
440 .GE. IF(UEXT(I)0.) THEN
441  TM(I+1)=TM(I+1)+FM(I)
442  ALF(I)=FM(I)/TM(I+1)
443  ENDIF
444  161 CONTINUE
445 C
446  I=LONK
447 .GE. IF(UEXT(I)0.) THEN
448  TM(1)=TM(1)+FM(I)
449  ALF(I)=FM(I)/TM(1)
450  ENDIF
451 C
452  DO 162 I=1,LONK
453  ALF1(I)=1.-ALF(I)
454  ALFQ(I)=ALF(I)*ALF(I)
455  ALF1Q(I)=ALF1(I)*ALF1(I)
456  ALF2(I)=ALF1(I)-ALF(I)
457  ALF3(I)=ALF(I)*ALF1(I)
458  162 CONTINUE
459 C
460  DO 170 JV=1,NTRA
461  DO 1700 I=1,LONK
462 C
463 .LT. IF(UEXT(I)0.) THEN
464 C
465  TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*F0(I,JV)
466  T0 (I,JV)=T0(I,JV)+F0(I,JV)
467  TXX(I,JV)=ALFQ(I)*FXX(I,JV)+ALF1Q(I)*TXX(I,JV)
468  + +5.*( ALF3(I)*(FX(I,JV)-TX(I,JV))+ALF2(I)*TEMPTM )
469  TX (I,JV)=ALF (I)*FX (I,JV)+ALF1(I)*TX (I,JV)+3.*TEMPTM
470  TXY(I,JV)=ALF (I)*FXY(I,JV)+ALF1(I)*TXY(I,JV)
471  + +3.*(ALF1(I)*FY (I,JV)-ALF (I)*TY (I,JV))
472  TXZ(I,JV)=ALF (I)*FXZ(I,JV)+ALF1(I)*TXZ(I,JV)
473  + +3.*(ALF1(I)*FZ (I,JV)-ALF (I)*TZ (I,JV))
474  TY (I,JV)=TY (I,JV)+FY (I,JV)
475  TZ (I,JV)=TZ (I,JV)+FZ (I,JV)
476  TYY(I,JV)=TYY(I,JV)+FYY(I,JV)
477  TYZ(I,JV)=TYZ(I,JV)+FYZ(I,JV)
478  TZZ(I,JV)=TZZ(I,JV)+FZZ(I,JV)
479 C
480  ENDIF
481 C
482  1700 CONTINUE
483  170 CONTINUE
484 C
485  DO 171 JV=1,NTRA
486  DO 1710 I=1,LONK-1
487 C
488 .GE. IF(UEXT(I)0.) THEN
489 C
490  TEMPTM=ALF(I)*T0(I+1,JV)-ALF1(I)*F0(I,JV)
491  T0 (I+1,JV)=T0(I+1,JV)+F0(I,JV)
492  TXX(I+1,JV)=ALFQ(I)*FXX(I,JV)+ALF1Q(I)*TXX(I+1,JV)
493  + +5.*( ALF3(I)*(TX(I+1,JV)-FX(I,JV))-ALF2(I)*TEMPTM )
494  TX (I+1,JV)=ALF(I)*FX (I ,JV)+ALF1(I)*TX (I+1,JV)+3.*TEMPTM
495  TXY(I+1,JV)=ALF(I)*FXY(I ,JV)+ALF1(I)*TXY(I+1,JV)
496  + +3.*(ALF(I)*TY (I+1,JV)-ALF1(I)*FY (I ,JV))
497  TXZ(I+1,JV)=ALF(I)*FXZ(I ,JV)+ALF1(I)*TXZ(I+1,JV)
498  + +3.*(ALF(I)*TZ (I+1,JV)-ALF1(I)*FZ (I ,JV))
499  TY (I+1,JV)=TY (I+1,JV)+FY (I,JV)
500  TZ (I+1,JV)=TZ (I+1,JV)+FZ (I,JV)
501  TYY(I+1,JV)=TYY(I+1,JV)+FYY(I,JV)
502  TYZ(I+1,JV)=TYZ(I+1,JV)+FYZ(I,JV)
503  TZZ(I+1,JV)=TZZ(I+1,JV)+FZZ(I,JV)
504 C
505  ENDIF
506 C
507  1710 CONTINUE
508  171 CONTINUE
509 C
510  I=LONK
511 .GE. IF(UEXT(I)0.) THEN
512  DO 172 JV=1,NTRA
513  TEMPTM=ALF(I)*T0(1,JV)-ALF1(I)*F0(I,JV)
514  T0 (1,JV)=T0(1,JV)+F0(I,JV)
515  TXX(1,JV)=ALFQ(I)*FXX(I,JV)+ALF1Q(I)*TXX(1,JV)
516  + +5.*( ALF3(I)*(TX(1,JV)-FX(I,JV))-ALF2(I)*TEMPTM )
517  TX (1,JV)=ALF(I)*FX(I,JV)+ALF1(I)*TX(1,JV)+3.*TEMPTM
518  TXY(1,JV)=ALF(I)*FXY(I,JV)+ALF1(I)*TXY(1,JV)
519  + +3.*(ALF(I)*TY (1,JV)-ALF1(I)*FY (I,JV))
520  TXZ(1,JV)=ALF(I)*FXZ(I,JV)+ALF1(I)*TXZ(1,JV)
521  + +3.*(ALF(I)*TZ (1,JV)-ALF1(I)*FZ (I,JV))
522  TY (1,JV)=TY (1,JV)+FY (I,JV)
523  TZ (1,JV)=TZ (1,JV)+FZ (I,JV)
524  TYY(1,JV)=TYY(1,JV)+FYY(I,JV)
525  TYZ(1,JV)=TYZ(1,JV)+FYZ(I,JV)
526  TZZ(1,JV)=TZZ(1,JV)+FZZ(I,JV)
527  172 CONTINUE
528  ENDIF
529 C
530 C retour aux mailles d'origine(passage des tij aux sij)
531 c
532  IF(numk.GT.1) THEN
533 c
534  DO 18 i2=1,numk
535 c
536  DO 180 i=1,lonk
537 c
538  i3=i2+(i-1)*numk
539  sm(i3,k,l)=smnew(i3)
540  alf(i)=smnew(i3)/tm(i)
541  tm(i)=tm(i)-smnew(i3)
542 c
543  alfq(i)=alf(i)*alf(i)
544  alf1(i)=1.-alf(i)
545  alf1q(i)=alf1(i)*alf1(i)
546  alf2(i)=alf1(i)-alf(i)
547  alf3(i)=alf(i)*alfq(i)
548  alf4(i)=alf1(i)*alf1q(i)
549 c
550  180 CONTINUE
551 c
552  DO 181 jv=1,ntra
553  DO 181 i=1,lonk
554 c
555  i3=i2+(i-1)*numk
556  s0(i3,k,l,jv)=alf(i)* ( t0(i,jv)-alf1(i)*
557  + ( tx(i,jv)-alf2(i)*txx(i,jv) ) )
558  ssx(i3,k,l,jv)=alfq(i)*(tx(i,jv)-3.*alf1(i)*txx(i,jv))
559  ssxx(i3,k,l,jv)=alf3(i)*txx(i,jv)
560  sy(i3,k,l,jv)=alf(i)*(ty(i,jv)-alf1(i)*txy(i,jv))
561  sz(i3,k,l,jv)=alf(i)*(tz(i,jv)-alf1(i)*txz(i,jv))
562  ssxy(i3,k,l,jv)=alfq(i)*txy(i,jv)
563  ssxz(i3,k,l,jv)=alfq(i)*txz(i,jv)
564  syy(i3,k,l,jv)=alf(i)*tyy(i,jv)
565  syz(i3,k,l,jv)=alf(i)*tyz(i,jv)
566  szz(i3,k,l,jv)=alf(i)*tzz(i,jv)
567 c
568 c reajusts moments remaining in the box
569 c
570  t0(i,jv)=t0(i,jv)-s0(i3,k,l,jv)
571  tx(i,jv)=alf1q(i)*(tx(i,jv)+3.*alf(i)*txx(i,jv))
572  txx(i,jv)=alf4(i)*txx(i,jv)
573  ty(i,jv)=ty(i,jv)-sy(i3,k,l,jv)
574  tz(i,jv)=tz(i,jv)-sz(i3,k,l,jv)
575  tyy(i,jv)=tyy(i,jv)-syy(i3,k,l,jv)
576  tyz(i,jv)=tyz(i,jv)-syz(i3,k,l,jv)
577  tzz(i,jv)=tzz(i,jv)-szz(i3,k,l,jv)
578  txy(i,jv)=alf1q(i)*txy(i,jv)
579  txz(i,jv)=alf1q(i)*txz(i,jv)
580 c
581  181 CONTINUE
582 c
583  18 CONTINUE
584 c
585  ELSE
586 c
587  DO 190 i=1,lon
588  sm(i,k,l)=tm(i)
589  190 CONTINUE
590  DO 191 jv=1,ntra
591  DO 1910 i=1,lon
592  s0(i,k,l,jv)=t0(i,jv)
593  ssx(i,k,l,jv)=tx(i,jv)
594  sy(i,k,l,jv)=ty(i,jv)
595  sz(i,k,l,jv)=tz(i,jv)
596  ssxx(i,k,l,jv)=txx(i,jv)
597  ssxy(i,k,l,jv)=txy(i,jv)
598  ssxz(i,k,l,jv)=txz(i,jv)
599  syy(i,k,l,jv)=tyy(i,jv)
600  syz(i,k,l,jv)=tyz(i,jv)
601  szz(i,k,l,jv)=tzz(i,jv)
602  1910 CONTINUE
603  191 CONTINUE
604 c
605  ENDIF
606 c
607  1 CONTINUE
608 c
609 c ----------- aa test en fin de advx ------ controle des s*
610 
611 c DO 9999 l = 1, llm
612 c DO 9999 j = 1, jjp1
613 c DO 9999 i = 1, iip1
614 c IF (s0(i,j,l,ntra).lt.0..and.limit) THEN
615 c print*, '-------------------'
616 c print*, 'En fin de ADVXP'
617 c print*,'S0(',i,j,l,')=',s0(i,j,l,ntra)
618 c print*, 'SSX(',i,j,l,')=',ssx(i,j,l,ntra)
619 c print*, 'SY(',i,j,l,')=',sy(i,j,l,ntra)
620 c print*, 'SZ(',i,j,l,')=',sz(i,j,l,ntra)
621 c WRITE (*,*) 'On arrete !! - pbl en fin de ADVXP'
622 c stop
623 c ENDIF
624 c 9999 CONTINUE
625 c ---------- bouclage cyclique
626 
627  DO l = 1,llm
628  DO j = 1,jjp1
629  sm(iip1,j,l) = sm(1,j,l)
630  s0(iip1,j,l,ntra) = s0(1,j,l,ntra)
631  ssx(iip1,j,l,ntra) = ssx(1,j,l,ntra)
632  sy(iip1,j,l,ntra) = sy(1,j,l,ntra)
633  sz(iip1,j,l,ntra) = sz(1,j,l,ntra)
634  END DO
635  END DO
636 
637 c ----------- qqtite totale de traceur dans tte l'atmosphere
638  DO l = 1, llm
639  DO j = 1, jjp1
640  DO i = 1, iim
641  sqf = sqf + S0(i,j,l,ntra)
642  END DO
643  END DO
644  END DO
645 
646  PRINT*,'------ diag dans advx2 - sortie -----'
647  PRINT*,'sqf=',sqf
648 c-------------------------------------------------------------
649  RETURN
650  END
level
!$Id NSTRA real GKLIFT real GVSEC REAL GWD_RANDO_RUWMAX!Maximum Eliassen Palm flux at launch level
Definition: YOEGWD.h:12
t0
!$Id!Thermodynamical constants for t0 real clmci real epsim1 real hrd real grav COMMON cvthermo rowl t0
Definition: cvthermo.h:6
l
c c $Id c c calculs statistiques distribution nuage ftion du regime dynamique c c Ce calcul doit etre fait a partir de valeurs mensuelles CALL nbregdyn DO kmaxm1 DO l
Definition: calcul_REGDYN.h:13
fy
!$Header!c REAL ripx REAL fy
Definition: fxy_new.h:6
fx
!$Header!c REAL ripx REAL fx
Definition: fxy_new.h:6
llm
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
Definition: 1D_interp_cases.h:103
k
c c $Id c c calculs statistiques distribution nuage ftion du regime dynamique c c Ce calcul doit etre fait a partir de valeurs mensuelles CALL nbregdyn DO k
Definition: calcul_REGDYN.h:12
i
!$Id klon initialisation mois suivants day_rain itap ENDIF!Calcul fin de nday_rain calcul nday_rain itap DO i
Definition: calcul_divers.h:24
advx
subroutine advx(limit, dtx, pbaru, sm, s0, sx, sy, sz, lati, latf)
Definition: advx.F:6
jjp1
!$Header jjp1
Definition: paramet.h:14
j
!$Id Turb_fcg!implicit none!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc!cette routine permet d obtenir hq et ainsi de!pouvoir calculer la convergence et le cisaillement dans la physiq!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc INTEGER klev REAL j
Definition: 1Dconv.h:27
parameter
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
x
!$Header!c c INCLUDE fxyprim h c c c Fonctions in line c c REAL fyprim REAL rj c c il faut la calculer avant d appeler ces fonctions c c c Fonctions a changer selon x(x) et y(y) choisis.c-----------------------------------------------------------------c c.....ici
fxy
subroutine fxy(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, xprimp025)
Definition: fxy.F:7
iim
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24
de
do llm!au dessus de
Definition: 1D_nudge_sandu_astex.h:1