Context Navigation

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

Rev	Line
[2759]	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