Context Navigation

advyp.f90 @ 5403

Last change on this file since 5403 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: 17.8 KB

Rev	Line
[524]	1	!
	2	! $Header$
	3	!
[5246]	4	SUBROUTINE ADVYP(LIMIT,DTY,PBARV,SM,S0,SSX,SY,SZ &
	5	,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra )
[5281]	6	USE comgeom_mod_h
[5271]	7	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	8	USE paramet_mod_h
[5271]	9	IMPLICIT NONE
[5246]	10	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	11	! C
	12	! second-order moments (SOM) advection of tracer in Y direction C
	13	! C
	14	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	15	! C
	16	! Source : Pascal Simon ( Meteo, CNRM ) C
	17	! Adaptation : A.A. (LGGE) C
	18	! Derniere Modif : 19/10/95 LAST
	19	! C
	20	! sont les arguments d'entree pour le s-pg C
	21	! C
	22	! argument de sortie du s-pg C
	23	! C
	24	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	25	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	26	!
	27	! Rem : Probleme aux poles il faut reecrire ce cas specifique
	28	! Attention au sens de l'indexation
	29	!
	30	! parametres principaux du modele
	31	!
	32	!
[5271]	33
[5272]	34
[524]	35
[5246]	36	! Arguments :
	37	! ----------
	38	! dty : frequence fictive d'appel du transport
	39	! parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
[524]	40
[5246]	41	INTEGER :: lon,lat,niv
	42	INTEGER :: i,j,jv,k,kp,l
	43	INTEGER :: ntra
	44	! PARAMETER (ntra = 1)
[524]	45
[5246]	46	REAL :: dty
	47	REAL :: pbarv ( iip1,jjm, llm )
[524]	48
[5246]	49	! moments: SM total mass in each grid box
	50	! S0 mass of tracer in each grid box
	51	! Si 1rst order moment in i direction
	52	!
	53	REAL :: SM(iip1,jjp1,llm) &
	54	,S0(iip1,jjp1,llm,ntra)
	55	REAL :: SSX(iip1,jjp1,llm,ntra) &
	56	,SY(iip1,jjp1,llm,ntra) &
	57	,SZ(iip1,jjp1,llm,ntra) &
	58	,SSXX(iip1,jjp1,llm,ntra) &
	59	,SSXY(iip1,jjp1,llm,ntra) &
	60	,SSXZ(iip1,jjp1,llm,ntra) &
	61	,SYY(iip1,jjp1,llm,ntra) &
	62	,SYZ(iip1,jjp1,llm,ntra) &
	63	,SZZ(iip1,jjp1,llm,ntra)
	64	!
	65	! Local :
	66	! -------
[524]	67
[5246]	68	! mass fluxes across the boundaries (UGRI,VGRI,WGRI)
	69	! mass fluxes in kg
	70	! declaration :
[524]	71
[5246]	72	REAL :: VGRI(iip1,0:jjp1,llm)
[524]	73
[5246]	74	! Rem : UGRI et WGRI ne sont pas utilises dans
	75	! cette subroutine ( advection en y uniquement )
	76	! Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
	77	!
	78	! the moments F are similarly defined and used as temporary
	79	! storage for portions of the grid boxes in transit
	80	!
	81	! the moments Fij are used as temporary storage for
	82	! portions of the grid boxes in transit at the current level
	83	!
	84	! work arrays
	85	!
	86	!
	87	REAL :: F0(iim,0:jjp1,ntra),FM(iim,0:jjp1)
	88	REAL :: FX(iim,jjm,ntra),FY(iim,jjm,ntra)
	89	REAL :: FZ(iim,jjm,ntra)
	90	REAL :: FXX(iim,jjm,ntra),FXY(iim,jjm,ntra)
	91	REAL :: FXZ(iim,jjm,ntra),FYY(iim,jjm,ntra)
	92	REAL :: FYZ(iim,jjm,ntra),FZZ(iim,jjm,ntra)
	93	REAL :: S00(ntra)
	94	REAL :: SM0 ! Just temporal variable
	95	!
	96	! work arrays
	97	!
	98	REAL :: ALF(iim,0:jjp1),ALF1(iim,0:jjp1)
	99	REAL :: ALFQ(iim,0:jjp1),ALF1Q(iim,0:jjp1)
	100	REAL :: ALF2(iim,0:jjp1),ALF3(iim,0:jjp1)
	101	REAL :: ALF4(iim,0:jjp1)
	102	REAL :: TEMPTM ! Just temporal variable
	103	REAL :: SLPMAX,S1MAX,S1NEW,S2NEW
	104	!
	105	! Special pour poles
	106	!
	107	REAL :: sbms,sfms,sfzs,sbmn,sfmn,sfzn
	108	REAL :: sns0(ntra),snsz(ntra),snsm
	109	REAL :: qy1(iim,llm,ntra),qylat(iim,llm,ntra)
	110	REAL :: cx1(llm,ntra), cxLAT(llm,ntra)
	111	REAL :: cy1(llm,ntra), cyLAT(llm,ntra)
	112	REAL :: z1(iim), zcos(iim), zsin(iim)
	113	REAL :: SSUM
	114	EXTERNAL SSUM
	115	!
	116	REAL :: sqi,sqf
	117	LOGICAL :: LIMIT
