Context Navigation

advz.F @ 4775

Last change on this file since 4775 was 2641, checked in by Laurent Fairhead, 8 years ago
Merged trunk changes r2593:2640 into testing branch
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: 9.0 KB

Rev	Line
[524]	1	!
	2	! $Header$
	3	!
	4	SUBROUTINE advz(limit,dtz,w,sm,s0,sx,sy,sz)
	5	IMPLICIT NONE
	6
	7	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	8	C C
	9	C first-order moments (FOM) advection of tracer in Z direction C
	10	C C
	11	C Source : Pascal Simon (Meteo,CNRM) C
	12	C Adaptation : A.Armengaud (LGGE) juin 94 C
	13	C C
	14	C C
	15	C sont des arguments d'entree pour le s-pg... C
	16	C C
	17	C dq est l'argument de sortie pour le s-pg C
[2641]	18	C C
[524]	19	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	20	C
	21	C parametres principaux du modele
	22	C
[2641]	23	include "dimensions.h"
	24	include "paramet.h"
[524]	25
	26	C #include "traceur.h"
	27
	28	C Arguments :
	29	C -----------
	30	C dtz : frequence fictive d'appel du transport
	31	C w : flux de masse en z en Pa.m2.s-1
	32
	33	INTEGER ntra
	34	PARAMETER (ntra = 1)
	35
	36	REAL dtz
	37	REAL w ( iip1,jjp1,llm )
	38
	39	C moments: SM total mass in each grid box
	40	C S0 mass of tracer in each grid box
	41	C Si 1rst order moment in i direction
	42	C
	43	REAL SM(iip1,jjp1,llm)
	44	+ ,S0(iip1,jjp1,llm,ntra)
	45	REAL sx(iip1,jjp1,llm,ntra)
	46	+ ,sy(iip1,jjp1,llm,ntra)
	47	+ ,sz(iip1,jjp1,llm,ntra)
	48
	49
	50	C Local :
	51	C -------
	52
	53	C mass fluxes across the boundaries (UGRI,VGRI,WGRI)
	54	C mass fluxes in kg
	55	C declaration :
	56
	57	REAL WGRI(iip1,jjp1,0:llm)
	58
	59	C
	60	C the moments F are used as temporary storage for
	61	C portions of grid boxes in transit at the current latitude
	62	C
	63	REAL FM(iim,llm)
	64	REAL F0(iim,llm,ntra),FX(iim,llm,ntra)
	65	REAL FY(iim,llm,ntra),FZ(iim,llm,ntra)
	66	C
	67	C work arrays
	68	C
	69	REAL ALF(iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
	70	REAL TEMPTM ! Just temporal variable
	71	REAL sqi,sqf
	72	C
	73	LOGICAL LIMIT
	74	INTEGER lon,lat,niv
	75	INTEGER i,j,jv,k,l,lp
	76
	77	lon = iim
	78	lat = jjp1
	79	niv = llm
	80
	81	C * Test de passage d'arguments ****
	82
	83	c DO 399 l = 1, llm
	84	c DO 399 j = 1, jjp1
	85	c DO 399 i = 1, iip1
	86	c IF (S0(i,j,l,ntra) .lt. 0. ) THEN
	87	c PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
	88	c print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
	89	c print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
	90	c print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
	91	c PRINT*, 'AIE !! debut ADVZ - pbl arg. passage dans ADVZ'
	92	c STOP
	93	c ENDIF
	94	399 CONTINUE
	95
	96	C-----------------------------------------------------------------
	97	C *** Test : diag de la qqtite totale de traceur
	98	C dans l'atmosphere avant l'advection en z
	99	sqi = 0.
	100	sqf = 0.
	101
	102	DO l = 1,llm
	103	DO j = 1,jjp1
	104	DO i = 1,iim
[644]	105	cIM 240305 sqi = sqi + S0(i,j,l,9)
	106	sqi = sqi + S0(i,j,l,ntra)
[524]	107	ENDDO
	108	ENDDO
	109	ENDDO
	110	PRINT*,'-------- DIAG DANS ADVZ - ENTREE ---------'
	111	PRINT*,'sqi=',sqi
	112
	113	C-----------------------------------------------------------------
	114	C Interface : adaptation nouveau modele
	115	C -------------------------------------
	116	C
	117	C Conversion du flux de masse en kg.s-1
	118
	119	DO 500 l = 1,llm
	120	DO 500 j = 1,jjp1
	121	DO 500 i = 1,iip1
	122	c wgri (i,j,llm+1-l) = w (i,j,l) / g
	123	wgri (i,j,llm+1-l) = w (i,j,l)
	124	c wgri (i,j,0) = 0. ! a detruire ult.
	125	c wgri (i,j,l) = 0.1 ! w (i,j,l)
	126	c wgri (i,j,llm) = 0. ! a detruire ult.
	127	500 CONTINUE
	128	DO j = 1,jjp1
	129	DO i = 1,iip1
	130	wgri(i,j,0)=0.
	131	enddo
	132	enddo
	133
	134	C-----------------------------------------------------------------
	135
	136	C start here
	137	C boucle sur les latitudes
	138	C
	139	DO 1 K=1,LAT
	140	C
	141	C place limits on appropriate moments before transport
	142	C (if flux-limiting is to be applied)
	143	C
	144	IF(.NOT.LIMIT) GO TO 101
	145	C
	146	DO 10 JV=1,NTRA
	147	DO 10 L=1,NIV
	148	DO 100 I=1,LON
	149	sz(I,K,L,JV)=SIGN(AMIN1(AMAX1(S0(I,K,L,JV),0.),
	150	+ ABS(sz(I,K,L,JV))),sz(I,K,L,JV))
	151	100 CONTINUE
	152	10 CONTINUE
	153	C
	154	101 CONTINUE
	155	C
	156	C boucle sur les niveaux intercouches de 1 a NIV-1
	157	C (flux nul au sommet L=0 et a la base L=NIV)
	158	C
	159	C calculate flux and moments between adjacent boxes
	160	C (flux from LP to L if WGRI(L).lt.0, from L to LP if WGRI(L).gt.0)
	161	C 1- create temporary moments/masses for partial boxes in transit
	162	C 2- reajusts moments remaining in the box
	163	C
	164	DO 11 L=1,NIV-1
	165	LP=L+1
	166	C
	167	DO 110 I=1,LON
	168	C
	169	IF(WGRI(I,K,L).LT.0.) THEN
	170	FM(I,L)=-WGRI(I,K,L)*DTZ
	171	ALF(I)=FM(I,L)/SM(I,K,LP)
	172	SM(I,K,LP)=SM(I,K,LP)-FM(I,L)
	173	ELSE
	174	FM(I,L)=WGRI(I,K,L)*DTZ
	175	ALF(I)=FM(I,L)/SM(I,K,L)
	176	SM(I,K,L)=SM(I,K,L)-FM(I,L)
	177	ENDIF
	178	C
	179	ALFQ (I)=ALF(I)*ALF(I)
	180	ALF1 (I)=1.-ALF(I)
	181	ALF1Q(I)=ALF1(I)*ALF1(I)
	182	C
	183	110 CONTINUE
	184	C
	185	DO 111 JV=1,NTRA
	186	DO 1110 I=1,LON
	187	C
	188	IF(WGRI(I,K,L).LT.0.) THEN
	189	C
	190	F0(I,L,JV)=ALF (I)( S0(I,K,LP,JV)-ALF1(I)sz(I,K,LP,JV) )
	191	FZ(I,L,JV)=ALFQ(I)*sz(I,K,LP,JV)
	192	FX(I,L,JV)=ALF (I)*sx(I,K,LP,JV)
	193	FY(I,L,JV)=ALF (I)*sy(I,K,LP,JV)
	194	C
	195	S0(I,K,LP,JV)=S0(I,K,LP,JV)-F0(I,L,JV)
	196	sz(I,K,LP,JV)=ALF1Q(I)*sz(I,K,LP,JV)
	197	sx(I,K,LP,JV)=sx(I,K,LP,JV)-FX(I,L,JV)
	198	sy(I,K,LP,JV)=sy(I,K,LP,JV)-FY(I,L,JV)
	199	C
	200	ELSE
	201	C
	202	F0(I,L,JV)=ALF (I)(S0(I,K,L,JV)+ALF1(I)sz(I,K,L,JV) )
	203	FZ(I,L,JV)=ALFQ(I)*sz(I,K,L,JV)
	204	FX(I,L,JV)=ALF (I)*sx(I,K,L,JV)
	205	FY(I,L,JV)=ALF (I)*sy(I,K,L,JV)
	206	C
	207	S0(I,K,L,JV)=S0(I,K,L,JV)-F0(I,L,JV)
	208	sz(I,K,L,JV)=ALF1Q(I)*sz(I,K,L,JV)
	209	sx(I,K,L,JV)=sx(I,K,L,JV)-FX(I,L,JV)
	210	sy(I,K,L,JV)=sy(I,K,L,JV)-FY(I,L,JV)
	211	C
	212	ENDIF
	213	C
	214	1110 CONTINUE
	215	111 CONTINUE
	216	C
	217	11 CONTINUE
	218	C
	219	C puts the temporary moments Fi into appropriate neighboring boxes
	220	C
	221	DO 12 L=1,NIV-1
	222	LP=L+1
	223	C
	224	DO 120 I=1,LON
	225	C
	226	IF(WGRI(I,K,L).LT.0.) THEN
	227	SM(I,K,L)=SM(I,K,L)+FM(I,L)
	228	ALF(I)=FM(I,L)/SM(I,K,L)
	229	ELSE
	230	SM(I,K,LP)=SM(I,K,LP)+FM(I,L)
	231	ALF(I)=FM(I,L)/SM(I,K,LP)
	232	ENDIF
	233	C
	234	ALF1(I)=1.-ALF(I)
	235	ALFQ(I)=ALF(I)*ALF(I)
	236	ALF1Q(I)=ALF1(I)*ALF1(I)
	237	C
	238	120 CONTINUE
	239	C
	240	DO 121 JV=1,NTRA
	241	DO 1210 I=1,LON
	242	C
	243	IF(WGRI(I,K,L).LT.0.) THEN
	244	C
	245	TEMPTM=-ALF(I)S0(I,K,L,JV)+ALF1(I)F0(I,L,JV)
	246	S0(I,K,L,JV)=S0(I,K,L,JV)+F0(I,L,JV)
	247	sz(I,K,L,JV)=ALF(I)FZ(I,L,JV)+ALF1(I)sz(I,K,L,JV)+3.*TEMPTM
	248	sx(I,K,L,JV)=sx(I,K,L,JV)+FX(I,L,JV)
	249	sy(I,K,L,JV)=sy(I,K,L,JV)+FY(I,L,JV)
	250	C
	251	ELSE
	252	C
	253	TEMPTM=ALF(I)S0(I,K,LP,JV)-ALF1(I)F0(I,L,JV)
	254	S0(I,K,LP,JV)=S0(I,K,LP,JV)+F0(I,L,JV)
	255	sz(I,K,LP,JV)=ALF(I)FZ(I,L,JV)+ALF1(I)sz(I,K,LP,JV)
	256	+ +3.*TEMPTM
	257	sx(I,K,LP,JV)=sx(I,K,LP,JV)+FX(I,L,JV)
	258	sy(I,K,LP,JV)=sy(I,K,LP,JV)+FY(I,L,JV)
	259	C
	260	ENDIF
	261	C
	262	1210 CONTINUE
	263	121 CONTINUE
	264	C
	265	12 CONTINUE
	266	C
	267	C fin de la boucle principale sur les latitudes
	268	C
	269	1 CONTINUE
	270	C
	271	C-------------------------------------------------------------
	272	C
	273	C ----------- AA Test en fin de ADVX ------ Controle des S*
	274
	275	c DO 9999 l = 1, llm
	276	c DO 9999 j = 1, jjp1
	277	c DO 9999 i = 1, iip1
	278	c IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN
	279	c PRINT*, '-------------------'
	280	c PRINT*, 'En fin de ADVZ'
	281	c PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
	282	c print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
	283	c print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
	284	c print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
	285	c WRITE (,) 'On arrete !! - pbl en fin de ADVZ1'
	286	c STOP
	287	c ENDIF
	288	9999 CONTINUE
	289
	290	C *** ------------------- bouclage cyclique en X ------------
	291
	292	c DO l = 1,llm
	293	c DO j = 1,jjp1
	294	c SM(iip1,j,l) = SM(1,j,l)
	295	c S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
	296	C sx(iip1,j,l,ntra) = sx(1,j,l,ntra)
	297	c sy(iip1,j,l,ntra) = sy(1,j,l,ntra)
	298	c sz(iip1,j,l,ntra) = sz(1,j,l,ntra)
	299	c ENDDO
	300	c ENDDO
	301
	302	C-------------------------------------------------------------
	303	C *** Test : diag de la qqtite totale de traceur
	304	C dans l'atmosphere avant l'advection en z
	305	DO l = 1,llm
	306	DO j = 1,jjp1
	307	DO i = 1,iim
[644]	308	cIM 240305 sqf = sqf + S0(i,j,l,9)
	309	sqf = sqf + S0(i,j,l,ntra)
[524]	310	ENDDO
	311	ENDDO
	312	ENDDO
	313	PRINT*,'-------- DIAG DANS ADVZ - SORTIE ---------'
	314	PRINT*,'sqf=', sqf
	315
	316	C-------------------------------------------------------------
	317	RETURN
	318	END
	319	C_______________________________________________________________
	320	C_______________________________________________________________

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

Download in other formats:

Original Format