Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_surface_driver.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: 52.9 KB

Line
1	!WRF:MEDIATION_LAYER:PHYSICS
2	!
3	MODULE module_surface_driver
4	CONTAINS
5
6	SUBROUTINE surface_driver( &
7	& acsnom,acsnow,akhs,akms,albedo,br,canwat &
8	& ,chklowq,dt,dx,dz8w,dzs,glw &
9	& ,grdflx,gsw,swdown,gz1oz0,hfx,ht,ifsnow,isfflx &
10	& ,isltyp,itimestep,ivgtyp,lowlyr,mavail,rmol &
11	& ,num_soil_layers,p8w,pblh,pi_phy,pshltr,psih &
12	& ,psim,p_phy,q10,q2,qfx,qsfc,qshltr,qz0 &
13	& ,raincv,rho,sfcevp,sfcexc,sfcrunoff &
14	& ,smois,smstav,smstot,snoalb,snow,snowc,snowh,stepbl &
15	& ,th10,th2,thz0,th_phy,tmn,tshltr,tsk,tslb &
16	& ,t_phy,u10,udrunoff,ust,uz0,u_frame,u_phy,v10,vegfra &
17	& ,vz0,v_frame,v_phy,warm_rain,wspd,xice,xland,z,znt,zs &
18	& ,xicem,isice,iswater,ct,tke_myj &
19	& ,albbck,embck,lh,sh2o,shdmax,shdmin,z0 &
20	& ,flqc,flhc,psfc,sst,sst_update,t2,emiss &
21	& ,sf_sfclay_physics,sf_surface_physics,ra_lw_physics &
22	& ,landusef,soilctop,soilcbot,ra,rs,nlcat,nscat,vegf_px & ! PX-LSM
23	& ,snowncv, anal_interval, lai, pxlsm_smois_init & ! PX-LSM
24	& ,pxlsm_soil_nudge & ! PX-LSM
25	! Optional urban
26	& ,declin_urb,cosz_urb2d,omg_urb2d,xlat_urb2d & !I urban
27	& ,num_roof_layers, num_wall_layers & !I urban
28	& ,num_road_layers, dzr, dzb, dzg & !I urban
29	& ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d & !H urban
30	& ,uc_urb2d & !H urban
31	& ,xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d & !H urban
32	& ,trl_urb3d,tbl_urb3d,tgl_urb3d & !H urban
33	& ,sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d & !H urban
34	& ,frc_urb2d, utype_urb2d & !H urban
35	& ,ucmcall & ! urban
36	& , ids,ide,jds,jde,kds,kde &
37	& , ims,ime,jms,jme,kms,kme &
38	& , i_start,i_end,j_start,j_end,kts,kte,num_tiles &
39	! Optional moisture tracers
40	& ,qv_curr, qc_curr, qr_curr &
41	& ,qi_curr, qs_curr, qg_curr &
42	! Optional moisture tracer flags
43	& ,f_qv,f_qc,f_qr &
44	& ,f_qi,f_qs,f_qg &
45	! Other optionals (more or less em specific)
46	& ,capg,hol,mol &
47	& ,rainncv,rainbl,regime,thc &
48	& ,qsg,qvg,qcg,soilt1,tsnav &
49	& ,smfr3d,keepfr3dflag &
50	! Other optionals (more or less nmm specific)
51	& ,potevp,snopcx,soiltb,sr &
52	! Optional observation PX LSM surface nudging
53	& ,t2_ndg_old, q2_ndg_old, t2_ndg_new, q2_ndg_new &
54	& ,sn_ndg_old, sn_ndg_new &
55	& ,t2obs, q2obs &
56	! Optional observation nudging
57	& ,uratx,vratx,tratx &
58	! Optional simple oml model
59	& ,omlcall,oml_hml0,oml_gamma &
60	& ,tml,t0ml,hml,h0ml,huml,hvml,f &
61	& ,ustm,ck,cka,cd,cda,isftcflx &
62	! Optional adaptive time step
63	& ,bldt,curr_secs,adapt_step_flag &
64	)
65
66	#if ( ! NMM_CORE == 1 )
67	USE module_state_description, ONLY : SFCLAYSCHEME &
68	,MYJSFCSCHEME &
69	,GFSSFCSCHEME &
70	,PXSFCSCHEME &
71	,SLABSCHEME &
72	,LSMSCHEME &
73	,RUCLSMSCHEME &
74	,PXLSMSCHEME
75	#else
76	USE module_state_description, ONLY : SFCLAYSCHEME &
77	,MYJSFCSCHEME &
78	,GFSSFCSCHEME &
79	,PXSFCSCHEME &
80	,SLABSCHEME &
81	,NMMLSMSCHEME &
82	,LSMSCHEME &
83	,RUCLSMSCHEME &
84	,PXLSMSCHEME
85	#endif
86	USE module_model_constants
87	! *** add new modules of schemes here
88
89	USE module_sf_sfclay
90	USE module_sf_myjsfc
91	USE module_sf_gfs
92	USE module_sf_noahdrv
93	USE module_sf_ruclsm
94	USE module_sf_pxsfclay
95	USE module_sf_pxlsm
96	#if ( NMM_CORE == 1 )
97	USE module_sf_lsm_nmm
98	#endif
99
100	USE module_sf_slab
101	!
102	USE module_sf_sfcdiags
103	!
104
105	! This driver calls subroutines for the surface parameterizations.
106	!
107	! surface layer: (between surface and pbl)
108	! 1. sfclay
109	! 2. myjsfc
110	! 7. Pleim surface layer
111	! surface: ground temp/lsm scheme:
112	! 1. slab
113	! 2. Noah LSM
114	! 7. Pleim-Xiu LSM
115	! 99. NMM LSM (NMM core only)
116	!------------------------------------------------------------------
117	IMPLICIT NONE
118	!======================================================================
119	! Grid structure in physics part of WRF
120	!----------------------------------------------------------------------
121	! The horizontal velocities used in the physics are unstaggered
122	! relative to temperature/moisture variables. All predicted
123	! variables are carried at half levels except w, which is at full
124	! levels. Some arrays with names (*8w) are at w (full) levels.
125	!
126	!----------------------------------------------------------------------
127	! In WRF, kms (smallest number) is the bottom level and kme (largest
128	! number) is the top level. In your scheme, if 1 is at the top level,
129	! then you have to reverse the order in the k direction.
130	!
131	! kme - half level (no data at this level)
132	! kme ----- full level
133	! kme-1 - half level
134	! kme-1 ----- full level
135	! .
136	! kms+2 - half level
137	! kms+2 ----- full level
138	! kms+1 - half level
139	! kms+1 ----- full level
140	! kms - half level
141	! kms ----- full level
142	!
143	!======================================================================
144	! Definitions
145	!-----------
146	! Theta potential temperature (K)
147	! Qv water vapor mixing ratio (kg/kg)
148	! Qc cloud water mixing ratio (kg/kg)
149	! Qr rain water mixing ratio (kg/kg)
150	! Qi cloud ice mixing ratio (kg/kg)
151	! Qs snow mixing ratio (kg/kg)
152	!-----------------------------------------------------------------
153	!-- itimestep number of time steps
154	!-- GLW downward long wave flux at ground surface (W/m^2)
155	!-- GSW net short wave flux at ground surface (W/m^2)
156	!-- SWDOWN downward short wave flux at ground surface (W/m^2)
157	!-- EMISS surface emissivity (between 0 and 1)
158	!-- TSK surface temperature (K)
159	!-- TMN soil temperature at lower boundary (K)
160	!-- XLAND land mask (1 for land, 2 for water)
161	!-- ZNT time-varying roughness length (m)
162	!-- Z0 background roughness length (m)
163	!-- MAVAIL surface moisture availability (between 0 and 1)
164	!-- UST u* in similarity theory (m/s)
165	!-- MOL T* (similarity theory) (K)
166	!-- HOL PBL height over Monin-Obukhov length
167	!-- PBLH PBL height (m)
168	!-- CAPG heat capacity for soil (J/K/m^3)
169	!-- THC thermal inertia (Cal/cm/K/s^0.5)
170	!-- SNOWC flag indicating snow coverage (1 for snow cover)
171	!-- HFX net upward heat flux at the surface (W/m^2)
172	!-- QFX net upward moisture flux at the surface (kg/m^2/s)
173	!-- LH net upward latent heat flux at surface (W/m^2)
174	!-- REGIME flag indicating PBL regime (stable, unstable, etc.)
175	!-- tke_myj turbulence kinetic energy from Mellor-Yamada-Janjic (MYJ) (m^2/s^2)
176	!-- akhs sfc exchange coefficient of heat/moisture from MYJ
177	!-- akms sfc exchange coefficient of momentum from MYJ
178	!-- thz0 potential temperature at roughness length (K)
179	!-- uz0 u wind component at roughness length (m/s)
180	!-- vz0 v wind component at roughness length (m/s)
181	!-- qsfc specific humidity at lower boundary (kg/kg)
182	!-- uratx ratio of u over u10 (Added for obs-nudging)
183	!-- vratx ratio of v over v10 (Added for obs-nudging)
184	!-- tratx ratio of t over th2 (Added for obs-nudging)
185	!-- u10 diagnostic 10-m u component from surface layer
186	!-- v10 diagnostic 10-m v component from surface layer
187	!-- th2 diagnostic 2-m theta from surface layer and lsm
188	!-- t2 diagnostic 2-m temperature from surface layer and lsm
189	!-- q2 diagnostic 2-m mixing ratio from surface layer and lsm
190	!-- tshltr diagnostic 2-m theta from MYJ
191	!-- th10 diagnostic 10-m theta from MYJ
192	!-- qshltr diagnostic 2-m specific humidity from MYJ
193	!-- q10 diagnostic 10-m specific humidity from MYJ
194	!-- lowlyr index of lowest model layer above ground
195	!-- rr dry air density (kg/m^3)
196	!-- u_phy u-velocity interpolated to theta points (m/s)
197	!-- v_phy v-velocity interpolated to theta points (m/s)
198	!-- th_phy potential temperature (K)
199	!-- moist moisture array (4D - last index is species) (kg/kg)
200	!-- p_phy pressure (Pa)
201	!-- pi_phy exner function (dimensionless)
202	!-- pshltr diagnostic shelter (2m) pressure from MYJ (Pa)
203	!-- p8w pressure at full levels (Pa)
204	!-- t_phy temperature (K)
205	!-- dz8w dz between full levels (m)
206	!-- z height above sea level (m)
207	!-- DX horizontal space interval (m)
208	!-- DT time step (second)
209	!-- PSFC pressure at the surface (Pa)
210	!-- SST sea-surface temperature (K)
211	!-- TSLB
212	!-- ZS
213	!-- DZS
214	!-- num_soil_layers number of soil layer
215	!-- IFSNOW ifsnow=1 for snow-cover effects
216	!-- omlcall whether to call simple ocean mixed layer model from slab (1 = use oml)
217	!-- oml_hml0 initial mixed layer depth (if real-data not available, default 50 m)
218	!-- oml_gamma lapse rate below mixed layer in ocean (default 0.14 K m-1)
219	!-- ck enthalpy exchange coeff at 10 meters
220	!-- cd momentum exchange coeff at 10 meters
221	!-- cka enthalpy exchange coeff at the lowest model level
222	!-- cda momentum exchange coeff at the lowest model level
223	!
224	!-- LANDUSEF Landuse fraction ! P-X LSM
225	!-- SOILCTOP Top soil fraction ! P-X LSM
226	!-- SOILCBOT Bottom soil fraction ! P-X LSM
227	!-- RA Aerodynamic resistence ! P-X LSM
228	!-- RS Stomatal resistence ! P-X LSM
229	!-- NLCAT Number of landuse categories ! P-X LSM
230	!-- NSCAT Number of soil categories ! P-X LSM
231	!
232	!-- ids start index for i in domain
233	!-- ide end index for i in domain
234	!-- jds start index for j in domain
235	!-- jde end index for j in domain
236	!-- kds start index for k in domain
237	!-- kde end index for k in domain
238	!-- ims start index for i in memory
239	!-- ime end index for i in memory
240	!-- jms start index for j in memory
241	!-- jme end index for j in memory
242	!-- kms start index for k in memory
243	!-- kme end index for k in memory
244	!-- its start index for i in tile
245	!-- ite end index for i in tile
246	!-- jts start index for j in tile
247	!-- jte end index for j in tile
248	!-- kts start index for k in tile
249	!-- kte end index for k in tile
250	!
251	!******************************************************************
252	!------------------------------------------------------------------
253
254	INTEGER, INTENT(IN) :: &
255	& ids,ide,jds,jde,kds,kde &
256	& ,ims,ime,jms,jme,kms,kme &
257	& ,kts,kte,num_tiles
258
259	INTEGER, INTENT(IN):: NLCAT
260	INTEGER, INTENT(IN):: NSCAT
261
262	INTEGER, INTENT(IN) :: sf_sfclay_physics, sf_surface_physics, &
263	ra_lw_physics, sst_update
264
265	INTEGER, INTENT(IN) :: ucmcall !urban
266
267	INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
268	& i_start,i_end,j_start,j_end
269
270	INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: ISLTYP
271	INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: IVGTYP
272	INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: LOWLYR
273	INTEGER, INTENT(IN ):: IFSNOW
274	INTEGER, INTENT(IN ):: ISFFLX
275	INTEGER, INTENT(IN ):: ITIMESTEP
276	INTEGER, INTENT(IN ):: NUM_SOIL_LAYERS
277	INTEGER, INTENT(IN ):: STEPBL
278	INTEGER, INTENT(IN ):: ISICE
279	INTEGER, INTENT(IN ):: ISWATER
280	LOGICAL, INTENT(IN ):: WARM_RAIN
281	REAL , INTENT(IN ):: U_FRAME
282	REAL , INTENT(IN ):: V_FRAME
283	REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SMOIS
284	REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: TSLB
285	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: GLW
286	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: GSW,SWDOWN
287	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: HT
288	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: RAINCV
289	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SST
290	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: TMN
291	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: VEGFRA
292	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: XICE
293	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XLAND
294	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XICEM
295	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MAVAIL
296	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: SNOALB
297	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ACSNOW
298	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKHS
299	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKMS
300	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ALBEDO
301	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: CANWAT
302
303	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: GRDFLX
304	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: HFX
305	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: RMOL
306	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: PBLH
307	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: Q2
308	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QFX
309	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QSFC
310	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QZ0
311	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SFCRUNOFF
312	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTAV
313	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTOT
314	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOW
315	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWC
316	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWH
317	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TH2
318	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: THZ0
319	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TSK
320	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UDRUNOFF
321	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UST
322	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UZ0
323	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: VZ0
324	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: WSPD
325	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ZNT
326	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: BR
327	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: CHKLOWQ
328	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: GZ1OZ0
329	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSHLTR
330	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIH
331	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIM
332	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: Q10
333	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: QSHLTR
334	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TH10
335	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TSHLTR
336	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: U10
337	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: V10
338	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSFC
339	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: ACSNOM
340	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEVP
341	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEXC
342	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLHC
343	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLQC
344	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CT
345	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: DZ8W
346	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P8W
347	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: PI_PHY
348	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P_PHY
349	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: RHO
350	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: TH_PHY
351	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: T_PHY
352	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: U_PHY
353	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: V_PHY
354	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: Z
355	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: TKE_MYJ
356	REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: DZS
357	REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: ZS
358	REAL, INTENT(IN ):: DT
359	REAL, INTENT(IN ):: DX
360	REAL, INTENT(IN ),OPTIONAL :: bldt
361	REAL, INTENT(IN ),OPTIONAL :: curr_secs
362	LOGICAL, INTENT(IN ),OPTIONAL :: adapt_step_flag
363
364	! arguments for NCAR surface physics
365
366	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: ALBBCK ! INOUT needed for NMM
367	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: EMBCK
368	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: LH
369	REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SH2O
370	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMAX
371	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMIN
372	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: Z0
373
374	!
375	! Optional
376	!
377	! arguments for Ocean Mixed Layer Model
378	REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT ):: TML, T0ML, HML, H0ML, HUML, HVML
379	REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(IN ):: F
380	REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(OUT ):: CK, CKA, CD, CDA, USTM
381
382	INTEGER, OPTIONAL, INTENT(IN ):: ISFTCFLX
383	INTEGER, OPTIONAL, INTENT(IN ):: OMLCALL
384	REAL , OPTIONAL, INTENT(IN ):: OML_HML0
385	REAL , OPTIONAL, INTENT(IN ):: OML_GAMMA
386	!
387	! Observation nudging
388	!
389	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: uratx !Added for obs-nudging
390	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: vratx !Added for obs-nudging
391	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: tratx !Added for obs-nudging
392	!
393	! PX LSM Surface Grid Analysis nudging
394	!
395	INTEGER, OPTIONAL, INTENT(IN) :: pxlsm_smois_init, pxlsm_soil_nudge, ANAL_INTERVAL
396	REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , OPTIONAL, INTENT(INOUT):: LANDUSEF
397	REAL, DIMENSION( ims:ime, NSCAT, jms:jme ) , OPTIONAL, INTENT(INOUT):: SOILCTOP, SOILCBOT
398	REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT):: VEGF_PX
399	REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: RA
400	REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: RS
401	REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: LAI
402	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: T2OBS
403	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: Q2OBS
404
405	REAL, DIMENSION( ims:ime, jms:jme ), &
406	OPTIONAL, INTENT(INOUT) :: t2_ndg_old, &
407	q2_ndg_old, &
408	t2_ndg_new, &
409	q2_ndg_new, &
410	sn_ndg_old, &
411	sn_ndg_new
412	!
413	!
414	! Flags relating to the optional tendency arrays declared above
415	! Models that carry the optional tendencies will provdide the
416	! optional arguments at compile time; these flags all the model
417	! to determine at run-time whether a particular tracer is in
418	! use or not.
419	!
420	LOGICAL, INTENT(IN), OPTIONAL :: &
421	f_qv &
422	,f_qc &
423	,f_qr &
424	,f_qi &
425	,f_qs &
426	,f_qg
427
428	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
429	OPTIONAL, INTENT(INOUT) :: &
430	! optional moisture tracers
431	! 2 time levels; if only one then use CURR
432	qv_curr, qc_curr, qr_curr &
433	,qi_curr, qs_curr, qg_curr
434	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN) :: snowncv
435	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: capg
436	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: emiss
437	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: hol
438	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: mol
439	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: regime
440	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: rainncv
441	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: RAINBL
442	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: t2
443	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: thc
444	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qsg
445	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qvg
446	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qcg
447	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soilt1
448	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: tsnav
449	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: potevp ! NMM LSM
450	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: snopcx ! NMM LSM
451	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soiltb ! NMM LSM
452	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: sr ! NMM and RUC LSM
453	REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: smfr3d
454	REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: keepfr3dflag
455
456	! LOCAL VAR
457
458	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
459	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
460
461	REAL, DIMENSION( ims:ime, jms:jme ) :: ZOL
462
463	REAL, DIMENSION( ims:ime, jms:jme ) :: &
464	QGH, &
465	CHS, &
466	CPM, &
467	CHS2, &
468	CQS2
469
470	REAL :: DTMIN,DTBL
471	!
472	INTEGER :: i,J,K,NK,jj,ij
473	LOGICAL :: radiation, myj, frpcpn
474	!-------------------------------------------------
475	! urban related variables are added to declaration
476	!-------------------------------------------------
477	REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB !urban
478	REAL, OPTIONAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D !urban
479	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D !urban
480	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D !urban
481	INTEGER, OPTIONAL, INTENT(IN) :: num_roof_layers !urban
482	INTEGER, OPTIONAL, INTENT(IN) :: num_wall_layers !urban
483	INTEGER, OPTIONAL, INTENT(IN) :: num_road_layers !urban
484	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZR !urban
485	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZB !urban
486	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZG !urban
487
488	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !urban
489	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !urban
490	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !urban
491	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TC_URB2D !urban
492	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: QC_URB2D !urban
493	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: UC_URB2D !urban
494	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXR_URB2D !urban
495	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXB_URB2D !urban
496	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXG_URB2D !urban
497	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXC_URB2D !urban
498	REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
499	INTENT(INOUT) :: TRL_URB3D !urban
500	REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
501	INTENT(INOUT) :: TBL_URB3D !urban
502	REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
503	INTENT(INOUT) :: TGL_URB3D !urban
504	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !urban
505	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: LH_URB2D !urban
506	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: G_URB2D !urban
507	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: RN_URB2D !urban
508	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TS_URB2D !urban
509	!
510	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !urban
511	INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !urban
512
513	REAL, DIMENSION( ims:ime, jms:jme ) :: PSIM_URB2D !urban local var
514	REAL, DIMENSION( ims:ime, jms:jme ) :: PSIH_URB2D !urban local var
515	REAL, DIMENSION( ims:ime, jms:jme ) :: GZ1OZ0_URB2D !urban local var
516	!m REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_URB2D !urban local var
517	REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_URB2D !urban local var
518	REAL, DIMENSION( ims:ime, jms:jme ) :: U10_URB2D !urban local var
519	REAL, DIMENSION( ims:ime, jms:jme ) :: V10_URB2D !urban local var
520	REAL, DIMENSION( ims:ime, jms:jme ) :: TH2_URB2D !urban local var
521	REAL, DIMENSION( ims:ime, jms:jme ) :: Q2_URB2D !urban local var
522	REAL, DIMENSION( ims:ime, jms:jme ) :: UST_URB2D !urban local var
523
524	!------------------------------------------------------------------
525	CHARACTER*256 :: message
526	REAL :: next_bl_time
527	LOGICAL :: run_param
528	LOGICAL :: do_adapt
529	!
530	!
531	!------------------------------------------------------------------
532	!
533
534	if (sf_sfclay_physics .eq. 0) return
535	! if (sf_sfclay_physics .eq. 0 .or. sf_surface_physics.eq.0) return
536
537	v_phytmp = 0.
538	u_phytmp = 0.
539	ZOL = 0.
540	QGH = 0.
541	CHS = 0.
542	CPM = 0.
543	CHS2 = 0.
544	DTMIN = 0.
545	DTBL = 0.
546
547	! RAINBL in mm (Accumulation between PBL calls)
548
549	IF ( PRESENT( rainncv ) .AND. PRESENT( rainbl ) ) THEN
550	!$OMP PARALLEL DO &
551	!$OMP PRIVATE ( ij, i, j, k )
552	DO ij = 1 , num_tiles
553	DO j=j_start(ij),j_end(ij)
554	DO i=i_start(ij),i_end(ij)
555	RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j)
556	RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
557	ENDDO
558	ENDDO
559	ENDDO
560	!$OMP END PARALLEL DO
561	ELSE IF ( PRESENT( rainbl ) ) THEN
562	!$OMP PARALLEL DO &
563	!$OMP PRIVATE ( ij, i, j, k )
564	DO ij = 1 , num_tiles
565	DO j=j_start(ij),j_end(ij)
566	DO i=i_start(ij),i_end(ij)
567	RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j)
568	RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
569	ENDDO
570	ENDDO
571	ENDDO
572	!$OMP END PARALLEL DO
573	ENDIF
574	! Update SST
575	IF (sst_update .EQ. 1) THEN
576	!$OMP PARALLEL DO &
577	!$OMP PRIVATE ( ij, i, j, k )
578	DO ij = 1 , num_tiles
579	DO j=j_start(ij),j_end(ij)
580	DO i=i_start(ij),i_end(ij)
581	IF(XLAND(i,j) .GT. 1.5 .AND. XICE(I,J) .GT. 0.5 .AND. XICEM(I,J) .LT. 0.5)THEN
582	! water point turns to sea-ice point
583	XICEM(I,J) = XICE(I,J)
584	XLAND(I,J) = 1.
585	IVGTYP(I,J) = ISICE
586	ISLTYP(I,J) = 16
587	VEGFRA(I,J) = 0.
588	TMN(I,J) = 271.4
589	DO nk = 1, num_soil_layers
590	TSLB(I,NK,J) = TSK(I,J)
591	SMOIS(I,NK,J) = 1.0
592	SH2O(I,NK,J) = 0.0
593	ENDDO
594	ENDIF
595	IF(XLAND(i,j) .GT. 1.5) THEN
596	TSK(i,j) =SST(i,j)
597	TSLB(i,1,j)=SST(i,j)
598	ENDIF
599	IF(XLAND(i,j) .LT. 1.5 .AND. XICEM(I,J) .GT. 0.5 .AND. XICE(I,J) .LT. 0.5)THEN
600	! sea-ice point turns to water point
601	XICEM(I,J) = XICE(I,J)
602	XLAND(I,J) = 2.
603	IVGTYP(I,J) = ISWATER
604	ISLTYP(I,J) = 14
605	VEGFRA(I,J) = 0.
606	TMN(I,J) = SST(I,J)
607	DO nk = 1, num_soil_layers
608	TSLB(I,NK,J) = SST(I,J)
609	SMOIS(I,NK,J) = 1.0
610	SH2O(I,NK,J) = 1.0
611	ENDDO
612	ENDIF
613	ENDDO
614	ENDDO
615	ENDDO
616	!$OMP END PARALLEL DO
617	ENDIF
618
619
620	!
621	! Modified for adaptive time step
622	!
623
624	IF ( (itimestep .EQ. 1) .OR. (MOD(itimestep,STEPBL) .EQ. 0) ) THEN
625	run_param = .TRUE.
626	ELSE
627	run_param = .FALSE.
628	ENDIF
629	IF (PRESENT(adapt_step_flag)) THEN
630	IF ((adapt_step_flag)) THEN
631	IF ( (itimestep .EQ. 1) .OR. (bldt .EQ. 0) .OR. &
632	( CURR_SECS + dt >= ( INT( CURR_SECS / ( bldt * 60 ) + 1 ) * bldt * 60) ) ) THEN
633	run_param = .TRUE.
634	ELSE
635	run_param = .FALSE.
636	ENDIF
637	ENDIF
638	ENDIF
639
640	IF ( run_param ) then
641
642	! IF (itimestep .eq. 1 .or. mod(itimestep,STEPBL) .eq. 0) THEN
643
644	radiation = .false.
645	myj = .false.
646	frpcpn = .false.
647
648	IF (ra_lw_physics .gt. 0) radiation = .true.
649
650	!----
651	! CALCULATE CONSTANT
652
653	DTMIN=DT/60.
654	! Surface schemes need PBL time step for updates and accumulations
655	! Assume these schemes provide no tendencies
656
657	if (PRESENT(adapt_step_flag)) then
658	if (adapt_step_flag) then
659	do_adapt = .TRUE.
660	else
661	do_adapt = .FALSE.
662	endif
663	else
664	do_adapt = .FALSE.
665	endif
666
667	if (PRESENT(BLDT)) then
668	if (bldt .eq. 0) then
669	DTBL = dt
670	ELSE
671	if (do_adapt) then
672	call wrf_message("WARNING: When using an adaptive time-step the boundary layer"// &
673	" time-step should be 0 (i.e., equivalent to model time-step). "// &
674	"In order to proceed, for boundary layer calculations, the "// &
675	"boundary layer time-step"// &
676	" will be rounded to the nearest minute, possibly resulting in"// &
677	" innacurate results.")
678	DTBL=bldt*60
679	else
680	DTBL=DT*STEPBL
681	endif
682	endif
683	else
684	DTBL=DT*STEPBL
685	endif
686
687	! SAVE OLD VALUES
688
689
690	!$OMP PARALLEL DO &
691	!$OMP PRIVATE ( ij, i, j, k )
692	DO ij = 1 , num_tiles
693	DO j=j_start(ij),j_end(ij)
694	DO i=i_start(ij),i_end(ij)
695	! PSFC : in Pa
696	PSFC(I,J)=p8w(I,kts,J)
697	! REVERSE ORDER IN THE VERTICAL DIRECTION
698	DO k=kts,kte
699	v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
700	u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
701	ENDDO
702	ENDDO
703	ENDDO
704	ENDDO
705	!$OMP END PARALLEL DO
706
707	!$OMP PARALLEL DO &
708	!$OMP PRIVATE ( ij, i, j, k )
709	DO ij = 1 , num_tiles
710	sfclay_select: SELECT CASE(sf_sfclay_physics)
711
712	CASE (SFCLAYSCHEME)
713	! DX varies spatially in NMM, therefore, SFCLAY cannot be called
714	! because it takes a scalar DX. NMM passes in a dummy value for this
715	! scalar. NEEDS FURTHER ATTENTION. JM 20050215
716	IF (PRESENT(qv_curr) .AND. &
717	PRESENT(mol) .AND. PRESENT(regime) .AND. &
718	.TRUE. ) THEN
719	CALL wrf_debug( 100, 'in SFCLAY' )
720	CALL SFCLAY(u_phytmp,v_phytmp,t_phy,qv_curr,&
721	p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
722	znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
723	xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
724	u10,v10,th2,t2,q2, &
725	gz1oz0,wspd,br,isfflx,dx, &
726	svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
727	P1000mb, &
728	ids,ide, jds,jde, kds,kde, &
729	ims,ime, jms,jme, kms,kme, &
730	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
731	uratx,vratx,tratx, &
732	ustm,ck,cka,cd,cda,isftcflx )
733	ELSE
734	CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
735	ENDIF
736
737
738	CASE (PXSFCSCHEME)
739	#if (NMM_CORE != 1)
740	IF (PRESENT(qv_curr) .AND. &
741	PRESENT(mol) .AND. PRESENT(regime) .AND. &
742	.TRUE. ) THEN
743	CALL wrf_debug( 100, 'in PX Surface Layer scheme' )
744	CALL PXSFCLAY(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
745	p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
746	znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
747	xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
748	u10,v10, &
749	gz1oz0,wspd,br,isfflx,dx, &
750	svp1,svp2,svp3,svpt0,ep_1,ep_2,karman, &
751	ids,ide, jds,jde, kds,kde, &
752	ims,ime, jms,jme, kms,kme, &
753	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
754	ELSE
755	CALL wrf_error_fatal('Lacking arguments for PX Surface Layer in surface driver')
756	ENDIF
757	#else
758	CALL wrf_error_fatal('PX Surface Layer scheme cannot be used with NMM')
759	#endif
760
761	CASE (MYJSFCSCHEME)
762	IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
763	.TRUE. ) THEN
764
765	myj =.true.
766
767	CALL wrf_debug(100,'in MYJSFC')
768	CALL MYJSFC(itimestep,ht,dz8w, &
769	p_phy,p8w,th_phy,t_phy, &
770	qv_curr,qc_curr, &
771	u_phy,v_phy,tke_myj, &
772	tsk,qsfc,thz0,qz0,uz0,vz0, &
773	lowlyr, &
774	xland, &
775	ust,znt,z0,pblh,mavail,rmol, &
776	akhs,akms, &
777	chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
778	u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
779	p1000mb, &
780	ids,ide, jds,jde, kds,kde, &
781	ims,ime, jms,jme, kms,kme, &
782	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
783	ELSE
784	CALL wrf_error_fatal('Lacking arguments for MYJSFC in surface driver')
785	ENDIF
786
787	CASE (GFSSFCSCHEME)
788	IF (PRESENT(qv_curr) .AND. .TRUE. ) THEN
789	CALL wrf_debug( 100, 'in GFSSFC' )
790	CALL SF_GFS(u_phytmp,v_phytmp,t_phy,qv_curr, &
791	p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
792	ZNT,UST,PSIM,PSIH, &
793	XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
794	QGH,QSFC,U10,V10, &
795	GZ1OZ0,WSPD,BR,ISFFLX, &
796	EP_1,EP_2,KARMAN,itimestep, &
797	ids,ide, jds,jde, kds,kde, &
798	ims,ime, jms,jme, kms,kme, &
799	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
800	CALL wrf_debug(100,'in SFCDIAGS')
801	ELSE
802	CALL wrf_error_fatal('Lacking arguments for SF_GFS in surface driver')
803	ENDIF
804
805	CASE DEFAULT
806
807	WRITE( message , * ) &
808	'The sfclay option does not exist: sf_sfclay_physics = ', sf_sfclay_physics
809	CALL wrf_error_fatal ( message )
810
811	END SELECT sfclay_select
812	ENDDO
813	!$OMP END PARALLEL DO
814
815	IF (ISFFLX.EQ.0 ) GOTO 430
816	!$OMP PARALLEL DO &
817	!$OMP PRIVATE ( ij, i, j, k )
818	DO ij = 1 , num_tiles
819
820	sfc_select: SELECT CASE(sf_surface_physics)
821
822	CASE (SLABSCHEME)
823
824	IF (PRESENT(qv_curr) .AND. &
825	PRESENT(capg) .AND. &
826	.TRUE. ) THEN
827	DO j=j_start(ij),j_end(ij)
828	DO i=i_start(ij),i_end(ij)
829	! CQS2 ACCOUNTS FOR MAVAIL FOR SFCDIAGS 2M Q
830	CQS2(I,J)= CQS2(I,J)*MAVAIL(I,J)
831	ENDDO
832	ENDDO
833
834	CALL wrf_debug(100,'in SLAB')
835	CALL SLAB(t_phy,qv_curr,p_phy,flhc,flqc, &
836	psfc,xland,tmn,hfx,qfx,lh,tsk,qsfc,chklowq, &
837	gsw,glw,capg,thc,snowc,emiss,mavail, &
838	dtbl,rcp,xlv,dtmin,ifsnow, &
839	svp1,svp2,svp3,svpt0,ep_2,karman,eomeg,stbolt, &
840	tslb,zs,dzs,num_soil_layers,radiation, &
841	p1000mb, &
842	ids,ide, jds,jde, kds,kde, &
843	ims,ime, jms,jme, kms,kme, &
844	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,&
845	tml,t0ml,hml,h0ml,huml,hvml,ust,u_phy,v_phy,f,g, &
846	omlcall,oml_gamma )
847
848	DO j=j_start(ij),j_end(ij)
849	DO i=i_start(ij),i_end(ij)
850	SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
851	ENDDO
852	ENDDO
853
854	CALL wrf_debug(100,'in SFCDIAGS')
855	CALL SFCDIAGS(hfx,qfx,tsk,qsfc,chs2,cqs2,t2,th2,q2, &
856	psfc,cp,r_d,rcp, &
857	ids,ide, jds,jde, kds,kde, &
858	ims,ime, jms,jme, kms,kme, &
859	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
860
861	ENDIF
862
863	#if ( NMM_CORE == 1 )
864	CASE (NMMLSMSCHEME)
865	IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
866	PRESENT(potevp) .AND. PRESENT(snopcx) .AND. &
867	PRESENT(soiltb) .AND. PRESENT(sr) .AND. &
868	.TRUE. ) THEN
869	CALL wrf_debug(100,'in NMM LSM')
870	CALL nmmlsm(dz8w,qv_curr,p8w,rho, &
871	t_phy,th_phy,tsk,chs, &
872	hfx,qfx,qgh,swdown,glw,lh,rmol, &
873	smstav,smstot,sfcrunoff, &
874	udrunoff,ivgtyp,isltyp,vegfra,sfcevp,potevp, &
875	grdflx,sfcexc,acsnow,acsnom,snopcx, &
876	albbck,tmn,xland,xice,qz0, &
877	th2,q2,snowc,cqs2,qsfc,soiltb,chklowq,rainbl, &
878	num_soil_layers,dtbl,dzs,itimestep, &
879	smois,tslb,snow,canwat,cpm,rcp,sr, & !tslb
880	albedo,snoalb,sh2o,snowh, &
881	ids,ide, jds,jde, kds,kde, &
882	ims,ime, jms,jme, kms,kme, &
883	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
884	CALL wrf_debug(100,'back from NMM LSM')
885	ELSE
886	CALL wrf_error_fatal('Lacking arguments for NMMLSM in surface driver')
887	ENDIF
888	#endif
889
890	CASE (LSMSCHEME)
891
892	IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
893	! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
894	! PRESENT(declin_urb) .AND. PRESENT(cosz_urb2d) .AND. &
895	! PRESENT(omg_urb2d) .AND. PRESENT( xlat_urb2d) .AND. &
896	! PRESENT(dzr) .AND. &
897	! PRESENT( dzb) .AND. PRESENT(dzg) .AND. &
898	! PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d) .AND. &
899	! PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND. &
900	! PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND. &
901	! PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND. &
902	! PRESENT(xxxg_urb2d) .AND. &
903	! PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND. &
904	! PRESENT(tbl_urb3d) .AND. PRESENT(tgl_urb3d) .AND. &
905	! PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d) .AND. &
906	! PRESENT(g_urb2d) .AND. PRESENT(rn_urb2d) .AND. &
907	! PRESENT(ts_urb2d) .AND. &
908	! PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d) .AND. &
909	.TRUE. ) THEN
910	!------------------------------------------------------------------
911	IF( PRESENT(sr) ) THEN
912	frpcpn=.true.
913	ENDIF
914
915	CALL wrf_debug(100,'in NOAH DRV')
916	CALL lsm(dz8w,qv_curr,p8w,t_phy,tsk, &
917	hfx,qfx,lh,grdflx,qgh,gsw,swdown,glw,smstav,smstot, &
918	sfcrunoff,udrunoff,ivgtyp,isltyp,vegfra, &
919	albedo,albbck,znt,z0, tmn,xland,xice, emiss, embck, &
920	snowc,qsfc,rainbl, &
921	num_soil_layers,dtbl,dzs,itimestep, &
922	smois,tslb,snow,canwat, &
923	chs, chs2, cqs2, cpm,rcp,SR,chklowq,qz0, &
924	!MEk June07
925	myj,frpcpn, &
926	sh2o,snowh, & !h
927	u_phy,v_phy, & !I
928	snoalb,shdmin,shdmax, & !i
929	acsnom,acsnow, & !o
930	! MEK MAY 2007
931	snopcx, & !o
932	! MEK JUL2007
933	potevp, & !o
934	ids,ide, jds,jde, kds,kde, &
935	ims,ime, jms,jme, kms,kme, &
936	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
937	ucmcall &
938	!Optional urban
939	,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d, & !H urban
940	uc_urb2d, & !H urban
941	xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d, & !H urban
942	trl_urb3d,tbl_urb3d,tgl_urb3d, & !H urban
943	sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d, & !H urban
944	psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d, & !O urban
945	GZ1OZ0_urb2d, AKMS_URB2D, & !O urban
946	th2_urb2d,q2_urb2d,ust_urb2d, & !O urban
947	declin_urb,cosz_urb2d,omg_urb2d, & !I urban
948	xlat_urb2d, & !I urban
949	num_roof_layers, num_wall_layers, & !I urban
950	num_road_layers, DZR, DZB, DZG, & !I urban
951	FRC_URB2D, UTYPE_URB2D & ! urban
952	)
953
954
955	DO j=j_start(ij),j_end(ij)
956	DO i=i_start(ij),i_end(ij)
957	! CHKLOWQ(I,J)= 1.0
958	SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
959	SFCEXC(I,J)= CHS(I,J)
960	ENDDO
961	ENDDO
962
963	CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2, &
964	PSFC,CP,R_d,RCP, &
965	ids,ide, jds,jde, kds,kde, &
966	ims,ime, jms,jme, kms,kme, &
967	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
968
969	!urban
970	IF(UCMCALL.eq.1) THEN
971	DO j=j_start(ij),j_end(ij) !urban
972	DO i=i_start(ij),i_end(ij) !urban
973	IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. & !urban
974	IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
975	! TH2(I,J) = TH2_URB2D(I,J) !urban
976	! T2(I,J) = TH2_URB2D(I,J)/(1.E5/PSFC(I,J))**RCP !urban
977	!m T2(I,J) = TH2_URB2D(I,J) !urban
978	T2(I,J) = FRC_URB2D(i,j)TH2_URB2D(I,J) + (1-FRC_URB2D(i,j))T2(I,J) !urban
979	TH2(I,J) = T2(I,J)(1.E5/PSFC(I,J))*RCP !urban
980	!m Q2(I,J) = Q2_URB2D(I,J) !urban
981	Q2(I,J) = FRC_URB2D(i,j)Q2_URB2D(I,J) +(1-FRC_URB2D(i,j)) Q2(I,J) !urban
982	U10(I,J) = U10_URB2D(I,J) !urban
983	V10(I,J) = V10_URB2D(I,J) !urban
984	PSIM(I,J) = PSIM_URB2D(I,J) !urban
985	PSIH(I,J) = PSIH_URB2D(I,J) !urban
986	GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J) !urban
987	!m AKHS(I,J) = AKHS_URB2D(I,J) !urban
988	AKHS(I,J) = CHS(I,J) !urban
989	AKMS(I,J) = AKMS_URB2D(I,J) !urban
990	END IF !urban
991	ENDDO !urban
992	ENDDO !urban
993	ENDIF
994	!------------------------------------------------------------------
995
996	ELSE
997	CALL wrf_error_fatal('Lacking arguments for LSM in surface driver')
998	ENDIF
999
1000	CASE (RUCLSMSCHEME)
1001	IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
1002	! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
1003	PRESENT(qsg) .AND. PRESENT(qvg) .AND. &
1004	PRESENT(qcg) .AND. PRESENT(soilt1) .AND. &
1005	PRESENT(tsnav) .AND. PRESENT(smfr3d) .AND. &
1006	PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND. &
1007	.TRUE. ) THEN
1008
1009	IF( PRESENT(sr) ) THEN
1010	frpcpn=.true.
1011	ELSE
1012	SR = 1.
1013	ENDIF
1014
1015	CALL wrf_debug(100,'in RUC LSM')
1016	CALL LSMRUC(dtbl,itimestep,num_soil_layers, &
1017	zs,rainbl,snow,snowh,snowc,sr,frpcpn, &
1018	dz8w,p8w,t_phy,qv_curr,qc_curr,rho, & !p8w in [pa]
1019	glw,gsw,emiss,chklowq, &
1020	chs,flqc,flhc,mavail,canwat,vegfra,albedo,znt, &
1021	snoalb, albbck, & !new
1022	qsfc,qsg,qvg,qcg,soilt1,tsnav, &
1023	tmn,ivgtyp,isltyp,xland,xice, &
1024	cp,g,xlv,stbolt, &
1025	smois,sh2o,smstav,smstot,tslb,tsk,hfx,qfx,lh, &
1026	sfcrunoff,udrunoff,sfcexc, &
1027	sfcevp,grdflx,acsnow, &
1028	smfr3d,keepfr3dflag, &
1029	myj, &
1030	ids,ide, jds,jde, kds,kde, &
1031	ims,ime, jms,jme, kms,kme, &
1032	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1033
1034	!tgs IF(.not. MYJ) then
1035
1036	CALL SFCDIAGS(HFX,QFX,TSK,QVG,CHS2,CQS2,T2,TH2,Q2, &
1037	PSFC,CP,R_d,RCP, &
1038	ids,ide, jds,jde, kds,kde, &
1039	ims,ime, jms,jme, kms,kme, &
1040	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1041	!tgs ENDIF
1042
1043
1044	ELSE
1045	CALL wrf_error_fatal('Lacking arguments for RUCLSM in surface driver')
1046	ENDIF
1047
1048	CASE (PXLSMSCHEME)
1049	IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
1050	PRESENT(emiss) .AND. PRESENT(t2) .AND. &
1051	PRESENT(qsg) .AND. PRESENT(qvg) .AND. &
1052	PRESENT(qcg) .AND. PRESENT(soilt1) .AND. &
1053	PRESENT(tsnav) .AND. PRESENT(smfr3d) .AND. &
1054	PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND. &
1055	.TRUE. ) THEN
1056	CALL wrf_debug(100,'in P-X LSM')
1057	CALL PXLSM(u_phy, v_phy, dz8w, qv_curr, t_phy, th_phy, rho, &
1058	psfc, gsw, glw, rainbl, emiss, &
1059	ITIMESTEP, num_soil_layers, DT, anal_interval, &
1060	xland, albbck, albedo, snoalb, smois, tslb, &
1061	mavail,T2, Q2, &
1062	zs, dzs, psih, &
1063	landusef,soilctop,soilcbot,vegfra, vegf_px, &
1064	isltyp,ra,rs,lai,nlcat,nscat, &
1065	hfx,qfx,lh,tsk,znt,canwat, &
1066	grdflx,shdmin,shdmax, &
1067	snowc,pblh,rmol,ust,capg,dtbl, &
1068	t2_ndg_old,t2_ndg_new,q2_ndg_old,q2_ndg_new, &
1069	sn_ndg_old, sn_ndg_new, snow, snowh,snowncv, &
1070	t2obs, q2obs, pxlsm_smois_init, pxlsm_soil_nudge, &
1071	ids,ide, jds,jde, kds,kde, &
1072	ims,ime, jms,jme, kms,kme, &
1073	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
1074
1075	DO j=j_start(ij),j_end(ij)
1076	DO i=i_start(ij),i_end(ij)
1077	CHKLOWQ(I,J)= 1.0
1078	TH2(I,J) = T2(I,J)(1.E5/PSFC(I,J))*RCP
1079	SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
1080	ENDDO
1081	ENDDO
1082
1083	ELSE
1084	CALL wrf_error_fatal('Lacking arguments for P-X LSM in surface driver')
1085	ENDIF
1086
1087	CASE DEFAULT
1088
1089	IF ( itimestep .eq. 1 ) THEN
1090	WRITE( message , * ) &
1091	'No land surface physics option is used: sf_surface_physics = ', sf_surface_physics
1092	CALL wrf_message ( message )
1093	ENDIF
1094
1095	END SELECT sfc_select
1096	ENDDO
1097	!$OMP END PARALLEL DO
1098
1099	430 CONTINUE
1100
1101
1102	! Reset RAINBL in mm (Accumulation between PBL calls)
1103
1104	IF ( PRESENT( rainbl ) ) THEN
1105	!$OMP PARALLEL DO &
1106	!$OMP PRIVATE ( ij, i, j, k )
1107	DO ij = 1 , num_tiles
1108	DO j=j_start(ij),j_end(ij)
1109	DO i=i_start(ij),i_end(ij)
1110	RAINBL(i,j) = 0.
1111	ENDDO
1112	ENDDO
1113	ENDDO
1114	!$OMP END PARALLEL DO
1115	ENDIF
1116
1117	ENDIF
1118
1119	END SUBROUTINE surface_driver
1120
1121	END MODULE module_surface_driver
1122

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

Download in other formats:

Original Format