GCC Code Coverage Report


Directory: ./
File: dyn3d_common/advyp.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 300 0.0%
Branches: 0 132 0.0%

Line Branch Exec Source
1 !
2 ! $Header$
3 !
4 ✗ SUBROUTINE ADVYP(LIMIT,DTY,PBARV,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 Y direction C
10 C C
11 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
12 C C
13 C Source : Pascal Simon ( Meteo, CNRM ) C
14 C Adaptation : A.A. (LGGE) C
15 C Derniere Modif : 19/10/95 LAST
16 C C
17 C sont les arguments d'entree pour le s-pg C
18 C C
19 C argument de sortie du s-pg C
20 C C
21 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
22 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
23 C
24 C Rem : Probleme aux poles il faut reecrire ce cas specifique
25 C Attention au sens de l'indexation
26 C
27 C parametres principaux du modele
28 C
29 C
30 include "dimensions.h"
31 include "paramet.h"
32 include "comgeom.h"
33
34 C Arguments :
35 C ----------
36 C dty : frequence fictive d'appel du transport
37 C parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
38
39 INTEGER lon,lat,niv
40 INTEGER i,j,jv,k,kp,l
41 INTEGER ntra
42 C PARAMETER (ntra = 1)
43
44 REAL dty
45 REAL pbarv ( iip1,jjm, llm )
46
47 C moments: SM total mass in each grid box
48 C S0 mass of tracer in each grid box
49 C Si 1rst order moment in i direction
50 C
51 REAL SM(iip1,jjp1,llm)
52 + ,S0(iip1,jjp1,llm,ntra)
53 REAL SSX(iip1,jjp1,llm,ntra)
54 + ,SY(iip1,jjp1,llm,ntra)
55 + ,SZ(iip1,jjp1,llm,ntra)
56 + ,SSXX(iip1,jjp1,llm,ntra)
57 + ,SSXY(iip1,jjp1,llm,ntra)
58 + ,SSXZ(iip1,jjp1,llm,ntra)
59 + ,SYY(iip1,jjp1,llm,ntra)
60 + ,SYZ(iip1,jjp1,llm,ntra)
61 + ,SZZ(iip1,jjp1,llm,ntra)
62 C
63 C Local :
64 C -------
65
66 C mass fluxes across the boundaries (UGRI,VGRI,WGRI)
67 C mass fluxes in kg
68 C declaration :
69
70 REAL VGRI(iip1,0:jjp1,llm)
71
72 C Rem : UGRI et WGRI ne sont pas utilises dans
73 C cette subroutine ( advection en y uniquement )
74 C Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
75 C
76 C the moments F are similarly defined and used as temporary
77 C storage for portions of the grid boxes in transit
78 C
79 C the moments Fij are used as temporary storage for
80 C portions of the grid boxes in transit at the current level
81 C
82 C work arrays
83 C
84 C
85 ✗ REAL F0(iim,0:jjp1,ntra),FM(iim,0:jjp1)
86 ✗ REAL FX(iim,jjm,ntra),FY(iim,jjm,ntra)
87 ✗ REAL FZ(iim,jjm,ntra)
88 ✗ REAL FXX(iim,jjm,ntra),FXY(iim,jjm,ntra)
89 ✗ REAL FXZ(iim,jjm,ntra),FYY(iim,jjm,ntra)
90 ✗ REAL FYZ(iim,jjm,ntra),FZZ(iim,jjm,ntra)
91 ✗ REAL S00(ntra)
92 REAL SM0 ! Just temporal variable
93 C
94 C work arrays
95 C
96 REAL ALF(iim,0:jjp1),ALF1(iim,0:jjp1)
97 REAL ALFQ(iim,0:jjp1),ALF1Q(iim,0:jjp1)
98 REAL ALF2(iim,0:jjp1),ALF3(iim,0:jjp1)
99 REAL ALF4(iim,0:jjp1)
100 REAL TEMPTM ! Just temporal variable
101 REAL SLPMAX,S1MAX,S1NEW,S2NEW
102 c
103 C Special pour poles
104 c
105 REAL sbms,sfms,sfzs,sbmn,sfmn,sfzn
106 REAL sns0(ntra),snsz(ntra),snsm
107 REAL qy1(iim,llm,ntra),qylat(iim,llm,ntra)
108 REAL cx1(llm,ntra), cxLAT(llm,ntra)
109 REAL cy1(llm,ntra), cyLAT(llm,ntra)
110 REAL z1(iim), zcos(iim), zsin(iim)
111 REAL SSUM
112 EXTERNAL SSUM
113 C
114 REAL sqi,sqf
115 LOGICAL LIMIT
116
117 lon = iim ! rem : Il est possible qu'un pbl. arrive ici
118 lat = jjp1 ! a cause des dim. differentes entre les
119 niv = llm ! tab. S et VGRI
120
121 c-----------------------------------------------------------------
122 C initialisations
123
124 sbms = 0.
125 sfms = 0.
126 sfzs = 0.
127 sbmn = 0.
128 sfmn = 0.
129 sfzn = 0.
130
131 c-----------------------------------------------------------------
132 C *** Test : diag de la qtite totale de traceur dans
133 C l'atmosphere avant l'advection en Y
134 c
135 ✗ sqi = 0.
136 ✗ sqf = 0.
137
138 ✗ DO l = 1,llm
139 ✗ DO j = 1,jjp1
140 ✗ DO i = 1,iim
141 ✗ sqi = sqi + S0(i,j,l,ntra)
142 END DO
143 END DO
144 END DO
145 ✗ PRINT*,'---------- DIAG DANS ADVY - ENTREE --------'
146 ✗ PRINT*,'sqi=',sqi
147
148 c-----------------------------------------------------------------
149 C Interface : adaptation nouveau modele
150 C -------------------------------------
151 C
152 C Conversion des flux de masses en kg
153 C-AA 20/10/94 le signe -1 est necessaire car indexation opposee
154
155 ✗ DO 500 l = 1,llm
156 ✗ DO 500 j = 1,jjm
157 ✗ DO 500 i = 1,iip1
158 ✗ vgri (i,j,llm+1-l)=-1.*pbarv (i,j,l)
159 ✗ 500 CONTINUE
160
161 CAA Initialisation de flux fictifs aux bords sup. des boites pol.
162
163 ✗ DO l = 1,llm
164 ✗ DO i = 1,iip1
165 ✗ vgri(i,0,l) = 0.
166 ✗ vgri(i,jjp1,l) = 0.
167 ENDDO
168 ENDDO
169 c
170 c----------------- START HERE -----------------------
171 C boucle sur les niveaux
172 C
173 ✗ DO 1 L=1,NIV
174 C
175 C place limits on appropriate moments before transport
176 C (if flux-limiting is to be applied)
177 C
178 ✗ IF(.NOT.LIMIT) GO TO 11
179 C
180 ✗ DO 10 JV=1,NTRA
181 ✗ DO 10 K=1,LAT
182 ✗ DO 100 I=1,LON
183 ✗ IF(S0(I,K,L,JV).GT.0.) THEN
184 ✗ SLPMAX=AMAX1(S0(I,K,L,JV),0.)
185 ✗ S1MAX=1.5*SLPMAX
186 ✗ S1NEW=AMIN1(S1MAX,AMAX1(-S1MAX,SY(I,K,L,JV)))
187 S2NEW=AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. ,
188 ✗ + AMAX1(ABS(S1NEW)-SLPMAX,SYY(I,K,L,JV)) )
189 ✗ SY (I,K,L,JV)=S1NEW
190 ✗ SYY(I,K,L,JV)=S2NEW
191 ✗ SSXY(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SSXY(I,K,L,JV)))
192 ✗ SYZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SYZ(I,K,L,JV)))
193 ELSE
194 ✗ SY (I,K,L,JV)=0.
195 ✗ SYY(I,K,L,JV)=0.
196 ✗ SSXY(I,K,L,JV)=0.
197 ✗ SYZ(I,K,L,JV)=0.
198 ENDIF
199 ✗ 100 CONTINUE
200 ✗ 10 CONTINUE
201 C
202 11 CONTINUE
203 C
204 C le flux a travers le pole Nord est traite separement
205 C
206 SM0=0.
207 ✗ DO 20 JV=1,NTRA
208 ✗ S00(JV)=0.
209 ✗ 20 CONTINUE
210 C
211 ✗ DO 21 I=1,LON
212 C
213 ✗ IF(VGRI(I,0,L).LE.0.) THEN
214 ✗ FM(I,0)=-VGRI(I,0,L)*DTY
215 ✗ ALF(I,0)=FM(I,0)/SM(I,1,L)
216 ✗ SM(I,1,L)=SM(I,1,L)-FM(I,0)
217 ✗ SM0=SM0+FM(I,0)
218 ENDIF
219 C
220 ✗ ALFQ(I,0)=ALF(I,0)*ALF(I,0)
221 ✗ ALF1(I,0)=1.-ALF(I,0)
222 ✗ ALF1Q(I,0)=ALF1(I,0)*ALF1(I,0)
223 ✗ ALF2(I,0)=ALF1(I,0)-ALF(I,0)
224 ✗ ALF3(I,0)=ALF(I,0)*ALFQ(I,0)
225 ✗ ALF4(I,0)=ALF1(I,0)*ALF1Q(I,0)
226 C
227 ✗ 21 CONTINUE
228 c print*,'ADVYP 21'
229 C
230 ✗ DO 22 JV=1,NTRA
231 ✗ DO 220 I=1,LON
232 C
233 ✗ IF(VGRI(I,0,L).LE.0.) THEN
234 C
235 F0(I,0,JV)=ALF(I,0)* ( S0(I,1,L,JV)-ALF1(I,0)*
236 ✗ + ( SY(I,1,L,JV)-ALF2(I,0)*SYY(I,1,L,JV) ) )
237 C
238 ✗ S00(JV)=S00(JV)+F0(I,0,JV)
239 ✗ S0 (I,1,L,JV)=S0(I,1,L,JV)-F0(I,0,JV)
240 SY (I,1,L,JV)=ALF1Q(I,0)*
241 ✗ + (SY(I,1,L,JV)+3.*ALF(I,0)*SYY(I,1,L,JV))
242 ✗ SYY(I,1,L,JV)=ALF4 (I,0)*SYY(I,1,L,JV)
243 SSX (I,1,L,JV)=ALF1 (I,0)*
244 ✗ + (SSX(I,1,L,JV)+ALF(I,0)*SSXY(I,1,L,JV) )
245 SZ (I,1,L,JV)=ALF1 (I,0)*
246 ✗ + (SZ(I,1,L,JV)+ALF(I,0)*SSXZ(I,1,L,JV) )
247 ✗ SSXX(I,1,L,JV)=ALF1 (I,0)*SSXX(I,1,L,JV)
248 ✗ SSXZ(I,1,L,JV)=ALF1 (I,0)*SSXZ(I,1,L,JV)
249 ✗ SZZ(I,1,L,JV)=ALF1 (I,0)*SZZ(I,1,L,JV)
250 ✗ SSXY(I,1,L,JV)=ALF1Q(I,0)*SSXY(I,1,L,JV)
251 ✗ SYZ(I,1,L,JV)=ALF1Q(I,0)*SYZ(I,1,L,JV)
252 C
253 ENDIF
254 C
255 ✗ 220 CONTINUE
256 ✗ 22 CONTINUE
257 C
258 ✗ DO 23 I=1,LON
259 ✗ IF(VGRI(I,0,L).GT.0.) THEN
260 ✗ FM(I,0)=VGRI(I,0,L)*DTY
261 ✗ ALF(I,0)=FM(I,0)/SM0
262 ENDIF
263 ✗ 23 CONTINUE
264 C
265 ✗ DO 24 JV=1,NTRA
266 ✗ DO 240 I=1,LON
267 ✗ IF(VGRI(I,0,L).GT.0.) THEN
268 ✗ F0(I,0,JV)=ALF(I,0)*S00(JV)
269 ENDIF
270 ✗ 240 CONTINUE
271 ✗ 24 CONTINUE
272 C
273 C puts the temporary moments Fi into appropriate neighboring boxes
274 C
275 c print*,'av ADVYP 25'
276 ✗ DO 25 I=1,LON
277 C
278 ✗ IF(VGRI(I,0,L).GT.0.) THEN
279 ✗ SM(I,1,L)=SM(I,1,L)+FM(I,0)
280 ✗ ALF(I,0)=FM(I,0)/SM(I,1,L)
281 ENDIF
282 C
283 ✗ ALFQ(I,0)=ALF(I,0)*ALF(I,0)
284 ✗ ALF1(I,0)=1.-ALF(I,0)
285 ✗ ALF1Q(I,0)=ALF1(I,0)*ALF1(I,0)
286 ✗ ALF2(I,0)=ALF1(I,0)-ALF(I,0)
287 ✗ ALF3(I,0)=ALF1(I,0)*ALF(I,0)
288 C
289 ✗ 25 CONTINUE
290 c print*,'av ADVYP 25'
291 C
292 ✗ DO 26 JV=1,NTRA
293 ✗ DO 260 I=1,LON
294 C
295 ✗ IF(VGRI(I,0,L).GT.0.) THEN
296 C
297 ✗ TEMPTM=ALF(I,0)*S0(I,1,L,JV)-ALF1(I,0)*F0(I,0,JV)
298 ✗ S0 (I,1,L,JV)=S0(I,1,L,JV)+F0(I,0,JV)
299 SYY(I,1,L,JV)=ALF1Q(I,0)*SYY(I,1,L,JV)
300 ✗ + +5.*( ALF3 (I,0)*SY (I,1,L,JV)-ALF2(I,0)*TEMPTM )
301 ✗ SY (I,1,L,JV)=ALF1 (I,0)*SY (I,1,L,JV)+3.*TEMPTM
302 ✗ SSXY(I,1,L,JV)=ALF1 (I,0)*SSXY(I,1,L,JV)+3.*ALF(I,0)*SSX(I,1,L,JV)
303 ✗ SYZ(I,1,L,JV)=ALF1 (I,0)*SYZ(I,1,L,JV)+3.*ALF(I,0)*SZ(I,1,L,JV)
304 C
305 ENDIF
306 C
307 ✗ 260 CONTINUE
308 ✗ 26 CONTINUE
309 C
310 C calculate flux and moments between adjacent boxes
311 C 1- create temporary moments/masses for partial boxes in transit
312 C 2- reajusts moments remaining in the box
313 C
314 C flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0
315 C
316 c print*,'av ADVYP 30'
317 ✗ DO 30 K=1,LAT-1
318 ✗ KP=K+1
319 ✗ DO 300 I=1,LON
320 C
321 ✗ IF(VGRI(I,K,L).LT.0.) THEN
322 ✗ FM(I,K)=-VGRI(I,K,L)*DTY
323 ✗ ALF(I,K)=FM(I,K)/SM(I,KP,L)
324 ✗ SM(I,KP,L)=SM(I,KP,L)-FM(I,K)
325 ELSE
326 ✗ FM(I,K)=VGRI(I,K,L)*DTY
327 ✗ ALF(I,K)=FM(I,K)/SM(I,K,L)
328 ✗ SM(I,K,L)=SM(I,K,L)-FM(I,K)
329 ENDIF
330 C
331 ✗ ALFQ(I,K)=ALF(I,K)*ALF(I,K)
332 ✗ ALF1(I,K)=1.-ALF(I,K)
333 ✗ ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
334 ✗ ALF2(I,K)=ALF1(I,K)-ALF(I,K)
335 ✗ ALF3(I,K)=ALF(I,K)*ALFQ(I,K)
336 ✗ ALF4(I,K)=ALF1(I,K)*ALF1Q(I,K)
337 C
338 ✗ 300 CONTINUE
339 ✗ 30 CONTINUE
340 c print*,'ap ADVYP 30'
341 C
342 ✗ DO 31 JV=1,NTRA
343 ✗ DO 31 K=1,LAT-1
344 ✗ KP=K+1
345 ✗ DO 310 I=1,LON
346 C
347 ✗ IF(VGRI(I,K,L).LT.0.) THEN
348 C
349 F0 (I,K,JV)=ALF (I,K)* ( S0(I,KP,L,JV)-ALF1(I,K)*
350 ✗ + ( SY(I,KP,L,JV)-ALF2(I,K)*SYY(I,KP,L,JV) ) )
351 FY (I,K,JV)=ALFQ(I,K)*
352 ✗ + (SY(I,KP,L,JV)-3.*ALF1(I,K)*SYY(I,KP,L,JV))
353 ✗ FYY(I,K,JV)=ALF3(I,K)*SYY(I,KP,L,JV)
354 FX (I,K,JV)=ALF (I,K)*
355 ✗ + (SSX(I,KP,L,JV)-ALF1(I,K)*SSXY(I,KP,L,JV))
356 FZ (I,K,JV)=ALF (I,K)*
357 ✗ + (SZ(I,KP,L,JV)-ALF1(I,K)*SYZ(I,KP,L,JV))
358 ✗ FXY(I,K,JV)=ALFQ(I,K)*SSXY(I,KP,L,JV)
359 ✗ FYZ(I,K,JV)=ALFQ(I,K)*SYZ(I,KP,L,JV)
360 ✗ FXX(I,K,JV)=ALF (I,K)*SSXX(I,KP,L,JV)
361 ✗ FXZ(I,K,JV)=ALF (I,K)*SSXZ(I,KP,L,JV)
362 ✗ FZZ(I,K,JV)=ALF (I,K)*SZZ(I,KP,L,JV)
363 C
364 ✗ S0 (I,KP,L,JV)=S0(I,KP,L,JV)-F0(I,K,JV)
365 SY (I,KP,L,JV)=ALF1Q(I,K)*
366 ✗ + (SY(I,KP,L,JV)+3.*ALF(I,K)*SYY(I,KP,L,JV))
367 ✗ SYY(I,KP,L,JV)=ALF4(I,K)*SYY(I,KP,L,JV)
368 ✗ SSX (I,KP,L,JV)=SSX (I,KP,L,JV)-FX (I,K,JV)
369 ✗ SZ (I,KP,L,JV)=SZ (I,KP,L,JV)-FZ (I,K,JV)
370 ✗ SSXX(I,KP,L,JV)=SSXX(I,KP,L,JV)-FXX(I,K,JV)
371 ✗ SSXZ(I,KP,L,JV)=SSXZ(I,KP,L,JV)-FXZ(I,K,JV)
372 ✗ SZZ(I,KP,L,JV)=SZZ(I,KP,L,JV)-FZZ(I,K,JV)
373 ✗ SSXY(I,KP,L,JV)=ALF1Q(I,K)*SSXY(I,KP,L,JV)
374 ✗ SYZ(I,KP,L,JV)=ALF1Q(I,K)*SYZ(I,KP,L,JV)
375 C
376 ELSE
377 C
378 F0 (I,K,JV)=ALF (I,K)* ( S0(I,K,L,JV)+ALF1(I,K)*
379 ✗ + ( SY(I,K,L,JV)+ALF2(I,K)*SYY(I,K,L,JV) ) )
380 FY (I,K,JV)=ALFQ(I,K)*
381 ✗ + (SY(I,K,L,JV)+3.*ALF1(I,K)*SYY(I,K,L,JV))
382 ✗ FYY(I,K,JV)=ALF3(I,K)*SYY(I,K,L,JV)
383 ✗ FX (I,K,JV)=ALF (I,K)*(SSX(I,K,L,JV)+ALF1(I,K)*SSXY(I,K,L,JV))
384 ✗ FZ (I,K,JV)=ALF (I,K)*(SZ(I,K,L,JV)+ALF1(I,K)*SYZ(I,K,L,JV))
385 ✗ FXY(I,K,JV)=ALFQ(I,K)*SSXY(I,K,L,JV)
386 ✗ FYZ(I,K,JV)=ALFQ(I,K)*SYZ(I,K,L,JV)
387 ✗ FXX(I,K,JV)=ALF (I,K)*SSXX(I,K,L,JV)
388 ✗ FXZ(I,K,JV)=ALF (I,K)*SSXZ(I,K,L,JV)
389 ✗ FZZ(I,K,JV)=ALF (I,K)*SZZ(I,K,L,JV)
390 C
391 ✗ S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0 (I,K,JV)
392 SY (I,K,L,JV)=ALF1Q(I,K)*
393 ✗ + (SY(I,K,L,JV)-3.*ALF(I,K)*SYY(I,K,L,JV))
394 ✗ SYY(I,K,L,JV)=ALF4(I,K)*SYY(I,K,L,JV)
395 ✗ SSX (I,K,L,JV)=SSX (I,K,L,JV)-FX (I,K,JV)
396 ✗ SZ (I,K,L,JV)=SZ (I,K,L,JV)-FZ (I,K,JV)
397 ✗ SSXX(I,K,L,JV)=SSXX(I,K,L,JV)-FXX(I,K,JV)
398 ✗ SSXZ(I,K,L,JV)=SSXZ(I,K,L,JV)-FXZ(I,K,JV)
399 ✗ SZZ(I,K,L,JV)=SZZ(I,K,L,JV)-FZZ(I,K,JV)
400 ✗ SSXY(I,K,L,JV)=ALF1Q(I,K)*SSXY(I,K,L,JV)
401 ✗ SYZ(I,K,L,JV)=ALF1Q(I,K)*SYZ(I,K,L,JV)
402 C
403 ENDIF
404 C
405 ✗ 310 CONTINUE
406 ✗ 31 CONTINUE
407 c print*,'ap ADVYP 31'
408 C
409 C puts the temporary moments Fi into appropriate neighboring boxes
410 C
411 ✗ DO 32 K=1,LAT-1
412 ✗ KP=K+1
413 ✗ DO 320 I=1,LON
414 C
415 ✗ IF(VGRI(I,K,L).LT.0.) THEN
416 ✗ SM(I,K,L)=SM(I,K,L)+FM(I,K)
417 ✗ ALF(I,K)=FM(I,K)/SM(I,K,L)
418 ELSE
419 ✗ SM(I,KP,L)=SM(I,KP,L)+FM(I,K)
420 ✗ ALF(I,K)=FM(I,K)/SM(I,KP,L)
421 ENDIF
422 C
423 ✗ ALFQ(I,K)=ALF(I,K)*ALF(I,K)
424 ✗ ALF1(I,K)=1.-ALF(I,K)
425 ✗ ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
426 ✗ ALF2(I,K)=ALF1(I,K)-ALF(I,K)
427 ✗ ALF3(I,K)=ALF1(I,K)*ALF(I,K)
428 C
429 ✗ 320 CONTINUE
430 ✗ 32 CONTINUE
431 c print*,'ap ADVYP 32'
432 C
433 ✗ DO 33 JV=1,NTRA
434 ✗ DO 33 K=1,LAT-1
435 ✗ KP=K+1
436 ✗ DO 330 I=1,LON
437 C
438 ✗ IF(VGRI(I,K,L).LT.0.) THEN
439 C
440 ✗ TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
441 ✗ S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
442 SYY(I,K,L,JV)=ALFQ(I,K)*FYY(I,K,JV)+ALF1Q(I,K)*SYY(I,K,L,JV)
443 ✗ + +5.*( ALF3(I,K)*(FY(I,K,JV)-SY(I,K,L,JV))+ALF2(I,K)*TEMPTM )
444 SY (I,K,L,JV)=ALF(I,K)*FY(I,K,JV)+ALF1(I,K)*SY(I,K,L,JV)
445 ✗ + +3.*TEMPTM
446 SSXY(I,K,L,JV)=ALF (I,K)*FXY(I,K,JV)+ALF1(I,K)*SSXY(I,K,L,JV)
447 ✗ + +3.*(ALF1(I,K)*FX (I,K,JV)-ALF (I,K)*SSX (I,K,L,JV))
448 SYZ(I,K,L,JV)=ALF (I,K)*FYZ(I,K,JV)+ALF1(I,K)*SYZ(I,K,L,JV)
449 ✗ + +3.*(ALF1(I,K)*FZ (I,K,JV)-ALF (I,K)*SZ (I,K,L,JV))
450 ✗ SSX (I,K,L,JV)=SSX (I,K,L,JV)+FX (I,K,JV)
451 ✗ SZ (I,K,L,JV)=SZ (I,K,L,JV)+FZ (I,K,JV)
452 ✗ SSXX(I,K,L,JV)=SSXX(I,K,L,JV)+FXX(I,K,JV)
453 ✗ SSXZ(I,K,L,JV)=SSXZ(I,K,L,JV)+FXZ(I,K,JV)
454 ✗ SZZ(I,K,L,JV)=SZZ(I,K,L,JV)+FZZ(I,K,JV)
455 C
456 ELSE
457 C
458 ✗ TEMPTM=ALF(I,K)*S0(I,KP,L,JV)-ALF1(I,K)*F0(I,K,JV)
459 ✗ S0 (I,KP,L,JV)=S0(I,KP,L,JV)+F0(I,K,JV)
460 SYY(I,KP,L,JV)=ALFQ(I,K)*FYY(I,K,JV)+ALF1Q(I,K)*SYY(I,KP,L,JV)
461 ✗ + +5.*( ALF3(I,K)*(SY(I,KP,L,JV)-FY(I,K,JV))-ALF2(I,K)*TEMPTM )
462 SY (I,KP,L,JV)=ALF(I,K)*FY(I,K,JV)+ALF1(I,K)*SY(I,KP,L,JV)
463 ✗ + +3.*TEMPTM
464 SSXY(I,KP,L,JV)=ALF(I,K)*FXY(I,K,JV)+ALF1(I,K)*SSXY(I,KP,L,JV)
465 ✗ + +3.*(ALF(I,K)*SSX(I,KP,L,JV)-ALF1(I,K)*FX(I,K,JV))
466 SYZ(I,KP,L,JV)=ALF(I,K)*FYZ(I,K,JV)+ALF1(I,K)*SYZ(I,KP,L,JV)
467 ✗ + +3.*(ALF(I,K)*SZ(I,KP,L,JV)-ALF1(I,K)*FZ(I,K,JV))
468 ✗ SSX (I,KP,L,JV)=SSX (I,KP,L,JV)+FX (I,K,JV)
469 ✗ SZ (I,KP,L,JV)=SZ (I,KP,L,JV)+FZ (I,K,JV)
470 ✗ SSXX(I,KP,L,JV)=SSXX(I,KP,L,JV)+FXX(I,K,JV)
471 ✗ SSXZ(I,KP,L,JV)=SSXZ(I,KP,L,JV)+FXZ(I,K,JV)
472 ✗ SZZ(I,KP,L,JV)=SZZ(I,KP,L,JV)+FZZ(I,K,JV)
473 C
474 ENDIF
475 C
476 ✗ 330 CONTINUE
477 ✗ 33 CONTINUE
478 c print*,'ap ADVYP 33'
479 C
480 C traitement special pour le pole Sud (idem pole Nord)
481 C
482 K=LAT
483 C
484 SM0=0.
485 ✗ DO 40 JV=1,NTRA
486 ✗ S00(JV)=0.
487 ✗ 40 CONTINUE
488 C
489 ✗ DO 41 I=1,LON
490 C
491 ✗ IF(VGRI(I,K,L).GE.0.) THEN
492 ✗ FM(I,K)=VGRI(I,K,L)*DTY
493 ✗ ALF(I,K)=FM(I,K)/SM(I,K,L)
494 ✗ SM(I,K,L)=SM(I,K,L)-FM(I,K)
495 ✗ SM0=SM0+FM(I,K)
496 ENDIF
497 C
498 ✗ ALFQ(I,K)=ALF(I,K)*ALF(I,K)
499 ✗ ALF1(I,K)=1.-ALF(I,K)
500 ✗ ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
501 ✗ ALF2(I,K)=ALF1(I,K)-ALF(I,K)
502 ✗ ALF3(I,K)=ALF(I,K)*ALFQ(I,K)
503 ✗ ALF4(I,K)=ALF1(I,K)*ALF1Q(I,K)
504 C
505 ✗ 41 CONTINUE
506 c print*,'ap ADVYP 41'
507 C
508 ✗ DO 42 JV=1,NTRA
509 ✗ DO 420 I=1,LON
510 C
511 ✗ IF(VGRI(I,K,L).GE.0.) THEN
512 F0 (I,K,JV)=ALF(I,K)* ( S0(I,K,L,JV)+ALF1(I,K)*
513 ✗ + ( SY(I,K,L,JV)+ALF2(I,K)*SYY(I,K,L,JV) ) )
514 ✗ S00(JV)=S00(JV)+F0(I,K,JV)
515 C
516 ✗ S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0 (I,K,JV)
517 SY (I,K,L,JV)=ALF1Q(I,K)*
518 ✗ + (SY(I,K,L,JV)-3.*ALF(I,K)*SYY(I,K,L,JV))
519 ✗ SYY(I,K,L,JV)=ALF4 (I,K)*SYY(I,K,L,JV)
520 ✗ SSX (I,K,L,JV)=ALF1(I,K)*(SSX(I,K,L,JV)-ALF(I,K)*SSXY(I,K,L,JV))
521 ✗ SZ (I,K,L,JV)=ALF1(I,K)*(SZ(I,K,L,JV)-ALF(I,K)*SYZ(I,K,L,JV))
522 ✗ SSXX(I,K,L,JV)=ALF1 (I,K)*SSXX(I,K,L,JV)
523 ✗ SSXZ(I,K,L,JV)=ALF1 (I,K)*SSXZ(I,K,L,JV)
524 ✗ SZZ(I,K,L,JV)=ALF1 (I,K)*SZZ(I,K,L,JV)
525 ✗ SSXY(I,K,L,JV)=ALF1Q(I,K)*SSXY(I,K,L,JV)
526 ✗ SYZ(I,K,L,JV)=ALF1Q(I,K)*SYZ(I,K,L,JV)
527 ENDIF
528 C
529 ✗ 420 CONTINUE
530 ✗ 42 CONTINUE
531 c print*,'ap ADVYP 42'
532 C
533 ✗ DO 43 I=1,LON
534 ✗ IF(VGRI(I,K,L).LT.0.) THEN
535 ✗ FM(I,K)=-VGRI(I,K,L)*DTY
536 ✗ ALF(I,K)=FM(I,K)/SM0
537 ENDIF
538 ✗ 43 CONTINUE
539 c print*,'ap ADVYP 43'
540 C
541 ✗ DO 44 JV=1,NTRA
542 ✗ DO 440 I=1,LON
543 ✗ IF(VGRI(I,K,L).LT.0.) THEN
544 ✗ F0(I,K,JV)=ALF(I,K)*S00(JV)
545 ENDIF
546 ✗ 440 CONTINUE
547 ✗ 44 CONTINUE
548 C
549 C puts the temporary moments Fi into appropriate neighboring boxes
550 C
551 ✗ DO 45 I=1,LON
552 C
553 ✗ IF(VGRI(I,K,L).LT.0.) THEN
554 ✗ SM(I,K,L)=SM(I,K,L)+FM(I,K)
555 ✗ ALF(I,K)=FM(I,K)/SM(I,K,L)
556 ENDIF
557 C
558 ✗ ALFQ(I,K)=ALF(I,K)*ALF(I,K)
559 ✗ ALF1(I,K)=1.-ALF(I,K)
560 ✗ ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
561 ✗ ALF2(I,K)=ALF1(I,K)-ALF(I,K)
562 ✗ ALF3(I,K)=ALF1(I,K)*ALF(I,K)
563 C
564 ✗ 45 CONTINUE
565 c print*,'ap ADVYP 45'
566 C
567 ✗ DO 46 JV=1,NTRA
568 ✗ DO 460 I=1,LON
569 C
570 ✗ IF(VGRI(I,K,L).LT.0.) THEN
571 C
572 ✗ TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
573 ✗ S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
574 SYY(I,K,L,JV)=ALF1Q(I,K)*SYY(I,K,L,JV)
575 ✗ + +5.*(-ALF3 (I,K)*SY (I,K,L,JV)+ALF2(I,K)*TEMPTM )
576 ✗ SY (I,K,L,JV)=ALF1(I,K)*SY (I,K,L,JV)+3.*TEMPTM
577 ✗ SSXY(I,K,L,JV)=ALF1(I,K)*SSXY(I,K,L,JV)-3.*ALF(I,K)*SSX(I,K,L,JV)
578 ✗ SYZ(I,K,L,JV)=ALF1(I,K)*SYZ(I,K,L,JV)-3.*ALF(I,K)*SZ(I,K,L,JV)
579 C
580 ENDIF
581 C
582 ✗ 460 CONTINUE
583 ✗ 46 CONTINUE
584 c print*,'ap ADVYP 46'
585 C
586 ✗ 1 CONTINUE
587
588 c--------------------------------------------------
589 C bouclage cyclique horizontal .
590
591 ✗ DO l = 1,llm
592 ✗ DO jv = 1,ntra
593 ✗ DO j = 1,jjp1
594 ✗ SM(iip1,j,l) = SM(1,j,l)
595 ✗ S0(iip1,j,l,jv) = S0(1,j,l,jv)
596 ✗ SSX(iip1,j,l,jv) = SSX(1,j,l,jv)
597 ✗ SY(iip1,j,l,jv) = SY(1,j,l,jv)
598 ✗ SZ(iip1,j,l,jv) = SZ(1,j,l,jv)
599 END DO
600 END DO
601 END DO
602
603 c -------------------------------------------------------------------
604 C *** Test negativite:
605
606 c DO jv = 1,ntra
607 c DO l = 1,llm
608 c DO j = 1,jjp1
609 c DO i = 1,iip1
610 c IF (s0( i,j,l,jv ).lt.0.) THEN
611 c PRINT*, '------ S0 < 0 en FIN ADVYP ---'
612 c PRINT*, 'S0(',i,j,l,jv,')=', S0(i,j,l,jv)
613 cc STOP
614 c ENDIF
615 c ENDDO
616 c ENDDO
617 c ENDDO
618 c ENDDO
619
620
621 c -------------------------------------------------------------------
622 C *** Test : diag de la qtite totale de traceur dans
623 C l'atmosphere avant l'advection en Y
624
625 ✗ DO l = 1,llm
626 ✗ DO j = 1,jjp1
627 ✗ DO i = 1,iim
628 ✗ sqf = sqf + S0(i,j,l,ntra)
629 END DO
630 END DO
631 END DO
632 ✗ PRINT*,'---------- DIAG DANS ADVY - SORTIE --------'
633 ✗ PRINT*,'sqf=',sqf
634 c print*,'ap ADVYP fin'
635
636 c-----------------------------------------------------------------
637 C
638 ✗ RETURN
639 END
640
641
642
643
644
645
646
647
648
649
650
651
652