Context Navigation

advxp.F @ 1

Last change on this file since 1 was 1, checked in by emillour, 14 years ago
Import initial LMDZ5
File size: 18.1 KB

Rev	Line
[1]	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