Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_sf_noahdrv.F @ 3094

Last change on this file since 3094 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 59.1 KB

Rev	Line
[2759]	1	MODULE module_sf_noahdrv
	2
	3	!-------------------------------
	4	USE module_sf_noahlsm
	5	USE module_sf_urban
	6	#ifdef WRF_CHEM
	7	USE module_data_gocart_dust
	8	#endif
	9	!-------------------------------
	10
	11	!
	12	CONTAINS
	13	!
	14	!----------------------------------------------------------------
	15	! Urban related variable are added to arguments - urban
	16	!----------------------------------------------------------------
	17	SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK, &
	18	HFX,QFX,LH,GRDFLX, QGH,GSW,SWDOWN,GLW,SMSTAV,SMSTOT, &
	19	SFCRUNOFF, UDRUNOFF,IVGTYP,ISLTYP,VEGFRA, &
	20	ALBEDO,ALBBCK,ZNT,Z0,TMN,XLAND,XICE,EMISS,EMBCK, &
	21	SNOWC,QSFC,RAINBL, &
	22	num_soil_layers,DT,DZS,ITIMESTEP, &
	23	SMOIS,TSLB,SNOW,CANWAT, &
	24	CHS,CHS2,CQS2,CPM,ROVCP,SR,chklowq,qz0, & !H
	25	myj,frpcpn, &
	26	SH2O,SNOWH, & !H
	27	U_PHY,V_PHY, & !I
	28	SNOALB,SHDMIN,SHDMAX, & !I
	29	ACSNOM,ACSNOW, & !O
	30	SNOPCX, & !O
	31	! MEK JUL2007
	32	POTEVP, & !O
	33	ids,ide, jds,jde, kds,kde, &
	34	ims,ime, jms,jme, kms,kme, &
	35	its,ite, jts,jte, kts,kte, &
	36	ucmcall, &
	37	!Optional Urban
	38	TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !H urban
	39	UC_URB2D, & !H urban
	40	XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !H urban
	41	TRL_URB3D,TBL_URB3D,TGL_URB3D, & !H urban
	42	SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D,TS_URB2D, & !H urban
	43	PSIM_URB2D,PSIH_URB2D,U10_URB2D,V10_URB2D, & !O urban
	44	GZ1OZ0_URB2D, AKMS_URB2D, & !O urban
	45	TH2_URB2D,Q2_URB2D, UST_URB2D, & !O urban
	46	DECLIN_URB,COSZ_URB2D,OMG_URB2D, & !I urban
	47	XLAT_URB2D, & !I urban
	48	num_roof_layers, num_wall_layers, & !I urban
	49	num_road_layers, DZR, DZB, DZG, & !I urban
	50	FRC_URB2D,UTYPE_URB2D) !O
	51	!----------------------------------------------------------------
	52	IMPLICIT NONE
	53	!----------------------------------------------------------------
	54	!----------------------------------------------------------------
	55	! --- atmospheric (WRF generic) variables
	56	!-- DT time step (seconds)
	57	!-- DZ8W thickness of layers (m)
	58	!-- T3D temperature (K)
	59	!-- QV3D 3D water vapor mixing ratio (Kg/Kg)
	60	!-- P3D 3D pressure (Pa)
	61	!-- FLHC exchange coefficient for heat (m/s)
	62	!-- FLQC exchange coefficient for moisture (m/s)
	63	!-- PSFC surface pressure (Pa)
	64	!-- XLAND land mask (1 for land, 2 for water)
	65	!-- QGH saturated mixing ratio at 2 meter
	66	!-- GSW downward short wave flux at ground surface (W/m^2)
	67	!-- GLW downward long wave flux at ground surface (W/m^2)
	68	!-- History variables
	69	!-- CANWAT canopy moisture content (mm)
	70	!-- TSK surface temperature (K)
	71	!-- TSLB soil temp (k)
	72	!-- SMOIS total soil moisture content (volumetric fraction)
	73	!-- SH2O unfrozen soil moisture content (volumetric fraction)
	74	! note: frozen soil moisture (i.e., soil ice) = SMOIS - SH2O
	75	!-- SNOWH actual snow depth (m)
	76	!-- SNOW liquid water-equivalent snow depth (m)
	77	!-- ALBEDO time-varying surface albedo including snow effect (unitless fraction)
	78	!-- ALBBCK background surface albedo (unitless fraction)
	79	!-- CHS surface exchange coefficient for heat and moisture (m s-1);
	80	!-- CHS2 2m surface exchange coefficient for heat (m s-1);
	81	!-- CQS2 2m surface exchange coefficient for moisture (m s-1);
	82	! --- soil variables
	83	!-- num_soil_layers the number of soil layers
	84	!-- ZS depths of centers of soil layers (m)
	85	!-- DZS thicknesses of soil layers (m)
	86	!-- SLDPTH thickness of each soil layer (m, same as DZS)
	87	!-- TMN soil temperature at lower boundary (K)
	88	!-- SMCWLT wilting point (volumetric)
	89	!-- SMCDRY dry soil moisture threshold where direct evap from
	90	! top soil layer ends (volumetric)
	91	!-- SMCREF soil moisture threshold below which transpiration begins to
	92	! stress (volumetric)
	93	!-- SMCMAX porosity, i.e. saturated value of soil moisture (volumetric)
	94	!-- NROOT number of root layers, a function of veg type, determined
	95	! in subroutine redprm.
	96	!-- SMSTAV Soil moisture availability for evapotranspiration (
	97	! fraction between SMCWLT and SMCMXA)
	98	!-- SMSTOT Total soil moisture content frozen+unfrozen) in the soil column (mm)
	99	! --- snow variables
	100	!-- SNOWC fraction snow coverage (0-1.0)
	101	! --- vegetation variables
	102	!-- SNOALB upper bound on maximum albedo over deep snow
	103	!-- SHDMIN minimum areal fractional coverage of annual green vegetation
	104	!-- SHDMAX maximum areal fractional coverage of annual green vegetation
	105	!-- XLAI leaf area index (dimensionless)
	106	!-- Z0BRD Background fixed roughness length (M)
	107	!-- Z0 Background vroughness length (M) as function
	108	!-- ZNT Time varying roughness length (M) as function
	109	!-- ALBD(IVGTPK,ISN) background albedo reading from a table
	110	! --- LSM output
	111	!-- HFX upward heat flux at the surface (W/m^2)
	112	!-- QFX upward moisture flux at the surface (kg/m^2/s)
	113	!-- LH upward moisture flux at the surface (W m-2)
	114	!-- GRDFLX(I,J) ground heat flux (W m-2)
	115	!-- FDOWN radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN
	116	!----------------------------------------------------------------------------
	117	!-- EC canopy water evaporation ((W m-2)
	118	!-- EDIR direct soil evaporation (W m-2)
	119	!-- ET plant transpiration from a particular root layer (W m-2)
	120	!-- ETT total plant transpiration (W m-2)
	121	!-- ESNOW sublimation from (or deposition to if <0) snowpack (W m-2)
	122	!-- DRIP through-fall of precip and/or dew in excess of canopy
	123	! water-holding capacity (m)
	124	!-- DEW dewfall (or frostfall for t<273.15) (M)
	125	! ----------------------------------------------------------------------
	126	!-- BETA ratio of actual/potential evap (dimensionless)
	127	!-- ETP potential evaporation (W m-2)
	128	! ----------------------------------------------------------------------
	129	!-- FLX1 precip-snow sfc (W m-2)
	130	!-- FLX2 freezing rain latent heat flux (W m-2)
	131	!-- FLX3 phase-change heat flux from snowmelt (W m-2)
	132	! ----------------------------------------------------------------------
	133	!-- ACSNOM snow melt (mm) (water equivalent)
	134	!-- ACSNOW accumulated snow fall (mm) (water equivalent)
	135	!-- SNOPCX snow phase change heat flux (W/m^2)
	136	!-- POTEVP accumulated potential evaporation (W/m^2)
	137	! ----------------------------------------------------------------------
	138	!-- RUNOFF1 surface runoff (m s-1), not infiltrating the surface
	139	!-- RUNOFF2 subsurface runoff (m s-1), drainage out bottom of last
	140	! soil layer (baseflow)
	141	! important note: here RUNOFF2 is actually the sum of RUNOFF2 and RUNOFF3
	142	!-- RUNOFF3 numerical trunctation in excess of porosity (smcmax)
	143	! for a given soil layer at the end of a time step (m s-1).
	144	! ----------------------------------------------------------------------
	145	!-- RC canopy resistance (s m-1)
	146	!-- PC plant coefficient (unitless fraction, 0-1) where PC*ETP = actual transp
	147	!-- RSMIN minimum canopy resistance (s m-1)
	148	!-- RCS incoming solar rc factor (dimensionless)
	149	!-- RCT air temperature rc factor (dimensionless)
	150	!-- RCQ atmos vapor pressure deficit rc factor (dimensionless)
	151	!-- RCSOIL soil moisture rc factor (dimensionless)
	152
	153	!-- EMISS surface emissivity (between 0 and 1)
	154	!-- EMBCK Background surface emissivity (between 0 and 1)
	155
	156	!-- ROVCP R/CP
	157	! (R_d/R_v) (dimensionless)
	158	!-- ids start index for i in domain
	159	!-- ide end index for i in domain
	160	!-- jds start index for j in domain
	161	!-- jde end index for j in domain
	162	!-- kds start index for k in domain
	163	!-- kde end index for k in domain
	164	!-- ims start index for i in memory
	165	!-- ime end index for i in memory
	166	!-- jms start index for j in memory
	167	!-- jme end index for j in memory
	168	!-- kms start index for k in memory
	169	!-- kme end index for k in memory
	170	!-- its start index for i in tile
	171	!-- ite end index for i in tile
	172	!-- jts start index for j in tile
	173	!-- jte end index for j in tile
	174	!-- kts start index for k in tile
	175	!-- kte end index for k in tile
	176	!
	177	!-- SR fraction of frozen precip (0.0 to 1.0)
	178	!----------------------------------------------------------------
	179
	180	! IN only
	181
	182	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
	183	ims,ime, jms,jme, kms,kme, &
	184	its,ite, jts,jte, kts,kte
	185
	186	INTEGER, INTENT(IN ) :: ucmcall !urban
	187
	188	REAL, DIMENSION( ims:ime, jms:jme ) , &
	189	INTENT(IN ) :: TMN, &
	190	XLAND, &
	191	XICE, &
	192	VEGFRA, &
	193	SHDMIN, &
	194	SHDMAX, &
	195	SNOALB, &
	196	GSW, &
	197	SWDOWN, & !added 10 jan 2007
	198	GLW, &
	199	Z0, &
	200	ALBBCK, &
	201	RAINBL, &
	202	EMBCK, &
	203	SR
	204
	205
	206	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	207	INTENT(IN ) :: QV3D, &
	208	p8w3D, &
	209	DZ8W, &
	210	T3D
	211	REAL, DIMENSION( ims:ime, jms:jme ) , &
	212	INTENT(IN ) :: QGH, &
	213	CHS, &
	214	CPM
	215
	216	INTEGER, DIMENSION( ims:ime, jms:jme ) , &
	217	INTENT(IN ) :: IVGTYP, &
	218	ISLTYP
	219
	220	INTEGER, INTENT(IN) :: num_soil_layers,ITIMESTEP
	221
	222	REAL, INTENT(IN ) :: DT,ROVCP
	223
	224	REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::DZS
	225
	226	! IN and OUT
	227
	228	REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
	229	INTENT(INOUT) :: SMOIS, & ! total soil moisture
	230	SH2O, & ! new soil liquid
	231	TSLB ! TSLB STEMP
	232
	233	REAL, DIMENSION( ims:ime, jms:jme ) , &
	234	INTENT(INOUT) :: TSK, & !was TGB (temperature)
	235	HFX, &
	236	QFX, &
	237	LH, &
	238	GRDFLX, &
	239	QSFC,&
	240	CQS2,&
	241	CHS2,&
	242	SNOW, &
	243	SNOWC, &
	244	SNOWH, & !new
	245	CANWAT, &
	246	SMSTAV, &
	247	SMSTOT, &
	248	SFCRUNOFF, &
	249	UDRUNOFF, &
	250	ACSNOM, &
	251	ACSNOW, &
	252	SNOPCX, &
	253	EMISS, &
	254	POTEVP, &
	255	ALBEDO, &
	256	ZNT
	257
	258	REAL, DIMENSION( ims:ime, jms:jme ) , &
	259	INTENT(OUT) :: CHKLOWQ
	260	REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: QZ0
	261
	262	! Local variables (moved here from driver to make routine thread safe, 20031007 jm)
	263
	264	REAL, DIMENSION(1:num_soil_layers) :: ET
	265
	266	REAL :: BETA, ETP, SSOIL,EC, EDIR, ESNOW, ETT, &
	267	FLX1,FLX2,FLX3, DRIP,DEW,FDOWN,RC,PC,RSMIN,XLAI, &
	268	! RCS,RCT,RCQ,RCSOIL
	269	RCS,RCT,RCQ,RCSOIL,FFROZP
	270
	271	LOGICAL, INTENT(IN ) :: myj,frpcpn
	272
	273	! DECLARATIONS - LOGICAL
	274	! ----------------------------------------------------------------------
	275	LOGICAL, PARAMETER :: LOCAL=.false.
	276	LOGICAL :: FRZGRA, SNOWNG
	277
	278	LOGICAL :: IPRINT
	279
	280	! ----------------------------------------------------------------------
	281	! DECLARATIONS - INTEGER
	282	! ----------------------------------------------------------------------
	283	INTEGER :: I,J, ICE,NSOIL,SLOPETYP,SOILTYP,VEGTYP
	284	INTEGER :: NROOT
	285	INTEGER :: KZ ,K
	286	INTEGER :: NS
	287	! ----------------------------------------------------------------------
	288	! DECLARATIONS - REAL
	289	! ----------------------------------------------------------------------
	290
	291	REAL :: SHMIN,SHMAX,DQSDT2,LWDN,PRCP,PRCPRAIN, &
	292	Q2SAT,Q2SATI,SFCPRS,SFCSPD,SFCTMP,SHDFAC,SNOALB1, &
	293	SOLDN,TBOT,ZLVL, Q2K,ALBBRD, ALBEDOK, ETA, ETA_KINEMATIC, &
	294	EMBRD, &
	295	Z0K,RUNOFF1,RUNOFF2,RUNOFF3,SHEAT,SOLNET,E2SAT,SFCTSNO, &
	296	! mek, WRF testing, expanded diagnostics
	297	SOLUP,LWUP,RNET,RES,Q1SFC,TAIRV,RHO,SATFLG
	298	! MEK MAY 2007
	299	REAL :: FDTLIW
	300	! MEK JUL2007 for pot. evap.
	301	REAL :: FDTW
	302
	303	REAL :: EMISSI
	304
	305	REAL :: SNCOVR,SNEQV,SNOWHK,CMC, CHK,TH2
	306
	307	REAL :: SMCDRY,SMCMAX,SMCREF,SMCWLT,SNOMLT,SOILM,SOILW,Q1,T1
	308
	309	REAL :: DUMMY,Z0BRD
	310	!
	311	REAL :: COSZ, SOLARDIRECT
	312	!
	313	REAL, DIMENSION(1:num_soil_layers):: SLDPTH, STC,SMC,SWC
	314	!
	315	REAL, DIMENSION(1:num_soil_layers) :: ZSOIL, RTDIS
	316	REAL, PARAMETER :: TRESH=.95E0, A2=17.67,A3=273.15,A4=29.65, &
	317	T0=273.16E0, ELWV=2.50E6, A23M4=A2*(A3-A4)
	318	! MEK MAY 2007
	319	REAL, PARAMETER :: ROW=1.E3,ELIW=XLF,ROWLIW=ROW*ELIW
	320
	321	! ----------------------------------------------------------------------
	322	! DECLARATIONS START - urban
	323	! ----------------------------------------------------------------------
	324
	325	! input variables surface_driver --> lsm
	326	INTEGER, INTENT(IN) :: num_roof_layers
	327	INTEGER, INTENT(IN) :: num_wall_layers
	328	INTEGER, INTENT(IN) :: num_road_layers
	329	REAL, OPTIONAL, DIMENSION(1:num_roof_layers), INTENT(IN) :: DZR
	330	REAL, OPTIONAL, DIMENSION(1:num_wall_layers), INTENT(IN) :: DZB
	331	REAL, OPTIONAL, DIMENSION(1:num_road_layers), INTENT(IN) :: DZG
	332	REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB
	333	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D
	334	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D
	335	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D
	336	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: U_PHY
	337	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: V_PHY
	338
	339	! input variables lsm --> urban
	340	INTEGER :: UTYPE_URB ! urban type [urban=1, suburban=2, rural=3]
	341	REAL :: TA_URB ! potential temp at 1st atmospheric level [K]
	342	REAL :: QA_URB ! mixing ratio at 1st atmospheric level [kg/kg]
	343	REAL :: UA_URB ! wind speed at 1st atmospheric level [m/s]
	344	REAL :: U1_URB ! u at 1st atmospheric level [m/s]
	345	REAL :: V1_URB ! v at 1st atmospheric level [m/s]
	346	REAL :: SSG_URB ! downward total short wave radiation [W/m/m]
	347	REAL :: LLG_URB ! downward long wave radiation [W/m/m]
	348	REAL :: RAIN_URB ! precipitation [mm/h]
	349	REAL :: RHOO_URB ! air density [kg/m^3]
	350	REAL :: ZA_URB ! first atmospheric level [m]
	351	REAL :: DELT_URB ! time step [s]
	352	REAL :: SSGD_URB ! downward direct short wave radiation [W/m/m]
	353	REAL :: SSGQ_URB ! downward diffuse short wave radiation [W/m/m]
	354	REAL :: XLAT_URB ! latitude [deg]
	355	REAL :: COSZ_URB ! cosz
	356	REAL :: OMG_URB ! hour angle
	357	REAL :: ZNT_URB ! roughness length [m]
	358	REAL :: TR_URB
	359	REAL :: TB_URB
	360	REAL :: TG_URB
	361	REAL :: TC_URB
	362	REAL :: QC_URB
	363	REAL :: UC_URB
	364	REAL :: XXXR_URB
	365	REAL :: XXXB_URB
	366	REAL :: XXXG_URB
	367	REAL :: XXXC_URB
	368	REAL, DIMENSION(1:num_roof_layers) :: TRL_URB ! roof layer temp [K]
	369	REAL, DIMENSION(1:num_wall_layers) :: TBL_URB ! wall layer temp [K]
	370	REAL, DIMENSION(1:num_road_layers) :: TGL_URB ! road layer temp [K]
	371	LOGICAL :: LSOLAR_URB
	372	! state variable surface_driver <--> lsm <--> urban
	373	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D
	374	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D
	375	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D
	376	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D
	377	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D
	378	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UC_URB2D
	379	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D
	380	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D
	381	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D
	382	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D
	383	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D
	384	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D
	385	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D
	386	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D
	387	!
	388	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D
	389
	390	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D
	391	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D
	392	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D
	393
	394	! output variable lsm --> surface_driver
	395	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIM_URB2D
	396	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIH_URB2D
	397	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: GZ1OZ0_URB2D
	398	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: U10_URB2D
	399	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: V10_URB2D
	400	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: TH2_URB2D
	401	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: Q2_URB2D
	402	!
	403	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: AKMS_URB2D
	404	!
	405	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: UST_URB2D
	406	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FRC_URB2D
	407	INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: UTYPE_URB2D
	408
	409
	410	! output variables urban --> lsm
	411	REAL :: TS_URB ! surface radiative temperature [K]
	412	REAL :: QS_URB ! surface humidity [-]
	413	REAL :: SH_URB ! sensible heat flux [W/m/m]
	414	REAL :: LH_URB ! latent heat flux [W/m/m]
	415	REAL :: LH_KINEMATIC_URB ! latent heat flux, kinetic [kg/m/m/s]
	416	REAL :: SW_URB ! upward short wave radiation flux [W/m/m]
	417	REAL :: ALB_URB ! time-varying albedo [fraction]
	418	REAL :: LW_URB ! upward long wave radiation flux [W/m/m]
	419	REAL :: G_URB ! heat flux into the ground [W/m/m]
	420	REAL :: RN_URB ! net radiation [W/m/m]
	421	REAL :: PSIM_URB ! shear f for momentum [-]
	422	REAL :: PSIH_URB ! shear f for heat [-]
	423	REAL :: GZ1OZ0_URB ! shear f for heat [-]
	424	REAL :: U10_URB ! wind u component at 10 m [m/s]
	425	REAL :: V10_URB ! wind v component at 10 m [m/s]
	426	REAL :: TH2_URB ! potential temperature at 2 m [K]
	427	REAL :: Q2_URB ! humidity at 2 m [-]
	428	REAL :: CHS_URB
	429	REAL :: CHS2_URB
	430	REAL :: UST_URB
	431
	432	! ----------------------------------------------------------------------
	433	! DECLARATIONS END - urban
	434	! ----------------------------------------------------------------------
	435
	436	REAL, PARAMETER :: CAPA=R_D/CP
	437	REAL :: APELM,APES,SFCTH2,PSFC
	438
	439	! PRINT *,'THIS IS UNIFIED NOAH LSM'
	440
	441	! MEK MAY 2007
	442	FDTLIW=DT/ROWLIW
	443	! MEK JUL2007
	444	FDTW=DT/(XLV*RHOWATER)
	445	! debug printout
	446	IPRINT=.false.
	447
	448	! SLOPETYP=2
	449	SLOPETYP=1
	450	! SHDMIN=0.00
	451
	452
	453	NSOIL=num_soil_layers
	454
	455	DO NS=1,NSOIL
	456	SLDPTH(NS)=DZS(NS)
	457	ENDDO
	458
	459	DO J=jts,jte
	460
	461	IF(ITIMESTEP.EQ.1)THEN
	462	DO 50 I=its,ite
	463	!*** initialize soil conditions for IHOP 31 May case
	464	! IF((XLAND(I,J)-1.5) < 0.)THEN
	465	! if (I==108.and.j==85) then
	466	! DO NS=1,NSOIL
	467	! SMOIS(I,NS,J)=0.10
	468	! SH2O(I,NS,J)=0.10
	469	! enddo
	470	! endif
	471	! ENDIF
	472
	473	!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
	474	IF((XLAND(I,J)-1.5).GE.0.)THEN
	475	! check sea-ice point
	476	IF(XICE(I,J).EQ.1..and.IPRINT)PRINT*,' sea-ice at water point, I=',I, &
	477	'J=',J
	478	!*** Open Water Case
	479	SMSTAV(I,J)=1.0
	480	SMSTOT(I,J)=1.0
	481	DO NS=1,NSOIL
	482	SMOIS(I,NS,J)=1.0
	483	TSLB(I,NS,J)=273.16 !STEMP
	484	ENDDO
	485	ELSE
	486	IF(XICE(I,J).EQ.1.)THEN
	487	!*** SEA-ICE CASE
	488	SMSTAV(I,J)=1.0
	489	SMSTOT(I,J)=1.0
	490	DO NS=1,NSOIL
	491	SMOIS(I,NS,J)=1.0
	492	ENDDO
	493	ENDIF
	494	ENDIF
	495	!
	496	50 CONTINUE
	497	ENDIF ! end of initialization over ocean
	498
	499	!-----------------------------------------------------------------------
	500	DO 100 I=its,ite
	501	! surface pressure
	502	PSFC=P8w3D(i,1,j)
	503	! pressure in middle of lowest layer
	504	SFCPRS=(P8W3D(I,KTS+1,j)+P8W3D(i,KTS,j))*0.5
	505	! convert from mixing ratio to specific humidity
	506	Q2K=QV3D(i,1,j)/(1.0+QV3D(i,1,j))
	507	!
	508	! Q2SAT=QGH(I,j)
	509	Q2SAT=QGH(I,J)/(1.0+QGH(I,J)) ! Q2SAT is sp humidity
	510	! add check on myj=.true.
	511	! IF((Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN
	512	IF((myj).AND.(Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN
	513	SATFLG=0.
	514	CHKLOWQ(I,J)=0.
	515	ELSE
	516	SATFLG=1.0
	517	CHKLOWQ(I,J)=1.
	518	ENDIF
	519
	520	SFCTMP=T3D(i,1,j)
	521	ZLVL=0.5*DZ8W(i,1,j)
	522
	523	! TH2=SFCTMP+(0.0097545*ZLVL)
	524	! calculate SFCTH2 via Exner function vs lapse-rate (above)
	525	APES=(1.E5/PSFC)**CAPA
	526	APELM=(1.E5/SFCPRS)**CAPA
	527	SFCTH2=SFCTMP*APELM
	528	TH2=SFCTH2/APES
	529	!
	530	EMISSI = EMISS(I,J)
	531	LWDN=GLW(I,J)*EMISSI
	532	! SOLDN is total incoming solar
	533	SOLDN=SWDOWN(I,J)
	534	! GSW is net downward solar
	535	! SOLNET=GSW(I,J)
	536	! use mid-day albedo to determine net downward solar (no solar zenith angle correction)
	537	SOLNET=SOLDN*(1.-ALBEDO(I,J))
	538	PRCP=RAINBL(i,j)/DT
	539	VEGTYP=IVGTYP(I,J)
	540	SOILTYP=ISLTYP(I,J)
	541	SHDFAC=VEGFRA(I,J)/100.
	542	T1=TSK(I,J)
	543	CHK=CHS(I,J)
	544	SHMIN=SHDMIN(I,J)/100. !NEW
	545	SHMAX=SHDMAX(I,J)/100. !NEW
	546	SNOALB1=SNOALB(I,J) !NEW
	547	! convert snow water equivalent from mm to meter
	548	SNEQV=SNOW(I,J)*0.001
	549	! snow depth in meters
	550	SNOWHK=SNOWH(I,J)
	551
	552	! if "SR" present, set frac of frozen precip ("FFROZP") = snow-ratio ("SR", range:0-1)
	553	! SR from e.g. Ferrier microphysics
	554	! otherwise define from 1st atmos level temperature
	555	IF(FRPCPN) THEN
	556	FFROZP=SR(I,J)
	557	ELSE
	558	IF (SFCTMP <= 273.15) THEN
	559	FFROZP = 1.0
	560	ELSE
	561	FFROZP = 0.0
	562	ENDIF
	563	ENDIF
	564	!***
	565	IF((XLAND(I,J)-1.5).GE.0.)THEN ! begining of land/sea if block
	566	! Open water points
	567	ELSE
	568	! Land or sea-ice case
	569
	570	IF (XICE(I,J) .GT. 0.5) THEN
	571	ICE=1
	572	ELSE
	573	ICE=0
	574	ENDIF
	575	DQSDT2=Q2SATA23M4/(SFCTMP-A4)*2
	576
	577	IF(SNOW(I,J).GT.0.0)THEN
	578	! snow on surface (use ice saturation properties)
	579	SFCTSNO=SFCTMP
	580	E2SAT=611.2EXP(6174.(1./273.15 - 1./SFCTSNO))
	581	Q2SATI=0.622*E2SAT/(SFCPRS-E2SAT)
	582	Q2SATI=Q2SATI/(1.0+Q2SATI) ! spec. hum.
	583	IF(T1 .GT. 273.15)THEN
	584	! warm ground temps, weight the saturation between ice and water according to SNOWC
	585	Q2SAT=Q2SAT(1.-SNOWC(I,J)) + Q2SATISNOWC(I,J)
	586	DQSDT2=DQSDT2(1.-SNOWC(I,J)) + Q2SATI6174./(SFCTSNO*2)SNOWC(I,J)
	587	ELSE
	588	! cold ground temps, use ice saturation only
	589	Q2SAT=Q2SATI
	590	DQSDT2=Q2SATI6174./(SFCTSNO*2)
	591	ENDIF
	592	! for snow cover fraction at 0 C, ground temp will not change, so DQSDT2 effectively zero
	593	IF(T1 .GT. 273. .AND. SNOWC(I,J) .GT. 0.)DQSDT2=DQSDT2*(1.-SNOWC(I,J))
	594	ENDIF
	595
	596	IF(ICE.EQ.0)THEN
	597	TBOT=TMN(I,J)
	598	ELSE
	599	TBOT=271.16
	600	ENDIF
	601	IF(VEGTYP.EQ.25) SHDFAC=0.0000
	602	IF(VEGTYP.EQ.26) SHDFAC=0.0000
	603	IF(VEGTYP.EQ.27) SHDFAC=0.0000
	604	IF(SOILTYP.EQ.14.AND.XICE(I,J).EQ.0.)THEN
	605	IF(IPRINT)PRINT*,' SOIL TYPE FOUND TO BE WATER AT A LAND-POINT'
	606	IF(IPRINT)PRINT*,i,j,'RESET SOIL in surfce.F'
	607	SOILTYP=7
	608	ENDIF
	609	CMC=CANWAT(I,J)
	610
	611	!-------------------------------------------
	612	!*** convert snow depth from mm to meter
	613	!
	614	! IF(RDMAXALB) THEN
	615	! SNOALB=ALBMAX(I,J)*0.01
	616	! ELSE
	617	! SNOALB=MAXALB(IVGTPK)*0.01
	618	! ENDIF
	619	! IF(RDBRDALB) THEN
	620	! ALBBRD=ALBEDO(I,J)*0.01
	621	! ELSE
	622	! ALBBRD=ALBD(IVGTPK,ISN)*0.01
	623	! ENDIF
	624
	625	! SNOALB1=0.80
	626	! SHMIN=0.00
	627	ALBBRD=ALBBCK(I,J)
	628	Z0BRD=Z0(I,J)
	629	EMBRD=EMBCK(I,J)
	630	!FEI: temporaray arrays above need to be changed later by using SI
	631
	632	DO 70 NS=1,NSOIL
	633	SMC(NS)=SMOIS(I,NS,J)
	634	STC(NS)=TSLB(I,NS,J) !STEMP
	635	SWC(NS)=SH2O(I,NS,J)
	636	70 CONTINUE
	637	!
	638	if ( (SNEQV.ne.0..AND.SNOWHK.eq.0.).or.(SNOWHK.le.SNEQV) )THEN
	639	SNOWHK= 5.*SNEQV
	640	endif
	641	!
	642
	643	!Fei: urban. for urban surface, if calling UCM, redefine urban as 5: Cropland/Grassland Mosaic
	644
	645	IF(UCMCALL == 1 ) THEN
	646	IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &
	647	IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN
	648	VEGTYP = 5
	649	SHDFAC = 0.8
	650	ALBEDOK =0.2
	651	ALBBRD =0.2
	652	IF ( FRC_URB2D(I,J) < 0.99 ) THEN
	653	T1= ( TSK(I,J) -FRC_URB2D(I,J) * TS_URB2D (I,J) )/ (1-FRC_URB2D(I,J))
	654	ELSE
	655	T1 = TSK(I,J)
	656	ENDIF
	657	ENDIF
	658	ELSE
	659	IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &
	660	IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN
	661	VEGTYP = 1
	662	ENDIF
	663	ENDIF
	664
	665	IF(IPRINT) THEN
	666	!
	667	print*, 'BEFORE SFLX, in Noahlsm_driver'
	668	print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL, &
	669	'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
	670	LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN, &
	671	'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K, &
	672	'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
	673	'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
	674	'SHMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB1',SNOALB1,'TBOT',&
	675	TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
	676	STC, 'SMC',SMC, 'SWC',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
	677	'ALBEDO',ALBEDO,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT, &
	678	'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC, &
	679	'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
	680	'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
	681	'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
	682	'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
	683	'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS, &
	684	'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW, &
	685	'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
	686	'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
	687	endif
	688
	689
	690	CALL SFLX (FFROZP, ICE,DT,ZLVL,NSOIL,SLDPTH, & !C
	691	LOCAL, & !L
	692	LUTYPE, SLTYPE, & !CL
	693	LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K,DUMMY, & !F
	694	DUMMY,DUMMY, DUMMY, & !F PRCPRAIN not used
	695	TH2,Q2SAT,DQSDT2, & !I
	696	VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHMIN,DUMMY, & !I
	697	ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD, & !S
	698	CMC,T1,STC,SMC,SWC,SNOWHK,SNEQV,ALBEDOK,CHK,dummy,& !H
	699	ETA,SHEAT, ETA_KINEMATIC,FDOWN, & !O
	700	EC,EDIR,ET,ETT,ESNOW,DRIP,DEW, & !O
	701	BETA,ETP,SSOIL, & !O
	702	FLX1,FLX2,FLX3, & !O
	703	SNOMLT,SNCOVR, & !O
	704	RUNOFF1,RUNOFF2,RUNOFF3, & !O
	705	RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL, & !O
	706	SOILW,SOILM,Q1, & !D
	707	SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT)
	708
	709
	710	IF(IPRINT) THEN
	711
	712	print*, 'AFTER SFLX, in Noahlsm_driver'
	713	print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL, &
	714	'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
	715	LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN, &
	716	'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K, &
	717	'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
	718	'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
	719	'SHDMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB',SNOALB1,'TBOT',&
	720	TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
	721	STC, 'SMC',SMC, 'SWc',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
	722	'ALBEDO',ALBEDOK,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT, &
	723	'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC, &
	724	'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
	725	'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
	726	'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
	727	'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
	728	'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS, &
	729	'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW, &
	730	'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
	731	'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
	732	endif
	733
	734	!*** UPDATE STATE VARIABLES
	735	CANWAT(I,J)=CMC
	736	SNOW(I,J)=SNEQV*1000.
	737	! SNOWH(I,J)=SNOWHK*1000.
	738	SNOWH(I,J)=SNOWHK ! SNOWHK in meters
	739	ALBEDO(I,J)=ALBEDOK
	740	EMISS(I,J) = EMISSI
	741	! MEK Nov2006 turn off
	742	! ZNT(I,J)=Z0K
	743	TSK(I,J)=T1
	744	HFX(I,J)=SHEAT
	745	! MEk Jul07 add potential evap accum
	746	POTEVP(I,J)=POTEVP(I,J)+ETP*FDTW
	747	QFX(I,J)=ETA_KINEMATIC
	748
	749	LH(I,J)=ETA
	750	GRDFLX(I,J)=SSOIL
	751	SNOWC(I,J)=SNCOVR
	752	CHS2(I,J)=CQS2(I,J)
	753	! prevent diagnostic ground q (q1) from being greater than qsat(tsk)
	754	! as happens over snow cover where the cqs2 value also becomes irrelevant
	755	! by setting cqs2=chs in this situation the 2m q should become just qv(k=1)
	756	IF (Q1 .GT. QSFC(I,J)) THEN
	757	CQS2(I,J) = CHS(I,J)
	758	ENDIF
	759	! QSFC(I,J)=Q1
	760	! Convert QSFC back to mixing ratio
	761	QSFC(I,J)= Q1/(1.0-Q1)
	762	!
	763	DO 80 NS=1,NSOIL
	764	SMOIS(I,NS,J)=SMC(NS)
	765	TSLB(I,NS,J)=STC(NS) ! STEMP
	766	SH2O(I,NS,J)=SWC(NS)
	767	80 CONTINUE
	768	! ENDIF
	769
	770	IF (UCMCALL == 1 ) THEN ! Beginning of UCM CALL if block
	771	!--------------------------------------
	772	! URBAN CANOPY MODEL START - urban
	773	!--------------------------------------
	774	! Input variables lsm --> urban
	775
	776
	777	IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &
	778	IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN
	779
	780	! Call urban
	781
	782	!
	783	UTYPE_URB = UTYPE_URB2D(I,J) !urban type (low, high or industrial)
	784
	785	TA_URB = SFCTMP ! [K]
	786	QA_URB = Q2K ! [kg/kg]
	787	UA_URB = SQRT(U_PHY(I,1,J)2.+V_PHY(I,1,J)2.)
	788	U1_URB = U_PHY(I,1,J)
	789	V1_URB = V_PHY(I,1,J)
	790	IF(UA_URB < 1.) UA_URB=1. ! [m/s]
	791	SSG_URB = SOLDN ! [W/m/m]
	792	SSGD_URB = 0.8*SOLDN ! [W/m/m]
	793	SSGQ_URB = SSG_URB-SSGD_URB ! [W/m/m]
	794	LLG_URB = LWDN ! [W/m/m]
	795	RAIN_URB = RAINBL(I,J) ! [mm]
	796	RHOO_URB = SFCPRS / (287.04 * SFCTMP * (1.0+ 0.61 * Q2K)) ![kg/m/m/m]
	797	ZA_URB = ZLVL ! [m]
	798	DELT_URB = DT ! [sec]
	799	XLAT_URB = XLAT_URB2D(I,J) ! [deg]
	800	COSZ_URB = COSZ_URB2D(I,J) !
	801	OMG_URB = OMG_URB2D(I,J) !
	802	ZNT_URB = ZNT(I,J)
	803
	804	LSOLAR_URB = .FALSE.
	805
	806	TR_URB = TR_URB2D(I,J)
	807	TB_URB = TB_URB2D(I,J)
	808	TG_URB = TG_URB2D(I,J)
	809	TC_URB = TC_URB2D(I,J)
	810	QC_URB = QC_URB2D(I,J)
	811	UC_URB = UC_URB2D(I,J)
	812
	813	DO K = 1,num_roof_layers
	814	TRL_URB(K) = TRL_URB3D(I,K,J)
	815	END DO
	816	DO K = 1,num_wall_layers
	817	TBL_URB(K) = TBL_URB3D(I,K,J)
	818	END DO
	819	DO K = 1,num_road_layers
	820	TGL_URB(K) = TGL_URB3D(I,K,J)
	821	END DO
	822
	823	XXXR_URB = XXXR_URB2D(I,J)
	824	XXXB_URB = XXXB_URB2D(I,J)
	825	XXXG_URB = XXXG_URB2D(I,J)
	826	XXXC_URB = XXXC_URB2D(I,J)
	827	!
	828	CHS_URB = CHS(I,J)
	829	CHS2_URB = CHS2(I,J)
	830	!
	831
	832	! Call urban
	833
	834
	835	CALL urban(LSOLAR_URB, & ! I
	836	num_roof_layers,num_wall_layers,num_road_layers, & ! C
	837	DZR,DZB,DZG, & ! C
	838	UTYPE_URB,TA_URB,QA_URB,UA_URB,U1_URB,V1_URB,SSG_URB, & ! I
	839	SSGD_URB,SSGQ_URB,LLG_URB,RAIN_URB,RHOO_URB, & ! I
	840	ZA_URB,DECLIN_URB,COSZ_URB,OMG_URB, & ! I
	841	XLAT_URB,DELT_URB,ZNT_URB, & ! I
	842	CHS_URB, CHS2_URB, & ! I
	843	TR_URB, TB_URB, TG_URB, TC_URB, QC_URB,UC_URB, & ! H
	844	TRL_URB,TBL_URB,TGL_URB, & ! H
	845	XXXR_URB, XXXB_URB, XXXG_URB, XXXC_URB, & ! H
	846	TS_URB,QS_URB,SH_URB,LH_URB,LH_KINEMATIC_URB, & ! O
	847	SW_URB,ALB_URB,LW_URB,G_URB,RN_URB,PSIM_URB,PSIH_URB, & ! O
	848	GZ1OZ0_URB, & !O
	849	U10_URB, V10_URB, TH2_URB, Q2_URB, & ! O
	850	UST_URB) !O
	851
	852
	853	IF(IPRINT) THEN
	854
	855	print*, 'AFTER CALL URBAN'
	856	print*,'num_roof_layers',num_roof_layers, 'num_wall_layers', &
	857	num_wall_layers, &
	858	'DZR',DZR,'DZB',DZB,'DZG',DZG,'UTYPE_URB',UTYPE_URB,'TA_URB', &
	859	TA_URB, &
	860	'QA_URB',QA_URB,'UA_URB',UA_URB,'U1_URB',U1_URB,'V1_URB', &
	861	V1_URB, &
	862	'SSG_URB',SSG_URB,'SSGD_URB',SSGD_URB,'SSGQ_URB',SSGQ_URB, &
	863	'LLG_URB',LLG_URB,'RAIN_URB',RAIN_URB,'RHOO_URB',RHOO_URB, &
	864	'ZA_URB',ZA_URB, 'DECLIN_URB',DECLIN_URB,'COSZ_URB',COSZ_URB,&
	865	'OMG_URB',OMG_URB,'XLAT_URB',XLAT_URB,'DELT_URB',DELT_URB, &
	866	'ZNT_URB',ZNT_URB,'TR_URB',TR_URB, 'TB_URB',TB_URB,'TG_URB',&
	867	TG_URB,'TC_URB',TC_URB,'QC_URB',QC_URB,'TRL_URB',TRL_URB, &
	868	'TBL_URB',TBL_URB,'TGL_URB',TGL_URB,'XXXR_URB',XXXR_URB, &
	869	'XXXB_URB',XXXB_URB,'XXXG_URB',XXXG_URB,'XXXC_URB',XXXC_URB,&
	870	'TS_URB',TS_URB,'QS_URB',QS_URB,'SH_URB',SH_URB,'LH_URB', &
	871	LH_URB, 'LH_KINEMATIC_URB',LH_KINEMATIC_URB,'SW_URB',SW_URB,&
	872	'ALB_URB',ALB_URB,'LW_URB',LW_URB,'G_URB',G_URB,'RN_URB', &
	873	RN_URB, 'PSIM_URB',PSIM_URB,'PSIH_URB',PSIH_URB, &
	874	'U10_URB',U10_URB,'V10_URB',V10_URB,'TH2_URB',TH2_URB, &
	875	'Q2_URB',Q2_URB,'CHS_URB',CHS_URB,'CHS2_URB',CHS2_URB
	876	endif
	877
	878	TS_URB2D(I,J) = TS_URB
	879
	880	ALBEDO(I,J) = FRC_URB2D(I,J)ALB_URB+(1-FRC_URB2D(I,J))ALBEDOK ![-]
	881	HFX(I,J) = FRC_URB2D(I,J)SH_URB+(1-FRC_URB2D(I,J))SHEAT ![W/m/m]
	882	QFX(I,J) = FRC_URB2D(I,J)*LH_KINEMATIC_URB &
	883	+ (1-FRC_URB2D(I,J))*ETA_KINEMATIC ![kg/m/m/s]
	884	LH(I,J) = FRC_URB2D(I,J)LH_URB+(1-FRC_URB2D(I,J))ETA ![W/m/m]
	885	GRDFLX(I,J) = FRC_URB2D(I,J)G_URB+(1-FRC_URB2D(I,J))SSOIL ![W/m/m]
	886	TSK(I,J) = FRC_URB2D(I,J)TS_URB+(1-FRC_URB2D(I,J))T1 ![K]
	887	QSFC(I,J)= FRC_URB2D(I,J)QS_URB+(1-FRC_URB2D(I,J))Q1 ![-]
	888
	889	IF(IPRINT)THEN
	890
	891	print*, ' FRC_URB2D', FRC_URB2D, &
	892	'ALB_URB',ALB_URB, 'ALBEDOK',ALBEDOK, &
	893	'ALBEDO(I,J)', ALBEDO(I,J), &
	894	'SH_URB',SH_URB,'SHEAT',SHEAT, 'HFX(I,J)',HFX(I,J), &
	895	'LH_KINEMATIC_URB',LH_KINEMATIC_URB,'ETA_KINEMATIC', &
	896	ETA_KINEMATIC, 'QFX(I,J)',QFX(I,J), &
	897	'LH_URB',LH_URB, 'ETA',ETA, 'LH(I,J)',LH(I,J), &
	898	'G_URB',G_URB,'SSOIL',SSOIL,'GRDFLX(I,J)', GRDFLX(I,J),&
	899	'TS_URB',TS_URB,'T1',T1,'TSK(I,J)',TSK(I,J), &
	900	'QS_URB',QS_URB,'Q1',Q1,'QSFC(I,J)',QSFC(I,J)
	901	endif
	902
	903
	904
	905
	906	! Renew Urban State Varialbes
	907
	908	TR_URB2D(I,J) = TR_URB
	909	TB_URB2D(I,J) = TB_URB
	910	TG_URB2D(I,J) = TG_URB
	911	TC_URB2D(I,J) = TC_URB
	912	QC_URB2D(I,J) = QC_URB
	913	UC_URB2D(I,J) = UC_URB
	914
	915	DO K = 1,num_roof_layers
	916	TRL_URB3D(I,K,J) = TRL_URB(K)
	917	END DO
	918	DO K = 1,num_wall_layers
	919	TBL_URB3D(I,K,J) = TBL_URB(K)
	920	END DO
	921	DO K = 1,num_road_layers
	922	TGL_URB3D(I,K,J) = TGL_URB(K)
	923	END DO
	924	XXXR_URB2D(I,J) = XXXR_URB
	925	XXXB_URB2D(I,J) = XXXB_URB
	926	XXXG_URB2D(I,J) = XXXG_URB
	927	XXXC_URB2D(I,J) = XXXC_URB
	928
	929	SH_URB2D(I,J) = SH_URB
	930	LH_URB2D(I,J) = LH_URB
	931	G_URB2D(I,J) = G_URB
	932	RN_URB2D(I,J) = RN_URB
	933	PSIM_URB2D(I,J) = PSIM_URB
	934	PSIH_URB2D(I,J) = PSIH_URB
	935	GZ1OZ0_URB2D(I,J)= GZ1OZ0_URB
	936	U10_URB2D(I,J) = U10_URB
	937	V10_URB2D(I,J) = V10_URB
	938	TH2_URB2D(I,J) = TH2_URB
	939	Q2_URB2D(I,J) = Q2_URB
	940	UST_URB2D(I,J) = UST_URB
	941	AKMS_URB2D(I,J) = KARMAN * UST_URB2D(I,J)/(GZ1OZ0_URB2D(I,J)-PSIM_URB2D(I,J))
	942
	943	END IF
	944
	945	ENDIF ! end of UCM CALL if block
	946	!--------------------------------------
	947	! Urban Part End - urban
	948	!--------------------------------------
	949
	950	!*** DIAGNOSTICS
	951	SMSTAV(I,J)=SOILW
	952	SMSTOT(I,J)=SOILM*1000.
	953	! Convert the water unit into mm
	954	SFCRUNOFF(I,J)=SFCRUNOFF(I,J)+RUNOFF1DT1000.0
	955	UDRUNOFF(I,J)=UDRUNOFF(I,J)+(RUNOFF2+RUNOFF3)DT1000.0
	956	! snow defined when fraction of frozen precip (FFROZP) > 0.5,
	957	IF(FFROZP.GT.0.5)THEN
	958	ACSNOW(I,J)=ACSNOW(I,J)+PRCP*DT
	959	ENDIF
	960	IF(SNOW(I,J).GT.0.)THEN
	961	ACSNOM(I,J)=ACSNOM(I,J)+SNOMLT*1000.
	962	! accumulated snow-melt energy
	963	SNOPCX(I,J)=SNOPCX(I,J)-SNOMLT/FDTLIW
	964	ENDIF
	965
	966	ENDIF ! endif of land-sea test
	967
	968	100 CONTINUE ! of I loop
	969
	970	ENDDO ! of J loop
	971	!------------------------------------------------------
	972	END SUBROUTINE lsm
	973	!------------------------------------------------------
	974
	975	SUBROUTINE LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, &
	976	SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, &
	977	ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
	978	FNDSOILW, FNDSNOWH, &
	979	num_soil_layers, restart, &
	980	allowed_to_read , &
	981	ids,ide, jds,jde, kds,kde, &
	982	ims,ime, jms,jme, kms,kme, &
	983	its,ite, jts,jte, kts,kte )
	984
	985	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
	986	ims,ime, jms,jme, kms,kme, &
	987	its,ite, jts,jte, kts,kte
	988
	989	INTEGER, INTENT(IN) :: num_soil_layers
	990
	991	LOGICAL , INTENT(IN) :: restart , allowed_to_read
	992
	993	REAL, DIMENSION( num_soil_layers), INTENT(INOUT) :: ZS, DZS
	994
	995	REAL, DIMENSION( ims:ime, num_soil_layers, jms:jme ) , &
	996	INTENT(INOUT) :: SMOIS, & !Total soil moisture
	997	SH2O, & !liquid soil moisture
	998	TSLB !STEMP
	999
	1000	REAL, DIMENSION( ims:ime, jms:jme ) , &
	1001	INTENT(INOUT) :: SNOW, &
	1002	SNOWH, &
	1003	SNOWC, &
	1004	CANWAT, &
	1005	SMSTAV, &
	1006	SMSTOT, &
	1007	SFCRUNOFF, &
	1008	UDRUNOFF, &
	1009	ACSNOW, &
	1010	VEGFRA, &
	1011	ACSNOM
	1012
	1013	INTEGER, DIMENSION( ims:ime, jms:jme ) , &
	1014	INTENT(IN) :: IVGTYP, &
	1015	ISLTYP
	1016
	1017	LOGICAL, INTENT(IN) :: FNDSOILW , &
	1018	FNDSNOWH
	1019
	1020	INTEGER :: L
	1021	REAL :: BX, SMCMAX, PSISAT, FREE
	1022	REAL, PARAMETER :: BLIM = 5.5, HLICE = 3.335E5, &
	1023	GRAV = 9.81, T0 = 273.15
	1024	INTEGER :: errflag
	1025
	1026	character*4 :: MMINLU, MMINSL
	1027	!
	1028	MMINLU='USGS'
	1029	MMINSL='STAS'
	1030	!
	1031
	1032	! initialize three Noah LSM related tables
	1033	IF ( allowed_to_read ) THEN
	1034	CALL wrf_message( 'INITIALIZE THREE Noah LSM RELATED TABLES' )
	1035	! CALL LSM_PARM_INIT
	1036	CALL SOIL_VEG_GEN_PARM( MMINLU, MMINSL )
	1037	ENDIF
	1038
	1039	IF(.not.restart)THEN
	1040
	1041	itf=min0(ite,ide-1)
	1042	jtf=min0(jte,jde-1)
	1043
	1044	errflag = 0
	1045	DO j = jts,jtf
	1046	DO i = its,itf
	1047	IF ( ISLTYP( i,j ) .LT. 1 ) THEN
	1048	errflag = 1
	1049	WRITE(err_message,*)"module_sf_noahlsm.F: lsminit: out of range ISLTYP ",i,j,ISLTYP( i,j )
	1050	CALL wrf_message(err_message)
	1051	ENDIF
	1052	ENDDO
	1053	ENDDO
	1054	IF ( errflag .EQ. 1 ) THEN
	1055	CALL wrf_error_fatal( "module_sf_noahlsm.F: lsminit: out of range value "// &
	1056	"of ISLTYP. Is this field in the input?" )
	1057	ENDIF
	1058	#ifdef WRF_CHEM
	1059	!
	1060	! need this parameter for dust parameterization in wrf/chem
	1061	!
	1062	do I=1,NSLTYPE
	1063	porosity(i)=maxsmc(i)
	1064	enddo
	1065	#endif
	1066
	1067	! initialize soil liquid water content SH2O
	1068
	1069	! IF(.NOT.FNDSOILW) THEN
	1070
	1071	! If no SWC, do the following
	1072	! PRINT *,'SOIL WATER NOT FOUND - VALUE SET IN LSMINIT'
	1073	DO J = jts,jtf
	1074	DO I = its,itf
	1075	BX = BB(ISLTYP(I,J))
	1076	SMCMAX = MAXSMC(ISLTYP(I,J))
	1077	PSISAT = SATPSI(ISLTYP(I,J))
	1078	if ((bx > 0.0).and.(smcmax > 0.0).and.(psisat > 0.0)) then
	1079	DO NS=1, num_soil_layers
	1080	! ----------------------------------------------------------------------
	1081	!SH2O <= SMOIS for T < 273.149K (-0.001C)
	1082	IF (TSLB(I,NS,J) < 273.149) THEN
	1083	! ----------------------------------------------------------------------
	1084	! first guess following explicit solution for Flerchinger Eqn from Koren
	1085	! et al, JGR, 1999, Eqn 17 (KCOUNT=0 in FUNCTION FRH2O).
	1086	! ISLTPK is soil type
	1087	BX = BB(ISLTYP(I,J))
	1088	SMCMAX = MAXSMC(ISLTYP(I,J))
	1089	PSISAT = SATPSI(ISLTYP(I,J))
	1090	IF ( BX > BLIM ) BX = BLIM
	1091	FK=(( (HLICE/(GRAV(-PSISAT))) &
	1092	((TSLB(I,NS,J)-T0)/TSLB(I,NS,J)) )*(-1/BX) )SMCMAX
	1093	IF (FK < 0.02) FK = 0.02
	1094	SH2O(I,NS,J) = MIN( FK, SMOIS(I,NS,J) )
	1095	! ----------------------------------------------------------------------
	1096	! now use iterative solution for liquid soil water content using
	1097	! FUNCTION FRH2O with the initial guess for SH2O from above explicit
	1098	! first guess.
	1099	CALL FRH2O (FREE,TSLB(I,NS,J),SMOIS(I,NS,J),SH2O(I,NS,J), &
	1100	SMCMAX,BX,PSISAT)
	1101	SH2O(I,NS,J) = FREE
	1102	ELSE ! of IF (TSLB(I,NS,J)
	1103	! ----------------------------------------------------------------------
	1104	! SH2O = SMOIS ( for T => 273.149K (-0.001C)
	1105	SH2O(I,NS,J)=SMOIS(I,NS,J)
	1106	! ----------------------------------------------------------------------
	1107	ENDIF ! of IF (TSLB(I,NS,J)
	1108	END DO ! of DO NS=1, num_soil_layers
	1109	else ! of if ((bx > 0.0)
	1110	DO NS=1, num_soil_layers
	1111	SH2O(I,NS,J)=SMOIS(I,NS,J)
	1112	END DO
	1113	endif ! of if ((bx > 0.0)
	1114	ENDDO ! DO I = its,itf
	1115	ENDDO ! DO J = jts,jtf
	1116	! ENDIF ! of IF(.NOT.FNDSOILW)THEN
	1117
	1118	! initialize physical snow height SNOWH
	1119
	1120	IF(.NOT.FNDSNOWH)THEN
	1121	! If no SNOWH do the following
	1122	CALL wrf_message( 'SNOW HEIGHT NOT FOUND - VALUE DEFINED IN LSMINIT' )
	1123	DO J = jts,jtf
	1124	DO I = its,itf
	1125	SNOWH(I,J)=SNOW(I,J)*0.005 ! SNOW in mm and SNOWH in m
	1126	ENDDO
	1127	ENDDO
	1128	ENDIF
	1129
	1130	! initialize canopy water to ZERO
	1131
	1132	! GO TO 110
	1133	! print*,'Note that canopy water content (CANWAT) is set to ZERO in LSMINIT'
	1134	DO J = jts,jtf
	1135	DO I = its,itf
	1136	CANWAT(I,J)=0.0
	1137	ENDDO
	1138	ENDDO
	1139	110 CONTINUE
	1140
	1141	ENDIF
	1142	!------------------------------------------------------------------------------
	1143	END SUBROUTINE lsminit
	1144	!------------------------------------------------------------------------------
	1145
	1146
	1147
	1148	!
	1149	!-----------------------------------------------------------------
	1150	SUBROUTINE LSM_PARM_INIT
	1151	!-----------------------------------------------------------------
	1152
	1153	character*4 :: MMINLU, MMINSL
	1154
	1155	MMINLU='USGS'
	1156	MMINSL='STAS'
	1157	call SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
	1158
	1159	!-----------------------------------------------------------------
	1160	END SUBROUTINE LSM_PARM_INIT
	1161	!-----------------------------------------------------------------
	1162
	1163	!-----------------------------------------------------------------
	1164	SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
	1165	!-----------------------------------------------------------------
	1166
	1167	USE module_wrf_error
	1168	IMPLICIT NONE
	1169
	1170	integer :: LUMATCH, IINDEX, LC, NUM_SLOPE
	1171	integer :: ierr
	1172	INTEGER , PARAMETER :: OPEN_OK = 0
	1173
	1174	character*4 :: MMINLU, MMINSL
	1175	character*128 :: mess , message
	1176	logical, external :: wrf_dm_on_monitor
	1177
	1178
	1179	!-----SPECIFY VEGETATION RELATED CHARACTERISTICS :
	1180	! ALBBCK: SFC albedo (in percentage)
	1181	! Z0: Roughness length (m)
	1182	! SHDFAC: Green vegetation fraction (in percentage)
	1183	! Note: The ALBEDO, Z0, and SHDFAC values read from the following table
	1184	! ALBEDO, amd Z0 are specified in LAND-USE TABLE; and SHDFAC is
	1185	! the monthly green vegetation data
	1186	! CMXTBL: MAX CNPY Capacity (m)
	1187	! NROTBL: Rooting depth (layer)
	1188	! RSMIN: Mimimum stomatal resistance (s m-1)
	1189	! RSMAX: Max. stomatal resistance (s m-1)
	1190	! RGL: Parameters used in radiation stress function
	1191	! HS: Parameter used in vapor pressure deficit functio
	1192	! TOPT: Optimum transpiration air temperature. (K)
	1193	! CMCMAX: Maximum canopy water capacity
	1194	! CFACTR: Parameter used in the canopy inteception calculati
	1195	! SNUP: Threshold snow depth (in water equivalent m) that
	1196	! implies 100% snow cover
	1197	! LAI: Leaf area index (dimensionless)
	1198	! MAXALB: Upper bound on maximum albedo over deep snow
	1199	!
	1200	!-----READ IN VEGETAION PROPERTIES FROM VEGPARM.TBL
	1201	!
	1202
	1203	IF ( wrf_dm_on_monitor() ) THEN
	1204
	1205	OPEN(19, FILE='VEGPARM.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
	1206	IF(ierr .NE. OPEN_OK ) THEN
	1207	WRITE(message,FMT='(A)') &
	1208	'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening VEGPARM.TBL'
	1209	CALL wrf_error_fatal ( message )
	1210	END IF
	1211
	1212	WRITE ( mess, * ) 'INPUT LANDUSE = ',MMINLU
	1213	CALL wrf_message( mess )
	1214
	1215	LUMATCH=0
	1216
	1217	READ (19,*)
	1218	READ (19,2000,END=2002)LUTYPE
	1219	READ (19,*)LUCATS,IINDEX
	1220	2000 FORMAT (A4)
	1221
	1222	IF(LUTYPE.EQ.MMINLU)THEN
	1223	WRITE( mess , * ) 'LANDUSE TYPE = ',LUTYPE,' FOUND', &
	1224	LUCATS,' CATEGORIES'
	1225	CALL wrf_message( mess )
	1226	LUMATCH=1
	1227	ENDIF
	1228	! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
	1229	IF ( SIZE(ALBTBL) < LUCATS .OR. &
	1230	SIZE(Z0TBL) < LUCATS .OR. &
	1231	SIZE(SHDTBL) < LUCATS .OR. &
	1232	SIZE(NROTBL) < LUCATS .OR. &
	1233	SIZE(RSTBL) < LUCATS .OR. &
	1234	SIZE(RGLTBL) < LUCATS .OR. &
	1235	SIZE(HSTBL) < LUCATS .OR. &
	1236	SIZE(SNUPTBL) < LUCATS .OR. &
	1237	SIZE(LAITBL) < LUCATS .OR. &
	1238	SIZE(MAXALB) < LUCATS ) THEN
	1239	CALL wrf_error_fatal('Table sizes too small for value of LUCATS in module_sf_noahdrv.F')
	1240	ENDIF
	1241
	1242	IF(LUTYPE.EQ.MMINLU)THEN
	1243	DO LC=1,LUCATS
	1244	READ (19,*)IINDEX,ALBTBL(LC),Z0TBL(LC),SHDTBL(LC), &
	1245	NROTBL(LC),RSTBL(LC),RGLTBL(LC),HSTBL(LC), &
	1246	SNUPTBL(LC),LAITBL(LC),MAXALB(LC)
	1247	ENDDO
	1248	!
	1249	READ (19,*)
	1250	READ (19,*)TOPT_DATA
	1251	READ (19,*)
	1252	READ (19,*)CMCMAX_DATA
	1253	READ (19,*)
	1254	READ (19,*)CFACTR_DATA
	1255	READ (19,*)
	1256	READ (19,*)RSMAX_DATA
	1257	READ (19,*)
	1258	READ (19,*)BARE
	1259	ENDIF
	1260	!
	1261	2002 CONTINUE
	1262
	1263	CLOSE (19)
	1264	ENDIF
	1265
	1266	CALL wrf_dm_bcast_string ( LUTYPE , 4 )
	1267	CALL wrf_dm_bcast_integer ( LUCATS , 1 )
	1268	CALL wrf_dm_bcast_integer ( IINDEX , 1 )
	1269	CALL wrf_dm_bcast_integer ( LUMATCH , 1 )
	1270	CALL wrf_dm_bcast_real ( ALBTBL , NLUS )
	1271	CALL wrf_dm_bcast_real ( Z0TBL , NLUS )
	1272	CALL wrf_dm_bcast_real ( SHDTBL , NLUS )
	1273	CALL wrf_dm_bcast_real ( NROTBL , NLUS )
	1274	CALL wrf_dm_bcast_real ( RSTBL , NLUS )
	1275	CALL wrf_dm_bcast_real ( RGLTBL , NLUS )
	1276	CALL wrf_dm_bcast_real ( HSTBL , NLUS )
	1277	CALL wrf_dm_bcast_real ( SNUPTBL , NLUS )
	1278	CALL wrf_dm_bcast_real ( LAITBL , NLUS )
	1279	CALL wrf_dm_bcast_real ( MAXALB , NLUS )
	1280	CALL wrf_dm_bcast_real ( TOPT_DATA , 1 )
	1281	CALL wrf_dm_bcast_real ( CMCMAX_DATA , 1 )
	1282	CALL wrf_dm_bcast_real ( CFACTR_DATA , 1 )
	1283	CALL wrf_dm_bcast_real ( RSMAX_DATA , 1 )
	1284	CALL wrf_dm_bcast_integer ( BARE , 1 )
	1285
	1286	!
	1287	!-----READ IN SOIL PROPERTIES FROM SOILPARM.TBL
	1288	!
	1289	IF ( wrf_dm_on_monitor() ) THEN
	1290	OPEN(19, FILE='SOILPARM.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
	1291	IF(ierr .NE. OPEN_OK ) THEN
	1292	WRITE(message,FMT='(A)') &
	1293	'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening SOILPARM.TBL'
	1294	CALL wrf_error_fatal ( message )
	1295	END IF
	1296
	1297	MMINSL='STAS' !oct2
	1298	WRITE(mess,*) 'INPUT SOIL TEXTURE CLASSIFICAION = ',MMINSL
	1299	CALL wrf_message( mess )
	1300
	1301	LUMATCH=0
	1302
	1303	READ (19,*)
	1304	READ (19,2000,END=2003)SLTYPE
	1305	READ (19,*)SLCATS,IINDEX
	1306	IF(SLTYPE.EQ.MMINSL)THEN
	1307	WRITE( mess , * ) 'SOIL TEXTURE CLASSIFICATION = ',SLTYPE,' FOUND', &
	1308	SLCATS,' CATEGORIES'
	1309	CALL wrf_message ( mess )
	1310	LUMATCH=1
	1311	ENDIF
	1312	! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
	1313	IF ( SIZE(BB ) < SLCATS .OR. &
	1314	SIZE(DRYSMC) < SLCATS .OR. &
	1315	SIZE(F11 ) < SLCATS .OR. &
	1316	SIZE(MAXSMC) < SLCATS .OR. &
	1317	SIZE(REFSMC) < SLCATS .OR. &
	1318	SIZE(SATPSI) < SLCATS .OR. &
	1319	SIZE(SATDK ) < SLCATS .OR. &
	1320	SIZE(SATDW ) < SLCATS .OR. &
	1321	SIZE(WLTSMC) < SLCATS .OR. &
	1322	SIZE(QTZ ) < SLCATS ) THEN
	1323	CALL wrf_error_fatal('Table sizes too small for value of SLCATS in module_sf_noahdrv.F')
	1324	ENDIF
	1325	IF(SLTYPE.EQ.MMINSL)THEN
	1326	DO LC=1,SLCATS
	1327	READ (19,*) IINDEX,BB(LC),DRYSMC(LC),F11(LC),MAXSMC(LC),&
	1328	REFSMC(LC),SATPSI(LC),SATDK(LC), SATDW(LC), &
	1329	WLTSMC(LC), QTZ(LC)
	1330	ENDDO
	1331	ENDIF
	1332
	1333	2003 CONTINUE
	1334
	1335	CLOSE (19)
	1336	ENDIF
	1337
	1338	CALL wrf_dm_bcast_integer ( LUMATCH , 1 )
	1339	CALL wrf_dm_bcast_string ( SLTYPE , 4 )
	1340	CALL wrf_dm_bcast_string ( MMINSL , 4 ) ! since this is reset above, see oct2 ^
	1341	CALL wrf_dm_bcast_integer ( SLCATS , 1 )
	1342	CALL wrf_dm_bcast_integer ( IINDEX , 1 )
	1343	CALL wrf_dm_bcast_real ( BB , NSLTYPE )
	1344	CALL wrf_dm_bcast_real ( DRYSMC , NSLTYPE )
	1345	CALL wrf_dm_bcast_real ( F11 , NSLTYPE )
	1346	CALL wrf_dm_bcast_real ( MAXSMC , NSLTYPE )
	1347	CALL wrf_dm_bcast_real ( REFSMC , NSLTYPE )
	1348	CALL wrf_dm_bcast_real ( SATPSI , NSLTYPE )
	1349	CALL wrf_dm_bcast_real ( SATDK , NSLTYPE )
	1350	CALL wrf_dm_bcast_real ( SATDW , NSLTYPE )
	1351	CALL wrf_dm_bcast_real ( WLTSMC , NSLTYPE )
	1352	CALL wrf_dm_bcast_real ( QTZ , NSLTYPE )
	1353
	1354	IF(LUMATCH.EQ.0)THEN
	1355	CALL wrf_message( 'SOIl TEXTURE IN INPUT FILE DOES NOT ' )
	1356	CALL wrf_message( 'MATCH SOILPARM TABLE' )
	1357	CALL wrf_error_fatal ( 'INCONSISTENT OR MISSING SOILPARM FILE' )
	1358	ENDIF
	1359
	1360	!
	1361	!-----READ IN GENERAL PARAMETERS FROM GENPARM.TBL
	1362	!
	1363	IF ( wrf_dm_on_monitor() ) THEN
	1364	OPEN(19, FILE='GENPARM.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
	1365	IF(ierr .NE. OPEN_OK ) THEN
	1366	WRITE(message,FMT='(A)') &
	1367	'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening GENPARM.TBL'
	1368	CALL wrf_error_fatal ( message )
	1369	END IF
	1370
	1371	READ (19,*)
	1372	READ (19,*)
	1373	READ (19,*) NUM_SLOPE
	1374
	1375	SLPCATS=NUM_SLOPE
	1376	! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
	1377	IF ( SIZE(slope_data) < NUM_SLOPE ) THEN
	1378	CALL wrf_error_fatal('NUM_SLOPE too large for slope_data array in module_sf_noahdrv')
	1379	ENDIF
	1380
	1381	DO LC=1,SLPCATS
	1382	READ (19,*)SLOPE_DATA(LC)
	1383	ENDDO
	1384
	1385	READ (19,*)
	1386	READ (19,*)SBETA_DATA
	1387	READ (19,*)
	1388	READ (19,*)FXEXP_DATA
	1389	READ (19,*)
	1390	READ (19,*)CSOIL_DATA
	1391	READ (19,*)
	1392	READ (19,*)SALP_DATA
	1393	READ (19,*)
	1394	READ (19,*)REFDK_DATA
	1395	READ (19,*)
	1396	READ (19,*)REFKDT_DATA
	1397	READ (19,*)
	1398	READ (19,*)FRZK_DATA
	1399	READ (19,*)
	1400	READ (19,*)ZBOT_DATA
	1401	READ (19,*)
	1402	READ (19,*)CZIL_DATA
	1403	READ (19,*)
	1404	READ (19,*)SMLOW_DATA
	1405	READ (19,*)
	1406	READ (19,*)SMHIGH_DATA
	1407	CLOSE (19)
	1408	ENDIF
	1409
	1410	CALL wrf_dm_bcast_integer ( NUM_SLOPE , 1 )
	1411	CALL wrf_dm_bcast_integer ( SLPCATS , 1 )
	1412	CALL wrf_dm_bcast_real ( SLOPE_DATA , NSLOPE )
	1413	CALL wrf_dm_bcast_real ( SBETA_DATA , 1 )
	1414	CALL wrf_dm_bcast_real ( FXEXP_DATA , 1 )
	1415	CALL wrf_dm_bcast_real ( CSOIL_DATA , 1 )
	1416	CALL wrf_dm_bcast_real ( SALP_DATA , 1 )
	1417	CALL wrf_dm_bcast_real ( REFDK_DATA , 1 )
	1418	CALL wrf_dm_bcast_real ( REFKDT_DATA , 1 )
	1419	CALL wrf_dm_bcast_real ( FRZK_DATA , 1 )
	1420	CALL wrf_dm_bcast_real ( ZBOT_DATA , 1 )
	1421	CALL wrf_dm_bcast_real ( CZIL_DATA , 1 )
	1422	CALL wrf_dm_bcast_real ( SMLOW_DATA , 1 )
	1423	CALL wrf_dm_bcast_real ( SMHIGH_DATA , 1 )
	1424
	1425
	1426	!-----------------------------------------------------------------
	1427	END SUBROUTINE SOIL_VEG_GEN_PARM
	1428	!-----------------------------------------------------------------
	1429
	1430	END MODULE module_sf_noahdrv

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

Download in other formats:

Original Format