Context Navigation

advxp.f90 @ 5127

Last change on this file since 5127 was 5105, checked in by abarral, 3 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: 16.5 KB

Line
1
2	! $Header$
3
4	SUBROUTINE ADVXP(LIMIT,DTX,PBARU,SM,S0,SSX,SY,SZ &
5	,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra)
6	IMPLICIT NONE
7	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8	! C
9	! second-order moments (SOM) advection of tracer in X direction C
10	! C
11	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
12	!
13	! parametres principaux du modele
14	!
15	include "dimensions.h"
16	include "paramet.h"
17
18	INTEGER :: ntra
19	! PARAMETER (ntra = 1)
20	!
21	! definition de la grille du modele
22	!
23	REAL :: dtx
24	REAL :: pbaru ( iip1,jjp1,llm )
25	!
26	! moments: SM total mass in each grid box
27	! S0 mass of tracer in each grid box
28	! Si 1rst order moment in i direction
29	! Sij 2nd order moment in i and j directions
30	!
31	REAL :: SM(iip1,jjp1,llm) &
32	,S0(iip1,jjp1,llm,ntra)
33	REAL :: SSX(iip1,jjp1,llm,ntra) &
34	,SY(iip1,jjp1,llm,ntra) &
35	,SZ(iip1,jjp1,llm,ntra)
36	REAL :: SSXX(iip1,jjp1,llm,ntra) &
37	,SSXY(iip1,jjp1,llm,ntra) &
38	,SSXZ(iip1,jjp1,llm,ntra) &
39	,SYY(iip1,jjp1,llm,ntra) &
40	,SYZ(iip1,jjp1,llm,ntra) &
41	,SZZ(iip1,jjp1,llm,ntra)
42
43	! Local :
44	! -------
45
46	! mass fluxes across the boundaries (UGRI,VGRI,WGRI)
47	! mass fluxes in kg
48	! declaration :
49
50	REAL :: UGRI(iip1,jjp1,llm)
51
52	! Rem : VGRI et WGRI ne sont pas utilises dans
53	! cette SUBROUTINE ( advection en x uniquement )
54	!
55	!
56	! Tij are the moments for the current latitude and level
57	!
58	REAL :: TM (iim)
59	REAL :: T0 (iim,NTRA),TX (iim,NTRA)
60	REAL :: TY (iim,NTRA),TZ (iim,NTRA)
61	REAL :: TXX(iim,NTRA),TXY(iim,NTRA)
62	REAL :: TXZ(iim,NTRA),TYY(iim,NTRA)
63	REAL :: TYZ(iim,NTRA),TZZ(iim,NTRA)
64	!
65	! the moments F are similarly defined and used as temporary
66	! storage for portions of the grid boxes in transit
67	!
68	REAL :: FM (iim)
69	REAL :: F0 (iim,NTRA),FX (iim,NTRA)
70	REAL :: FY (iim,NTRA),FZ (iim,NTRA)
71	REAL :: FXX(iim,NTRA),FXY(iim,NTRA)
72	REAL :: FXZ(iim,NTRA),FYY(iim,NTRA)
73	REAL :: FYZ(iim,NTRA),FZZ(iim,NTRA)
74	!
75	! work arrays
76	!
77	REAL :: ALF (iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
78	REAL :: ALF2(iim),ALF3(iim),ALF4(iim)
79	!
80	REAL :: SMNEW(iim),UEXT(iim)
81	REAL :: sqi,sqf
82	REAL :: TEMPTM
83	REAL :: SLPMAX
84	REAL :: S1MAX,S1NEW,S2NEW
85
86	LOGICAL :: LIMIT
87	INTEGER :: NUM(jjp1),LONK,NUMK
88	INTEGER :: lon,lati,latf,niv
89	INTEGER :: i,i2,i3,j,jv,l,k,iter
90
91	lon = iim
92	lati=2
93	latf = jjm
94	niv = llm
95
96	! * Test de passage d'arguments ****
97
98	! DO 399 l = 1, llm
99	! DO 399 j = 1, jjp1
100	! DO 399 i = 1, iip1
101	! IF (S0(i,j,l,ntra) .lt. 0. ) THEN
102	! PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
103	! PRINT*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
104	! PRINT*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
105	! PRINT*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
106	! PRINT*, 'AIE !! debut ADVXP - pbl arg. passage dans ADVXP'
107	!c STOP
108	! ENDIF
109	! 399 CONTINUE
110
111	! *** Test : diagnostique de la qtite totale de traceur
112	! dans l'atmosphere avant l'advection
113	!
114	sqi =0.
115	sqf =0.
116	!
117	DO l = 1, llm
118	DO j = 1, jjp1
119	DO i = 1, iim
120	sqi = sqi + S0(i,j,l,ntra)
121	END DO
122	END DO
123	END DO
124	PRINT*,'------ DIAG DANS ADVX2 - ENTREE -----'
125	PRINT*,'sqi=',sqi
126	! test
127	! -------------------------------------
128	DO j =1,jjp1
129	NUM(j) =1
130	END DO
131	! DO l=1,llm
132	! NUM(2,l)=6
133	! NUM(3,l)=6
134	! NUM(jjm-1,l)=6
135	! NUM(jjm,l)=6
136	! ENDDO
137	! DO j=2,6
138	! NUM(j)=12
139	! ENDDO
140	! DO j=jjm-5,jjm-1
141	! NUM(j)=12
142	! ENDDO
143
144	! Interface : adaptation nouveau modele
145	! -------------------------------------
146	!
147	! ---------------------------------------------------------
148	! Conversion des flux de masses en kg/s
149	! pbaru est en N/s d'ou :
150	! ugri est en kg/s
151
152	DO l = 1,llm
153	DO j = 1,jjp1
154	DO i = 1,iip1
155	ugri (i,j,llm+1-l) =pbaru (i,j,l)
156	END DO
157	END DO
158	END DO
159
160	! ---------------------------------------------------------
161	! start here
162	!
163	! boucle principale sur les niveaux et les latitudes
164	!
165	DO L=1,NIV
166	DO K=lati,latf
167
168	!
169	! initialisation
170	!
171	! program assumes periodic boundaries in X
172	!
173	DO I=2,LON
174	SMNEW(I)=SM(I,K,L)+(UGRI(I-1,K,L)-UGRI(I,K,L))*DTX
175	END DO
176	SMNEW(1)=SM(1,K,L)+(UGRI(LON,K,L)-UGRI(1,K,L))*DTX
177	!
178	! modifications for extended polar zones
179	!
180	NUMK=NUM(K)
181	LONK=LON/NUMK
182	!
183	IF(NUMK>1) THEN
184	!
185	DO I=1,LON
186	TM(I)=0.
187	END DO
188	DO JV=1,NTRA
189	DO I=1,LON
190	T0 (I,JV)=0.
191	TX (I,JV)=0.
192	TY (I,JV)=0.
193	TZ (I,JV)=0.
194	TXX(I,JV)=0.
195	TXY(I,JV)=0.
196	TXZ(I,JV)=0.
197	TYY(I,JV)=0.
198	TYZ(I,JV)=0.
199	TZZ(I,JV)=0.
200	END DO
201	END DO
202	!
203	DO I2=1,NUMK
204	!
205	DO I=1,LONK
206	I3=(I-1)*NUMK+I2
207	TM(I)=TM(I)+SM(I3,K,L)
208	ALF(I)=SM(I3,K,L)/TM(I)
209	ALF1(I)=1.-ALF(I)
210	ALFQ(I)=ALF(I)*ALF(I)
211	ALF1Q(I)=ALF1(I)*ALF1(I)
212	ALF2(I)=ALF1(I)-ALF(I)
213	ALF3(I)=ALF(I)*ALF1(I)
214	END DO
215	!
216	DO JV=1,NTRA
217	DO I=1,LONK
218	I3=(I-1)*NUMK+I2
219	TEMPTM=-ALF(I)T0(I,JV)+ALF1(I)S0(I3,K,L,JV)
220	T0 (I,JV)=T0(I,JV)+S0(I3,K,L,JV)
221	TXX(I,JV)=ALFQ(I)SSXX(I3,K,L,JV)+ALF1Q(I)TXX(I,JV) &
222	+5.( ALF3(I)(SSX(I3,K,L,JV)-TX(I,JV))+ALF2(I)*TEMPTM )
223	TX (I,JV)=ALF(I)SSX(I3,K,L,JV)+ALF1(I)TX(I,JV)+3.*TEMPTM
224	TXY(I,JV)=ALF (I)SSXY(I3,K,L,JV)+ALF1(I)TXY(I,JV) &
225	+3.(ALF1(I)SY (I3,K,L,JV)-ALF (I)*TY (I,JV))
226	TXZ(I,JV)=ALF (I)SSXZ(I3,K,L,JV)+ALF1(I)TXZ(I,JV) &
227	+3.(ALF1(I)SZ (I3,K,L,JV)-ALF (I)*TZ (I,JV))
228	TY (I,JV)=TY (I,JV)+SY (I3,K,L,JV)
229	TZ (I,JV)=TZ (I,JV)+SZ (I3,K,L,JV)
230	TYY(I,JV)=TYY(I,JV)+SYY(I3,K,L,JV)
231	TYZ(I,JV)=TYZ(I,JV)+SYZ(I3,K,L,JV)
232	TZZ(I,JV)=TZZ(I,JV)+SZZ(I3,K,L,JV)
233	END DO
234	END DO
235	!
236	END DO
237	!
238	ELSE
239	!
240	DO I=1,LON
241	TM(I)=SM(I,K,L)
242	END DO
243	DO JV=1,NTRA
244	DO I=1,LON
245	T0 (I,JV)=S0 (I,K,L,JV)
246	TX (I,JV)=SSX (I,K,L,JV)
247	TY (I,JV)=SY (I,K,L,JV)
248	TZ (I,JV)=SZ (I,K,L,JV)
249	TXX(I,JV)=SSXX(I,K,L,JV)
250	TXY(I,JV)=SSXY(I,K,L,JV)
251	TXZ(I,JV)=SSXZ(I,K,L,JV)
252	TYY(I,JV)=SYY(I,K,L,JV)
253	TYZ(I,JV)=SYZ(I,K,L,JV)
254	TZZ(I,JV)=SZZ(I,K,L,JV)
255	END DO
256	END DO
257	!
258	ENDIF
259	!
260	DO I=1,LONK
261	UEXT(I)=UGRI(I*NUMK,K,L)
262	END DO
263	!
264	! place limits on appropriate moments before transport
265	! (if flux-limiting is to be applied)
266	!
267	IF(.NOT.LIMIT) GO TO 13
268	!
269	DO JV=1,NTRA
270	DO I=1,LONK
271	IF(T0(I,JV)>0.) THEN
272	SLPMAX=T0(I,JV)
273	S1MAX=1.5*SLPMAX
274	S1NEW=AMIN1(S1MAX,AMAX1(-S1MAX,TX(I,JV)))
275	S2NEW=AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. , &
276	AMAX1(ABS(S1NEW)-SLPMAX,TXX(I,JV)) )
277	TX (I,JV)=S1NEW
278	TXX(I,JV)=S2NEW
279	TXY(I,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,TXY(I,JV)))
280	TXZ(I,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,TXZ(I,JV)))
281	ELSE
282	TX (I,JV)=0.
283	TXX(I,JV)=0.
284	TXY(I,JV)=0.
285	TXZ(I,JV)=0.
286	ENDIF
287	END DO
288	END DO
289	!
290	13 CONTINUE
291	!
292	! calculate flux and moments between adjacent boxes
293	! 1- create temporary moments/masses for partial boxes in transit
294	! 2- reajusts moments remaining in the box
295	!
296	! flux from IP to I if U(I).lt.0
297	!
298	DO I=1,LONK-1
299	IF(UEXT(I)<0.) THEN
300	FM(I)=-UEXT(I)*DTX
301	ALF(I)=FM(I)/TM(I+1)
302	TM(I+1)=TM(I+1)-FM(I)
303	ENDIF
304	END DO
305	!
306	I=LONK
307	IF(UEXT(I)<0.) THEN
308	FM(I)=-UEXT(I)*DTX
309	ALF(I)=FM(I)/TM(1)
310	TM(1)=TM(1)-FM(I)
311	ENDIF
312	!
313	! flux from I to IP if U(I).gt.0
314	!
315	DO I=1,LONK
316	IF(UEXT(I)>=0.) THEN
317	FM(I)=UEXT(I)*DTX
318	ALF(I)=FM(I)/TM(I)
319	TM(I)=TM(I)-FM(I)
320	ENDIF
321	END DO
322	!
323	DO I=1,LONK
324	ALFQ(I)=ALF(I)*ALF(I)
325	ALF1(I)=1.-ALF(I)
326	ALF1Q(I)=ALF1(I)*ALF1(I)
327	ALF2(I)=ALF1(I)-ALF(I)
328	ALF3(I)=ALF(I)*ALFQ(I)
329	ALF4(I)=ALF1(I)*ALF1Q(I)
330	END DO
331	!
332	DO JV=1,NTRA
333	DO I=1,LONK-1
334	!
335	IF(UEXT(I)<0.) THEN
336	!
337	F0 (I,JV)=ALF (I)* ( T0(I+1,JV)-ALF1(I)* &
338	( TX(I+1,JV)-ALF2(I)*TXX(I+1,JV) ) )
339	FX (I,JV)=ALFQ(I)(TX(I+1,JV)-3.ALF1(I)*TXX(I+1,JV))
340	FXX(I,JV)=ALF3(I)*TXX(I+1,JV)
341	FY (I,JV)=ALF (I)(TY(I+1,JV)-ALF1(I)TXY(I+1,JV))
342	FZ (I,JV)=ALF (I)(TZ(I+1,JV)-ALF1(I)TXZ(I+1,JV))
343	FXY(I,JV)=ALFQ(I)*TXY(I+1,JV)
344	FXZ(I,JV)=ALFQ(I)*TXZ(I+1,JV)
345	FYY(I,JV)=ALF (I)*TYY(I+1,JV)
346	FYZ(I,JV)=ALF (I)*TYZ(I+1,JV)
347	FZZ(I,JV)=ALF (I)*TZZ(I+1,JV)
348	!
349	T0 (I+1,JV)=T0(I+1,JV)-F0(I,JV)
350	TX (I+1,JV)=ALF1Q(I)(TX(I+1,JV)+3.ALF(I)*TXX(I+1,JV))
351	TXX(I+1,JV)=ALF4(I)*TXX(I+1,JV)
352	TY (I+1,JV)=TY (I+1,JV)-FY (I,JV)
353	TZ (I+1,JV)=TZ (I+1,JV)-FZ (I,JV)
354	TYY(I+1,JV)=TYY(I+1,JV)-FYY(I,JV)
355	TYZ(I+1,JV)=TYZ(I+1,JV)-FYZ(I,JV)
356	TZZ(I+1,JV)=TZZ(I+1,JV)-FZZ(I,JV)
357	TXY(I+1,JV)=ALF1Q(I)*TXY(I+1,JV)
358	TXZ(I+1,JV)=ALF1Q(I)*TXZ(I+1,JV)
359	!
360	ENDIF
361	!
362	END DO
363	END DO
364	!
365	I=LONK
366	IF(UEXT(I)<0.) THEN
367	!
368	DO JV=1,NTRA
369	!
370	F0 (I,JV)=ALF (I)* ( T0(1,JV)-ALF1(I)* &
371	( TX(1,JV)-ALF2(I)*TXX(1,JV) ) )
372	FX (I,JV)=ALFQ(I)(TX(1,JV)-3.ALF1(I)*TXX(1,JV))
373	FXX(I,JV)=ALF3(I)*TXX(1,JV)
374	FY (I,JV)=ALF (I)(TY(1,JV)-ALF1(I)TXY(1,JV))
375	FZ (I,JV)=ALF (I)(TZ(1,JV)-ALF1(I)TXZ(1,JV))
376	FXY(I,JV)=ALFQ(I)*TXY(1,JV)
377	FXZ(I,JV)=ALFQ(I)*TXZ(1,JV)
378	FYY(I,JV)=ALF (I)*TYY(1,JV)
379	FYZ(I,JV)=ALF (I)*TYZ(1,JV)
380	FZZ(I,JV)=ALF (I)*TZZ(1,JV)
381	!
382	T0 (1,JV)=T0(1,JV)-F0(I,JV)
383	TX (1,JV)=ALF1Q(I)(TX(1,JV)+3.ALF(I)*TXX(1,JV))
384	TXX(1,JV)=ALF4(I)*TXX(1,JV)
385	TY (1,JV)=TY (1,JV)-FY (I,JV)
386	TZ (1,JV)=TZ (1,JV)-FZ (I,JV)
387	TYY(1,JV)=TYY(1,JV)-FYY(I,JV)
388	TYZ(1,JV)=TYZ(1,JV)-FYZ(I,JV)
389	TZZ(1,JV)=TZZ(1,JV)-FZZ(I,JV)
390	TXY(1,JV)=ALF1Q(I)*TXY(1,JV)
391	TXZ(1,JV)=ALF1Q(I)*TXZ(1,JV)
392	!
393	END DO
394	!
395	ENDIF
396	!
397	DO JV=1,NTRA
398	DO I=1,LONK
399	!
400	IF(UEXT(I)>=0.) THEN
401	!
402	F0 (I,JV)=ALF (I)* ( T0(I,JV)+ALF1(I)* &
403	( TX(I,JV)+ALF2(I)*TXX(I,JV) ) )
404	FX (I,JV)=ALFQ(I)(TX(I,JV)+3.ALF1(I)*TXX(I,JV))
405	FXX(I,JV)=ALF3(I)*TXX(I,JV)
406	FY (I,JV)=ALF (I)(TY(I,JV)+ALF1(I)TXY(I,JV))
407	FZ (I,JV)=ALF (I)(TZ(I,JV)+ALF1(I)TXZ(I,JV))
408	FXY(I,JV)=ALFQ(I)*TXY(I,JV)
409	FXZ(I,JV)=ALFQ(I)*TXZ(I,JV)
410	FYY(I,JV)=ALF (I)*TYY(I,JV)
411	FYZ(I,JV)=ALF (I)*TYZ(I,JV)
412	FZZ(I,JV)=ALF (I)*TZZ(I,JV)
413	!
414	T0 (I,JV)=T0(I,JV)-F0(I,JV)
415	TX (I,JV)=ALF1Q(I)(TX(I,JV)-3.ALF(I)*TXX(I,JV))
416	TXX(I,JV)=ALF4(I)*TXX(I,JV)
417	TY (I,JV)=TY (I,JV)-FY (I,JV)
418	TZ (I,JV)=TZ (I,JV)-FZ (I,JV)
419	TYY(I,JV)=TYY(I,JV)-FYY(I,JV)
420	TYZ(I,JV)=TYZ(I,JV)-FYZ(I,JV)
421	TZZ(I,JV)=TZZ(I,JV)-FZZ(I,JV)
422	TXY(I,JV)=ALF1Q(I)*TXY(I,JV)
423	TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
424	!
425	ENDIF
426	!
427	END DO
428	END DO
429	!
430	! puts the temporary moments Fi into appropriate neighboring boxes
431	!
432	DO I=1,LONK
433	IF(UEXT(I)<0.) THEN
434	TM(I)=TM(I)+FM(I)
435	ALF(I)=FM(I)/TM(I)
436	ENDIF
437	END DO
438	!
439	DO I=1,LONK-1
440	IF(UEXT(I)>=0.) THEN
441	TM(I+1)=TM(I+1)+FM(I)
442	ALF(I)=FM(I)/TM(I+1)
443	ENDIF
444	END DO
445	!
446	I=LONK
447	IF(UEXT(I)>=0.) THEN
448	TM(1)=TM(1)+FM(I)
449	ALF(I)=FM(I)/TM(1)
450	ENDIF
451	!
452	DO I=1,LONK
453	ALF1(I)=1.-ALF(I)
454	ALFQ(I)=ALF(I)*ALF(I)
455	ALF1Q(I)=ALF1(I)*ALF1(I)
456	ALF2(I)=ALF1(I)-ALF(I)
457	ALF3(I)=ALF(I)*ALF1(I)
458	END DO
459	!
460	DO JV=1,NTRA
461	DO I=1,LONK
462	!
463	IF(UEXT(I)<0.) THEN
464	!
465	TEMPTM=-ALF(I)T0(I,JV)+ALF1(I)F0(I,JV)
466	T0 (I,JV)=T0(I,JV)+F0(I,JV)
467	TXX(I,JV)=ALFQ(I)FXX(I,JV)+ALF1Q(I)TXX(I,JV) &
468	+5.( ALF3(I)(FX(I,JV)-TX(I,JV))+ALF2(I)*TEMPTM )
469	TX (I,JV)=ALF (I)FX (I,JV)+ALF1(I)TX (I,JV)+3.*TEMPTM
470	TXY(I,JV)=ALF (I)FXY(I,JV)+ALF1(I)TXY(I,JV) &
471	+3.(ALF1(I)FY (I,JV)-ALF (I)*TY (I,JV))
472	TXZ(I,JV)=ALF (I)FXZ(I,JV)+ALF1(I)TXZ(I,JV) &
473	+3.(ALF1(I)FZ (I,JV)-ALF (I)*TZ (I,JV))
474	TY (I,JV)=TY (I,JV)+FY (I,JV)
475	TZ (I,JV)=TZ (I,JV)+FZ (I,JV)
476	TYY(I,JV)=TYY(I,JV)+FYY(I,JV)
477	TYZ(I,JV)=TYZ(I,JV)+FYZ(I,JV)
478	TZZ(I,JV)=TZZ(I,JV)+FZZ(I,JV)
479	!
480	ENDIF
481	!
482	END DO
483	END DO
484	!
485	DO JV=1,NTRA
486	DO I=1,LONK-1
487	!
488	IF(UEXT(I)>=0.) THEN
489	!
490	TEMPTM=ALF(I)T0(I+1,JV)-ALF1(I)F0(I,JV)
491	T0 (I+1,JV)=T0(I+1,JV)+F0(I,JV)
492	TXX(I+1,JV)=ALFQ(I)FXX(I,JV)+ALF1Q(I)TXX(I+1,JV) &
493	+5.( ALF3(I)(TX(I+1,JV)-FX(I,JV))-ALF2(I)*TEMPTM )
494	TX (I+1,JV)=ALF(I)FX (I ,JV)+ALF1(I)TX (I+1,JV)+3.*TEMPTM
495	TXY(I+1,JV)=ALF(I)FXY(I ,JV)+ALF1(I)TXY(I+1,JV) &
496	+3.(ALF(I)TY (I+1,JV)-ALF1(I)*FY (I ,JV))
497	TXZ(I+1,JV)=ALF(I)FXZ(I ,JV)+ALF1(I)TXZ(I+1,JV) &
498	+3.(ALF(I)TZ (I+1,JV)-ALF1(I)*FZ (I ,JV))
499	TY (I+1,JV)=TY (I+1,JV)+FY (I,JV)
500	TZ (I+1,JV)=TZ (I+1,JV)+FZ (I,JV)
501	TYY(I+1,JV)=TYY(I+1,JV)+FYY(I,JV)
502	TYZ(I+1,JV)=TYZ(I+1,JV)+FYZ(I,JV)
503	TZZ(I+1,JV)=TZZ(I+1,JV)+FZZ(I,JV)
504	!
505	ENDIF
506	!
507	END DO
508	END DO
509	!
510	I=LONK
511	IF(UEXT(I)>=0.) THEN
512	DO JV=1,NTRA
513	TEMPTM=ALF(I)T0(1,JV)-ALF1(I)F0(I,JV)
514	T0 (1,JV)=T0(1,JV)+F0(I,JV)
515	TXX(1,JV)=ALFQ(I)FXX(I,JV)+ALF1Q(I)TXX(1,JV) &
516	+5.( ALF3(I)(TX(1,JV)-FX(I,JV))-ALF2(I)*TEMPTM )
517	TX (1,JV)=ALF(I)FX(I,JV)+ALF1(I)TX(1,JV)+3.*TEMPTM
518	TXY(1,JV)=ALF(I)FXY(I,JV)+ALF1(I)TXY(1,JV) &
519	+3.(ALF(I)TY (1,JV)-ALF1(I)*FY (I,JV))
520	TXZ(1,JV)=ALF(I)FXZ(I,JV)+ALF1(I)TXZ(1,JV) &
521	+3.(ALF(I)TZ (1,JV)-ALF1(I)*FZ (I,JV))
522	TY (1,JV)=TY (1,JV)+FY (I,JV)
523	TZ (1,JV)=TZ (1,JV)+FZ (I,JV)
524	TYY(1,JV)=TYY(1,JV)+FYY(I,JV)
525	TYZ(1,JV)=TYZ(1,JV)+FYZ(I,JV)
526	TZZ(1,JV)=TZZ(1,JV)+FZZ(I,JV)
527	END DO
528	ENDIF
529	!
530	! retour aux mailles d'origine (passage des Tij aux Sij)
531	!
532	IF(NUMK>1) THEN
533	!
534	DO I2=1,NUMK
535	!
536	DO I=1,LONK
537	!
538	I3=I2+(I-1)*NUMK
539	SM(I3,K,L)=SMNEW(I3)
540	ALF(I)=SMNEW(I3)/TM(I)
541	TM(I)=TM(I)-SMNEW(I3)
542	!
543	ALFQ(I)=ALF(I)*ALF(I)
544	ALF1(I)=1.-ALF(I)
545	ALF1Q(I)=ALF1(I)*ALF1(I)
546	ALF2(I)=ALF1(I)-ALF(I)
547	ALF3(I)=ALF(I)*ALFQ(I)
548	ALF4(I)=ALF1(I)*ALF1Q(I)
549	!
550	END DO
551	!
552	DO JV=1,NTRA
553	DO I=1,LONK
554	!
555	I3=I2+(I-1)*NUMK
556	S0 (I3,K,L,JV)=ALF (I)* ( T0(I,JV)-ALF1(I)* &
557	( TX(I,JV)-ALF2(I)*TXX(I,JV) ) )
558	SSX (I3,K,L,JV)=ALFQ(I)(TX(I,JV)-3.ALF1(I)*TXX(I,JV))
559	SSXX(I3,K,L,JV)=ALF3(I)*TXX(I,JV)
560	SY (I3,K,L,JV)=ALF (I)(TY(I,JV)-ALF1(I)TXY(I,JV))
561	SZ (I3,K,L,JV)=ALF (I)(TZ(I,JV)-ALF1(I)TXZ(I,JV))
562	SSXY(I3,K,L,JV)=ALFQ(I)*TXY(I,JV)
563	SSXZ(I3,K,L,JV)=ALFQ(I)*TXZ(I,JV)
564	SYY(I3,K,L,JV)=ALF (I)*TYY(I,JV)
565	SYZ(I3,K,L,JV)=ALF (I)*TYZ(I,JV)
566	SZZ(I3,K,L,JV)=ALF (I)*TZZ(I,JV)
567	!
568	! reajusts moments remaining in the box
569	!
570	T0 (I,JV)=T0(I,JV)-S0(I3,K,L,JV)
571	TX (I,JV)=ALF1Q(I)(TX(I,JV)+3.ALF(I)*TXX(I,JV))
572	TXX(I,JV)=ALF4 (I)*TXX(I,JV)
573	TY (I,JV)=TY (I,JV)-SY (I3,K,L,JV)
574	TZ (I,JV)=TZ (I,JV)-SZ (I3,K,L,JV)
575	TYY(I,JV)=TYY(I,JV)-SYY(I3,K,L,JV)
576	TYZ(I,JV)=TYZ(I,JV)-SYZ(I3,K,L,JV)
577	TZZ(I,JV)=TZZ(I,JV)-SZZ(I3,K,L,JV)
578	TXY(I,JV)=ALF1Q(I)*TXY(I,JV)
579	TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
580	!
581	END DO
582	END DO
583	!
584	END DO
585	!
586	ELSE
587	!
588	DO I=1,LON
589	SM(I,K,L)=TM(I)
590	END DO
591	DO JV=1,NTRA
592	DO I=1,LON
593	S0 (I,K,L,JV)=T0 (I,JV)
594	SSX (I,K,L,JV)=TX (I,JV)
595	SY (I,K,L,JV)=TY (I,JV)
596	SZ (I,K,L,JV)=TZ (I,JV)
597	SSXX(I,K,L,JV)=TXX(I,JV)
598	SSXY(I,K,L,JV)=TXY(I,JV)
599	SSXZ(I,K,L,JV)=TXZ(I,JV)
600	SYY(I,K,L,JV)=TYY(I,JV)
601	SYZ(I,K,L,JV)=TYZ(I,JV)
602	SZZ(I,K,L,JV)=TZZ(I,JV)
603	END DO
604	END DO
605	!
606	ENDIF
607	!
608	END DO
609	END DO
610	!
611	! ----------- AA Test en fin de ADVX ------ Controle des S*
612
613	! DO 9999 l = 1, llm
614	! DO 9999 j = 1, jjp1
615	! DO 9999 i = 1, iip1
616	! IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN
617	! PRINT*, '-------------------'
618	! PRINT*, 'En fin de ADVXP'
619	! PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
620	! PRINT*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
621	! PRINT*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
622	! PRINT*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
623	! WRITE (,) 'On arrete !! - pbl en fin de ADVXP'
624	! STOP
625	! ENDIF
626	! 9999 CONTINUE
627	! ---------- bouclage cyclique
628
629	DO l = 1,llm
630	DO j = 1,jjp1
631	SM(iip1,j,l) = SM(1,j,l)
632	S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
633	SSX(iip1,j,l,ntra) = SSX(1,j,l,ntra)
634	SY(iip1,j,l,ntra) = SY(1,j,l,ntra)
635	SZ(iip1,j,l,ntra) = SZ(1,j,l,ntra)
636	END DO
637	END DO
638
639	! ----------- qqtite totale de traceur dans tte l'atmosphere
640	DO l = 1, llm
641	DO j = 1, jjp1
642	DO i = 1, iim
643	sqf = sqf + S0(i,j,l,ntra)
644	END DO
645	END DO
646	END DO
647
648	PRINT*,'------ DIAG DANS ADVX2 - SORTIE -----'
649	PRINT*,'sqf=',sqf
650	!-------------------------------------------------------------
651	RETURN
652	END SUBROUTINE ADVXP

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

Download in other formats:

Original Format