Context Navigation

advxp.F @ 3493

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

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

Download in other formats:

Original Format