Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
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

Line
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