Context Navigation

advz.f90 @ 5136

Last change on this file since 5136 was 5134, checked in by abarral, 4 months ago
Replace academic.h, alpale.h, comdissip.h, comdissipn.h, comdissnew.h by modules Remove unused clesph0.h
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: 8.5 KB

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

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

Download in other formats:

Original Format