Context Navigation

advzp.f90 @ 5408

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

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

Download in other formats:

Original Format