Context Navigation

advz.F @ 5081

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

Line
1	!
2	! $Header$
3	!
4	SUBROUTINE advz(limit,dtz,w,sm,s0,sx,sy,sz)
5	IMPLICIT NONE
6
7	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8	C C
9	C first-order moments (FOM) advection of tracer in Z direction C
10	C C
11	C Source : Pascal Simon (Meteo,CNRM) C
12	C Adaptation : A.Armengaud (LGGE) juin 94 C
13	C C
14	C C
15	C sont des arguments d'entree pour le s-pg... C
16	C C
17	C dq est l'argument de sortie pour le s-pg C
18	C C
19	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
20	C
21	C parametres principaux du modele
22	C
23	include "dimensions.h"
24	include "paramet.h"
25
26	C #include "traceur.h"
27
28	C Arguments :
29	C -----------
30	C dtz : frequence fictive d'appel du transport
31	C w : flux de masse en z en Pa.m2.s-1
32
33	INTEGER ntra
34	PARAMETER (ntra = 1)
35
36	REAL dtz
37	REAL w ( iip1,jjp1,llm )
38
39	C moments: SM total mass in each grid box
40	C S0 mass of tracer in each grid box
41	C Si 1rst order moment in i direction
42	C
43	REAL SM(iip1,jjp1,llm)
44	+ ,S0(iip1,jjp1,llm,ntra)
45	REAL sx(iip1,jjp1,llm,ntra)
46	+ ,sy(iip1,jjp1,llm,ntra)
47	+ ,sz(iip1,jjp1,llm,ntra)
48
49
50	C Local :
51	C -------
52
53	C mass fluxes across the boundaries (UGRI,VGRI,WGRI)
54	C mass fluxes in kg
55	C declaration :
56
57	REAL WGRI(iip1,jjp1,0:llm)
58
59	C
60	C the moments F are used as temporary storage for
61	C portions of grid boxes in transit at the current latitude
62	C
63	REAL FM(iim,llm)
64	REAL F0(iim,llm,ntra),FX(iim,llm,ntra)
65	REAL FY(iim,llm,ntra),FZ(iim,llm,ntra)
66	C
67	C work arrays
68	C
69	REAL ALF(iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
70	REAL TEMPTM ! Just temporal variable
71	REAL sqi,sqf
72	C
73	LOGICAL LIMIT
74	INTEGER lon,lat,niv
75	INTEGER i,j,jv,k,l,lp
76
77	lon = iim
78	lat = jjp1
79	niv = llm
80
81	C * Test de passage d'arguments ****
82
83	c DO 399 l = 1, llm
84	c DO 399 j = 1, jjp1
85	c DO 399 i = 1, iip1
86	c IF (S0(i,j,l,ntra) .lt. 0. ) THEN
87	c PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
88	c print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
89	c print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
90	c print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
91	c PRINT*, 'AIE !! debut ADVZ - pbl arg. passage dans ADVZ'
92	c STOP
93	c ENDIF
94	399 CONTINUE
95
96	C-----------------------------------------------------------------
97	C *** Test : diag de la qqtite totale de traceur
98	C dans l'atmosphere avant l'advection en z
99	sqi = 0.
100	sqf = 0.
101
102	DO l = 1,llm
103	DO j = 1,jjp1
104	DO i = 1,iim
105	cIM 240305 sqi = sqi + S0(i,j,l,9)
106	sqi = sqi + S0(i,j,l,ntra)
107	ENDDO
108	ENDDO
109	ENDDO
110	PRINT*,'-------- DIAG DANS ADVZ - ENTREE ---------'
111	PRINT*,'sqi=',sqi
112
113	C-----------------------------------------------------------------
114	C Interface : adaptation nouveau modele
115	C -------------------------------------
116	C
117	C Conversion du flux de masse en kg.s-1
118
119	DO 500 l = 1,llm
120	DO 500 j = 1,jjp1
121	DO 500 i = 1,iip1
122	c wgri (i,j,llm+1-l) = w (i,j,l) / g
123	wgri (i,j,llm+1-l) = w (i,j,l)
124	c wgri (i,j,0) = 0. ! a detruire ult.
125	c wgri (i,j,l) = 0.1 ! w (i,j,l)
126	c wgri (i,j,llm) = 0. ! a detruire ult.
127	500 CONTINUE
128	DO j = 1,jjp1
129	DO i = 1,iip1
130	wgri(i,j,0)=0.
131	enddo
132	enddo
133
134	C-----------------------------------------------------------------
135
136	C start here
137	C boucle sur les latitudes
138	C
139	DO 1 K=1,LAT
140	C
141	C place limits on appropriate moments before transport
142	C (if flux-limiting is to be applied)
143	C
144	IF(.NOT.LIMIT) GO TO 101
145	C
146	DO 10 JV=1,NTRA
147	DO 10 L=1,NIV
148	DO 100 I=1,LON
149	sz(I,K,L,JV)=SIGN(AMIN1(AMAX1(S0(I,K,L,JV),0.),
150	+ ABS(sz(I,K,L,JV))),sz(I,K,L,JV))
151	100 CONTINUE
152	10 CONTINUE
153	C
154	101 CONTINUE
155	C
156	C boucle sur les niveaux intercouches de 1 a NIV-1
157	C (flux nul au sommet L=0 et a la base L=NIV)
158	C
159	C calculate flux and moments between adjacent boxes
160	C (flux from LP to L if WGRI(L).lt.0, from L to LP if WGRI(L).gt.0)
161	C 1- create temporary moments/masses for partial boxes in transit
162	C 2- reajusts moments remaining in the box
163	C
164	DO 11 L=1,NIV-1
165	LP=L+1
166	C
167	DO 110 I=1,LON
168	C
169	IF(WGRI(I,K,L).LT.0.) THEN
170	FM(I,L)=-WGRI(I,K,L)*DTZ
171	ALF(I)=FM(I,L)/SM(I,K,LP)
172	SM(I,K,LP)=SM(I,K,LP)-FM(I,L)
173	ELSE
174	FM(I,L)=WGRI(I,K,L)*DTZ
175	ALF(I)=FM(I,L)/SM(I,K,L)
176	SM(I,K,L)=SM(I,K,L)-FM(I,L)
177	ENDIF
178	C
179	ALFQ (I)=ALF(I)*ALF(I)
180	ALF1 (I)=1.-ALF(I)
181	ALF1Q(I)=ALF1(I)*ALF1(I)
182	C
183	110 CONTINUE
184	C
185	DO 111 JV=1,NTRA
186	DO 1110 I=1,LON
187	C
188	IF(WGRI(I,K,L).LT.0.) THEN
189	C
190	F0(I,L,JV)=ALF (I)( S0(I,K,LP,JV)-ALF1(I)sz(I,K,LP,JV) )
191	FZ(I,L,JV)=ALFQ(I)*sz(I,K,LP,JV)
192	FX(I,L,JV)=ALF (I)*sx(I,K,LP,JV)
193	FY(I,L,JV)=ALF (I)*sy(I,K,LP,JV)
194	C
195	S0(I,K,LP,JV)=S0(I,K,LP,JV)-F0(I,L,JV)
196	sz(I,K,LP,JV)=ALF1Q(I)*sz(I,K,LP,JV)
197	sx(I,K,LP,JV)=sx(I,K,LP,JV)-FX(I,L,JV)
198	sy(I,K,LP,JV)=sy(I,K,LP,JV)-FY(I,L,JV)
199	C
200	ELSE
201	C
202	F0(I,L,JV)=ALF (I)(S0(I,K,L,JV)+ALF1(I)sz(I,K,L,JV) )
203	FZ(I,L,JV)=ALFQ(I)*sz(I,K,L,JV)
204	FX(I,L,JV)=ALF (I)*sx(I,K,L,JV)
205	FY(I,L,JV)=ALF (I)*sy(I,K,L,JV)
206	C
207	S0(I,K,L,JV)=S0(I,K,L,JV)-F0(I,L,JV)
208	sz(I,K,L,JV)=ALF1Q(I)*sz(I,K,L,JV)
209	sx(I,K,L,JV)=sx(I,K,L,JV)-FX(I,L,JV)
210	sy(I,K,L,JV)=sy(I,K,L,JV)-FY(I,L,JV)
211	C
212	ENDIF
213	C
214	1110 CONTINUE
215	111 CONTINUE
216	C
217	11 CONTINUE
218	C
219	C puts the temporary moments Fi into appropriate neighboring boxes
220	C
221	DO 12 L=1,NIV-1
222	LP=L+1
223	C
224	DO 120 I=1,LON
225	C
226	IF(WGRI(I,K,L).LT.0.) THEN
227	SM(I,K,L)=SM(I,K,L)+FM(I,L)
228	ALF(I)=FM(I,L)/SM(I,K,L)
229	ELSE
230	SM(I,K,LP)=SM(I,K,LP)+FM(I,L)
231	ALF(I)=FM(I,L)/SM(I,K,LP)
232	ENDIF
233	C
234	ALF1(I)=1.-ALF(I)
235	ALFQ(I)=ALF(I)*ALF(I)
236	ALF1Q(I)=ALF1(I)*ALF1(I)
237	C
238	120 CONTINUE
239	C
240	DO 121 JV=1,NTRA
241	DO 1210 I=1,LON
242	C
243	IF(WGRI(I,K,L).LT.0.) THEN
244	C
245	TEMPTM=-ALF(I)S0(I,K,L,JV)+ALF1(I)F0(I,L,JV)
246	S0(I,K,L,JV)=S0(I,K,L,JV)+F0(I,L,JV)
247	sz(I,K,L,JV)=ALF(I)FZ(I,L,JV)+ALF1(I)sz(I,K,L,JV)+3.*TEMPTM
248	sx(I,K,L,JV)=sx(I,K,L,JV)+FX(I,L,JV)
249	sy(I,K,L,JV)=sy(I,K,L,JV)+FY(I,L,JV)
250	C
251	ELSE
252	C
253	TEMPTM=ALF(I)S0(I,K,LP,JV)-ALF1(I)F0(I,L,JV)
254	S0(I,K,LP,JV)=S0(I,K,LP,JV)+F0(I,L,JV)
255	sz(I,K,LP,JV)=ALF(I)FZ(I,L,JV)+ALF1(I)sz(I,K,LP,JV)
256	+ +3.*TEMPTM
257	sx(I,K,LP,JV)=sx(I,K,LP,JV)+FX(I,L,JV)
258	sy(I,K,LP,JV)=sy(I,K,LP,JV)+FY(I,L,JV)
259	C
260	ENDIF
261	C
262	1210 CONTINUE
263	121 CONTINUE
264	C
265	12 CONTINUE
266	C
267	C fin de la boucle principale sur les latitudes
268	C
269	1 CONTINUE
270	C
271	C-------------------------------------------------------------
272	C
273	C ----------- AA Test en fin de ADVX ------ Controle des S*
274
275	c DO 9999 l = 1, llm
276	c DO 9999 j = 1, jjp1
277	c DO 9999 i = 1, iip1
278	c IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN
279	c PRINT*, '-------------------'
280	c PRINT*, 'En fin de ADVZ'
281	c PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
282	c print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
283	c print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
284	c print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
285	c WRITE (,) 'On arrete !! - pbl en fin de ADVZ1'
286	c STOP
287	c ENDIF
288	9999 CONTINUE
289
290	C *** ------------------- bouclage cyclique en X ------------
291
292	c DO l = 1,llm
293	c DO j = 1,jjp1
294	c SM(iip1,j,l) = SM(1,j,l)
295	c S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
296	C sx(iip1,j,l,ntra) = sx(1,j,l,ntra)
297	c sy(iip1,j,l,ntra) = sy(1,j,l,ntra)
298	c sz(iip1,j,l,ntra) = sz(1,j,l,ntra)
299	c ENDDO
300	c ENDDO
301
302	C-------------------------------------------------------------
303	C *** Test : diag de la qqtite totale de traceur
304	C dans l'atmosphere avant l'advection en z
305	DO l = 1,llm
306	DO j = 1,jjp1
307	DO i = 1,iim
308	cIM 240305 sqf = sqf + S0(i,j,l,9)
309	sqf = sqf + S0(i,j,l,ntra)
310	ENDDO
311	ENDDO
312	ENDDO
313	PRINT*,'-------- DIAG DANS ADVZ - SORTIE ---------'
314	PRINT*,'sqf=', sqf
315
316	C-------------------------------------------------------------
317	RETURN
318	END
319	C_______________________________________________________________
320	C_______________________________________________________________

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

Download in other formats:

Original Format