[524]	118
[5246]	119	lon = iim ! rem : Il est possible qu'un pbl. arrive ici
	120	lat = jjp1 ! a cause des dim. differentes entre les
	121	niv = llm ! tab. S et VGRI
[524]	122
[5246]	123	!-----------------------------------------------------------------
	124	! initialisations
[524]	125
[5246]	126	sbms = 0.
	127	sfms = 0.
	128	sfzs = 0.
	129	sbmn = 0.
	130	sfmn = 0.
	131	sfzn = 0.
[524]	132
[5246]	133	!-----------------------------------------------------------------
	134	! *** Test : diag de la qtite totale de traceur dans
	135	! l'atmosphere avant l'advection en Y
	136	!
	137	sqi = 0.
	138	sqf = 0.
[524]	139
[5246]	140	DO l = 1,llm
	141	DO j = 1,jjp1
	142	DO i = 1,iim
	143	sqi = sqi + S0(i,j,l,ntra)
	144	END DO
	145	END DO
	146	END DO
	147	PRINT*,'---------- DIAG DANS ADVY - ENTREE --------'
	148	PRINT*,'sqi=',sqi
[524]	149
[5246]	150	!-----------------------------------------------------------------
	151	! Interface : adaptation nouveau modele
	152	! -------------------------------------
	153	!
	154	! Conversion des flux de masses en kg
	155	!-AA 20/10/94 le signe -1 est necessaire car indexation opposee
[524]	156
[5246]	157	DO l = 1,llm
	158	DO j = 1,jjm
	159	DO i = 1,iip1
	160	vgri (i,j,llm+1-l)=-1.*pbarv (i,j,l)
	161	END DO
	162	END DO
	163	END DO
	164
	165	!AA Initialisation de flux fictifs aux bords sup. des boites pol.
	166
	167	DO l = 1,llm
	168	DO i = 1,iip1
	169	vgri(i,0,l) = 0.
	170	vgri(i,jjp1,l) = 0.
	171	ENDDO
	172	ENDDO
	173	!
	174	!----------------- START HERE -----------------------
	175	! boucle sur les niveaux
	176	!
	177	DO L=1,NIV
	178	!
	179	! place limits on appropriate moments before transport
	180	! (if flux-limiting is to be applied)
	181	!
	182	IF(.NOT.LIMIT) GO TO 11
	183	!
	184	DO JV=1,NTRA
	185	DO K=1,LAT
	186	DO I=1,LON
	187	IF(S0(I,K,L,JV).GT.0.) THEN
	188	SLPMAX=AMAX1(S0(I,K,L,JV),0.)
	189	S1MAX=1.5*SLPMAX
	190	S1NEW=AMIN1(S1MAX,AMAX1(-S1MAX,SY(I,K,L,JV)))
	191	S2NEW=AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. , &
	192	AMAX1(ABS(S1NEW)-SLPMAX,SYY(I,K,L,JV)) )
	193	SY (I,K,L,JV)=S1NEW
	194	SYY(I,K,L,JV)=S2NEW
	195	SSXY(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SSXY(I,K,L,JV)))
	196	SYZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SYZ(I,K,L,JV)))
	197	ELSE
	198	SY (I,K,L,JV)=0.
	199	SYY(I,K,L,JV)=0.
	200	SSXY(I,K,L,JV)=0.
	201	SYZ(I,K,L,JV)=0.
	202	ENDIF
	203	END DO
	204	END DO
	205	END DO
	206	!
