Context Navigation

advzp.F @ 2981

Last change on this file since 2981 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: 12.2 KB

Line
1	!
2	! $Header$
3	!
4	SUBROUTINE ADVZP(LIMIT,DTZ,W,SM,S0,SSX,SY,SZ
5	. ,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra )
6
7	IMPLICIT NONE
8
9	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10	C C
11	C second-order moments (SOM) advection of tracer in Z direction C
12	C C
13	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
14	C C
15	C Source : Pascal Simon ( Meteo, CNRM ) C
16	C Adaptation : A.A. (LGGE) C
17	C Derniere Modif : 19/11/95 LAST C
18	C C
19	C sont les arguments d'entree pour le s-pg C
20	C C
21	C argument de sortie du s-pg C
22	C C
23	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
24	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
25	C
26	C Rem : Probleme aux poles il faut reecrire ce cas specifique
27	C Attention au sens de l'indexation
28	C
29
30	C
31	C parametres principaux du modele
32	C
33	include "dimensions.h"
34	include "paramet.h"
35	include "comgeom.h"
36	C
37	C Arguments :
38	C ----------
39	C dty : frequence fictive d'appel du transport
40	C parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
41	c
42	INTEGER lon,lat,niv
43	INTEGER i,j,jv,k,kp,l,lp
44	INTEGER ntra
45	c PARAMETER (ntra = 1)
46	c
47	REAL dtz
48	REAL w ( iip1,jjp1,llm )
49	c
50	C moments: SM total mass in each grid box
51	C S0 mass of tracer in each grid box
52	C Si 1rst order moment in i direction
53	C
54	REAL SM(iip1,jjp1,llm)
55	+ ,S0(iip1,jjp1,llm,ntra)
56	REAL SSX(iip1,jjp1,llm,ntra)
57	+ ,SY(iip1,jjp1,llm,ntra)
58	+ ,SZ(iip1,jjp1,llm,ntra)
59	+ ,SSXX(iip1,jjp1,llm,ntra)
60	+ ,SSXY(iip1,jjp1,llm,ntra)
61	+ ,SSXZ(iip1,jjp1,llm,ntra)
62	+ ,SYY(iip1,jjp1,llm,ntra)
63	+ ,SYZ(iip1,jjp1,llm,ntra)
64	+ ,SZZ(iip1,jjp1,llm,ntra)
65	C
66	C Local :
67	C -------
68	C
69	C mass fluxes across the boundaries (UGRI,VGRI,WGRI)
70	C mass fluxes in kg
71	C declaration :
72	C
73	REAL WGRI(iip1,jjp1,0:llm)
74
75	C Rem : UGRI et VGRI ne sont pas utilises dans
76	C cette subroutine ( advection en z uniquement )
77	C Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
78	C attention a celui de WGRI
79	C
80	C the moments F are similarly defined and used as temporary
81	C storage for portions of the grid boxes in transit
82	C
83	C the moments Fij are used as temporary storage for
84	C portions of the grid boxes in transit at the current level
85	C
86	C work arrays
87	C
88	C
89	REAL F0(iim,llm,ntra),FM(iim,llm)
90	REAL FX(iim,llm,ntra),FY(iim,llm,ntra)
91	REAL FZ(iim,llm,ntra)
92	REAL FXX(iim,llm,ntra),FXY(iim,llm,ntra)
93	REAL FXZ(iim,llm,ntra),FYY(iim,llm,ntra)
94	REAL FYZ(iim,llm,ntra),FZZ(iim,llm,ntra)
95	REAL S00(ntra)
96	REAL SM0 ! Just temporal variable
97	C
98	C work arrays
99	C
100	REAL ALF(iim),ALF1(iim)
101	REAL ALFQ(iim),ALF1Q(iim)
102	REAL ALF2(iim),ALF3(iim)
103	REAL ALF4(iim)
104	REAL TEMPTM ! Just temporal variable
105	REAL SLPMAX,S1MAX,S1NEW,S2NEW
106	c
107	REAL sqi,sqf
108	LOGICAL LIMIT
109
110	lon = iim ! rem : Il est possible qu'un pbl. arrive ici
111	lat = jjp1 ! a cause des dim. differentes entre les
112	niv = llm ! tab. S et VGRI
113
114	c-----------------------------------------------------------------
115	C *** Test : diag de la qtite totale de traceur dans
116	C l'atmosphere avant l'advection en Y
117	c
118	sqi = 0.
119	sqf = 0.
120	c
121	DO l = 1,llm
122	DO j = 1,jjp1
123	DO i = 1,iim
124	sqi = sqi + S0(i,j,l,ntra)
125	END DO
126	END DO
127	END DO
128	PRINT*,'---------- DIAG DANS ADVZP - ENTREE --------'
129	PRINT*,'sqi=',sqi
130
131	c-----------------------------------------------------------------
132	C Interface : adaptation nouveau modele
133	C -------------------------------------
134	C
135	C Conversion des flux de masses en kg
136
137	DO 500 l = 1,llm
138	DO 500 j = 1,jjp1
139	DO 500 i = 1,iip1
140	wgri (i,j,llm+1-l) = w (i,j,l)
141	500 CONTINUE
142	do j=1,jjp1
143	do i=1,iip1
144	wgri(i,j,0)=0.
145	enddo
146	enddo
147	c
148	cAA rem : Je ne suis pas sur du signe
149	cAA Je ne suis pas sur pour le 0:llm
150	c
151	c-----------------------------------------------------------------
152	C---------------------- START HERE -------------------------------
153	C
154	C boucle sur les latitudes
155	C
156	DO 1 K=1,LAT
157	C
158	C place limits on appropriate moments before transport
159	C (if flux-limiting is to be applied)
160	C
161	IF(.NOT.LIMIT) GO TO 101
162	C
163	DO 10 JV=1,NTRA
164	DO 10 L=1,NIV
165	DO 100 I=1,LON
166	IF(S0(I,K,L,JV).GT.0.) THEN
167	SLPMAX=S0(I,K,L,JV)
168	S1MAX =1.5*SLPMAX
169	S1NEW =AMIN1(S1MAX,AMAX1(-S1MAX,SZ(I,K,L,JV)))
170	S2NEW =AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. ,
171	+ AMAX1(ABS(S1NEW)-SLPMAX,SZZ(I,K,L,JV)) )
172	SZ (I,K,L,JV)=S1NEW
173	SZZ(I,K,L,JV)=S2NEW
174	SSXZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SSXZ(I,K,L,JV)))
175	SYZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SYZ(I,K,L,JV)))
176	ELSE
177	SZ (I,K,L,JV)=0.
178	SZZ(I,K,L,JV)=0.
179	SSXZ(I,K,L,JV)=0.
180	SYZ(I,K,L,JV)=0.
181	ENDIF
182	100 CONTINUE
183	10 CONTINUE
184	C
185	101 CONTINUE
186	C
187	C boucle sur les niveaux intercouches de 1 a NIV-1
188	C (flux nul au sommet L=0 et a la base L=NIV)
189	C
190	C calculate flux and moments between adjacent boxes
191	C (flux from LP to L if WGRI(L).lt.0, from L to LP if WGRI(L).gt.0)
192	C 1- create temporary moments/masses for partial boxes in transit
193	C 2- reajusts moments remaining in the box
194	C
195	DO 11 L=1,NIV-1
196	LP=L+1
197	C
198	DO 110 I=1,LON
199	C
200	IF(WGRI(I,K,L).LT.0.) THEN
201	FM(I,L)=-WGRI(I,K,L)*DTZ
202	ALF(I)=FM(I,L)/SM(I,K,LP)
203	SM(I,K,LP)=SM(I,K,LP)-FM(I,L)
204	ELSE
205	FM(I,L)=WGRI(I,K,L)*DTZ
206	ALF(I)=FM(I,L)/SM(I,K,L)
207	SM(I,K,L)=SM(I,K,L)-FM(I,L)
208	ENDIF
209	C
210	ALFQ (I)=ALF(I)*ALF(I)
211	ALF1 (I)=1.-ALF(I)
212	ALF1Q(I)=ALF1(I)*ALF1(I)
213	ALF2 (I)=ALF1(I)-ALF(I)
214	ALF3 (I)=ALF(I)*ALFQ(I)
215	ALF4 (I)=ALF1(I)*ALF1Q(I)
216	C
217	110 CONTINUE
218	C
219	DO 111 JV=1,NTRA
220	DO 1110 I=1,LON
221	C
222	IF(WGRI(I,K,L).LT.0.) THEN
223	C
224	F0 (I,L,JV)=ALF (I)* ( S0(I,K,LP,JV)-ALF1(I)*
225	+ ( SZ(I,K,LP,JV)-ALF2(I)*SZZ(I,K,LP,JV) ) )
226	FZ (I,L,JV)=ALFQ(I)(SZ(I,K,LP,JV)-3.ALF1(I)*SZZ(I,K,LP,JV))
227	FZZ(I,L,JV)=ALF3(I)*SZZ(I,K,LP,JV)
228	FXZ(I,L,JV)=ALFQ(I)*SSXZ(I,K,LP,JV)
229	FYZ(I,L,JV)=ALFQ(I)*SYZ(I,K,LP,JV)
230	FX (I,L,JV)=ALF (I)(SSX(I,K,LP,JV)-ALF1(I)SSXZ(I,K,LP,JV))
231	FY (I,L,JV)=ALF (I)(SY(I,K,LP,JV)-ALF1(I)SYZ(I,K,LP,JV))
232	FXX(I,L,JV)=ALF (I)*SSXX(I,K,LP,JV)
233	FXY(I,L,JV)=ALF (I)*SSXY(I,K,LP,JV)
234	FYY(I,L,JV)=ALF (I)*SYY(I,K,LP,JV)
235	C
236	S0 (I,K,LP,JV)=S0 (I,K,LP,JV)-F0 (I,L,JV)
237	SZ (I,K,LP,JV)=ALF1Q(I)
238	+ (SZ(I,K,LP,JV)+3.ALF(I)*SZZ(I,K,LP,JV))
239	SZZ(I,K,LP,JV)=ALF4 (I)*SZZ(I,K,LP,JV)
240	SSXZ(I,K,LP,JV)=ALF1Q(I)*SSXZ(I,K,LP,JV)
241	SYZ(I,K,LP,JV)=ALF1Q(I)*SYZ(I,K,LP,JV)
242	SSX (I,K,LP,JV)=SSX (I,K,LP,JV)-FX (I,L,JV)
243	SY (I,K,LP,JV)=SY (I,K,LP,JV)-FY (I,L,JV)
244	SSXX(I,K,LP,JV)=SSXX(I,K,LP,JV)-FXX(I,L,JV)
245	SSXY(I,K,LP,JV)=SSXY(I,K,LP,JV)-FXY(I,L,JV)
246	SYY(I,K,LP,JV)=SYY(I,K,LP,JV)-FYY(I,L,JV)
247	C
248	ELSE
249	C
250	F0 (I,L,JV)=ALF (I)*(S0(I,K,L,JV)
251	+ +ALF1(I) * (SZ(I,K,L,JV)+ALF2(I)*SZZ(I,K,L,JV)) )
252	FZ (I,L,JV)=ALFQ(I)(SZ(I,K,L,JV)+3.ALF1(I)*SZZ(I,K,L,JV))
253	FZZ(I,L,JV)=ALF3(I)*SZZ(I,K,L,JV)
254	FXZ(I,L,JV)=ALFQ(I)*SSXZ(I,K,L,JV)
255	FYZ(I,L,JV)=ALFQ(I)*SYZ(I,K,L,JV)
256	FX (I,L,JV)=ALF (I)(SSX(I,K,L,JV)+ALF1(I)SSXZ(I,K,L,JV))
257	FY (I,L,JV)=ALF (I)(SY(I,K,L,JV)+ALF1(I)SYZ(I,K,L,JV))
258	FXX(I,L,JV)=ALF (I)*SSXX(I,K,L,JV)
259	FXY(I,L,JV)=ALF (I)*SSXY(I,K,L,JV)
260	FYY(I,L,JV)=ALF (I)*SYY(I,K,L,JV)
261	C
262	S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0(I,L,JV)
263	SZ (I,K,L,JV)=ALF1Q(I)(SZ(I,K,L,JV)-3.ALF(I)*SZZ(I,K,L,JV))
264	SZZ(I,K,L,JV)=ALF4 (I)*SZZ(I,K,L,JV)
265	SSXZ(I,K,L,JV)=ALF1Q(I)*SSXZ(I,K,L,JV)
266	SYZ(I,K,L,JV)=ALF1Q(I)*SYZ(I,K,L,JV)
267	SSX (I,K,L,JV)=SSX (I,K,L,JV)-FX (I,L,JV)
268	SY (I,K,L,JV)=SY (I,K,L,JV)-FY (I,L,JV)
269	SSXX(I,K,L,JV)=SSXX(I,K,L,JV)-FXX(I,L,JV)
270	SSXY(I,K,L,JV)=SSXY(I,K,L,JV)-FXY(I,L,JV)
271	SYY(I,K,L,JV)=SYY(I,K,L,JV)-FYY(I,L,JV)
272	C
273	ENDIF
274	C
275	1110 CONTINUE
276	111 CONTINUE
277	C
278	11 CONTINUE
279	C
280	C puts the temporary moments Fi into appropriate neighboring boxes
281	C
282	DO 12 L=1,NIV-1
283	LP=L+1
284	C
285	DO 120 I=1,LON
286	C
287	IF(WGRI(I,K,L).LT.0.) THEN
288	SM(I,K,L)=SM(I,K,L)+FM(I,L)
289	ALF(I)=FM(I,L)/SM(I,K,L)
290	ELSE
291	SM(I,K,LP)=SM(I,K,LP)+FM(I,L)
292	ALF(I)=FM(I,L)/SM(I,K,LP)
293	ENDIF
294	C
295	ALF1(I)=1.-ALF(I)
296	ALFQ(I)=ALF(I)*ALF(I)
297	ALF1Q(I)=ALF1(I)*ALF1(I)
298	ALF2(I)=ALF(I)*ALF1(I)
299	ALF3(I)=ALF1(I)-ALF(I)
300	C
301	120 CONTINUE
302	C
303	DO 121 JV=1,NTRA
304	DO 1210 I=1,LON
305	C
306	IF(WGRI(I,K,L).LT.0.) THEN
307	C
308	TEMPTM=-ALF(I)S0(I,K,L,JV)+ALF1(I)F0(I,L,JV)
309	S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,L,JV)
310	SZZ(I,K,L,JV)=ALFQ(I)FZZ(I,L,JV)+ALF1Q(I)SZZ(I,K,L,JV)
311	+ +5.( ALF2(I)(FZ(I,L,JV)-SZ(I,K,L,JV))+ALF3(I)*TEMPTM )
312	SZ (I,K,L,JV)=ALF (I)FZ (I,L,JV)+ALF1 (I)SZ (I,K,L,JV)
313	+ +3.*TEMPTM
314	SSXZ(I,K,L,JV)=ALF (I)FXZ(I,L,JV)+ALF1 (I)SSXZ(I,K,L,JV)
315	+ +3.(ALF1(I)FX (I,L,JV)-ALF (I)*SSX (I,K,L,JV))
316	SYZ(I,K,L,JV)=ALF (I)FYZ(I,L,JV)+ALF1 (I)SYZ(I,K,L,JV)
317	+ +3.(ALF1(I)FY (I,L,JV)-ALF (I)*SY (I,K,L,JV))
318	SSX (I,K,L,JV)=SSX (I,K,L,JV)+FX (I,L,JV)
319	SY (I,K,L,JV)=SY (I,K,L,JV)+FY (I,L,JV)
320	SSXX(I,K,L,JV)=SSXX(I,K,L,JV)+FXX(I,L,JV)
321	SSXY(I,K,L,JV)=SSXY(I,K,L,JV)+FXY(I,L,JV)
322	SYY(I,K,L,JV)=SYY(I,K,L,JV)+FYY(I,L,JV)
323	C
324	ELSE
325	C
326	TEMPTM=ALF(I)S0(I,K,LP,JV)-ALF1(I)F0(I,L,JV)
327	S0 (I,K,LP,JV)=S0(I,K,LP,JV)+F0(I,L,JV)
328	SZZ(I,K,LP,JV)=ALFQ(I)FZZ(I,L,JV)+ALF1Q(I)SZZ(I,K,LP,JV)
329	+ +5.( ALF2(I)(SZ(I,K,LP,JV)-FZ(I,L,JV))-ALF3(I)*TEMPTM )
330	SZ (I,K,LP,JV)=ALF (I)FZ(I,L,JV)+ALF1(I)SZ(I,K,LP,JV)
331	+ +3.*TEMPTM
332	SSXZ(I,K,LP,JV)=ALF(I)FXZ(I,L,JV)+ALF1(I)SSXZ(I,K,LP,JV)
333	+ +3.(ALF(I)SSX(I,K,LP,JV)-ALF1(I)*FX(I,L,JV))
334	SYZ(I,K,LP,JV)=ALF(I)FYZ(I,L,JV)+ALF1(I)SYZ(I,K,LP,JV)
335	+ +3.(ALF(I)SY(I,K,LP,JV)-ALF1(I)*FY(I,L,JV))
336	SSX (I,K,LP,JV)=SSX (I,K,LP,JV)+FX (I,L,JV)
337	SY (I,K,LP,JV)=SY (I,K,LP,JV)+FY (I,L,JV)
338	SSXX(I,K,LP,JV)=SSXX(I,K,LP,JV)+FXX(I,L,JV)
339	SSXY(I,K,LP,JV)=SSXY(I,K,LP,JV)+FXY(I,L,JV)
340	SYY(I,K,LP,JV)=SYY(I,K,LP,JV)+FYY(I,L,JV)
341	C
342	ENDIF
343	C
344	1210 CONTINUE
345	121 CONTINUE
346	C
347	12 CONTINUE
348	C
349	C fin de la boucle principale sur les latitudes
350	C
351	1 CONTINUE
352	C
353	DO l = 1,llm
354	DO j = 1,jjp1
355	SM(iip1,j,l) = SM(1,j,l)
356	S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
357	SSX(iip1,j,l,ntra) = SSX(1,j,l,ntra)
358	SY(iip1,j,l,ntra) = SY(1,j,l,ntra)
359	SZ(iip1,j,l,ntra) = SZ(1,j,l,ntra)
360	ENDDO
361	ENDDO
362	c C-------------------------------------------------------------
363	C *** Test : diag de la qqtite totale de tarceur
364	C dans l'atmosphere avant l'advection en z
365	DO l = 1,llm
366	DO j = 1,jjp1
367	DO i = 1,iim
368	sqf = sqf + S0(i,j,l,ntra)
369	ENDDO
370	ENDDO
371	ENDDO
372	PRINT*,'-------- DIAG DANS ADVZ - SORTIE ---------'
373	PRINT*,'sqf=', sqf
374
375	RETURN
376	END

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

Download in other formats:

Original Format