Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_sf_pxsfclay.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

Property svn:executable set to *

File size: 25.2 KB

Rev	Line
[1]	1	!WRF:MODEL_LAYER:PHYSICS
	2	!
	3	MODULE module_sf_pxsfclay
	4
	5	REAL , PARAMETER :: RICRIT = 0.25 !critical Richardson number
	6	REAL , PARAMETER :: BETAH = 5.0 ! 8.21
	7	REAL , PARAMETER :: BETAM = 5.0 ! 6.0
	8	REAL , PARAMETER :: BM = 13.0
	9	REAL , PARAMETER :: BH = 15.7
	10	REAL , PARAMETER :: GAMAM = 19.3
	11	REAL , PARAMETER :: GAMAH = 11.6
	12	REAL , PARAMETER :: PR0 = 0.95
	13	REAL , PARAMETER :: CZO = 0.032
	14	REAL , PARAMETER :: OZO = 1.E-4
	15	REAL , PARAMETER :: VCONVC = 1.0
	16
	17
	18	CONTAINS
	19
	20	!-------------------------------------------------------------------
	21	SUBROUTINE PXSFCLAY(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
	22	CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
	23	ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
	24	XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
	25	U10,V10, &
	26	GZ1OZ0,WSPD,BR,ISFFLX,DX, &
	27	SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
	28	ids,ide, jds,jde, kds,kde, &
	29	ims,ime, jms,jme, kms,kme, &
	30	its,ite, jts,jte, kts,kte )
	31	!-------------------------------------------------------------------
	32	IMPLICIT NONE
	33	!-------------------------------------------------------------------
	34	! THIS MODULE COMPUTES SFC RELATED PARAMETERS (U*, RA, REGIME, etc.)
	35	! USING A MODIFIED RICHARDSON NUMBER PARAMETERIZATIONS.
	36	!
	37	! THE PARAMETERIZATIONS OF THE PSI FUNCTIONS FOR UNSTABLE CONDITIONS
	38	! HAVE BEEN REPLACED WITH EMPIRICAL EXPRESSIONS WHICH RELATE RB DIRECTLY
	39	! TO PSIH AND PSIM. THESE EXPRESSIONS ARE FIT TO THE DYER (1974) FUNCTIONS
	40	! WITH HOGSTROM (1988) REVISED COEFFICIENTS. ALSO, THESE EXPERESSIONS
	41	! ASSUME A LAMINAR SUBLAYER RESISTANCE FOR HEAT (Rb = 5/U*) - JP 8/01
	42	!
	43	! Reference: Pleim (2006): JAMC, 45, 341-347
	44	!
	45	! REVISION HISTORY:
	46	! A. Xiu 2/2005 - developed WRF version based on the MM5 PX LSM
	47	! R. Gilliam 7/2006 - completed implementation into WRF model
	48	!***********************************************************************
	49	!-------------------------------------------------------------------
	50	!-- U3D 3D u-velocity interpolated to theta points (m/s)
	51	!-- V3D 3D v-velocity interpolated to theta points (m/s)
	52	!-- T3D temperature (K)
	53	!-- TH3D potential temperature (K)
	54	!-- QV3D 3D water vapor mixing ratio (Kg/Kg)
	55	!-- P3D 3D pressure (Pa)
	56	!-- dz8w dz between full levels (m)
	57	!-- CP heat capacity at constant pressure for dry air (J/kg/K)
	58	!-- G acceleration due to gravity (m/s^2)
	59	!-- ROVCP R/CP
	60	!-- R gas constant for dry air (j/kg/k)
	61	!-- XLV latent heat of vaporization (j/kg)
	62	!-- PSFC surface pressure (Pa)
	63	!-- CHS exchange coefficient for heat (m/s)
	64	!-- CHS2 exchange coefficient for heat at 2 m (m/s)
	65	!-- CQS2 exchange coefficient for moisture at 2 m (m/s)
	66	!-- CPM heat capacity at constant pressure for moist air (J/kg/K)
	67	!-- ZNT roughness length (m)
	68	!-- UST u* in similarity theory (m/s)
	69	!-- PBLH PBL height from previous time (m)
	70	!-- MAVAIL surface moisture availability (between 0 and 1)
	71	!-- ZOL z/L height over Monin-Obukhov length
	72	!-- MOL T* (similarity theory) (K)
	73	!-- REGIME flag indicating PBL regime (stable, unstable, etc.)
	74	!-- PSIM similarity stability function for momentum
	75	!-- PSIH similarity stability function for heat
	76	!-- XLAND land mask (1 for land, 2 for water)
	77	!-- HFX upward heat flux at the surface (W/m^2)
	78	!-- QFX upward moisture flux at the surface (kg/m^2/s)
	79	!-- LH net upward latent heat flux at surface (W/m^2)
	80	!-- TSK surface temperature (K)
	81	!-- FLHC exchange coefficient for heat (m/s)
	82	!-- FLQC exchange coefficient for moisture (m/s)
	83	!-- QGH lowest-level saturated mixing ratio
	84	!-- QSFC SPECIFIC HUMIDITY AT LOWER BOUNDARY
	85	!-- RMOL inverse Monin-Obukhov length (1/m)
	86	!-- U10 diagnostic 10m u wind
	87	!-- V10 diagnostic 10m v wind
	88	!-- GZ1OZ0 log(z/z0) where z0 is roughness length
	89	!-- WSPD wind speed at lowest model level (m/s)
	90	!-- BR bulk Richardson number in surface layer
	91	!-- ISFFLX isfflx=1 for surface heat and moisture fluxes
	92	!-- DX horizontal grid size (m)
	93	!-- SVP1 constant for saturation vapor pressure (kPa)
	94	!-- SVP2 constant for saturation vapor pressure (dimensionless)
	95	!-- SVP3 constant for saturation vapor pressure (K)
	96	!-- SVPT0 constant for saturation vapor pressure (K)
	97	!-- EP1 constant for virtual temperature (R_v/R_d - 1) (dimensionless)
	98	!-- EP2 constant for specific humidity calculation
	99	! (R_d/R_v) (dimensionless)
	100	!-- KARMAN Von Karman constant
	101	!-- ids start index for i in domain
	102	!-- ide end index for i in domain
	103	!-- jds start index for j in domain
	104	!-- jde end index for j in domain
	105	!-- kds start index for k in domain
	106	!-- kde end index for k in domain
	107	!-- ims start index for i in memory
	108	!-- ime end index for i in memory
	109	!-- jms start index for j in memory
	110	!-- jme end index for j in memory
	111	!-- kms start index for k in memory
	112	!-- kme end index for k in memory
	113	!-- its start index for i in tile
	114	!-- ite end index for i in tile
	115	!-- jts start index for j in tile
	116	!-- jte end index for j in tile
	117	!-- kts start index for k in tile
	118	!-- kte end index for k in tile
	119	!-------------------------------------------------------------------
	120	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
	121	ims,ime, jms,jme, kms,kme, &
	122	its,ite, jts,jte, kts,kte
	123	!
	124	INTEGER, INTENT(IN ) :: ISFFLX
	125	REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
	126	REAL, INTENT(IN ) :: EP1,EP2,KARMAN
	127	!
	128	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	129	INTENT(IN ) :: dz8w
	130
	131	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	132	INTENT(IN ) :: QV3D, &
	133	P3D, &
	134	T3D, &
	135	TH3D
	136
	137	REAL, DIMENSION( ims:ime, jms:jme ) , &
	138	INTENT(IN ) :: MAVAIL, &
	139	PBLH, &
	140	XLAND, &
	141	TSK
	142	REAL, DIMENSION( ims:ime, jms:jme ) , &
	143	INTENT(OUT ) :: U10, &
	144	V10, &
	145	QSFC
	146	!
	147	REAL, DIMENSION( ims:ime, jms:jme ) , &
	148	INTENT(INOUT) :: REGIME, &
	149	HFX, &
	150	QFX, &
	151	LH, &
	152	MOL,RMOL
	153	!m the following 5 are change to memory size
	154	!
	155	REAL, DIMENSION( ims:ime, jms:jme ) , &
	156	INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
	157	PSIM,PSIH
	158
	159	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	160	INTENT(IN ) :: U3D, &
	161	V3D
	162
	163	REAL, DIMENSION( ims:ime, jms:jme ) , &
	164	INTENT(IN ) :: PSFC
	165
	166	REAL, DIMENSION( ims:ime, jms:jme ) , &
	167	INTENT(INOUT) :: ZNT, &
	168	ZOL, &
	169	UST, &
	170	CPM, &
	171	CHS2, &
	172	CQS2, &
	173	CHS
	174
	175	REAL, DIMENSION( ims:ime, jms:jme ) , &
	176	INTENT(INOUT) :: FLHC,FLQC
	177
	178	REAL, DIMENSION( ims:ime, jms:jme ) , &
	179	INTENT(INOUT) :: &
	180	QGH
	181
	182
	183
	184	REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV,DX
	185
	186	! LOCAL VARS
	187
	188	REAL, DIMENSION( its:ite ) :: U1D, &
	189	V1D, &
	190	QV1D, &
	191	P1D, &
	192	T1D, &
	193	TH1D
	194
	195	REAL, DIMENSION( its:ite ) :: dz8w1d
	196
	197	INTEGER :: I,J
	198
	199	DO J=jts,jte
	200	DO i=its,ite
	201	dz8w1d(I) = dz8w(i,1,j)
	202	ENDDO
	203
	204	DO i=its,ite
	205	U1D(i) =U3D(i,1,j)
	206	V1D(i) =V3D(i,1,j)
	207	QV1D(i)=QV3D(i,1,j)
	208	P1D(i) =P3D(i,1,j)
	209	T1D(i) =T3D(i,1,j)
	210	TH1D(i) =TH3D(i,1,j)
	211	ENDDO
	212
	213
	214	! TST, WST, MOLENGTH, USTM need to be recaculated or passed in
	215
	216	CALL PXSFCLAY1D(J,U1D,V1D,T1D,TH1D,QV1D,P1D,dz8w1d, &
	217	CP,G,ROVCP,R,XLV,PSFC(ims,j),CHS(ims,j),CHS2(ims,j), &
	218	CQS2(ims,j),CPM(ims,j),PBLH(ims,j), RMOL(ims,j), &
	219	ZNT(ims,j),UST(ims,j),MAVAIL(ims,j),ZOL(ims,j), &
	220	MOL(ims,j),REGIME(ims,j),PSIM(ims,j),PSIH(ims,j), &
	221	XLAND(ims,j),HFX(ims,j),QFX(ims,j),TSK(ims,j), &
	222	U10(ims,j),V10(ims,j), &
	223	FLHC(ims,j),FLQC(ims,j),QGH(ims,j), &
	224	QSFC(ims,j),LH(ims,j), &
	225	GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),ISFFLX,DX, &
	226	SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
	227	ids,ide, jds,jde, kds,kde, &
	228	ims,ime, jms,jme, kms,kme, &
	229	its,ite, jts,jte, kts,kte )
	230	ENDDO
	231
	232
	233	END SUBROUTINE PXSFCLAY
	234	!====================================================================
	235	SUBROUTINE PXSFCLAY1D(J,US,VS,T1D,THETA1,QV1D,P1D,dz8w1d, &
	236	CP,G,ROVCP,R,XLV,PSFCPA,CHS,CHS2,CQS2,CPM,PBLH,RMOL, &
	237	ZNT,UST,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
	238	XLAND,HFX,QFX,TG, &
	239	U10,V10,FLHC,FLQC,QGH, &
	240	QSFC,LH,GZ1OZ0,WSPD,BR,ISFFLX,DX, &
	241	SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
	242	ids,ide, jds,jde, kds,kde, &
	243	ims,ime, jms,jme, kms,kme, &
	244	its,ite, jts,jte, kts,kte )
	245	!-------------------------------------------------------------------
	246	IMPLICIT NONE
	247	!-------------------------------------------------------------------
	248	REAL, PARAMETER :: XKA=2.4E-5
	249	REAL, PARAMETER :: PRT=1.
	250
	251	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
	252	ims,ime, jms,jme, kms,kme, &
	253	its,ite, jts,jte, kts,kte, &
	254	J
	255	!
	256	INTEGER, INTENT(IN ) :: ISFFLX
	257	REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
	258	REAL, INTENT(IN ) :: EP1,EP2,KARMAN
	259
	260	!
	261	REAL, DIMENSION( ims:ime ) , &
	262	INTENT(IN ) :: MAVAIL, &
	263	PBLH, &
	264	XLAND, &
	265	TG
	266	!
	267	REAL, DIMENSION( ims:ime ) , &
	268	INTENT(IN ) :: PSFCPA
	269
	270	REAL, DIMENSION( ims:ime ) , &
	271	INTENT(INOUT) :: REGIME, &
	272	HFX, &
	273	QFX, &
	274	MOL,RMOL
	275	!m the following 5 are changed to memory size---
	276	!
	277	REAL, DIMENSION( ims:ime ) , &
	278	INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
	279	PSIM,PSIH
	280
	281	REAL, DIMENSION( ims:ime ) , &
	282	INTENT(INOUT) :: ZNT, &
	283	ZOL, &
	284	UST, &
	285	CPM, &
	286	CHS2, &
	287	CQS2, &
	288	CHS
	289
	290	REAL, DIMENSION( ims:ime ) , &
	291	INTENT(INOUT) :: FLHC,FLQC
	292
	293	REAL, DIMENSION( ims:ime ) , &
	294	INTENT(INOUT) :: &
	295	QGH
	296
	297	REAL, DIMENSION( ims:ime ) , &
	298	INTENT(OUT) :: U10,V10, &
	299	QSFC,LH
	300
	301	REAL, INTENT(IN ) :: CP,G,ROVCP,XLV,DX,R
	302
	303	! MODULE-LOCAL VARIABLES, DEFINED IN SUBROUTINE SFCLAY
	304	REAL, DIMENSION( its:ite ), INTENT(IN ) :: dz8w1d
	305
	306	REAL, DIMENSION( its:ite ), INTENT(IN ) :: US, &
	307	VS, &
	308	QV1D, &
	309	P1D, &
	310	T1D, &
	311	THETA1
	312
	313	! LOCAL VARS
	314
	315	REAL, DIMENSION( its:ite ) :: ZA, &
	316	TH0, &
	317	THETAG, &
	318	WS, &
	319	RICUT, &
	320	USTM, &
	321	RA, &
	322	THETAV1, &
	323	MOLENGTH
	324	!
	325	REAL, DIMENSION( its:ite ) :: &
	326	RHOX,GOVRTH
	327	!
	328	REAL, DIMENSION( its:ite ) :: PSFC
	329	!
	330	INTEGER :: KL
	331
	332	INTEGER :: N,I,K,KK,L,NZOL,NK,NZOL2,NZOL10
	333
	334	REAL :: PL,THCON,TVCON,E1
	335	REAL :: ZL,TSKV,DTHVDZ,DTHVM,VCONV,RZOL,RZOL2,RZOL10,ZOL2,ZOL10
	336	REAL :: DTG,PSIX,DTTHX,PSIX10,PSIT,PSIT2,PSIQ,PSIQ2
	337	REAL :: FLUXC,VSGD
	338	REAL :: XMOL,ZOBOL,Z10OL,ZNTOL,YNT,YOB,X1,X2
	339	REAL :: G2OZ0,G10OZ0,RA2,ZOLL
	340	REAL :: TV0,CPOT,RICRITI,AM,AH,SQLNZZ0,RBH,RBW,TSTV
	341	REAL :: PSIH2, PSIM2, PSIH10, PSIM10, CQS
	342
	343	!-------------------------------Exicutable starts here--------------------
	344
	345	DO i = its,ite
	346	! PSFC cb
	347	PSFC(I)=PSFCPA(I)/1000.
	348	TVCON = 1.0 + EP1 * QV1D(I)
	349	THETAV1(I) = THETA1(I) * TVCON
	350	RHOX(I)=PSFCPA(I)/(RT1D(I)TVCON)
	351	ENDDO
	352
	353	!
	354	!-----Compute virtual potential temperature at surface
	355	!
	356	DO I=its,ite
	357	E1=SVP1EXP( SVP2(TG(I)-SVPT0)/(TG(I)-SVP3) )
	358	QSFC(I)=EP2*E1/(PSFC(I)-E1)
	359
	360	! QGH CHANGED TO USE LOWEST-LEVEL AIR TEMP CONSISTENT WITH MYJSFC CHANGE
	361	! Q2SAT = QGH IN LSM
	362	E1=SVP1EXP(SVP2(T1D(I)-SVPT0)/(T1D(I)-SVP3))
	363	PL = P1D(I)/1000.
	364	QGH(I)=EP2*E1/(PL-E1)
	365	CPM(I)=CP(1.+0.8QV1D(I))
	366	enddo
	367
	368	!.......... compute the thetav at ground
	369	DO I = its, ite
	370	TV0 = TG(I) * (1.0 + EP1 * QSFC(I)*MAVAIL(I))
	371	CPOT = (100./PSFC(I))**ROVCP
	372	TH0(I) = TV0 * (100./PSFC(I))**ROVCP
	373	THETAG(I) = CPOT * TG(I)
	374	ENDDO
	375	!
	376	!-----COMPUTE THE HEIGHT OF FULL- AND HALF-SIGMA LEVELS ABOVE GROUND
	377	! LEVEL, AND THE LAYER THICKNESSES.
	378	!
	379	!... DZ8W1D is DZ between full sigma levels and Z0 is the height of the first
	380	! half sigma level
	381	DO I = its,ite
	382	ZA(I) = 0.5 * DZ8W1D(I)
	383	WS(I) = SQRT(US(I) * US(I) + VS(I) * VS(I))
	384	ENDDO
	385	!
	386	!-----CALCULATE BULK RICHARDSON NO. OF SURFACE LAYER, ACCORDING TO
	387	! AKB(1976), EQ(12).
	388
	389	RICRITI = 1.0 / RICRIT
	390
	391	DO i = its,ite
	392	GZ1OZ0(I) = ALOG(ZA(I) / ZNT(I))
	393	DTHVDZ = THETAV1(I) - TH0(I)
	394	fluxc = max(hfx(i)/rhox(i)/cp &
	395	+ ep1TH0(I)qfx(i)/rhox(i),0.)
	396	VCONV = vconvc(g/tg(i)pblh(i)fluxc)*.33
	397	VSGD = 0.32 * (max(dx/5000.-1.,0.))**.33
	398	WSPD(I)=SQRT(WS(I)WS(I)+VCONVVCONV+vsgd*vsgd)
	399	WSPD(I) = AMAX1(WSPD(I),0.1)
	400	GOVRTH(I) = G / THETA1(I)
	401	BR(I) = GOVRTH(I) * ZA(I) * DTHVDZ / (WSPD(I) * WSPD(I))
	402	RICUT(I) = 1.0 / (RICRITI + GZ1OZ0(I))
	403	ENDDO
	404
	405	DO I = its,ite
	406	!------------------------------------------------------------------
	407	!-- NOTE THAT THE REGIMES USED IN HIRPBL HAVE BEEN CHANGED:
	408	ZOLL = 0.0
	409	IF (BR(I) .GE. RICUT(I)) THEN
	410	!
	411	!-----CLASS 1; VERY STABLE CONDITIONS: Z/L > 1
	412	!
	413	REGIME(I) = 1.0
	414	ZOLL = BR(I) * GZ1OZ0(I) / (1.0 - RICRITI * RICUT(I))
	415	PSIM(I) = 1.0 - BETAM - ZOLL
	416	PSIH(I) = 1.0 - BETAH - ZOLL
	417
	418	ELSE IF (BR(I) .GE. 0.0) THEN
	419
	420	!-----CLASS 2; STABLE: for 1 > Z/L >0
	421	!
	422	REGIME(I) = 2.0
	423	ZOLL = BR(I) * GZ1OZ0(I) / (1.0 - RICRITI * BR(I))
	424	PSIM(I) = -BETAM * ZOLL
	425	PSIH(I) = -BETAH * ZOLL
	426
	427	ELSE
	428	!
	429	!-----CLASS 3 or 4; UNSTABLE:
	430	! CLASS 4 IS FOR ACM NON-LOCAL CONVECTION (H/L < -3)
	431	!
	432	REGIME(I) = 3.0 ! Regime will be reset to 4 if ACM is used
	433	AM = 0.031 + 0.276 * ALOG(GZ1OZ0(I))
	434	AH = 0.04 + 0.355 * ALOG(GZ1OZ0(I))
	435	SQLNZZ0 = SQRT(GZ1OZ0(I))
	436	PSIM(I) = AM * ALOG(1.0 - BM * SQLNZZ0 * BR(I))
	437	PSIH(I) = AH * ALOG(1.0 - BH * SQLNZZ0 * BR(I))
	438	!
	439	ENDIF
	440	ENDDO
	441	!
	442	!-----COMPUTE THE FRICTIONAL VELOCITY AND SURFACE FLUXES:
	443	!
	444	DO I = its,ite
	445	DTG = THETA1(I) - THETAG(I)
	446	PSIX = GZ1OZ0(I) - PSIM(I)
	447	UST(I)=0.5UST(I)+0.5KARMAN*WSPD(I)/PSIX
	448	USTM(I) = UST(I)
	449
	450	!-----OVER WATER, ALTER ROUGHNESS LENGTH (Z0) ACCORDING TO WIND (UST).
	451	!
	452	IF ((XLAND(I)-1.5) .GE. 0.0) THEN
	453	ZNT(I) = CZO * USTM(I) * USTM(I) / G + OZO
	454	GZ1OZ0(I) = ALOG(ZA(I) / ZNT(I))
	455	PSIX = GZ1OZ0(I) - PSIM(I)
	456	UST(I) = KARMAN * WSPD(I) / PSIX
	457	USTM(I) = UST(I)
	458	ENDIF
	459
	460	RA(I) = PR0 * (GZ1OZ0(I) - PSIH(I)) / (KARMAN * UST(I))
	461	RBH = 5.0 / UST(I) ! 5/U* ! WESELY AND HICKS (1977)
	462	!... RB FOR WATER VAPOR = 5*(0.599/0.709)^2/3 /UST = 4.47/UST hi
	463	RBW = 4.47/UST(I)
	464	CHS(I) = 1./(RA(I) + RBH)
	465	CQS = 1./(RA(I) + RBW)
	466	MOL(I) = DTG * CHS(I) / UST(I) ! This is really TST
	467	TSTV = (THETAV1(I) - TH0(I)) * CHS(I) / UST(I)
	468	IF (ABS(TSTV) .LT. 1.E-5) TSTV = 1.E-5
	469	MOLENGTH(I) = THETAV1(I) * UST(I) * UST(I) / (KARMAN * &
	470	G * TSTV)
	471	!
	472	!---Compute 2m surface exchange coefficients for heat and moisture
	473	XMOL = MOLENGTH(I)
	474	IF(MOLENGTH(I).GT.0.0) XMOL = AMAX1(MOLENGTH(I),2.0)
	475	RMOL(I) = 1/XMOL
	476	ZOL(I) = ZA(I)*RMOL(I)
	477	ZOBOL = 1.5*RMOL(I)
	478	Z10OL = 10.0*RMOL(I)
	479	ZNTOL = ZNT(I)*RMOL(I)
	480	IF(XMOL.LT.0.0) THEN
	481	YNT = ( 1.0 - GAMAH * ZNTOL )**0.5
	482	YOB = ( 1.0 - GAMAH * ZOBOL )**0.5
	483	PSIH2 = 2. * ALOG((YOB+1.0)/(YNT+1.0))
	484	x1 = (1.0 - gamam * z10ol)**0.25
	485	x2 = (1.0 - gamam * zntol)**0.25
	486	psim10 = 2.0 * ALOG( (1.0+x1) / (1.0+x2) ) + &
	487	ALOG( (1.0+x1x1) / (1.0+x2x2)) - &
	488	2.0 * ATAN(x1) + 2.0 * ATAN(x2)
	489	ELSE
	490	IF((ZOBOL-ZNTOL).LE.1.0) THEN
	491	PSIH2 = -BETAH*(ZOBOL-ZNTOL)
	492	ELSE
	493	PSIH2 = 1.-BETAH-(ZOBOL-ZNTOL)
	494	ENDIF
	495	IF((Z10OL-ZNTOL).LE.1.0) THEN
	496	PSIM10 = -BETAM*(Z10OL-ZNTOL)
	497	ELSE
	498	PSIM10 = 1.-BETAM-(Z10OL-ZNTOL)
	499	ENDIF
	500	ENDIF
	501	G2OZ0 = ALOG(1.5 / ZNT(I))
	502	G10OZ0 = ALOG(10.0 / ZNT(I))
	503	RA2 = PR0 * (G2OZ0 - PSIH2) / (KARMAN * UST(I))
	504	CHS2(I) = 1.0/(RA2 + RBH)
	505	CQS2(I) = 1.0/(RA2 + RBW)
	506	U10(I) = US(I)*(G10OZ0-PSIM10)/PSIX
	507	V10(I) = VS(I)*(G10OZ0-PSIM10)/PSIX
	508	!IF(I.EQ.60.AND.J.EQ.60) PRINT *,' ZNT,USTM,U10,UZ1=',ZNT(I),USTM(I),U10(I),US(I)
	509	!
	510	!-----COMPUTE SURFACE HEAT AND MOIST FLUX:
	511	!
	512	FLHC(i)=CPM(I)RHOX(I)CHS(I)
	513	FLQC(i)=RHOX(I)CQSMAVAIL(I)
	514	QFX(I)=FLQC(I)*(QSFC(I)-QV1D(I))
	515	QFX(I)=AMAX1(QFX(I),0.)
	516	LH(I)=XLV*QFX(I)
	517	IF(XLAND(I)-1.5.GT.0.)THEN
	518	HFX(I)=-FLHC(I)*DTG
	519	ELSEIF(XLAND(I)-1.5.LT.0.)THEN
	520	HFX(I)=-FLHC(I)*DTG
	521	HFX(I)=AMAX1(HFX(I),-250.)
	522	ENDIF
	523	ENDDO
	524	END SUBROUTINE PXSFCLAY1D
	525
	526	!====================================================================
	527	SUBROUTINE pxsfclayinit( allowed_to_read )
	528
	529	LOGICAL , INTENT(IN) :: allowed_to_read
	530	INTEGER :: N
	531	REAL :: ZOLN,X,Y
	532
	533
	534	END SUBROUTINE pxsfclayinit
	535
	536	!-------------------------------------------------------------------
	537
	538	END MODULE module_sf_pxsfclay

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

Download in other formats:

Original Format