[524]	207	11 CONTINUE
[5246]	208	!
	209	! le flux a travers le pole Nord est traite separement
	210	!
	211	SM0=0.
	212	DO JV=1,NTRA
	213	S00(JV)=0.
	214	END DO
	215	!
	216	DO I=1,LON
	217	!
	218	IF(VGRI(I,0,L).LE.0.) THEN
	219	FM(I,0)=-VGRI(I,0,L)*DTY
	220	ALF(I,0)=FM(I,0)/SM(I,1,L)
	221	SM(I,1,L)=SM(I,1,L)-FM(I,0)
	222	SM0=SM0+FM(I,0)
	223	ENDIF
	224	!
	225	ALFQ(I,0)=ALF(I,0)*ALF(I,0)
	226	ALF1(I,0)=1.-ALF(I,0)
	227	ALF1Q(I,0)=ALF1(I,0)*ALF1(I,0)
	228	ALF2(I,0)=ALF1(I,0)-ALF(I,0)
	229	ALF3(I,0)=ALF(I,0)*ALFQ(I,0)
	230	ALF4(I,0)=ALF1(I,0)*ALF1Q(I,0)
	231	!
	232	END DO
	233	! print*,'ADVYP 21'
	234	!
	235	DO JV=1,NTRA
	236	DO I=1,LON
	237	!
	238	IF(VGRI(I,0,L).LE.0.) THEN
	239	!
	240	F0(I,0,JV)=ALF(I,0)* ( S0(I,1,L,JV)-ALF1(I,0)* &
	241	( SY(I,1,L,JV)-ALF2(I,0)*SYY(I,1,L,JV) ) )
	242	!
	243	S00(JV)=S00(JV)+F0(I,0,JV)
	244	S0 (I,1,L,JV)=S0(I,1,L,JV)-F0(I,0,JV)
	245	SY (I,1,L,JV)=ALF1Q(I,0)* &
	246	(SY(I,1,L,JV)+3.ALF(I,0)SYY(I,1,L,JV))
	247	SYY(I,1,L,JV)=ALF4 (I,0)*SYY(I,1,L,JV)
	248	SSX (I,1,L,JV)=ALF1 (I,0)* &
	249	(SSX(I,1,L,JV)+ALF(I,0)*SSXY(I,1,L,JV) )
	250	SZ (I,1,L,JV)=ALF1 (I,0)* &
	251	(SZ(I,1,L,JV)+ALF(I,0)*SSXZ(I,1,L,JV) )
	252	SSXX(I,1,L,JV)=ALF1 (I,0)*SSXX(I,1,L,JV)
	253	SSXZ(I,1,L,JV)=ALF1 (I,0)*SSXZ(I,1,L,JV)
	254	SZZ(I,1,L,JV)=ALF1 (I,0)*SZZ(I,1,L,JV)
	255	SSXY(I,1,L,JV)=ALF1Q(I,0)*SSXY(I,1,L,JV)
	256	SYZ(I,1,L,JV)=ALF1Q(I,0)*SYZ(I,1,L,JV)
	257	!
	258	ENDIF
	259	!
	260	END DO
	261	END DO
	262	!
	263	DO I=1,LON
	264	IF(VGRI(I,0,L).GT.0.) THEN
	265	FM(I,0)=VGRI(I,0,L)*DTY
	266	ALF(I,0)=FM(I,0)/SM0
	267	ENDIF
	268	END DO
	269	!
	270	DO JV=1,NTRA
	271	DO I=1,LON
	272	IF(VGRI(I,0,L).GT.0.) THEN
	273	F0(I,0,JV)=ALF(I,0)*S00(JV)
	274	ENDIF
	275	END DO
	276	END DO
	277	!
	278	! puts the temporary moments Fi into appropriate neighboring boxes
	279	!
	280	! print*,'av ADVYP 25'
	281	DO I=1,LON
	282	!
	283	IF(VGRI(I,0,L).GT.0.) THEN
	284	SM(I,1,L)=SM(I,1,L)+FM(I,0)
	285	ALF(I,0)=FM(I,0)/SM(I,1,L)
	286	ENDIF
	287	!
	288	ALFQ(I,0)=ALF(I,0)*ALF(I,0)
	289	ALF1(I,0)=1.-ALF(I,0)
	290	ALF1Q(I,0)=ALF1(I,0)*ALF1(I,0)
	291	ALF2(I,0)=ALF1(I,0)-ALF(I,0)
	292	ALF3(I,0)=ALF1(I,0)*ALF(I,0)
	293	!
	294	END DO
	295	! print*,'av ADVYP 25'
	296	!
	297	DO JV=1,NTRA
	298	DO I=1,LON
	299	!
	300	IF(VGRI(I,0,L).GT.0.) THEN
	301	!
	302	TEMPTM=ALF(I,0)S0(I,1,L,JV)-ALF1(I,0)F0(I,0,JV)
	303	S0 (I,1,L,JV)=S0(I,1,L,JV)+F0(I,0,JV)
	304	SYY(I,1,L,JV)=ALF1Q(I,0)*SYY(I,1,L,JV) &
	305	+5.( ALF3 (I,0)SY (I,1,L,JV)-ALF2(I,0)*TEMPTM )
	306	SY (I,1,L,JV)=ALF1 (I,0)SY (I,1,L,JV)+3.TEMPTM
	307	SSXY(I,1,L,JV)=ALF1 (I,0)SSXY(I,1,L,JV)+3.ALF(I,0)*SSX(I,1,L,JV)
	308	SYZ(I,1,L,JV)=ALF1 (I,0)SYZ(I,1,L,JV)+3.ALF(I,0)*SZ(I,1,L,JV)
	309	!
	310	ENDIF
	311	!
	312	END DO
	313	END DO
	314	!
	315	! calculate flux and moments between adjacent boxes
	316	! 1- create temporary moments/masses for partial boxes in transit
	317	! 2- reajusts moments remaining in the box
	318	!
	319	! flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0
	320	!
	321	! print*,'av ADVYP 30'
	322	DO K=1,LAT-1
	323	KP=K+1
	324	DO I=1,LON
	325	!
	326	IF(VGRI(I,K,L).LT.0.) THEN
	327	FM(I,K)=-VGRI(I,K,L)*DTY
	328	ALF(I,K)=FM(I,K)/SM(I,KP,L)
	329	SM(I,KP,L)=SM(I,KP,L)-FM(I,K)
	330	ELSE
	331	FM(I,K)=VGRI(I,K,L)*DTY
	332	ALF(I,K)=FM(I,K)/SM(I,K,L)
	333	SM(I,K,L)=SM(I,K,L)-FM(I,K)
	334	ENDIF
	335	!
	336	ALFQ(I,K)=ALF(I,K)*ALF(I,K)
	337	ALF1(I,K)=1.-ALF(I,K)
	338	ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
	339	ALF2(I,K)=ALF1(I,K)-ALF(I,K)
	340	ALF3(I,K)=ALF(I,K)*ALFQ(I,K)
	341	ALF4(I,K)=ALF1(I,K)*ALF1Q(I,K)
	342	!
	343	END DO
	344	END DO
	345	! print*,'ap ADVYP 30'
	346	!
	347	DO JV=1,NTRA
	348	DO K=1,LAT-1
	349	KP=K+1
	350	DO I=1,LON
	351	!
	352	IF(VGRI(I,K,L).LT.0.) THEN
	353	!
	354	F0 (I,K,JV)=ALF (I,K)* ( S0(I,KP,L,JV)-ALF1(I,K)* &
	355	( SY(I,KP,L,JV)-ALF2(I,K)*SYY(I,KP,L,JV) ) )
	356	FY (I,K,JV)=ALFQ(I,K)* &
	357	(SY(I,KP,L,JV)-3.ALF1(I,K)SYY(I,KP,L,JV))
	358	FYY(I,K,JV)=ALF3(I,K)*SYY(I,KP,L,JV)
	359	FX (I,K,JV)=ALF (I,K)* &
	360	(SSX(I,KP,L,JV)-ALF1(I,K)*SSXY(I,KP,L,JV))
	361	FZ (I,K,JV)=ALF (I,K)* &
	362	(SZ(I,KP,L,JV)-ALF1(I,K)*SYZ(I,KP,L,JV))
	363	FXY(I,K,JV)=ALFQ(I,K)*SSXY(I,KP,L,JV)
	364	FYZ(I,K,JV)=ALFQ(I,K)*SYZ(I,KP,L,JV)
	365	FXX(I,K,JV)=ALF (I,K)*SSXX(I,KP,L,JV)
	366	FXZ(I,K,JV)=ALF (I,K)*SSXZ(I,KP,L,JV)
	367	FZZ(I,K,JV)=ALF (I,K)*SZZ(I,KP,L,JV)
	368	!
	369	S0 (I,KP,L,JV)=S0(I,KP,L,JV)-F0(I,K,JV)
	370	SY (I,KP,L,JV)=ALF1Q(I,K)* &
	371	(SY(I,KP,L,JV)+3.ALF(I,K)SYY(I,KP,L,JV))
	372	SYY(I,KP,L,JV)=ALF4(I,K)*SYY(I,KP,L,JV)
	373	SSX (I,KP,L,JV)=SSX (I,KP,L,JV)-FX (I,K,JV)
	374	SZ (I,KP,L,JV)=SZ (I,KP,L,JV)-FZ (I,K,JV)
	375	SSXX(I,KP,L,JV)=SSXX(I,KP,L,JV)-FXX(I,K,JV)
	376	SSXZ(I,KP,L,JV)=SSXZ(I,KP,L,JV)-FXZ(I,K,JV)
	377	SZZ(I,KP,L,JV)=SZZ(I,KP,L,JV)-FZZ(I,K,JV)
	378	SSXY(I,KP,L,JV)=ALF1Q(I,K)*SSXY(I,KP,L,JV)
	379	SYZ(I,KP,L,JV)=ALF1Q(I,K)*SYZ(I,KP,L,JV)
	380	!
	381	ELSE
	382	!
	383	F0 (I,K,JV)=ALF (I,K)* ( S0(I,K,L,JV)+ALF1(I,K)* &
	384	( SY(I,K,L,JV)+ALF2(I,K)*SYY(I,K,L,JV) ) )
	385	FY (I,K,JV)=ALFQ(I,K)* &
	386	(SY(I,K,L,JV)+3.ALF1(I,K)SYY(I,K,L,JV))
	387	FYY(I,K,JV)=ALF3(I,K)*SYY(I,K,L,JV)
	388	FX (I,K,JV)=ALF (I,K)(SSX(I,K,L,JV)+ALF1(I,K)SSXY(I,K,L,JV))
	389	FZ (I,K,JV)=ALF (I,K)(SZ(I,K,L,JV)+ALF1(I,K)SYZ(I,K,L,JV))
	390	FXY(I,K,JV)=ALFQ(I,K)*SSXY(I,K,L,JV)
	391	FYZ(I,K,JV)=ALFQ(I,K)*SYZ(I,K,L,JV)
	392	FXX(I,K,JV)=ALF (I,K)*SSXX(I,K,L,JV)
	393	FXZ(I,K,JV)=ALF (I,K)*SSXZ(I,K,L,JV)
	394	FZZ(I,K,JV)=ALF (I,K)*SZZ(I,K,L,JV)
	395	!
	396	S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0 (I,K,JV)
	397	SY (I,K,L,JV)=ALF1Q(I,K)* &
	398	(SY(I,K,L,JV)-3.ALF(I,K)SYY(I,K,L,JV))
	399	SYY(I,K,L,JV)=ALF4(I,K)*SYY(I,K,L,JV)
	400	SSX (I,K,L,JV)=SSX (I,K,L,JV)-FX (I,K,JV)
	401	SZ (I,K,L,JV)=SZ (I,K,L,JV)-FZ (I,K,JV)
	402	SSXX(I,K,L,JV)=SSXX(I,K,L,JV)-FXX(I,K,JV)
	403	SSXZ(I,K,L,JV)=SSXZ(I,K,L,JV)-FXZ(I,K,JV)
	404	SZZ(I,K,L,JV)=SZZ(I,K,L,JV)-FZZ(I,K,JV)
	405	SSXY(I,K,L,JV)=ALF1Q(I,K)*SSXY(I,K,L,JV)
	406	SYZ(I,K,L,JV)=ALF1Q(I,K)*SYZ(I,K,L,JV)
	407	!
	408	ENDIF
	409	!
	410	END DO
	411	END DO
	412	END DO
	413	! print*,'ap ADVYP 31'
	414	!
	415	! puts the temporary moments Fi into appropriate neighboring boxes
	416	!
	417	DO K=1,LAT-1
	418	KP=K+1
	419	DO I=1,LON
	420	!
	421	IF(VGRI(I,K,L).LT.0.) THEN
	422	SM(I,K,L)=SM(I,K,L)+FM(I,K)
	423	ALF(I,K)=FM(I,K)/SM(I,K,L)
	424	ELSE
	425	SM(I,KP,L)=SM(I,KP,L)+FM(I,K)
	426	ALF(I,K)=FM(I,K)/SM(I,KP,L)
	427	ENDIF
	428	!
	429	ALFQ(I,K)=ALF(I,K)*ALF(I,K)
	430	ALF1(I,K)=1.-ALF(I,K)
	431	ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
	432	ALF2(I,K)=ALF1(I,K)-ALF(I,K)
	433	ALF3(I,K)=ALF1(I,K)*ALF(I,K)
	434	!
	435	END DO
	436	END DO
	437	! print*,'ap ADVYP 32'
	438	!
	439	DO JV=1,NTRA
	440	DO K=1,LAT-1
	441	KP=K+1
	442	DO I=1,LON
	443	!
	444	IF(VGRI(I,K,L).LT.0.) THEN
	445	!
	446	TEMPTM=-ALF(I,K)S0(I,K,L,JV)+ALF1(I,K)F0(I,K,JV)
	447	S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
	448	SYY(I,K,L,JV)=ALFQ(I,K)FYY(I,K,JV)+ALF1Q(I,K)SYY(I,K,L,JV) &
	449	+5.( ALF3(I,K)(FY(I,K,JV)-SY(I,K,L,JV))+ALF2(I,K)*TEMPTM )
	450	SY (I,K,L,JV)=ALF(I,K)FY(I,K,JV)+ALF1(I,K)SY(I,K,L,JV) &
	451	+3.*TEMPTM
	452	SSXY(I,K,L,JV)=ALF (I,K)FXY(I,K,JV)+ALF1(I,K)SSXY(I,K,L,JV) &
	453	+3.(ALF1(I,K)FX (I,K,JV)-ALF (I,K)*SSX (I,K,L,JV))
	454	SYZ(I,K,L,JV)=ALF (I,K)FYZ(I,K,JV)+ALF1(I,K)SYZ(I,K,L,JV) &
	455	+3.(ALF1(I,K)FZ (I,K,JV)-ALF (I,K)*SZ (I,K,L,JV))
	456	SSX (I,K,L,JV)=SSX (I,K,L,JV)+FX (I,K,JV)
	457	SZ (I,K,L,JV)=SZ (I,K,L,JV)+FZ (I,K,JV)
	458	SSXX(I,K,L,JV)=SSXX(I,K,L,JV)+FXX(I,K,JV)
	459	SSXZ(I,K,L,JV)=SSXZ(I,K,L,JV)+FXZ(I,K,JV)
	460	SZZ(I,K,L,JV)=SZZ(I,K,L,JV)+FZZ(I,K,JV)
	461	!
	462	ELSE
	463	!
	464	TEMPTM=ALF(I,K)S0(I,KP,L,JV)-ALF1(I,K)F0(I,K,JV)
	465	S0 (I,KP,L,JV)=S0(I,KP,L,JV)+F0(I,K,JV)
	466	SYY(I,KP,L,JV)=ALFQ(I,K)FYY(I,K,JV)+ALF1Q(I,K)SYY(I,KP,L,JV) &
	467	+5.( ALF3(I,K)(SY(I,KP,L,JV)-FY(I,K,JV))-ALF2(I,K)*TEMPTM )
	468	SY (I,KP,L,JV)=ALF(I,K)FY(I,K,JV)+ALF1(I,K)SY(I,KP,L,JV) &
	469	+3.*TEMPTM
	470	SSXY(I,KP,L,JV)=ALF(I,K)FXY(I,K,JV)+ALF1(I,K)SSXY(I,KP,L,JV) &
	471	+3.(ALF(I,K)SSX(I,KP,L,JV)-ALF1(I,K)*FX(I,K,JV))
	472	SYZ(I,KP,L,JV)=ALF(I,K)FYZ(I,K,JV)+ALF1(I,K)SYZ(I,KP,L,JV) &
	473	+3.(ALF(I,K)SZ(I,KP,L,JV)-ALF1(I,K)*FZ(I,K,JV))
	474	SSX (I,KP,L,JV)=SSX (I,KP,L,JV)+FX (I,K,JV)
	475	SZ (I,KP,L,JV)=SZ (I,KP,L,JV)+FZ (I,K,JV)
	476	SSXX(I,KP,L,JV)=SSXX(I,KP,L,JV)+FXX(I,K,JV)
	477	SSXZ(I,KP,L,JV)=SSXZ(I,KP,L,JV)+FXZ(I,K,JV)
	478	SZZ(I,KP,L,JV)=SZZ(I,KP,L,JV)+FZZ(I,K,JV)
	479	!
	480	ENDIF
	481	!
	482	END DO
	483	END DO
	484	END DO
	485	! print*,'ap ADVYP 33'
	486	!
	487	! traitement special pour le pole Sud (idem pole Nord)
	488	!
	489	K=LAT
	490	!
	491	SM0=0.
	492	DO JV=1,NTRA
	493	S00(JV)=0.
	494	END DO
	495	!
	496	DO I=1,LON
	497	!
	498	IF(VGRI(I,K,L).GE.0.) THEN
	499	FM(I,K)=VGRI(I,K,L)*DTY
	500	ALF(I,K)=FM(I,K)/SM(I,K,L)
	501	SM(I,K,L)=SM(I,K,L)-FM(I,K)
	502	SM0=SM0+FM(I,K)
	503	ENDIF
	504	!
	505	ALFQ(I,K)=ALF(I,K)*ALF(I,K)
	506	ALF1(I,K)=1.-ALF(I,K)
	507	ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
	508	ALF2(I,K)=ALF1(I,K)-ALF(I,K)
	509	ALF3(I,K)=ALF(I,K)*ALFQ(I,K)
	510	ALF4(I,K)=ALF1(I,K)*ALF1Q(I,K)
	511	!
	512	END DO
	513	! print*,'ap ADVYP 41'
	514	!
	515	DO JV=1,NTRA
	516	DO I=1,LON
	517	!
	518	IF(VGRI(I,K,L).GE.0.) THEN
	519	F0 (I,K,JV)=ALF(I,K)* ( S0(I,K,L,JV)+ALF1(I,K)* &
	520	( SY(I,K,L,JV)+ALF2(I,K)*SYY(I,K,L,JV) ) )
	521	S00(JV)=S00(JV)+F0(I,K,JV)
	522	!
	523	S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0 (I,K,JV)
	524	SY (I,K,L,JV)=ALF1Q(I,K)* &
	525	(SY(I,K,L,JV)-3.ALF(I,K)SYY(I,K,L,JV))
	526	SYY(I,K,L,JV)=ALF4 (I,K)*SYY(I,K,L,JV)
	527	SSX (I,K,L,JV)=ALF1(I,K)(SSX(I,K,L,JV)-ALF(I,K)SSXY(I,K,L,JV))
	528	SZ (I,K,L,JV)=ALF1(I,K)(SZ(I,K,L,JV)-ALF(I,K)SYZ(I,K,L,JV))
	529	SSXX(I,K,L,JV)=ALF1 (I,K)*SSXX(I,K,L,JV)
	530	SSXZ(I,K,L,JV)=ALF1 (I,K)*SSXZ(I,K,L,JV)
	531	SZZ(I,K,L,JV)=ALF1 (I,K)*SZZ(I,K,L,JV)
	532	SSXY(I,K,L,JV)=ALF1Q(I,K)*SSXY(I,K,L,JV)
	533	SYZ(I,K,L,JV)=ALF1Q(I,K)*SYZ(I,K,L,JV)
	534	ENDIF
	535	!
	536	END DO
	537	END DO
	538	! print*,'ap ADVYP 42'
	539	!
	540	DO I=1,LON
	541	IF(VGRI(I,K,L).LT.0.) THEN
	542	FM(I,K)=-VGRI(I,K,L)*DTY
	543	ALF(I,K)=FM(I,K)/SM0
	544	ENDIF
	545	END DO
	546	! print*,'ap ADVYP 43'
	547	!
	548	DO JV=1,NTRA
	549	DO I=1,LON
	550	IF(VGRI(I,K,L).LT.0.) THEN
	551	F0(I,K,JV)=ALF(I,K)*S00(JV)
	552	ENDIF
	553	END DO
	554	END DO
	555	!
	556	! puts the temporary moments Fi into appropriate neighboring boxes
	557	!
	558	DO I=1,LON
	559	!
	560	IF(VGRI(I,K,L).LT.0.) THEN
	561	SM(I,K,L)=SM(I,K,L)+FM(I,K)
	562	ALF(I,K)=FM(I,K)/SM(I,K,L)
	563	ENDIF
	564	!
	565	ALFQ(I,K)=ALF(I,K)*ALF(I,K)
	566	ALF1(I,K)=1.-ALF(I,K)
	567	ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
	568	ALF2(I,K)=ALF1(I,K)-ALF(I,K)
	569	ALF3(I,K)=ALF1(I,K)*ALF(I,K)
	570	!
	571	END DO
	572	! print*,'ap ADVYP 45'
	573	!
	574	DO JV=1,NTRA
	575	DO I=1,LON
	576	!
	577	IF(VGRI(I,K,L).LT.0.) THEN
	578	!
	579	TEMPTM=-ALF(I,K)S0(I,K,L,JV)+ALF1(I,K)F0(I,K,JV)
	580	S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
	581	SYY(I,K,L,JV)=ALF1Q(I,K)*SYY(I,K,L,JV) &
	582	+5.(-ALF3 (I,K)SY (I,K,L,JV)+ALF2(I,K)*TEMPTM )
	583	SY (I,K,L,JV)=ALF1(I,K)SY (I,K,L,JV)+3.TEMPTM
	584	SSXY(I,K,L,JV)=ALF1(I,K)SSXY(I,K,L,JV)-3.ALF(I,K)*SSX(I,K,L,JV)
	585	SYZ(I,K,L,JV)=ALF1(I,K)SYZ(I,K,L,JV)-3.ALF(I,K)*SZ(I,K,L,JV)
	586	!
	587	ENDIF
	588	!
	589	END DO
	590	END DO
	591	! print*,'ap ADVYP 46'
	592	!
	593	END DO
