Context Navigation

advzp.f90 @ 5122

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

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

Download in other formats:

Original Format