Context Navigation

advxp.F @ 2597

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

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

Download in other formats:

Original Format