[524]	594
[5246]	595	!--------------------------------------------------
	596	! bouclage cyclique horizontal .
[524]	597
[5246]	598	DO l = 1,llm
	599	DO jv = 1,ntra
	600	DO j = 1,jjp1
	601	SM(iip1,j,l) = SM(1,j,l)
	602	S0(iip1,j,l,jv) = S0(1,j,l,jv)
	603	SSX(iip1,j,l,jv) = SSX(1,j,l,jv)
	604	SY(iip1,j,l,jv) = SY(1,j,l,jv)
	605	SZ(iip1,j,l,jv) = SZ(1,j,l,jv)
	606	END DO
	607	END DO
	608	END DO
[524]	609
[5246]	610	! -------------------------------------------------------------------
	611	! *** Test negativite:
	612
	613	! DO jv = 1,ntra
	614	! DO l = 1,llm
	615	! DO j = 1,jjp1
	616	! DO i = 1,iip1
	617	! IF (s0( i,j,l,jv ).lt.0.) THEN
	618	! PRINT*, '------ S0 < 0 en FIN ADVYP ---'
	619	! PRINT*, 'S0(',i,j,l,jv,')=', S0(i,j,l,jv)
	620	!c STOP
	621	! ENDIF
	622	! ENDDO
	623	! ENDDO
	624	! ENDDO
	625	! ENDDO
	626
	627
	628	! -------------------------------------------------------------------
	629	! *** Test : diag de la qtite totale de traceur dans
	630	! l'atmosphere avant l'advection en Y
	631
	632	DO l = 1,llm
	633	DO j = 1,jjp1
	634	DO i = 1,iim
	635	sqf = sqf + S0(i,j,l,ntra)
[524]	636	END DO
[5246]	637	END DO
	638	END DO
	639	PRINT*,'---------- DIAG DANS ADVY - SORTIE --------'
	640	PRINT*,'sqf=',sqf
	641	! print*,'ap ADVYP fin'
[524]	642
[5246]	643	!-----------------------------------------------------------------
	644	!
	645	RETURN
	646	END SUBROUTINE ADVYP
[524]	647
	648
	649
	650
	651
	652
	653
	654
	655
	656
	657
	658

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

Download in other formats:

Original Format