Context Navigation

advy.f90 @ 5139

Last change on this file since 5139 was 5136, checked in by abarral, 8 weeks ago
Put comgeom.h, comgeom2.h into modules
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: 11.5 KB

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

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

Download in other formats:

Original Format