Context Navigation

advxp.F @ 1

Last change on this file since 1 was 1, checked in by emillour, 14 years ago
Import initial LMDZ5
File size: 18.1 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	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8	C C
9	C second-order moments (SOM) advection of tracer in X direction C
10	C C
11	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
12	C
13	C parametres principaux du modele
14	C
15	#include "dimensions.h"
16	#include "paramet.h"
17	#include "comconst.h"
18	#include "comvert.h"
19
20	INTEGER ntra
21	c PARAMETER (ntra = 1)
22	C
23	C definition de la grille du modele
24	C
25	REAL dtx
26	REAL pbaru ( iip1,jjp1,llm )
27	C
28	C moments: SM total mass in each grid box
29	C S0 mass of tracer in each grid box
30	C Si 1rst order moment in i direction
31	C Sij 2nd order moment in i and j directions
32	C
33	REAL SM(iip1,jjp1,llm)
34	+ ,S0(iip1,jjp1,llm,ntra)
35	REAL SSX(iip1,jjp1,llm,ntra)
36	+ ,SY(iip1,jjp1,llm,ntra)
37	+ ,SZ(iip1,jjp1,llm,ntra)
38	REAL SSXX(iip1,jjp1,llm,ntra)
39	+ ,SSXY(iip1,jjp1,llm,ntra)
40	+ ,SSXZ(iip1,jjp1,llm,ntra)
41	+ ,SYY(iip1,jjp1,llm,ntra)
42	+ ,SYZ(iip1,jjp1,llm,ntra)
43	+ ,SZZ(iip1,jjp1,llm,ntra)
44
45	C Local :
46	C -------
47
48	C mass fluxes across the boundaries (UGRI,VGRI,WGRI)
49	C mass fluxes in kg
50	C declaration :
51
52	REAL UGRI(iip1,jjp1,llm)
53
54	C Rem : VGRI et WGRI ne sont pas utilises dans
55	C cette subroutine ( advection en x uniquement )
56	C
57	C
58	C Tij are the moments for the current latitude and level
59	C
60	REAL TM (iim)
61	REAL T0 (iim,NTRA),TX (iim,NTRA)
62	REAL TY (iim,NTRA),TZ (iim,NTRA)
63	REAL TXX(iim,NTRA),TXY(iim,NTRA)
64	REAL TXZ(iim,NTRA),TYY(iim,NTRA)
65	REAL TYZ(iim,NTRA),TZZ(iim,NTRA)
66	C
67	C the moments F are similarly defined and used as temporary
68	C storage for portions of the grid boxes in transit
69	C
70	REAL FM (iim)
71	REAL F0 (iim,NTRA),FX (iim,NTRA)
72	REAL FY (iim,NTRA),FZ (iim,NTRA)
73	REAL FXX(iim,NTRA),FXY(iim,NTRA)
74	REAL FXZ(iim,NTRA),FYY(iim,NTRA)
75	REAL FYZ(iim,NTRA),FZZ(iim,NTRA)
76	C
77	C work arrays
78	C
79	REAL ALF (iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
80	REAL ALF2(iim),ALF3(iim),ALF4(iim)
81	C
82	REAL SMNEW(iim),UEXT(iim)
83	REAL sqi,sqf
84	REAL TEMPTM
85	REAL SLPMAX
86	REAL S1MAX,S1NEW,S2NEW
87
88	LOGICAL LIMIT
89	INTEGER NUM(jjp1),LONK,NUMK
90	INTEGER lon,lati,latf,niv
91	INTEGER i,i2,i3,j,jv,l,k,iter
92
93	lon = iim
94	lati=2
95	latf = jjm
96	niv = llm
97
98	C * Test de passage d'arguments ****
99
100	c DO 399 l = 1, llm
101	c DO 399 j = 1, jjp1
102	c DO 399 i = 1, iip1
103	c IF (S0(i,j,l,ntra) .lt. 0. ) THEN
104	c PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
105	c print*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
106	c print*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
107	c print*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
108	c PRINT*, 'AIE !! debut ADVXP - pbl arg. passage dans ADVXP'
109	cc STOP
110	c ENDIF
111	c 399 CONTINUE
112
113	C *** Test : diagnostique de la qtite totale de traceur
114	C dans l'atmosphere avant l'advection
115	c
116	sqi =0.
117	sqf =0.
118	c
119	DO l = 1, llm
120	DO j = 1, jjp1
121	DO i = 1, iim
122	sqi = sqi + S0(i,j,l,ntra)
123	END DO
124	END DO
125	END DO
126	PRINT*,'------ DIAG DANS ADVX2 - ENTREE -----'
127	PRINT*,'sqi=',sqi
128	c test
129	c -------------------------------------
130	DO 300 j =1,jjp1
131	NUM(j) =1
132	300 CONTINUE
133	c DO l=1,llm
134	c NUM(2,l)=6
135	c NUM(3,l)=6
136	c NUM(jjm-1,l)=6
137	c NUM(jjm,l)=6
138	c ENDDO
139	c DO j=2,6
140	c NUM(j)=12
141	c ENDDO
142	c DO j=jjm-5,jjm-1
143	c NUM(j)=12
144	c ENDDO
145
146	C Interface : adaptation nouveau modele
147	C -------------------------------------
148	C
149	C ---------------------------------------------------------
150	C Conversion des flux de masses en kg/s
151	C pbaru est en N/s d'ou :
152	C ugri est en kg/s
153
154	DO 500 l = 1,llm
155	DO 500 j = 1,jjp1
156	DO 500 i = 1,iip1
157	ugri (i,j,llm+1-l) =pbaru (i,j,l)
158	500 CONTINUE
159
160	C ---------------------------------------------------------
161	C start here
162	C
163	C boucle principale sur les niveaux et les latitudes
164	C
165	DO 1 L=1,NIV
166	DO 1 K=lati,latf
167
168	C
169	C initialisation
170	C
171	C program assumes periodic boundaries in X
172	C
173	DO 10 I=2,LON
174	SMNEW(I)=SM(I,K,L)+(UGRI(I-1,K,L)-UGRI(I,K,L))*DTX
175	10 CONTINUE
176	SMNEW(1)=SM(1,K,L)+(UGRI(LON,K,L)-UGRI(1,K,L))*DTX
177	C
178	C modifications for extended polar zones
179	C
180	NUMK=NUM(K)
181	LONK=LON/NUMK
182	C
183	IF(NUMK.GT.1) THEN
184	C
185	DO 111 I=1,LON
186	TM(I)=0.
187	111 CONTINUE
188	DO 112 JV=1,NTRA
189	DO 1120 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	1120 CONTINUE
201	112 CONTINUE
202	C
203	DO 11 I2=1,NUMK
204	C
205	DO 113 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	113 CONTINUE
215	C
216	DO 114 JV=1,NTRA
217	DO 1140 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	1140 CONTINUE
234	114 CONTINUE
235	C
236	11 CONTINUE
237	C
238	ELSE
239	C
240	DO 115 I=1,LON
241	TM(I)=SM(I,K,L)
242	115 CONTINUE
243	DO 116 JV=1,NTRA
244	DO 1160 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	1160 CONTINUE
256	116 CONTINUE
257	C
258	ENDIF
259	C
260	DO 117 I=1,LONK
261	UEXT(I)=UGRI(I*NUMK,K,L)
262	117 CONTINUE
263	C
264	C place limits on appropriate moments before transport
265	C (if flux-limiting is to be applied)
266	C
267	IF(.NOT.LIMIT) GO TO 13
268	C
269	DO 12 JV=1,NTRA
270	DO 120 I=1,LONK
271	IF(T0(I,JV).GT.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	120 CONTINUE
288	12 CONTINUE
289	C
290	13 CONTINUE
291	C
292	C calculate flux and moments between adjacent boxes
293	C 1- create temporary moments/masses for partial boxes in transit
294	C 2- reajusts moments remaining in the box
295	C
296	C flux from IP to I if U(I).lt.0
297	C
298	DO 140 I=1,LONK-1
299	IF(UEXT(I).LT.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	140 CONTINUE
305	C
306	I=LONK
307	IF(UEXT(I).LT.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	C
313	C flux from I to IP if U(I).gt.0
314	C
315	DO 141 I=1,LONK
316	IF(UEXT(I).GE.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	141 CONTINUE
322	C
323	DO 142 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	142 CONTINUE
331	C
332	DO 150 JV=1,NTRA
333	DO 1500 I=1,LONK-1
334	C
335	IF(UEXT(I).LT.0.) THEN
336	C
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	C
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	C
360	ENDIF
361	C
362	1500 CONTINUE
363	150 CONTINUE
364	C
365	I=LONK
366	IF(UEXT(I).LT.0.) THEN
367	C
368	DO 151 JV=1,NTRA
369	C
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	C
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	C
393	151 CONTINUE
394	C
395	ENDIF
396	C
397	DO 152 JV=1,NTRA
398	DO 1520 I=1,LONK
399	C
400	IF(UEXT(I).GE.0.) THEN
401	C
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	C
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	C
425	ENDIF
426	C
427	1520 CONTINUE
428	152 CONTINUE
429	C
430	C puts the temporary moments Fi into appropriate neighboring boxes
431	C
432	DO 160 I=1,LONK
433	IF(UEXT(I).LT.0.) THEN
434	TM(I)=TM(I)+FM(I)
435	ALF(I)=FM(I)/TM(I)
436	ENDIF
437	160 CONTINUE
438	C
439	DO 161 I=1,LONK-1
440	IF(UEXT(I).GE.0.) THEN
441	TM(I+1)=TM(I+1)+FM(I)
442	ALF(I)=FM(I)/TM(I+1)
443	ENDIF
444	161 CONTINUE
445	C
446	I=LONK
447	IF(UEXT(I).GE.0.) THEN
448	TM(1)=TM(1)+FM(I)
449	ALF(I)=FM(I)/TM(1)
450	ENDIF
451	C
452	DO 162 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	162 CONTINUE
459	C
460	DO 170 JV=1,NTRA
461	DO 1700 I=1,LONK
462	C
463	IF(UEXT(I).LT.0.) THEN
464	C
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	C
480	ENDIF
481	C
482	1700 CONTINUE
483	170 CONTINUE
484	C
485	DO 171 JV=1,NTRA
486	DO 1710 I=1,LONK-1
487	C
488	IF(UEXT(I).GE.0.) THEN
489	C
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	C
505	ENDIF
506	C
507	1710 CONTINUE
508	171 CONTINUE
509	C
510	I=LONK
511	IF(UEXT(I).GE.0.) THEN
512	DO 172 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	172 CONTINUE
528	ENDIF
529	C
530	C retour aux mailles d'origine (passage des Tij aux Sij)
531	C
532	IF(NUMK.GT.1) THEN
533	C
534	DO 18 I2=1,NUMK
535	C
536	DO 180 I=1,LONK
537	C
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	C
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	C
550	180 CONTINUE
551	C
552	DO 181 JV=1,NTRA
553	DO 181 I=1,LONK
554	C
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	C
568	C reajusts moments remaining in the box
569	C
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	C
581	181 CONTINUE
582	C
583	18 CONTINUE
584	C
585	ELSE
586	C
587	DO 190 I=1,LON
588	SM(I,K,L)=TM(I)
589	190 CONTINUE
590	DO 191 JV=1,NTRA
591	DO 1910 I=1,LON
592	S0 (I,K,L,JV)=T0 (I,JV)
593	SSX (I,K,L,JV)=TX (I,JV)
594	SY (I,K,L,JV)=TY (I,JV)
595	SZ (I,K,L,JV)=TZ (I,JV)
596	SSXX(I,K,L,JV)=TXX(I,JV)
597	SSXY(I,K,L,JV)=TXY(I,JV)
598	SSXZ(I,K,L,JV)=TXZ(I,JV)
599	SYY(I,K,L,JV)=TYY(I,JV)
600	SYZ(I,K,L,JV)=TYZ(I,JV)
601	SZZ(I,K,L,JV)=TZZ(I,JV)
602	1910 CONTINUE
603	191 CONTINUE
604	C
605	ENDIF
606	C
607	1 CONTINUE
608	C
609	C ----------- AA Test en fin de ADVX ------ Controle des S*
610
611	c DO 9999 l = 1, llm
612	c DO 9999 j = 1, jjp1
613	c DO 9999 i = 1, iip1
614	c IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN
615	c PRINT*, '-------------------'
616	c PRINT*, 'En fin de ADVXP'
617	c PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
618	c print*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
619	c print*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
620	c print*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
621	c WRITE (,) 'On arrete !! - pbl en fin de ADVXP'
622	c STOP
623	c ENDIF
624	c 9999 CONTINUE
625	c ---------- bouclage cyclique
626
627	DO l = 1,llm
628	DO j = 1,jjp1
629	SM(iip1,j,l) = SM(1,j,l)
630	S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
631	SSX(iip1,j,l,ntra) = SSX(1,j,l,ntra)
632	SY(iip1,j,l,ntra) = SY(1,j,l,ntra)
633	SZ(iip1,j,l,ntra) = SZ(1,j,l,ntra)
634	END DO
635	END DO
636
637	C ----------- qqtite totale de traceur dans tte l'atmosphere
638	DO l = 1, llm
639	DO j = 1, jjp1
640	DO i = 1, iim
641	sqf = sqf + S0(i,j,l,ntra)
642	END DO
643	END DO
644	END DO
645
646	PRINT*,'------ DIAG DANS ADVX2 - SORTIE -----'
647	PRINT*,'sqf=',sqf
648	c-------------------------------------------------------------
649	RETURN
650	END

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

Download in other formats:

Original Format