Context Navigation

advxp.F @ 5099

Last change on this file since 5099 was 5099, checked in by abarral, 4 months ago
Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90 Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad Create lmdz_yoerad.f90 (lint) Remove "!" on otherwise empty line
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: 17.9 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 j =1,jjp1
129	NUM(j) =1
130	END DO
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 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	C ---------------------------------------------------------
161	C start here
162	C
163	C boucle principale sur les niveaux et les latitudes
164	C
165	DO L=1,NIV
166	DO K=lati,latf
167
168	C
169	C initialisation
170	C
171	C program assumes periodic boundaries in X
172	C
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	C
178	C modifications for extended polar zones
179	C
180	NUMK=NUM(K)
181	LONK=LON/NUMK
182	C
183	IF(NUMK>1) THEN
184	C
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	C
203	DO I2=1,NUMK
204	C
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	C
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	C
236	END DO
237	C
238	ELSE
239	C
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	C
258	ENDIF
259	C
260	DO I=1,LONK
261	UEXT(I)=UGRI(I*NUMK,K,L)
262	END DO
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 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	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 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	C
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	C
313	C flux from I to IP if U(I).gt.0
314	C
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	C
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	C
332	DO JV=1,NTRA
333	DO I=1,LONK-1
334	C
335	IF(UEXT(I)<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	END DO
363	END DO
364	C
365	I=LONK
366	IF(UEXT(I)<0.) THEN
367	C
368	DO 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	END DO
394	C
395	ENDIF
396	C
397	DO JV=1,NTRA
398	DO I=1,LONK
399	C
400	IF(UEXT(I)>=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	END DO
428	END DO
429	C
430	C puts the temporary moments Fi into appropriate neighboring boxes
431	C
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	C
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	C
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	C
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	C
460	DO JV=1,NTRA
461	DO I=1,LONK
462	C
463	IF(UEXT(I)<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	END DO
483	END DO
484	C
485	DO JV=1,NTRA
486	DO I=1,LONK-1
487	C
488	IF(UEXT(I)>=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	END DO
508	END DO
509	C
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	C
530	C retour aux mailles d'origine (passage des Tij aux Sij)
531	C
532	IF(NUMK>1) THEN
533	C
534	DO I2=1,NUMK
535	C
536	DO 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	END DO
551	C
552	DO JV=1,NTRA
553	DO 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	END DO
582	END DO
583	C
584	END DO
585	C
586	ELSE
587	C
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	C
606	ENDIF
607	C
608	END DO
609	END DO
610	C
611	C ----------- AA Test en fin de ADVX ------ Controle des S*
612
613	c DO 9999 l = 1, llm
614	c DO 9999 j = 1, jjp1
615	c DO 9999 i = 1, iip1
616	c IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN
617	c PRINT*, '-------------------'
618	c PRINT*, 'En fin de ADVXP'
619	c PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
620	c print*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
621	c print*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
622	c print*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
623	c WRITE (,) 'On arrete !! - pbl en fin de ADVXP'
624	c STOP
625	c ENDIF
626	c 9999 CONTINUE
627	c ---------- 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	C ----------- 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	c-------------------------------------------------------------
651	RETURN
652	END

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

Download in other formats:

Original Format