Context Navigation

advy.F @ 2597

Last change on this file since 2597 was 2597, checked in by Ehouarn Millour, 8 years ago
Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod. 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: 10.1 KB

Line
1	!
2	! $Header$
3	!
4	SUBROUTINE advy(limit,dty,pbarv,sm,s0,sx,sy,sz)
5	IMPLICIT NONE
6
7	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8	C C
9	C first-order moments (SOM) advection of tracer in Y direction C
10	C C
11	C Source : Pascal Simon ( Meteo, CNRM ) C
12	C Adaptation : A.A. (LGGE) C
13	C Derniere Modif : 15/12/94 LAST
14	C C
15	C sont les arguments d'entree pour le s-pg C
16	C C
17	C argument de sortie du s-pg C
18	C C
19	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
20	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
21	C
22	C Rem : Probleme aux poles il faut reecrire ce cas specifique
23	C Attention au sens de l'indexation
24	C
25	C parametres principaux du modele
26	C
27	C
28	#include "dimensions.h"
29	#include "paramet.h"
30	#include "comvert.h"
31	#include "comgeom2.h"
32
33	C Arguments :
34	C ----------
35	C dty : frequence fictive d'appel du transport
36	C parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
37
38	INTEGER lon,lat,niv
39	INTEGER i,j,jv,k,kp,l
40	INTEGER ntra
41	PARAMETER (ntra = 1)
42
43	REAL dty
44	REAL pbarv ( iip1,jjm, llm )
45
46	C moments: SM total mass in each grid box
47	C S0 mass of tracer in each grid box
48	C Si 1rst order moment in i direction
49	C
50	REAL SM(iip1,jjp1,llm)
51	+ ,S0(iip1,jjp1,llm,ntra)
52	REAL sx(iip1,jjp1,llm,ntra)
53	+ ,sy(iip1,jjp1,llm,ntra)
54	+ ,sz(iip1,jjp1,llm,ntra)
55
56
57	C Local :
58	C -------
59
60	C mass fluxes across the boundaries (UGRI,VGRI,WGRI)
61	C mass fluxes in kg
62	C declaration :
63
64	REAL VGRI(iip1,0:jjp1,llm)
65
66	C Rem : UGRI et WGRI ne sont pas utilises dans
67	C cette subroutine ( advection en y uniquement )
68	C Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
69	C
70	C the moments F are similarly defined and used as temporary
71	C storage for portions of the grid boxes in transit
72	C
73	REAL F0(iim,0:jjp1,ntra),FM(iim,0:jjp1)
74	REAL FX(iim,jjm,ntra),FY(iim,jjm,ntra)
75	REAL FZ(iim,jjm,ntra)
76	REAL S00(ntra)
77	REAL SM0 ! Just temporal variable
78	C
79	C work arrays
80	C
81	REAL ALF(iim,0:jjp1),ALF1(iim,0:jjp1)
82	REAL ALFQ(iim,0:jjp1),ALF1Q(iim,0:jjp1)
83	REAL TEMPTM ! Just temporal variable
84	c
85	C Special pour poles
86	c
87	REAL sbms,sfms,sfzs,sbmn,sfmn,sfzn
88	REAL sns0(ntra),snsz(ntra),snsm
89	REAL s1v(llm),slatv(llm)
90	REAL qy1(iim,llm,ntra),qylat(iim,llm,ntra)
91	REAL cx1(llm,ntra), cxLAT(llm,ntra)
92	REAL cy1(llm,ntra), cyLAT(llm,ntra)
93	REAL z1(iim), zcos(iim), zsin(iim)
94	real smpn,smps,s0pn,s0ps
95	REAL SSUM
96	EXTERNAL SSUM
97	C
98	REAL sqi,sqf
99	LOGICAL LIMIT
100
101	lon = iim ! rem : Il est possible qu'un pbl. arrive ici
102	lat = jjp1 ! a cause des dim. differentes entre les
103	niv=llm
104
105	C
106	C the moments Fi are used as temporary storage for
107	C portions of the grid boxes in transit at the current level
108	C
109	C work arrays
110	C
111
112	DO l = 1,llm
113	DO j = 1,jjm
114	DO i = 1,iip1
115	vgri (i,j,llm+1-l)=-1.*pbarv(i,j,l)
116	enddo
117	enddo
118	do i=1,iip1
119	vgri(i,0,l) = 0.
120	vgri(i,jjp1,l) = 0.
121	enddo
122	enddo
123
124	DO 1 L=1,NIV
125	C
126	C place limits on appropriate moments before transport
127	C (if flux-limiting is to be applied)
128	C
129	IF(.NOT.LIMIT) GO TO 11
130	C
131	DO 10 JV=1,NTRA
132	DO 10 K=1,LAT
133	DO 100 I=1,LON
134	sy(I,K,L,JV)=SIGN(AMIN1(AMAX1(S0(I,K,L,JV),0.),
135	+ ABS(sy(I,K,L,JV))),sy(I,K,L,JV))
136	100 CONTINUE
137	10 CONTINUE
138	C
139	11 CONTINUE
140	C
141	C le flux a travers le pole Nord est traite separement
142	C
143	SM0=0.
144	DO 20 JV=1,NTRA
145	S00(JV)=0.
146	20 CONTINUE
147	C
148	DO 21 I=1,LON
149	C
150	IF(VGRI(I,0,L).LE.0.) THEN
151	FM(I,0)=-VGRI(I,0,L)*DTY
152	ALF(I,0)=FM(I,0)/SM(I,1,L)
153	SM(I,1,L)=SM(I,1,L)-FM(I,0)
154	SM0=SM0+FM(I,0)
155	ENDIF
156	C
157	ALFQ(I,0)=ALF(I,0)*ALF(I,0)
158	ALF1(I,0)=1.-ALF(I,0)
159	ALF1Q(I,0)=ALF1(I,0)*ALF1(I,0)
160	C
161	21 CONTINUE
162	C
163	DO 22 JV=1,NTRA
164	DO 220 I=1,LON
165	C
166	IF(VGRI(I,0,L).LE.0.) THEN
167	C
168	F0(I,0,JV)=ALF(I,0)*
169	+ ( S0(I,1,L,JV)-ALF1(I,0)*sy(I,1,L,JV) )
170	C
171	S00(JV)=S00(JV)+F0(I,0,JV)
172	S0(I,1,L,JV)=S0(I,1,L,JV)-F0(I,0,JV)
173	sy(I,1,L,JV)=ALF1Q(I,0)*sy(I,1,L,JV)
174	sx(I,1,L,JV)=ALF1 (I,0)*sx(I,1,L,JV)
175	sz(I,1,L,JV)=ALF1 (I,0)*sz(I,1,L,JV)
176	C
177	ENDIF
178	C
179	220 CONTINUE
180	22 CONTINUE
181	C
182	DO 23 I=1,LON
183	IF(VGRI(I,0,L).GT.0.) THEN
184	FM(I,0)=VGRI(I,0,L)*DTY
185	ALF(I,0)=FM(I,0)/SM0
186	ENDIF
187	23 CONTINUE
188	C
189	DO 24 JV=1,NTRA
190	DO 240 I=1,LON
191	IF(VGRI(I,0,L).GT.0.) THEN
192	F0(I,0,JV)=ALF(I,0)*S00(JV)
193	ENDIF
194	240 CONTINUE
195	24 CONTINUE
196	C
197	C puts the temporary moments Fi into appropriate neighboring boxes
198	C
199	DO 25 I=1,LON
200	C
201	IF(VGRI(I,0,L).GT.0.) THEN
202	SM(I,1,L)=SM(I,1,L)+FM(I,0)
203	ALF(I,0)=FM(I,0)/SM(I,1,L)
204	ENDIF
205	C
206	ALF1(I,0)=1.-ALF(I,0)
207	C
208	25 CONTINUE
209	C
210	DO 26 JV=1,NTRA
211	DO 260 I=1,LON
212	C
213	IF(VGRI(I,0,L).GT.0.) THEN
214	C
215	TEMPTM=ALF(I,0)S0(I,1,L,JV)-ALF1(I,0)F0(I,0,JV)
216	S0(I,1,L,JV)=S0(I,1,L,JV)+F0(I,0,JV)
217	sy(I,1,L,JV)=ALF1(I,0)sy(I,1,L,JV)+3.TEMPTM
218	C
219	ENDIF
220	C
221	260 CONTINUE
222	26 CONTINUE
223	C
224	C calculate flux and moments between adjacent boxes
225	C 1- create temporary moments/masses for partial boxes in transit
226	C 2- reajusts moments remaining in the box
227	C
228	C flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0
229	C
230	DO 30 K=1,LAT-1
231	KP=K+1
232	DO 300 I=1,LON
233	C
234	IF(VGRI(I,K,L).LT.0.) THEN
235	FM(I,K)=-VGRI(I,K,L)*DTY
236	ALF(I,K)=FM(I,K)/SM(I,KP,L)
237	SM(I,KP,L)=SM(I,KP,L)-FM(I,K)
238	ELSE
239	FM(I,K)=VGRI(I,K,L)*DTY
240	ALF(I,K)=FM(I,K)/SM(I,K,L)
241	SM(I,K,L)=SM(I,K,L)-FM(I,K)
242	ENDIF
243	C
244	ALFQ(I,K)=ALF(I,K)*ALF(I,K)
245	ALF1(I,K)=1.-ALF(I,K)
246	ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
247	C
248	300 CONTINUE
249	30 CONTINUE
250	C
251	DO 31 JV=1,NTRA
252	DO 31 K=1,LAT-1
253	KP=K+1
254	DO 310 I=1,LON
255	C
256	IF(VGRI(I,K,L).LT.0.) THEN
257	C
258	F0(I,K,JV)=ALF (I,K)*
259	+ ( S0(I,KP,L,JV)-ALF1(I,K)*sy(I,KP,L,JV) )
260	FY(I,K,JV)=ALFQ(I,K)*sy(I,KP,L,JV)
261	FX(I,K,JV)=ALF (I,K)*sx(I,KP,L,JV)
262	FZ(I,K,JV)=ALF (I,K)*sz(I,KP,L,JV)
263	C
264	S0(I,KP,L,JV)=S0(I,KP,L,JV)-F0(I,K,JV)
265	sy(I,KP,L,JV)=ALF1Q(I,K)*sy(I,KP,L,JV)
266	sx(I,KP,L,JV)=sx(I,KP,L,JV)-FX(I,K,JV)
267	sz(I,KP,L,JV)=sz(I,KP,L,JV)-FZ(I,K,JV)
268	C
269	ELSE
270	C
271	F0(I,K,JV)=ALF (I,K)*
272	+ ( S0(I,K,L,JV)+ALF1(I,K)*sy(I,K,L,JV) )
273	FY(I,K,JV)=ALFQ(I,K)*sy(I,K,L,JV)
274	FX(I,K,JV)=ALF(I,K)*sx(I,K,L,JV)
275	FZ(I,K,JV)=ALF(I,K)*sz(I,K,L,JV)
276	C
277	S0(I,K,L,JV)=S0(I,K,L,JV)-F0(I,K,JV)
278	sy(I,K,L,JV)=ALF1Q(I,K)*sy(I,K,L,JV)
279	sx(I,K,L,JV)=sx(I,K,L,JV)-FX(I,K,JV)
280	sz(I,K,L,JV)=sz(I,K,L,JV)-FZ(I,K,JV)
281	C
282	ENDIF
283	C
284	310 CONTINUE
285	31 CONTINUE
286	C
287	C puts the temporary moments Fi into appropriate neighboring boxes
288	C
289	DO 32 K=1,LAT-1
290	KP=K+1
291	DO 320 I=1,LON
292	C
293	IF(VGRI(I,K,L).LT.0.) THEN
294	SM(I,K,L)=SM(I,K,L)+FM(I,K)
295	ALF(I,K)=FM(I,K)/SM(I,K,L)
296	ELSE
297	SM(I,KP,L)=SM(I,KP,L)+FM(I,K)
298	ALF(I,K)=FM(I,K)/SM(I,KP,L)
299	ENDIF
300	C
301	ALF1(I,K)=1.-ALF(I,K)
302	C
303	320 CONTINUE
304	32 CONTINUE
305	C
306	DO 33 JV=1,NTRA
307	DO 33 K=1,LAT-1
308	KP=K+1
309	DO 330 I=1,LON
310	C
311	IF(VGRI(I,K,L).LT.0.) THEN
312	C
313	TEMPTM=-ALF(I,K)S0(I,K,L,JV)+ALF1(I,K)F0(I,K,JV)
314	S0(I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
315	sy(I,K,L,JV)=ALF(I,K)FY(I,K,JV)+ALF1(I,K)sy(I,K,L,JV)
316	+ +3.*TEMPTM
317	sx(I,K,L,JV)=sx(I,K,L,JV)+FX(I,K,JV)
318	sz(I,K,L,JV)=sz(I,K,L,JV)+FZ(I,K,JV)
319	C
320	ELSE
321	C
322	TEMPTM=ALF(I,K)S0(I,KP,L,JV)-ALF1(I,K)F0(I,K,JV)
323	S0(I,KP,L,JV)=S0(I,KP,L,JV)+F0(I,K,JV)
324	sy(I,KP,L,JV)=ALF(I,K)FY(I,K,JV)+ALF1(I,K)sy(I,KP,L,JV)
325	+ +3.*TEMPTM
326	sx(I,KP,L,JV)=sx(I,KP,L,JV)+FX(I,K,JV)
327	sz(I,KP,L,JV)=sz(I,KP,L,JV)+FZ(I,K,JV)
328	C
329	ENDIF
330	C
331	330 CONTINUE
332	33 CONTINUE
333	C
334	C traitement special pour le pole Sud (idem pole Nord)
335	C
336	K=LAT
337	C
338	SM0=0.
339	DO 40 JV=1,NTRA
340	S00(JV)=0.
341	40 CONTINUE
342	C
343	DO 41 I=1,LON
344	C
345	IF(VGRI(I,K,L).GE.0.) THEN
346	FM(I,K)=VGRI(I,K,L)*DTY
347	ALF(I,K)=FM(I,K)/SM(I,K,L)
348	SM(I,K,L)=SM(I,K,L)-FM(I,K)
349	SM0=SM0+FM(I,K)
350	ENDIF
351	C
352	ALFQ(I,K)=ALF(I,K)*ALF(I,K)
353	ALF1(I,K)=1.-ALF(I,K)
354	ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
355	C
356	41 CONTINUE
357	C
358	DO 42 JV=1,NTRA
359	DO 420 I=1,LON
360	C
361	IF(VGRI(I,K,L).GE.0.) THEN
362	F0 (I,K,JV)=ALF(I,K)*
363	+ ( S0(I,K,L,JV)+ALF1(I,K)*sy(I,K,L,JV) )
364	S00(JV)=S00(JV)+F0(I,K,JV)
365	C
366	S0(I,K,L,JV)=S0 (I,K,L,JV)-F0 (I,K,JV)
367	sy(I,K,L,JV)=ALF1Q(I,K)*sy(I,K,L,JV)
368	sx(I,K,L,JV)=ALF1(I,K)*sx(I,K,L,JV)
369	sz(I,K,L,JV)=ALF1(I,K)*sz(I,K,L,JV)
370	ENDIF
371	C
372	420 CONTINUE
373	42 CONTINUE
374	C
375	DO 43 I=1,LON
376	IF(VGRI(I,K,L).LT.0.) THEN
377	FM(I,K)=-VGRI(I,K,L)*DTY
378	ALF(I,K)=FM(I,K)/SM0
379	ENDIF
380	43 CONTINUE
381	C
382	DO 44 JV=1,NTRA
383	DO 440 I=1,LON
384	IF(VGRI(I,K,L).LT.0.) THEN
385	F0(I,K,JV)=ALF(I,K)*S00(JV)
386	ENDIF
387	440 CONTINUE
388	44 CONTINUE
389	C
390	C puts the temporary moments Fi into appropriate neighboring boxes
391	C
392	DO 45 I=1,LON
393	C
394	IF(VGRI(I,K,L).LT.0.) THEN
395	SM(I,K,L)=SM(I,K,L)+FM(I,K)
396	ALF(I,K)=FM(I,K)/SM(I,K,L)
397	ENDIF
398	C
399	ALF1(I,K)=1.-ALF(I,K)
400	C
401	45 CONTINUE
402	C
403	DO 46 JV=1,NTRA
404	DO 460 I=1,LON
405	C
406	IF(VGRI(I,K,L).LT.0.) THEN
407	C
408	TEMPTM=-ALF(I,K)S0(I,K,L,JV)+ALF1(I,K)F0(I,K,JV)
409	S0(I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
410	sy(I,K,L,JV)=ALF1(I,K)sy(I,K,L,JV)+3.TEMPTM
411	C
412	ENDIF
413	C
414	460 CONTINUE
415	46 CONTINUE
416	C
417	1 CONTINUE
418	C
419	RETURN
420	END
421

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

Download in other formats:

Original Format