Context Navigation

advxp.f90 @ 5423

Last change on this file since 5423 was 5159, checked in by abarral, 5 months ago
Put dimensions.h and paramet.h into modules
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: 16.3 KB

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

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

Download in other formats:

Original Format