Context Navigation

advxp.F @ 4962

Last change on this file since 4962 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

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