Context Navigation

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

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

Download in other formats:

Original Format