Context Navigation

advyp.f90 @ 5134

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

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

Download in other formats:

Original Format