Context Navigation

advxp.f90 @ 5396

Last change on this file since 5396 was 5285, checked in by abarral, 7 weeks ago
As discussed internally, remove generic ONLY: ... for new _mod_h 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.6 KB

Rev	Line
[524]	1	!
	2	! $Header$
	3	!
[5246]	4	SUBROUTINE ADVXP(LIMIT,DTX,PBARU,SM,S0,SSX,SY,SZ &
	5	,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra)
[5271]	6	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	7	USE paramet_mod_h
[5271]	8	IMPLICIT NONE
[5246]	9	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	10	! C
	11	! second-order moments (SOM) advection of tracer in X direction C
	12	! C
	13	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	14	!
	15	! parametres principaux du modele
	16	!
[5271]	17
[524]	18
[5272]	19
[5246]	20	INTEGER :: ntra
	21	! PARAMETER (ntra = 1)
	22	!
	23	! definition de la grille du modele
	24	!
	25	REAL :: dtx
	26	REAL :: pbaru ( iip1,jjp1,llm )
	27	!
	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
	32	!
	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
[5246]	45	! Local :
	46	! -------
[524]	47
[5246]	48	! mass fluxes across the boundaries (UGRI,VGRI,WGRI)
	49	! mass fluxes in kg
	50	! declaration :
