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 |
---|
7 | USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, & |
---|
8 | ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm |
---|
9 | IMPLICIT 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 |
---|
655 | END SUBROUTINE ADVXP |
---|