Context Navigation

advyp.F @ 5081

Last change on this file since 5081 was 2600, checked in by Ehouarn Millour, 8 years ago
Cleanup in the dynamics: turn comvert.h into module comvert_mod.F90 EM
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: 19.2 KB

Line
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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format