[524]	51
[5246]	52	REAL :: UGRI(iip1,jjp1,llm)
[524]	53
[5246]	54	! Rem : VGRI et WGRI ne sont pas utilises dans
	55	! cette subroutine ( advection en x uniquement )
	56	!
	57	!
	58	! Tij are the moments for the current latitude and level
	59	!
	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	!
	67	! the moments F are similarly defined and used as temporary
	68	! storage for portions of the grid boxes in transit
	69	!
	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	!
	77	! work arrays
	78	!
	79	REAL :: ALF (iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
	80	REAL :: ALF2(iim),ALF3(iim),ALF4(iim)
	81	!
	82	REAL :: SMNEW(iim),UEXT(iim)
	83	REAL :: sqi,sqf
	84	REAL :: TEMPTM
	85	REAL :: SLPMAX
	86	REAL :: S1MAX,S1NEW,S2NEW
[524]	87
[5246]	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
[5246]	93	lon = iim
	94	lati=2
	95	latf = jjm
	96	niv = llm
[524]	97
[5246]	98	! * Test de passage d'arguments ****
[524]	99
[5246]	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
[5246]	113	! *** Test : diagnostique de la qtite totale de traceur
	114	! dans l'atmosphere avant l'advection
	115	!
	116	sqi =0.
	117	sqf =0.
	118	!
	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
[5246]	146	! Interface : adaptation nouveau modele
	147	! -------------------------------------
	148	!
	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
[5246]	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
[5246]	162	! ---------------------------------------------------------
	163	! start here
	164	!
	165	! boucle principale sur les niveaux et les latitudes
	166	!
	167	DO L=1,NIV
	168	DO K=lati,latf
[524]	169
[5246]	170	!
	171	! initialisation
	172	!
	173	! program assumes periodic boundaries in X
	174	!
	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
	179	!
	180	! modifications for extended polar zones
	181	!
	182	NUMK=NUM(K)
	183	LONK=LON/NUMK
	184	!
	185	IF(NUMK.GT.1) THEN
	186	!
	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
	204	!
	205	DO I2=1,NUMK
	206	!
	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
	217	!
	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
	237	!
	238	END DO
	239	!
	240	ELSE
	241	!
	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
	259	!
	260	ENDIF
	261	!
	262	DO I=1,LONK
	263	UEXT(I)=UGRI(I*NUMK,K,L)
	264	END DO
	265	!
	266	! place limits on appropriate moments before transport
	267	! (if flux-limiting is to be applied)
	268	!
	269	IF(.NOT.LIMIT) GO TO 13
	270	!
	271	DO JV=1,NTRA
	272	DO I=1,LONK
	273	IF(T0(I,JV).GT.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
	291	!
[524]	292	13 CONTINUE
[5246]	293	!
	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
	297	!
	298	! flux from IP to I if U(I).lt.0
	299	!
	300	DO I=1,LONK-1
	301	IF(UEXT(I).LT.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
	307	!
	308	I=LONK
	309	IF(UEXT(I).LT.0.) THEN
	310	FM(I)=-UEXT(I)*DTX
	311	ALF(I)=FM(I)/TM(1)
	312	TM(1)=TM(1)-FM(I)
	313	ENDIF
	314	!
	315	! flux from I to IP if U(I).gt.0
	316	!
	317	DO I=1,LONK
	318	IF(UEXT(I).GE.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
	324	!
	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
	333	!
	334	DO JV=1,NTRA
	335	DO I=1,LONK-1
	336	!
	337	IF(UEXT(I).LT.0.) THEN
	338	!
	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)
	350	!
	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)
	361	!
	362	ENDIF
	363	!
	364	END DO
	365	END DO
	366	!
	367	I=LONK
	368	IF(UEXT(I).LT.0.) THEN
	369	!
	370	DO JV=1,NTRA
	371	!
	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)
	383	!
	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)
	394	!
	395	END DO
	396	!
	397	ENDIF
	398	!
	399	DO JV=1,NTRA
	400	DO I=1,LONK
	401	!
	402	IF(UEXT(I).GE.0.) THEN
	403	!
	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)
	415	!
	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)
	426	!
	427	ENDIF
	428	!
	429	END DO
	430	END DO
	431	!
	432	! puts the temporary moments Fi into appropriate neighboring boxes
	433	!
	434	DO I=1,LONK
	435	IF(UEXT(I).LT.0.) THEN
	436	TM(I)=TM(I)+FM(I)
	437	ALF(I)=FM(I)/TM(I)
	438	ENDIF
	439	END DO
	440	!
	441	DO I=1,LONK-1
	442	IF(UEXT(I).GE.0.) THEN
	443	TM(I+1)=TM(I+1)+FM(I)
	444	ALF(I)=FM(I)/TM(I+1)
	445	ENDIF
	446	END DO
	447	!
	448	I=LONK
	449	IF(UEXT(I).GE.0.) THEN
	450	TM(1)=TM(1)+FM(I)
	451	ALF(I)=FM(I)/TM(1)
	452	ENDIF
	453	!
	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
	461	!
	462	DO JV=1,NTRA
	463	DO I=1,LONK
	464	!
	465	IF(UEXT(I).LT.0.) THEN
	466	!
	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)
	481	!
	482	ENDIF
	483	!
	484	END DO
	485	END DO
	486	!
	487	DO JV=1,NTRA
	488	DO I=1,LONK-1
	489	!
	490	IF(UEXT(I).GE.0.) THEN
	491	!
	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)
	506	!
	507	ENDIF
	508	!
	509	END DO
	510	END DO
	511	!
	512	I=LONK
	513	IF(UEXT(I).GE.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
	531	!
	532	! retour aux mailles d'origine (passage des Tij aux Sij)
	533	!
	534	IF(NUMK.GT.1) THEN
	535	!
	536	DO I2=1,NUMK
	537	!
	538	DO I=1,LONK
	539	!
	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)
	544	!
	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)
	551	!
	552	END DO
	553	!
	554	DO JV=1,NTRA
	555	DO I=1,LONK
	556	!
	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)
	569	!
	570	! reajusts moments remaining in the box
	571	!
	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)
	582	!
	583	END DO
	584	END DO
	585	!
	586	END DO
	587	!
	588	ELSE
	589	!
	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
	607	!
	608	ENDIF
	609	!
	610	END DO
	611	END DO
	612	!
	613	! ----------- AA Test en fin de ADVX ------ Controle des S*
[524]	614
[5246]	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
[5246]	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
[5246]	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
[5246]	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