Context Navigation

advxp.F @ 2993

Last change on this file since 2993 was 2641, checked in by Laurent Fairhead, 8 years ago
Merged trunk changes r2593:2640 into testing branch
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: 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