Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_surface_driver.F @ 1

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

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

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 168.5 KB

Rev	Line
[1]	1	!WRF:MEDIATION_LAYER:PHYSICS
	2	!
	3	MODULE module_surface_driver
	4	CONTAINS
	5
	6	SUBROUTINE surface_driver( &
	7	& acgrdflx,achfx,aclhf &
	8	& ,acsnom,acsnow,akhs,akms,albedo,br,canwat &
	9	& ,chklowq,dt,dx,dz8w,dzs,glw &
	10	& ,grdflx,gsw,swdown,gz1oz0,hfx,ht,ifsnow,isfflx &
	11	& ,fractional_seaice,tice2tsk_if2cold &
	12	& ,isltyp,itimestep,julian_in,ivgtyp,lowlyr,mavail,rmol &
	13	& ,num_soil_layers,p8w,pblh,pi_phy,pshltr,psih &
	14	#if (NMM_CORE==1)
	15	& ,psim,p_phy,q10,q2,qfx,taux,tauy,qsfc,qshltr,qz0 &
	16	#else
	17	& ,psim,p_phy,q10,q2,qfx,qsfc,qshltr,qz0 &
	18	#endif
	19	& ,raincv,rho,sfcevp,sfcexc,sfcrunoff &
	20	& ,smois,smstav,smstot,snoalb,snow,snowc,snowh,stepbl &
	21	& ,smcrel &
	22	& ,th10,th2,thz0,th_phy,tmn,tshltr,tsk,tslb &
	23	& ,tyr,tyra,tdly,tlag,lagday,nyear,nday,tmn_update,yr &
	24	& ,t_phy,u10,udrunoff,ust,uz0,u_frame,u_phy,v10,vegfra &
	25	& ,vz0,v_frame,v_phy,warm_rain,wspd,xice,xland,z,znt,zs &
	26	#if (NMM_CORE==1)
	27	& ,xicem,isice,iswater,ct,tke_pbl,sfenth &
	28	#else
	29	& ,xicem,isice,iswater,ct,tke_pbl &
	30	#endif
	31	& ,albbck,embck,lh,sh2o,shdmax,shdmin,z0 &
	32	& ,flqc,flhc,psfc,sst,sstsk,dtw,sst_update,sst_skin,t2,emiss &
	33	& ,sf_sfclay_physics,sf_surface_physics,ra_lw_physics &
	34	& ,landusef,soilctop,soilcbot,ra,rs,nlcat,nscat,vegf_px & ! PX-LSM
	35	& ,snowncv, anal_interval, lai, pxlsm_smois_init & ! PX-LSM
	36	& ,pxlsm_soil_nudge & ! PX-LSM
	37	#if ( EM_CORE==1)
	38	& ,ch,tsq,qsq,cov & ! MYNN
	39	#endif
	40	! Optional urban
	41	& ,slope_rad,topo_shading,shadowmask & !I solar
	42	& ,swnorm,slope,slp_azi & !I solar
	43	& ,declin,solcon,coszen,hrang,xlat_urb2d & !I solar/urban
	44	& ,num_roof_layers, num_wall_layers & !I urban
	45	& ,num_road_layers, dzr, dzb, dzg & !I urban
	46	& ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d & !H urban
	47	& ,uc_urb2d & !H urban
	48	& ,xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d & !H urban
	49	& ,trl_urb3d,tbl_urb3d,tgl_urb3d & !H urban
	50	& ,sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d & !H urban
	51	& ,frc_urb2d, utype_urb2d & !H urban
	52	& ,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif &
	53	& , ids,ide,jds,jde,kds,kde &
	54	& , ims,ime,jms,jme,kms,kme &
	55	& , i_start,i_end,j_start,j_end,kts,kte,num_tiles &
	56	! Optional moisture tracers
	57	& ,qv_curr, qc_curr, qr_curr &
	58	& ,qi_curr, qs_curr, qg_curr &
	59	! Optional moisture tracer flags
	60	& ,f_qv,f_qc,f_qr &
	61	& ,f_qi,f_qs,f_qg &
	62	! Other optionals (more or less em specific)
	63	& ,capg,hol,mol &
	64	& ,rainncv,rainshv,rainbl,regime,thc &
	65	& ,qsg,qvg,qcg,soilt1,tsnav &
	66	& ,smfr3d,keepfr3dflag,dew &
	67	! Other optionals (more or less nmm specific)
	68	& ,potevp,snopcx,soiltb,sr &
	69	! Optional observation PX LSM surface nudging
	70	& ,t2_ndg_old, q2_ndg_old, t2_ndg_new, q2_ndg_new &
	71	& ,sn_ndg_old, sn_ndg_new &
	72	& ,t2obs, q2obs &
	73	! OPTIONAL, Required by TEMF surface layer 1/7/09 WA
	74	& ,hd_temf,te_temf,fCor,exch_temf,wm_temf &
	75	! Required by ideal SCM surface layer 1/6/10 WA
	76	& ,hfx_force,lh_force,tsk_force &
	77	& ,hfx_force_tend,lh_force_tend,tsk_force_tend &
	78	! Optional observation nudging
	79	& ,uratx,vratx,tratx &
	80	! Optional simple oml model
	81	& ,omlcall,oml_hml0,oml_gamma &
	82	& ,tml,t0ml,hml,h0ml,huml,hvml,f,tmoml &
	83	& ,ustm,ck,cka,cd,cda,isftcflx,iz0tlnd &
	84	& ,isurban, mminlu &
	85	& ,snotime &
	86	& ,rdlai2d &
	87	& ,usemonalb &
	88	& ,noahres &
	89	! Optional adaptive time step
	90	& ,bldt,curr_secs,adapt_step_flag &
	91	! Optional urban with BEP
	92	& ,sf_urban_physics,gmt,xlat,xlong,julday &
	93	& ,num_urban_layers & !multi-layer urban
	94	& ,trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d & !multi-layer urban
	95	& ,tlev_urb3d,qlev_urb3d & !multi-layer urban
	96	& ,tw1lev_urb3d,tw2lev_urb3d & !multi-layer urban
	97	& ,tglev_urb3d,tflev_urb3d & !multi-layer urban
	98	& ,sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d & !multi-layer urban
	99	& ,sfvent_urb3d,lfvent_urb3d & !multi-layer urban
	100	& ,sfwin1_urb3d,sfwin2_urb3d & !multi-layer urban
	101	& ,sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d & !multi-layer urban
	102	& ,a_u_bep,a_v_bep,a_t_bep,a_q_bep &
	103	& ,b_u_bep,b_v_bep,b_t_bep,b_q_bep &
	104	& ,sf_bep,vl_bep &
	105	& ,a_e_bep,b_e_bep,dlg_bep &
	106	& ,dl_u_bep &
	107	! Optional urban Bep end
	108	& )
	109
	110	#if ( ! NMM_CORE == 1 )
	111	USE module_state_description, ONLY : SFCLAYSCHEME &
	112	,MYJSFCSCHEME &
	113	,QNSESFCSCHEME &
	114	,GFSSFCSCHEME &
	115	,PXSFCSCHEME &
	116	,TEMFSFCSCHEME &
	117	,IDEALSCMSFCSCHEME &
	118	,SLABSCHEME &
	119	,LSMSCHEME &
	120	,RUCLSMSCHEME &
	121	,PXLSMSCHEME &
	122	,MYNNSFCSCHEME
	123	#else
	124	USE module_state_description, ONLY : SFCLAYSCHEME &
	125	,MYJSFCSCHEME &
	126	,QNSESFCSCHEME &
	127	,GFSSFCSCHEME &
	128	,PXSFCSCHEME &
	129	,SLABSCHEME &
	130	,LSMSCHEME &
	131	,RUCLSMSCHEME &
	132	,PXLSMSCHEME &
	133	,TEMFSFCSCHEME &
	134	,GFDLSFCSCHEME &
	135	,GFDLSLAB
	136
	137
	138	#endif
	139	USE module_model_constants
	140	! *** add new modules of schemes here
	141
	142	USE module_sf_sfclay
	143	USE module_sf_myjsfc
	144	USE module_sf_qnsesfc
	145	USE module_sf_gfs
	146	USE module_sf_noahdrv
	147	USE module_sf_ruclsm
	148	USE module_sf_pxsfclay
	149	USE module_sf_pxlsm
	150	USE module_sf_temfsfclay
	151	USE module_sf_idealscmsfclay
	152	#if ( EM_CORE==1)
	153	USE module_sf_mynn
	154	USE module_sf_oml
	155	#endif
	156
	157	#if ( NMM_CORE == 1 )
	158	USE module_sf_gfdl
	159	#endif
	160
	161	USE module_sf_slab
	162	!
	163	USE module_sf_sfcdiags
	164	USE module_sf_sfcdiags_ruclsm
	165	USE module_sf_sstskin
	166	USE module_sf_tmnupdate
	167	!
	168	! This driver calls subroutines for the surface parameterizations.
	169	!
	170	! surface layer: (between surface and pbl)
	171	! 1. sfclay
	172	! 2. myjsfc
	173	! 7. Pleim surface layer
	174	! 5. MYNN surface layer
	175	! surface: ground temp/lsm scheme:
	176	! 1. slab
	177	! 2. Noah LSM
	178	! 7. Pleim-Xiu LSM
	179	!
	180	! surface: ground temp/lsm scheme for urban:
	181	! 2. BEP
	182	!
	183	! ocean mixed layer model
	184	! omlcall = 1
	185	!------------------------------------------------------------------
	186	IMPLICIT NONE
	187	!======================================================================
	188	! Grid structure in physics part of WRF
	189	!----------------------------------------------------------------------
	190	! The horizontal velocities used in the physics are unstaggered
	191	! relative to temperature/moisture variables. All predicted
	192	! variables are carried at half levels except w, which is at full
	193	! levels. Some arrays with names (*8w) are at w (full) levels.
	194	!
	195	!----------------------------------------------------------------------
	196	! In WRF, kms (smallest number) is the bottom level and kme (largest
	197	! number) is the top level. In your scheme, if 1 is at the top level,
	198	! then you have to reverse the order in the k direction.
	199	!
	200	! kme - half level (no data at this level)
	201	! kme ----- full level
	202	! kme-1 - half level
	203	! kme-1 ----- full level
	204	! .
	205	! kms+2 - half level
	206	! kms+2 ----- full level
	207	! kms+1 - half level
	208	! kms+1 ----- full level
	209	! kms - half level
	210	! kms ----- full level
	211	!
	212	!======================================================================
	213	! Definitions
	214	!-----------
	215	! Theta potential temperature (K)
	216	! Qv water vapor mixing ratio (kg/kg)
	217	! Qc cloud water mixing ratio (kg/kg)
	218	! Qr rain water mixing ratio (kg/kg)
	219	! Qi cloud ice mixing ratio (kg/kg)
	220	! Qs snow mixing ratio (kg/kg)
	221	!-----------------------------------------------------------------
	222	!-- itimestep number of time steps
	223	!-- GLW downward long wave flux at ground surface (W/m^2)
	224	!-- GSW net short wave flux at ground surface (W/m^2)
	225	!-- SWDOWN downward short wave flux at ground surface (W/m^2)
	226	!-- EMISS surface emissivity (between 0 and 1)
	227	!-- TSK surface temperature (K)
	228	!-- TMN soil temperature at lower boundary (K)
	229	!-- TYR annual mean surface temperature of previous year (K)
	230	!-- TYRA accumulated surface temperature in the current year (K)
	231	!-- TLAG mean surface temperature of previous 140 days (K)
	232	!-- TDLY accumulated daily mean surface temperature of the current day (K)
	233	!-- XLAND land mask (1 for land, 2 for water)
	234	!-- ZNT time-varying roughness length (m)
	235	!-- Z0 background roughness length (m)
	236	!-- MAVAIL surface moisture availability (between 0 and 1)
	237	!-- UST u* in similarity theory (m/s)
	238	!-- MOL T* (similarity theory) (K)
	239	!-- HOL PBL height over Monin-Obukhov length
	240	!-- PBLH PBL height (m)
	241	!-- CAPG heat capacity for soil (J/K/m^3)
	242	!-- THC thermal inertia (Cal/cm/K/s^0.5)
	243	!-- SNOWC flag indicating snow coverage (1 for snow cover)
	244	!-- HFX net upward heat flux at the surface (W/m^2)
	245	!-- QFX net upward moisture flux at the surface (kg/m^2/s)
	246	!-- TAUX RHOU*2 for ocean coupling
	247	!-- TAUY RHOU*2 for ocean coupling
	248	!-- LH net upward latent heat flux at surface (W/m^2)
	249	!-- REGIME flag indicating PBL regime (stable, unstable, etc.)
	250	!-- tke_pbl turbulence kinetic energy from PBL schemes (m^2/s^2)
	251	!-- akhs sfc exchange coefficient of heat/moisture from MYJ
	252	!-- akms sfc exchange coefficient of momentum from MYJ
	253	!-- thz0 potential temperature at roughness length (K)
	254	!-- uz0 u wind component at roughness length (m/s)
	255	!-- vz0 v wind component at roughness length (m/s)
	256	!-- qsfc specific humidity at lower boundary (kg/kg)
	257	!-- uratx ratio of u over u10 (Added for obs-nudging)
	258	!-- vratx ratio of v over v10 (Added for obs-nudging)
	259	!-- tratx ratio of t over th2 (Added for obs-nudging)
	260	!-- u10 diagnostic 10-m u component from surface layer
	261	!-- v10 diagnostic 10-m v component from surface layer
	262	!-- th2 diagnostic 2-m theta from surface layer and lsm
	263	!-- t2 diagnostic 2-m temperature from surface layer and lsm
	264	!-- q2 diagnostic 2-m mixing ratio from surface layer and lsm
	265	!-- tshltr diagnostic 2-m theta from MYJ
	266	!-- th10 diagnostic 10-m theta from MYJ
	267	!-- qshltr diagnostic 2-m specific humidity from MYJ
	268	!-- q10 diagnostic 10-m specific humidity from MYJ
	269	!-- lowlyr index of lowest model layer above ground
	270	!-- rr dry air density (kg/m^3)
	271	!-- u_phy u-velocity interpolated to theta points (m/s)
	272	!-- v_phy v-velocity interpolated to theta points (m/s)
	273	!-- th_phy potential temperature (K)
	274	!-- moist moisture array (4D - last index is species) (kg/kg)
	275	!-- p_phy pressure (Pa)
	276	!-- pi_phy exner function (dimensionless)
	277	!-- pshltr diagnostic shelter (2m) pressure from MYJ (Pa)
	278	!-- p8w pressure at full levels (Pa)
	279	!-- t_phy temperature (K)
	280	!-- dz8w dz between full levels (m)
	281	!-- z height above sea level (m)
	282	!-- DX horizontal space interval (m)
	283	!-- DT time step (second)
	284	!-- PSFC pressure at the surface (Pa)
	285	!-- SST sea-surface temperature (K)
	286	!-- SSTSK skin sea-surface temperature (K)
	287	!-- DTW warm layer temp diff (K)
	288	!-- TSLB
	289	!-- ZS
	290	!-- DZS
	291	!-- num_soil_layers number of soil layer
	292	!-- IFSNOW ifsnow=1 for snow-cover effects
	293	!-- omlcall whether to call simple ocean mixed layer model from slab (1 = use oml)
	294	!-- oml_hml0 initial mixed layer depth (if real-data not available, default 50 m)
	295	!-- oml_gamma lapse rate below mixed layer in ocean (default 0.14 K m-1)
	296	!-- ck enthalpy exchange coeff at 10 meters
	297	!-- cd momentum exchange coeff at 10 meters
	298	!-- cka enthalpy exchange coeff at the lowest model level
	299	!-- cda momentum exchange coeff at the lowest model level
	300	!!!!!!!!!!!!!!
	301	!
	302	!
	303	!-- LANDUSEF Landuse fraction ! P-X LSM
	304	!-- SOILCTOP Top soil fraction ! P-X LSM
	305	!-- SOILCBOT Bottom soil fraction ! P-X LSM
	306	!-- RA Aerodynamic resistence ! P-X LSM
	307	!-- RS Stomatal resistence ! P-X LSM
	308	!-- NLCAT Number of landuse categories ! P-X LSM
	309	!-- NSCAT Number of soil categories ! P-X LSM
	310	!-- ch - drag coefficient for heat/moisture ! MYNN LSM
	311
	312	!
	313	!-- ids start index for i in domain
	314	!-- ide end index for i in domain
	315	!-- jds start index for j in domain
	316	!-- jde end index for j in domain
	317	!-- kds start index for k in domain
	318	!-- kde end index for k in domain
	319	!-- ims start index for i in memory
	320	!-- ime end index for i in memory
	321	!-- jms start index for j in memory
	322	!-- jme end index for j in memory
	323	!-- kms start index for k in memory
	324	!-- kme end index for k in memory
	325	!-- its start index for i in tile
	326	!-- ite end index for i in tile
	327	!-- jts start index for j in tile
	328	!-- jte end index for j in tile
	329	!-- kts start index for k in tile
	330	!-- kte end index for k in tile
	331	!
	332	!******************************************************************
	333	!------------------------------------------------------------------
	334
	335	INTEGER, INTENT(IN) :: &
	336	& ids,ide,jds,jde,kds,kde &
	337	& ,ims,ime,jms,jme,kms,kme &
	338	& ,kts,kte,num_tiles
	339
	340	INTEGER, INTENT(IN):: FRACTIONAL_SEAICE
	341
	342	INTEGER, INTENT(IN):: NLCAT
	343	INTEGER, INTENT(IN):: NSCAT
	344
	345	INTEGER, INTENT(IN) :: sf_sfclay_physics, sf_surface_physics, &
	346	sf_urban_physics,ra_lw_physics, sst_update
	347	INTEGER, INTENT(IN),OPTIONAL :: sst_skin, tmn_update
	348
	349	INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
	350	& i_start,i_end,j_start,j_end
	351
	352	INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: ISLTYP
	353	INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: IVGTYP
	354	INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: LOWLYR
	355	INTEGER, INTENT(IN ):: IFSNOW
	356	INTEGER, INTENT(IN ):: ISFFLX
	357	INTEGER, INTENT(IN ):: ITIMESTEP
	358	INTEGER, INTENT(IN ):: NUM_SOIL_LAYERS
	359	REAL, INTENT(IN ),OPTIONAL :: JULIAN_in
	360	INTEGER, INTENT(IN ):: LAGDAY
	361	INTEGER, INTENT(IN ):: STEPBL
	362	INTEGER, INTENT(IN ):: ISICE
	363	INTEGER, INTENT(IN ):: ISWATER
	364	INTEGER, INTENT(IN ), OPTIONAL :: ISURBAN
	365	CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: MMINLU
	366	LOGICAL, INTENT(IN ):: WARM_RAIN
	367	LOGICAL, INTENT(IN):: tice2tsk_if2cold
	368	INTEGER, INTENT(INOUT ),OPTIONAL :: NYEAR
	369	REAL , INTENT(INOUT ),OPTIONAL :: NDAY
	370	INTEGER, INTENT(IN ),OPTIONAL :: YR
	371	REAL , INTENT(IN ):: U_FRAME
	372	REAL , INTENT(IN ):: V_FRAME
	373	#if (NMM_CORE==1)
	374	real , intent(IN ):: SFENTH
	375	#endif
	376	REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SMOIS
	377	REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: TSLB
	378	REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(OUT) :: SMCREL
	379	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: GLW
	380	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: GSW,SWDOWN
	381	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: HT
	382	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: RAINCV
	383	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: SST
	384	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: SSTSK
	385	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: DTW
	386	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: TMN
	387	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: TYR
	388	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: TYRA
	389	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: TDLY
	390	REAL, DIMENSION( ims:ime , 1:lagday , jms:jme ), INTENT(INOUT ),OPTIONAL :: TLAG
	391	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: VEGFRA
	392	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: XICE
	393	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XLAND
	394	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XICEM
	395	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MAVAIL
	396	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: SNOALB
	397	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ACSNOW
	398	REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SNOTIME
	399	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKHS
	400	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKMS
	401	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ALBEDO
	402	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: CANWAT
	403
	404	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: GRDFLX
	405	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: HFX
	406	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: RMOL
	407	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: PBLH
	408	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: Q2
	409	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QFX
	410	#if (NMM_CORE==1)
	411	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT):: TAUX
	412	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT):: TAUY
	413	#endif
	414	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QSFC
	415	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QZ0
	416	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SFCRUNOFF
	417	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTAV
	418	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTOT
	419	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOW
	420	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWC
	421	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWH
	422	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TH2
	423	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: THZ0
	424	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TSK
	425	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UDRUNOFF
	426	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UST
	427	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UZ0
	428	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: VZ0
	429	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: WSPD
	430	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ZNT
	431	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: BR
	432	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: CHKLOWQ
	433	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: GZ1OZ0
	434	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSHLTR
	435	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIH
	436	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIM
	437	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: Q10
	438	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: QSHLTR
	439	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TH10
	440	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TSHLTR
	441	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: U10
	442	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: V10
	443	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSFC
	444	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: ACSNOM
	445	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEVP
	446	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL :: ACHFX
	447	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL :: ACLHF
	448	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL :: ACGRDFLX
	449	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEXC
	450	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLHC
	451	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLQC
	452	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CT
	453	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: DZ8W
	454	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P8W
	455	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: PI_PHY
	456	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P_PHY
	457	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: RHO
	458	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: TH_PHY
	459	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: T_PHY
	460	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: U_PHY
	461	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: V_PHY
	462	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: Z
	463
	464	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: TKE_PBL
	465	REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: DZS
	466	REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: ZS
	467	REAL, INTENT(IN ):: DT
	468	REAL, INTENT(IN ):: DX
	469	REAL, INTENT(IN ),OPTIONAL :: bldt
	470	REAL, INTENT(IN ),OPTIONAL :: curr_secs
	471	LOGICAL, INTENT(IN ),OPTIONAL :: adapt_step_flag
	472
	473	! arguments for NCAR surface physics
	474
	475	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: ALBBCK ! INOUT needed for NMM
	476	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: EMBCK
	477	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: LH
	478	REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SH2O
	479	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMAX
	480	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMIN
	481	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: Z0
	482
	483	! Variables for multi-layer UCM
	484	REAL, OPTIONAL, INTENT(IN ) :: GMT
	485	INTEGER, OPTIONAL, INTENT(IN ) :: JULDAY
	486	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) ::XLAT, XLONG
	487	INTEGER, INTENT(IN ):: NUM_URBAN_LAYERS
	488	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: trb_urb4d
	489	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1_urb4d
	490	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2_urb4d
	491	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tgb_urb4d
	492	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tlev_urb3d
	493	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: qlev_urb3d
	494	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1lev_urb3d
	495	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2lev_urb3d
	496	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tglev_urb3d
	497	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tflev_urb3d
	498	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d
	499	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d
	500	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d
	501	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d
	502	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d
	503	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin1_urb3d
	504	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin2_urb3d
	505	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw1_urb3d
	506	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw2_urb3d
	507	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfr_urb3d
	508	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfg_urb3d
	509	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_u_bep !Implicit momemtum component X-direction
	510	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_v_bep !Implicit momemtum component Y-direction
	511	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_t_bep !Implicit component pot. temperature
	512	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_e_bep !Implicit component TKE
	513	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_q_bep !Implicit component TKE
	514	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_u_bep !Explicit momentum component X-direction
	515	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_v_bep !Explicit momentum component Y-direction
	516	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_t_bep !Explicit component pot. temperature
	517	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_e_bep !Explicit component TKE
	518	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_q_bep !Explicit component TKE
	519	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::vl_bep !Fraction air volume in grid cell
	520	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dlg_bep !Height above ground
	521	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::sf_bep !Fraction air at the face of grid cell
	522	REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dl_u_bep !Length scale
	523
	524	! Optional
	525	!
	526	! arguments for Ocean Mixed Layer Model
	527	REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT ):: TML, T0ML, HML, H0ML, HUML, HVML
	528	REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(IN ):: F, TMOML
	529	REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(OUT ):: CK, CKA, CD, CDA, USTM
	530
	531	#if ( EM_CORE==1)
	532	REAL, DIMENSION( ims:ime , jms:jme ), &
	533	&OPTIONAL, INTENT(INOUT ):: ch
	534
	535	REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), &
	536	&OPTIONAL, INTENT(IN ):: tsq,qsq,cov
	537	#endif
	538
	539
	540	INTEGER, OPTIONAL, INTENT(IN ):: slope_rad, topo_shading
	541	INTEGER, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN):: shadowmask
	542	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: swnorm
	543	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN):: slope,slp_azi
	544
	545	INTEGER, OPTIONAL, INTENT(IN ):: ISFTCFLX,IZ0TLND
	546	INTEGER, OPTIONAL, INTENT(IN ):: OMLCALL
	547	REAL , OPTIONAL, INTENT(IN ):: OML_HML0
	548	REAL , OPTIONAL, INTENT(IN ):: OML_GAMMA
	549	!
	550	! Observation nudging
	551	!
	552	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: uratx !Added for obs-nudging
	553	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: vratx !Added for obs-nudging
	554	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: tratx !Added for obs-nudging
	555	!
	556	! PX LSM Surface Grid Analysis nudging
	557	!
	558	INTEGER, OPTIONAL, INTENT(IN) :: pxlsm_smois_init, pxlsm_soil_nudge, ANAL_INTERVAL
	559	REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , OPTIONAL, INTENT(INOUT):: LANDUSEF
	560	REAL, DIMENSION( ims:ime, NSCAT, jms:jme ) , OPTIONAL, INTENT(INOUT):: SOILCTOP, SOILCBOT
	561	REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT):: VEGF_PX
	562	REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: RA
	563	REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: RS
	564	REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: LAI
	565	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: T2OBS
	566	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: Q2OBS
	567
	568	REAL, DIMENSION( ims:ime, jms:jme ), &
	569	OPTIONAL, INTENT(INOUT) :: t2_ndg_old, &
	570	q2_ndg_old, &
	571	t2_ndg_new, &
	572	q2_ndg_new, &
	573	sn_ndg_old, &
	574	sn_ndg_new
	575	!
	576	!
	577	! Flags relating to the optional tendency arrays declared above
	578	! Models that carry the optional tendencies will provdide the
	579	! optional arguments at compile time; these flags all the model
	580	! to determine at run-time whether a particular tracer is in
	581	! use or not.
	582	!
	583	LOGICAL, INTENT(IN), OPTIONAL :: &
	584	f_qv &
	585	,f_qc &
	586	,f_qr &
	587	,f_qi &
	588	,f_qs &
	589	,f_qg
	590
	591	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
	592	OPTIONAL, INTENT(INOUT) :: &
	593	! optional moisture tracers
	594	! 2 time levels; if only one then use CURR
	595	qv_curr, qc_curr, qr_curr &
	596	,qi_curr, qs_curr, qg_curr
	597	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN) :: snowncv
	598	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: capg
	599	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: emiss
	600	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: hol
	601	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: mol
	602	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: regime
	603	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: rainncv
	604	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: rainshv
	605	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: RAINBL
	606	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: t2
	607	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: thc
	608	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qsg
	609	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qvg
	610	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qcg
	611	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: dew
	612	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soilt1
	613	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: tsnav
	614	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: potevp ! NMM LSM
	615	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: snopcx ! NMM LSM
	616	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soiltb ! NMM LSM
	617	REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: sr ! NMM and RUC LSM
	618	REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: smfr3d
	619	REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: keepfr3dflag
	620
	621	REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT), OPTIONAL :: NOAHRES
	622
	623	! Variables for TEMF surface layer
	624	REAL,OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: te_temf
	625	REAL,OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: hd_temf, exch_temf, wm_temf
	626	REAL,OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: fCor
	627
	628	! Variables for ideal SCM surface layer
	629	REAL,OPTIONAL, INTENT(INOUT) :: hfx_force,lh_force,tsk_force
	630	REAL,OPTIONAL, INTENT(IN ) :: hfx_force_tend,lh_force_tend,tsk_force_tend
	631
	632	! LOCAL VAR
	633
	634	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
	635	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
	636
	637	REAL, DIMENSION( ims:ime, jms:jme ) :: ZOL
	638
	639	REAL, DIMENSION( ims:ime, jms:jme ) :: &
	640	QGH, &
	641	CHS, &
	642	CPM, &
	643	CHS2, &
	644	CQS2
	645
	646	REAL :: DTMIN,DTBL
	647	!
	648	INTEGER :: i,J,K,NK,jj,ij
	649	INTEGER :: gfdl_ntsflg
	650	LOGICAL :: radiation, myj, frpcpn, isisfc
	651	LOGICAL, INTENT(in), OPTIONAL :: rdlai2d
	652	LOGICAL, INTENT(in), OPTIONAL :: usemonalb
	653	REAL :: julian
	654	REAL :: total_depth,mid_point_depth
	655	REAL :: tconst,tprior,tnew,yrday,deltat
	656	REAL :: SWSAVE
	657	REAL, DIMENSION( ims:ime, jms:jme ) :: GSWSAVE
	658	!-------------------------------------------------
	659	! urban related variables are added to declaration
	660	!-------------------------------------------------
	661	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF
	662	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF
	663	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF
	664	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF
	665	REAL, OPTIONAL, INTENT(IN) :: DECLIN, SOLCON
	666	REAL, OPTIONAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZEN
	667	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: HRANG
	668	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D !urban
	669	INTEGER, INTENT(IN) :: num_roof_layers !urban
	670	INTEGER, INTENT(IN) :: num_wall_layers !urban
	671	INTEGER, INTENT(IN) :: num_road_layers !urban
	672	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZR !urban
	673	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZB !urban
	674	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZG !urban
	675
	676	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !urban
	677	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !urban
	678	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !urban
	679	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TC_URB2D !urban
	680	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: QC_URB2D !urban
	681	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: UC_URB2D !urban
	682	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXR_URB2D !urban
	683	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXB_URB2D !urban
	684	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXG_URB2D !urban
	685	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXC_URB2D !urban
	686	REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
	687	INTENT(INOUT) :: TRL_URB3D !urban
	688	REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
	689	INTENT(INOUT) :: TBL_URB3D !urban
	690	REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
	691	INTENT(INOUT) :: TGL_URB3D !urban
	692	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !urban
	693	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: LH_URB2D !urban
	694	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: G_URB2D !urban
	695	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: RN_URB2D !urban
	696	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TS_URB2D !urban
	697	!
	698	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !urban
	699	INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !urban
	700
	701	REAL, DIMENSION( ims:ime, jms:jme ) :: PSIM_URB2D !urban local var
	702	REAL, DIMENSION( ims:ime, jms:jme ) :: PSIH_URB2D !urban local var
	703	REAL, DIMENSION( ims:ime, jms:jme ) :: GZ1OZ0_URB2D !urban local var
	704	!m REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_URB2D !urban local var
	705	REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_URB2D !urban local var
	706	REAL, DIMENSION( ims:ime, jms:jme ) :: U10_URB2D !urban local var
	707	REAL, DIMENSION( ims:ime, jms:jme ) :: V10_URB2D !urban local var
	708	REAL, DIMENSION( ims:ime, jms:jme ) :: TH2_URB2D !urban local var
	709	REAL, DIMENSION( ims:ime, jms:jme ) :: Q2_URB2D !urban local var
	710	REAL, DIMENSION( ims:ime, jms:jme ) :: UST_URB2D !urban local var
	711
	712	!
	713	REAL, DIMENSION( ims:ime, jms:jme ) :: HFX_SEA
	714	REAL, DIMENSION( ims:ime, jms:jme ) :: QFX_SEA
	715	REAL, DIMENSION( ims:ime, jms:jme ) :: LH_SEA
	716	REAL, DIMENSION( ims:ime, jms:jme ) :: QSFC_SEA
	717	REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_SEA
	718	REAL, DIMENSION( ims:ime, jms:jme ) :: ZNT_SEA
	719
	720	REAL, DIMENSION( ims:ime, jms:jme ) :: CHS_SEA
	721	REAL, DIMENSION( ims:ime, jms:jme ) :: CHS2_SEA
	722	REAL, DIMENSION( ims:ime, jms:jme ) :: CQS2_SEA
	723	REAL, DIMENSION( ims:ime, jms:jme ) :: CPM_SEA
	724	REAL, DIMENSION( ims:ime, jms:jme ) :: FLHC_SEA
	725	REAL, DIMENSION( ims:ime, jms:jme ) :: FLQC_SEA
	726	REAL, DIMENSION( ims:ime, jms:jme ) :: QGH_SEA
	727	!
	728	REAL, DIMENSION( ims:ime, jms:jme ) :: PSIH_SEA
	729	REAL, DIMENSION( ims:ime, jms:jme ) :: PBLH_SEA
	730	REAL, DIMENSION( ims:ime, jms:jme ) :: RMOL_SEA
	731	REAL, DIMENSION( ims:ime, jms:jme ) :: UST_SEA
	732	REAL, DIMENSION( ims:ime, jms:jme ) :: QZ0_SEA
	733	REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL
	734	!
	735	REAL :: xice_threshold
	736	!
	737
	738
	739	!------------------------------------------------------------------
	740	CHARACTER*256 :: message
	741	REAL :: next_bl_time
	742	LOGICAL :: run_param
	743	LOGICAL :: do_adapt
	744	!
	745	!
	746	!------------------------------------------------------------------
	747	!
	748
	749
	750	if (sf_sfclay_physics .eq. 0) return
	751	! if (sf_sfclay_physics .eq. 0 .or. sf_surface_physics.eq.0) return
	752
	753	if ( fractional_seaice == 0 ) then
	754	xice_threshold = 0.5
	755	else if ( fractional_seaice == 1 ) then
	756	xice_threshold = 0.02
	757	endif
	758
	759
	760	v_phytmp = 0.
	761	u_phytmp = 0.
	762	ZOL = 0.
	763	QGH = 0.
	764	CHS = 0.
	765	CPM = 0.
	766	CHS2 = 0.
	767	DTMIN = 0.
	768	DTBL = 0.
	769
	770	! RAINBL in mm (Accumulation between PBL calls)
	771
	772	IF ( PRESENT( rainncv ) .AND. PRESENT( rainbl ) ) THEN
	773	!$OMP PARALLEL DO &
	774	!$OMP PRIVATE ( ij, i, j, k )
	775	DO ij = 1 , num_tiles
	776	DO j=j_start(ij),j_end(ij)
	777	DO i=i_start(ij),i_end(ij)
	778	RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j)
	779	IF ( PRESENT( rainshv ))RAINBL(i,j) = RAINBL(i,j) + RAINSHV(i,j)
	780	RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
	781	ENDDO
	782	ENDDO
	783	ENDDO
	784	!$OMP END PARALLEL DO
	785	ELSE IF ( PRESENT( rainbl ) ) THEN
	786	!$OMP PARALLEL DO &
	787	!$OMP PRIVATE ( ij, i, j, k )
	788	DO ij = 1 , num_tiles
	789	DO j=j_start(ij),j_end(ij)
	790	DO i=i_start(ij),i_end(ij)
	791	RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j)
	792	IF ( PRESENT( rainshv ))RAINBL(i,j) = RAINBL(i,j) + RAINSHV(i,j)
	793	RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
	794	ENDDO
	795	ENDDO
	796	ENDDO
	797	!$OMP END PARALLEL DO
	798	ENDIF
	799	! Update SST
	800	IF (sst_update .EQ. 1) THEN
	801	!$OMP PARALLEL DO &
	802	!$OMP PRIVATE ( ij, i, j, k )
	803	DO ij = 1 , num_tiles
	804	DO j=j_start(ij),j_end(ij)
	805	DO i=i_start(ij),i_end(ij)
	806
	807	IF ( FRACTIONAL_SEAICE == 1 ) then
	808	IF ( ( XICE(I,J) .NE. XICEM(I,J) ) .AND. ( XICEM(I,J) .GT. XICE_THRESHOLD ) ) THEN
	809	! Fractional values of ALBEDO and EMISSIVITY are valid according to the
	810	! earlier fractional seaice value, XICEM. Recompute them for the new
	811	! seaice value XICE.
	812	ALBEDO(I,J) = 0.08 + XICE(I,J)/XICEM(I,J) * ( ALBEDO(I,J) - 0.08 )
	813	EMISS (I,J) = 0.98 + XICE(I,J)/XICEM(I,J) * ( EMISS (I,J) - 0.98 )
	814	ENDIF
	815	ENDIF
	816
	817	IF ( XLAND(i,j) .GT. 1.5 .AND. XICE(I,J) .GE. XICE_THRESHOLD .AND. XICEM(I,J) .LT. XICE_THRESHOLD ) THEN
	818	! water point turns to sea-ice point
	819	XICEM(I,J) = XICE(I,J)
	820	XLAND(I,J) = 1.
	821	IVGTYP(I,J) = ISICE
	822	ISLTYP(I,J) = 16
	823	VEGFRA(I,J) = 0.
	824	TMN(I,J) = 271.4
	825	! Over new ice, initial guesses of ALBEDO and EMISS are
	826	! based on default water and ice values for albedo and
	827	! emissivity. The land-surface schemes can update these
	828	! values
	829	ALBEDO(I,J) = 0.80 * XICE(I,J) + 0.08 * ( 1.0-XICE(I,J) )
	830	ALBBCK(I,J) = 0.80
	831	EMISS(I,J) = 0.98 * XICE(I,J) + 0.98 * ( 1.0-XICE(I,J) )
	832	EMBCK(I,J) = 0.98
	833	DO nk = 1, num_soil_layers
	834	TSLB(I,NK,J) = TSK(I,J)
	835	SMOIS(I,NK,J) = 1.0
	836	SH2O(I,NK,J) = 0.0
	837	ENDDO
	838	ENDIF
	839	IF(XLAND(i,j) .GT. 1.5) THEN
	840	TSK(i,j) =SST(i,j)
	841	TSLB(i,1,j)=SST(i,j)
	842	ENDIF
	843	IF ( XLAND(i,j) .LT. 1.5 .AND. XICEM(I,J) .GE. XICE_THRESHOLD .AND. XICE(I,J) .LT. XICE_THRESHOLD ) THEN
	844	! sea-ice point turns to water point
	845	XICEM(I,J) = XICE(I,J)
	846	XLAND(I,J) = 2.
	847	IVGTYP(I,J) = ISWATER
	848	ISLTYP(I,J) = 14
	849	VEGFRA(I,J) = 0.
	850	SNOW(I,J) = 0.
	851	SNOWC(I,J) = 0.
	852	SNOWH(I,J) = 0.
	853	TMN(I,J) = SST(I,J)
	854	ALBEDO(I,J) = 0.08
	855	ALBBCK(I,J) = 0.08
	856	EMISS(I,J) = 0.98
	857	EMBCK(I,J) = 0.98
	858	DO nk = 1, num_soil_layers
	859	TSLB(I,NK,J) = SST(I,J)
	860	SMOIS(I,NK,J) = 1.0
	861	SH2O(I,NK,J) = 1.0
	862	ENDDO
	863	ENDIF
	864
	865	XICEM(i,j) = XICE(i,j)
	866
	867	ENDDO
	868	ENDDO
	869	ENDDO
	870	!$OMP END PARALLEL DO
	871	ENDIF
	872
	873	IF(PRESENT(SST_SKIN))THEN
	874	IF (sst_skin .EQ. 1) THEN
	875	! Calculate skin sst based on Zeng and Beljaars (2005)
	876	CALL wrf_debug( 100, 'in SST_SKIN_UPDATE' )
	877	!$OMP PARALLEL DO &
	878	!$OMP PRIVATE ( ij, i, j, k )
	879	DO ij = 1 , num_tiles
	880	CALL sst_skin_update(xland,glw,gsw,hfx,qfx,tsk,ust, &
	881	emiss,dtw,sstsk,dt,stbolt, &
	882	ids, ide, jds, jde, kds, kde, &
	883	ims, ime, jms, jme, kms, kme, &
	884	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	885	DO j=j_start(ij),j_end(ij)
	886	DO i=i_start(ij),i_end(ij)
	887	IF(XLAND(i,j) .GT. 1.5)TSK(i,j)=SSTSK(i,j)
	888	ENDDO
	889	ENDDO
	890	ENDDO
	891	!$OMP END PARALLEL DO
	892	ENDIF
	893	ENDIF
	894
	895	IF(PRESENT(TMN_UPDATE))THEN
	896	IF (tmn_update .EQ. 1) THEN
	897	CALL wrf_debug( 100, 'in TMN_UPDATE' )
	898	CALL tmnupdate(tsk,tmn,tlag,tyr,tyra,tdly,nday,nyear,lagday, &
	899	julian_in, dt, yr, &
	900	ids, ide, jds, jde, kds, kde, &
	901	ims, ime, jms, jme, kms, kme, &
	902	i_start,i_end, j_start,j_end, kts,kte, num_tiles )
	903
	904	ENDIF
	905	ENDIF
	906	!
	907	! Modified for adaptive time step
	908	!
	909
	910	IF ( (itimestep .EQ. 1) .OR. (MOD(itimestep,STEPBL) .EQ. 0) ) THEN
	911	run_param = .TRUE.
	912	ELSE
	913	run_param = .FALSE.
	914	ENDIF
	915	IF (PRESENT(adapt_step_flag)) THEN
	916	IF ((adapt_step_flag)) THEN
	917	IF ( (itimestep .EQ. 1) .OR. (bldt .EQ. 0) .OR. &
	918	( CURR_SECS + dt >= ( INT( CURR_SECS / ( bldt * 60 ) + 1 ) * bldt * 60) ) ) THEN
	919	run_param = .TRUE.
	920	ELSE
	921	run_param = .FALSE.
	922	ENDIF
	923	ENDIF
	924	ENDIF
	925
	926	IF ( run_param ) then
	927
	928	! IF (itimestep .eq. 1 .or. mod(itimestep,STEPBL) .eq. 0) THEN
	929
	930	radiation = .false.
	931	frpcpn = .false.
	932	myj = ((sf_sfclay_physics .EQ. MYJSFCSCHEME) .OR. &
	933	(sf_sfclay_physics .EQ. QNSESFCSCHEME) )
	934	isisfc = ( FRACTIONAL_SEAICE .EQ. 1 .AND. ( &
	935	(sf_sfclay_physics .EQ. SFCLAYSCHEME ) .OR. &
	936	(sf_sfclay_physics .EQ. PXSFCSCHEME ) .OR. &
	937	(sf_sfclay_physics .EQ. MYJSFCSCHEME ) .OR. &
	938	(sf_sfclay_physics .EQ. GFSSFCSCHEME ) ) &
	939	)
	940
	941	IF (ra_lw_physics .gt. 0) radiation = .true.
	942
	943	IF( PRESENT(slope_rad).AND. radiation )THEN
	944	! topographic slope effects modify SWDOWN and GSW here
	945	IF (slope_rad .EQ. 1) THEN
	946	!$OMP PARALLEL DO &
	947	!$OMP PRIVATE ( ij, i, j, k )
	948	DO ij = 1 , num_tiles
	949	CALL TOPO_RAD_ADJ_DRVR (XLAT,XLONG,COSZEN, &
	950	shadowmask, &
	951	declin, &
	952	SWDOWN,GSW,SWNORM,GSWSAVE,solcon,hrang, &
	953	slope,slp_azi, &
	954	ids, ide, jds, jde, kds, kde, &
	955	ims, ime, jms, jme, kms, kme, &
	956	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	957	ENDDO
	958	!$OMP END PARALLEL DO
	959
	960	ENDIF
	961	ENDIF
	962	!----
	963	! CALCULATE CONSTANT
	964
	965	DTMIN=DT/60.
	966	! Surface schemes need PBL time step for updates and accumulations
	967	! Assume these schemes provide no tendencies
	968
	969	if (PRESENT(adapt_step_flag)) then
	970	if (adapt_step_flag) then
	971	do_adapt = .TRUE.
	972	else
	973	do_adapt = .FALSE.
	974	endif
	975	else
	976	do_adapt = .FALSE.
	977	endif
	978
	979	if (PRESENT(BLDT)) then
	980	if (bldt .eq. 0) then
	981	DTBL = dt
	982	ELSE
	983	if (do_adapt) then
	984	call wrf_message("WARNING: When using an adaptive time-step the boundary layer"// &
	985	" time-step should be 0 (i.e., equivalent to model time-step). "// &
	986	"In order to proceed, for boundary layer calculations, the "// &
	987	"boundary layer time-step"// &
	988	" will be rounded to the nearest minute, possibly resulting in"// &
	989	" innacurate results.")
	990	DTBL=bldt*60
	991	else
	992	DTBL=DT*STEPBL
	993	endif
	994	endif
	995	else
	996	DTBL=DT*STEPBL
	997	endif
	998
	999	! SAVE OLD VALUES
	1000
	1001
	1002	!$OMP PARALLEL DO &
	1003	!$OMP PRIVATE ( ij, i, j, k )
	1004	DO ij = 1 , num_tiles
	1005	DO j=j_start(ij),j_end(ij)
	1006	DO i=i_start(ij),i_end(ij)
	1007	! PSFC : in Pa
	1008	PSFC(I,J)=p8w(I,kts,J)
	1009	! REVERSE ORDER IN THE VERTICAL DIRECTION
	1010	DO k=kts,kte
	1011	v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
	1012	u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
	1013	ENDDO
	1014	ENDDO
	1015	ENDDO
	1016	ENDDO
	1017	!$OMP END PARALLEL DO
	1018
	1019	!$OMP PARALLEL DO &
	1020	!$OMP PRIVATE ( ij, i, j, k )
	1021	DO ij = 1 , num_tiles
	1022	sfclay_select: SELECT CASE(sf_sfclay_physics)
	1023
	1024	CASE (SFCLAYSCHEME)
	1025	! DX varies spatially in NMM, therefore, SFCLAY cannot be called
	1026	! because it takes a scalar DX. NMM passes in a dummy value for this
	1027	! scalar. NEEDS FURTHER ATTENTION. JM 20050215
	1028	IF (PRESENT(qv_curr) .AND. &
	1029	PRESENT(mol) .AND. PRESENT(regime) .AND. &
	1030	.TRUE. ) THEN
	1031	CALL wrf_debug( 100, 'in SFCLAY' )
	1032	IF ( FRACTIONAL_SEAICE == 1 ) THEN
	1033	CALL SFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr,&
	1034	p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
	1035	znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
	1036	xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
	1037	u10,v10,th2,t2,q2, &
	1038	gz1oz0,wspd,br,isfflx,dx, &
	1039	svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
	1040	P1000mb, &
	1041	XICE,SST,TSK_SEA, &
	1042	CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
	1043	HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
	1044	ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD, &
	1045	ids,ide, jds,jde, kds,kde, &
	1046	ims,ime, jms,jme, kms,kme, &
	1047	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
	1048	ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
	1049	ELSE
	1050	CALL SFCLAY(u_phytmp,v_phytmp,t_phy,qv_curr,&
	1051	p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
	1052	znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
	1053	xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
	1054	u10,v10,th2,t2,q2, &
	1055	gz1oz0,wspd,br,isfflx,dx, &
	1056	svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
	1057	P1000mb, &
	1058	ids,ide, jds,jde, kds,kde, &
	1059	ims,ime, jms,jme, kms,kme, &
	1060	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
	1061	ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
	1062	#if ( EM_CORE==1)
	1063	DO j = j_start(ij),j_end(ij)
	1064	DO i = i_start(ij),i_end(ij)
	1065	ch(i,j) = chs (i,j)
	1066	!! ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
	1067	end do
	1068	end do
	1069	#endif
	1070	ENDIF
	1071	ELSE
	1072	CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
	1073	ENDIF
	1074
	1075	CASE (PXSFCSCHEME)
	1076	#if (NMM_CORE != 1)
	1077	IF (PRESENT(qv_curr) .AND. &
	1078	PRESENT(mol) .AND. PRESENT(regime) .AND. &
	1079	.TRUE. ) THEN
	1080	CALL wrf_debug( 100, 'in PX Surface Layer scheme' )
	1081	IF ( FRACTIONAL_SEAICE == 1 ) THEN
	1082	CALL WRF_ERROR_FATAL("PXSFCLAY not adapted for FRACTIONAL_SEAICE=1 option")
	1083	CALL PXSFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
	1084	p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
	1085	znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
	1086	xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
	1087	u10,v10, &
	1088	gz1oz0,wspd,br,isfflx,dx, &
	1089	svp1,svp2,svp3,svpt0,ep_1,ep_2,karman, &
	1090	XICE, SST, ITIMESTEP, TICE2TSK_IF2COLD,XICE_THRESHOLD, &
	1091	CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA,FLHC_SEA,FLQC_SEA,&
	1092	HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, TSK_SEA, &
	1093	ids,ide, jds,jde, kds,kde, &
	1094	ims,ime, jms,jme, kms,kme, &
	1095	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1096	ELSE
	1097	CALL PXSFCLAY(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
	1098	p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
	1099	znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
	1100	xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
	1101	u10,v10, &
	1102	gz1oz0,wspd,br,isfflx,dx, &
	1103	svp1,svp2,svp3,svpt0,ep_1,ep_2,karman, &
	1104	ids,ide, jds,jde, kds,kde, &
	1105	ims,ime, jms,jme, kms,kme, &
	1106	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1107	ENDIF
	1108	ELSE
	1109	CALL wrf_error_fatal('Lacking arguments for PX Surface Layer in surface driver')
	1110	ENDIF
	1111	#else
	1112	CALL wrf_error_fatal('PX Surface Layer scheme cannot be used with NMM')
	1113	#endif
	1114
	1115	CASE (MYJSFCSCHEME)
	1116	IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
	1117	.TRUE. ) THEN
	1118
	1119	CALL wrf_debug(100,'in MYJSFC')
	1120	IF ( FRACTIONAL_SEAICE == 1 ) THEN
	1121	CALL MYJSFC_SEAICE_WRAPPER(itimestep,ht,dz8w, &
	1122	p_phy,p8w,th_phy,t_phy, &
	1123	qv_curr,qc_curr, &
	1124	u_phy,v_phy,tke_pbl, &
	1125	tsk,qsfc,thz0,qz0,uz0,vz0, &
	1126	lowlyr, &
	1127	xland,ivgtyp,isurban,iz0tlnd, &
	1128	TICE2TSK_IF2COLD, & ! Extra for wrapper.
	1129	XICE_THRESHOLD, & ! Extra for wrapper.
	1130	XICE, SST, & ! Extra for wrapper.
	1131	CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA, &
	1132	FLHC_SEA, FLQC_SEA, QSFC_SEA, &
	1133	QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA, LH_SEA, &
	1134	TSK_SEA, &
	1135	ust,znt,z0,pblh,mavail,rmol, &
	1136	akhs,akms, &
	1137	br, &
	1138	chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
	1139	u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
	1140	p1000mb, &
	1141	ids,ide, jds,jde, kds,kde, &
	1142	ims,ime, jms,jme, kms,kme, &
	1143	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1144	ELSE
	1145	CALL MYJSFC(itimestep,ht,dz8w, &
	1146	p_phy,p8w,th_phy,t_phy, &
	1147	qv_curr,qc_curr, &
	1148	u_phy,v_phy,tke_pbl, &
	1149	tsk,qsfc,thz0,qz0,uz0,vz0, &
	1150	lowlyr, &
	1151	xland,ivgtyp,isurban,iz0tlnd, &
	1152	ust,znt,z0,pblh,mavail,rmol, &
	1153	akhs,akms, &
	1154	br, &
	1155	chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
	1156	u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
	1157	p1000mb, &
	1158	ids,ide, jds,jde, kds,kde, &
	1159	ims,ime, jms,jme, kms,kme, &
	1160	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1161	#if ( EM_CORE==1)
	1162	DO j = j_start(ij),j_end(ij)
	1163	DO i = i_start(ij),i_end(ij)
	1164	wspd(i,j) = MAX(SQRT(u_phy(i,kts,j)2+v_phy(i,kts,j)2),0.001)
	1165	ch(i,j) = chs (i,j)
	1166	!! ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
	1167	END DO
	1168	END DO
	1169	#endif
	1170
	1171	ENDIF
	1172	ELSE
	1173	CALL wrf_error_fatal('Lacking arguments for MYJSFC in surface driver')
	1174	ENDIF
	1175
	1176	CASE (QNSESFCSCHEME)
	1177	IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
	1178	.TRUE. ) THEN
	1179	CALL wrf_debug(100,'in QNSESFC')
	1180	CALL QNSESFC(itimestep,ht,dz8w, &
	1181	p_phy,p8w,th_phy,t_phy, &
	1182	qv_curr,qc_curr, &
	1183	u_phy,v_phy,tke_pbl, &
	1184	tsk,qsfc,thz0,qz0,uz0,vz0, &
	1185	lowlyr, &
	1186	xland, &
	1187	ust,znt,z0,pblh,mavail,rmol, &
	1188	akhs,akms, &
	1189	br, &
	1190	chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
	1191	u10,v10,tshltr,th10,qshltr,q10,pshltr, &
	1192	ids,ide, jds,jde, kds,kde, &
	1193	ims,ime, jms,jme, kms,kme, &
	1194	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1195	ELSE
	1196	CALL wrf_error_fatal('Lacking arguments for QNSESFC in surface driver')
	1197	ENDIF
	1198
	1199	CASE (GFSSFCSCHEME)
	1200	IF (PRESENT(qv_curr) .AND. .TRUE. ) THEN
	1201	CALL wrf_debug( 100, 'in GFSSFC' )
	1202	IF (FRACTIONAL_SEAICE == 1) THEN
	1203	CALL SF_GFS_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr, &
	1204	p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
	1205	ZNT,UST,PSIM,PSIH, &
	1206	XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
	1207	QGH,QSFC,U10,V10, &
	1208	GZ1OZ0,WSPD,BR,ISFFLX, &
	1209	EP_1,EP_2,KARMAN,itimestep, &
	1210	TICE2TSK_IF2COLD, &
	1211	XICE_THRESHOLD, &
	1212	CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, &
	1213	FLHC_SEA, FLQC_SEA, &
	1214	HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, &
	1215	UST_SEA, ZNT_SEA, SST, XICE, &
	1216	ids,ide, jds,jde, kds,kde, &
	1217	ims,ime, jms,jme, kms,kme, &
	1218	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1219	ELSE
	1220	CALL SF_GFS(u_phytmp,v_phytmp,t_phy,qv_curr, &
	1221	p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
	1222	ZNT,UST,PSIM,PSIH, &
	1223	XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
	1224	QGH,QSFC,U10,V10, &
	1225	GZ1OZ0,WSPD,BR,ISFFLX, &
	1226	EP_1,EP_2,KARMAN,itimestep, &
	1227	ids,ide, jds,jde, kds,kde, &
	1228	ims,ime, jms,jme, kms,kme, &
	1229	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1230	ENDIF
	1231	CALL wrf_debug(100,'in SFCDIAGS')
	1232	ELSE
	1233	CALL wrf_error_fatal('Lacking arguments for SF_GFS in surface driver')
	1234	ENDIF
	1235
	1236	#if ( EM_CORE==1)
	1237	CASE(MYNNSFCSCHEME)
	1238
	1239	IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) &
	1240	& .AND. PRESENT(qcg) ) THEN
	1241
	1242	CALL wrf_debug(100,'in MYNNSFC')
	1243
	1244	CALL SFCLAY_mynn(u_phytmp,v_phytmp,t_phy,qv_curr,&
	1245	p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
	1246	znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
	1247	xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
	1248	u10,v10,th2,t2,q2, &
	1249	gz1oz0,wspd,br,isfflx,dx, &
	1250	svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
	1251	&itimestep,ch,th_phy,pi_phy,qc_curr,&
	1252	&tsq,qsq,cov,qcg,&
	1253	ids,ide, jds,jde, kds,kde, &
	1254	ims,ime, jms,jme, kms,kme, &
	1255	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1256
	1257	ELSE
	1258	CALL wrf_error_fatal('Lacking arguments for SFCLAY_mynn in surface driver')
	1259
	1260	ENDIF
	1261	#endif
	1262
	1263	#if ( EM_CORE==1)
	1264	CASE (TEMFSFCSCHEME)
	1265	IF (PRESENT(qv_curr).and.PRESENT(hd_temf)) THEN
	1266	CALL wrf_debug( 100, 'in TEMFSFCLAY' )
	1267	! WA 9/7/09 must initialize Z0 and ZNT for TEMF in ideal cases
	1268	! DO J=j_start(ij),j_end(ij)
	1269	! DO I=i_start(ij),i_end(ij)
	1270	! CHKLOWQ(i,j) = 1.0
	1271	! Z0(i,j) = 0.03 ! For GABLS2
	1272	! ZNT(i,j) = 0.03 ! For GABLS2
	1273	! ENDDO
	1274	! ENDDO
	1275	CALL TEMFSFCLAY(u3d=u_phytmp,v3d=v_phytmp,th3d=th_phy, &
	1276	qv3d=qv_curr,p3d=p_phy,pi3d=pi_phy,rho=rho,z=z,ht=ht, &
	1277	CP=cp,G=g,ROVCP=rovcp,R=r_d,XLV=xlv,psfc=psfc,chs=chs,&
	1278	chs2=chs2,cqs2=cqs2,CPM=cpm,znt=znt,ust=ust, &
	1279	MAVAIL=mavail,XLAND=xland,HFX=hfx,QFX=qfx,LH=lh, &
	1280	TSK=tsk,FLHC=flhc,FLQC=flqc,QGH=qgh,qsfc=qsfc, &
	1281	U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2, &
	1282	SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0,EP1=ep_1, &
	1283	EP2=ep_2,KARMAN=karman,fCor=fCor,te_temf=te_temf, &
	1284	hd_temf=hd_temf,exch_temf=exch_temf,wm_temf=wm_temf,&
	1285	ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde, &
	1286	ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme, &
	1287	its=i_start(ij),ite=i_end(ij), &
	1288	jts=j_start(ij),jte=j_end(ij), kts=kts,kte=kte )
	1289	ELSE
	1290	CALL wrf_error_fatal('Lacking arguments for TEMFSFCLAY in surface driver')
	1291	ENDIF
	1292
	1293	CASE (IDEALSCMSFCSCHEME)
	1294	IF (PRESENT(qv_curr)) THEN
	1295	CALL wrf_debug( 100, 'in IDEALSCMSFCLAY' )
	1296	CALL IDEALSCMSFCLAY(u3d=u_phytmp,v3d=v_phytmp,th3d=th_phy, &
	1297	qv3d=qv_curr,p3d=p_phy,pi3d=pi_phy,rho=rho,z=z,ht=ht, &
	1298	CP=cp,G=g,ROVCP=rovcp,R=r_d,XLV=xlv,psfc=psfc,chs=chs,&
	1299	chs2=chs2,cqs2=cqs2,CPM=cpm,znt=znt,ust=ust, &
	1300	MAVAIL=mavail,XLAND=xland,HFX=hfx,QFX=qfx,LH=lh, &
	1301	TSK=tsk,FLHC=flhc,FLQC=flqc,QGH=qgh,qsfc=qsfc, &
	1302	U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2, &
	1303	SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0,EP1=ep_1, &
	1304	EP2=ep_2,KARMAN=karman,fCor=fCor, &
	1305	exch_temf=exch_temf, &
	1306	hfx_force=hfx_force,lh_force=lh_force,tsk_force=tsk_force, &
	1307	hfx_force_tend=hfx_force_tend, &
	1308	lh_force_tend=lh_force_tend, &
	1309	tsk_force_tend=tsk_force_tend, &
	1310	dt=dt,itimestep=itimestep, &
	1311	ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde, &
	1312	ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme, &
	1313	its=i_start(ij),ite=i_end(ij), &
	1314	jts=j_start(ij),jte=j_end(ij), kts=kts,kte=kte )
	1315	ELSE
	1316	CALL wrf_error_fatal('Lacking arguments for IDEALSCMSFCLAY in surface driver')
	1317	ENDIF
	1318	#endif
	1319
	1320	#if (NMM_CORE==1)
	1321
	1322	CASE (GFDLSFCSCHEME)
	1323	CALL wrf_debug( 100, 'in GFDLSFC' )
	1324
	1325	IF(sf_surface_physics .eq. 88)THEN
	1326	GFDL_NTSFLG=1
	1327	ELSE
	1328	GFDL_NTSFLG=0
	1329	ENDIF
	1330
	1331	CALL SF_GFDL(u_phytmp,v_phytmp,t_phy,qv_curr,p_phy, &
	1332	CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
	1333	DTBL, SMOIS,num_soil_layers,ISLTYP,ZNT,UST,PSIM,PSIH, & !DT & MAVAIL
	1334	XLAND,HFX,QFX,TAUX,TAUY,LH,GSW,GLW,TSK,FLHC,FLQC, & ! gopal's doing for Ocean coupling
	1335	QGH,QSFC,U10,V10, &
	1336	GZ1OZ0,WSPD,BR,ISFFLX, &
	1337	EP_1,EP_2,KARMAN,GFDL_NTSFLG,SFENTH, &
	1338	ids,ide, jds,jde, kds,kde, &
	1339	ims,ime, jms,jme, kms,kme, &
	1340	i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte )
	1341	DO j=j_start(ij),j_end(ij)
	1342	DO i=i_start(ij),i_end(ij)
	1343	CHKLOWQ(I,J)= 1.0
	1344	ENDDO
	1345	ENDDO
	1346
	1347	#endif
	1348	CASE DEFAULT
	1349
	1350	WRITE( message , * ) &
	1351	'The sfclay option does not exist: sf_sfclay_physics = ', sf_sfclay_physics
	1352	CALL wrf_error_fatal ( message )
	1353
	1354	END SELECT sfclay_select
	1355
	1356	! Compute uratx, vratx, tratx for obs nudging
	1357	IF(PRESENT(uratx) .and. PRESENT(vratx) .and. PRESENT(tratx))THEN
	1358	DO J=j_start(ij),j_end(ij)
	1359	DO I=i_start(ij),i_end(ij)
	1360	IF(ABS(U10(I,J)) .GT. 1.E-10) THEN
	1361	uratx(I,J) = U_PHYTMP(I,1,J)/U10(I,J)
	1362	ELSE
	1363	uratx(I,J) = 1.2
	1364	END IF
	1365	IF(ABS(V10(I,J)) .GT. 1.E-10) THEN
	1366	vratx(I,J) = V_PHYTMP(I,1,J)/V10(I,J)
	1367	ELSE
	1368	vratx(I,J) = 1.2
	1369	END IF
	1370	! (Quotient P1000mb/P_PHY must be conditioned due to large value of P1000mb)
	1371	tratx(I,J) = (T_PHY(I,1,J)(P1000mb0.001/(P_PHY(I,1,J)/1000.))**RCP) &
	1372	/TH2(I,J)
	1373	ENDDO
	1374	ENDDO
	1375	ENDIF
	1376
	1377	ENDDO
	1378	!$OMP END PARALLEL DO
	1379
	1380	IF (ISFFLX.EQ.0 ) GOTO 430
	1381	!$OMP PARALLEL DO &
	1382	!$OMP PRIVATE ( ij, i, j, k )
	1383	DO ij = 1 , num_tiles
	1384
	1385	sfc_select: SELECT CASE(sf_surface_physics)
	1386
	1387	CASE (SLABSCHEME)
	1388
	1389	IF (PRESENT(qv_curr) .AND. &
	1390	PRESENT(capg) .AND. &
	1391	.TRUE. ) THEN
	1392	DO j=j_start(ij),j_end(ij)
	1393	DO i=i_start(ij),i_end(ij)
	1394	! CQS2 ACCOUNTS FOR MAVAIL FOR SFCDIAGS 2M Q
	1395	CQS2(I,J)= CQS2(I,J)*MAVAIL(I,J)
	1396	ENDDO
	1397	ENDDO
	1398
	1399	IF ( FRACTIONAL_SEAICE == 1 ) THEN
	1400	CALL wrf_error_fatal('SLAB scheme cannot be used with fractional seaice')
	1401	ENDIF
	1402	CALL wrf_debug(100,'in SLAB')
	1403	CALL SLAB(t_phy,qv_curr,p_phy,flhc,flqc, &
	1404	psfc,xland,tmn,hfx,qfx,lh,tsk,qsfc,chklowq, &
	1405	gsw,glw,capg,thc,snowc,emiss,mavail, &
	1406	dtbl,rcp,xlv,dtmin,ifsnow, &
	1407	svp1,svp2,svp3,svpt0,ep_2,karman,eomeg,stbolt, &
	1408	tslb,zs,dzs,num_soil_layers,radiation, &
	1409	p1000mb, &
	1410	ids,ide, jds,jde, kds,kde, &
	1411	ims,ime, jms,jme, kms,kme, &
	1412	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
	1413
	1414	DO j=j_start(ij),j_end(ij)
	1415	DO i=i_start(ij),i_end(ij)
	1416	SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
	1417	IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
	1418	IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
	1419	ENDDO
	1420	ENDDO
	1421
	1422	CALL wrf_debug(100,'in SFCDIAGS')
	1423	CALL SFCDIAGS(hfx,qfx,tsk,qsfc,chs2,cqs2,t2,th2,q2, &
	1424	psfc,cp,r_d,rcp, &
	1425	ids,ide, jds,jde, kds,kde, &
	1426	ims,ime, jms,jme, kms,kme, &
	1427	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1428
	1429	ENDIF
	1430
	1431	CASE (LSMSCHEME)
	1432
	1433	IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
	1434	! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
	1435	! PRESENT(declin) .AND. PRESENT(coszen) .AND. &
	1436	! PRESENT(hrang) .AND. PRESENT( xlat_urb2d) .AND. &
	1437	! PRESENT(dzr) .AND. &
	1438	! PRESENT( dzb) .AND. PRESENT(dzg) .AND. &
	1439	! PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d) .AND. &
	1440	! PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND. &
	1441	! PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND. &
	1442	! PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND. &
	1443	! PRESENT(xxxg_urb2d) .AND. &
	1444	! PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND. &
	1445	! PRESENT(tbl_urb3d) .AND. PRESENT(tgl_urb3d) .AND. &
	1446	! PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d) .AND. &
	1447	! PRESENT(g_urb2d) .AND. PRESENT(rn_urb2d) .AND. &
	1448	! PRESENT(ts_urb2d) .AND. &
	1449	! PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d) .AND. &
	1450	.TRUE. ) THEN
	1451	!------------------------------------------------------------------
	1452	IF( PRESENT(sr) ) THEN
	1453	frpcpn=.true.
	1454	ENDIF
	1455	IF ( FRACTIONAL_SEAICE == 1) THEN
	1456	! The fields passed to LSM need to represent the full ice values, not
	1457	! the fractional values. Convert ALBEDO and EMISS from the blended value
	1458	! to a value representing only the sea-ice portion. Albedo over open
	1459	! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
	1460	DO j = j_start(ij) , j_end(ij)
	1461	DO i = i_start(ij) , i_end(ij)
	1462	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
	1463	ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
	1464	EMISS(I,J) = (EMISS(I,J)-(1.-XICE(I,J))*0.98)/XICE(I,J)
	1465	ENDIF
	1466	ENDDO
	1467	ENDDO
	1468
	1469	IF ( isisfc ) THEN
	1470	! Use surface layer routine values from the ice portion of grid point
	1471	ELSE
	1472	!
	1473	! We don't have surface layer routine values at this time, so
	1474	! just use what we have. Use ice component of TSK
	1475	!
	1476	CALL get_local_ice_tsk( ims, ime, jms, jme, &
	1477	i_start(ij), i_end(ij), &
	1478	j_start(ij), j_end(ij), &
	1479	itimestep, .false., tice2tsk_if2cold, &
	1480	XICE, XICE_THRESHOLD, &
	1481	SST, TSK, TSK_SEA, TSK_LOCAL )
	1482
	1483	DO j = j_start(ij) , j_end(ij)
	1484	DO i = i_start(ij) , i_end(ij)
	1485	TSK(i,j) = TSK_LOCAL(i,j)
	1486	ENDDO
	1487	ENDDO
	1488	ENDIF
	1489	ENDIF
	1490
	1491	CALL wrf_debug(100,'in NOAH DRV')
	1492	CALL lsm(dz8w,qv_curr,p8w,t_phy,tsk, &
	1493	hfx,qfx,lh,grdflx,qgh,gsw,swdown,glw,smstav,smstot, &
	1494	sfcrunoff,udrunoff,ivgtyp,isltyp,isurban,isice,vegfra, &
	1495	albedo,albbck,znt,z0, tmn,xland,xice, emiss, embck, &
	1496	snowc,qsfc,rainbl, &
	1497	mminlu, &
	1498	num_soil_layers,dtbl,dzs,itimestep, &
	1499	smois,tslb,snow,canwat, &
	1500	chs, chs2, cqs2, cpm,rcp,SR,chklowq,lai,qz0, &
	1501	myj,frpcpn, &
	1502	sh2o,snowh, & !h
	1503	u_phy,v_phy, & !I
	1504	snoalb,shdmin,shdmax, & !i
	1505	snotime, & !o
	1506	acsnom,acsnow, & !o
	1507	snopcx, & !o
	1508	potevp, & !o
	1509	smcrel, & !o
	1510	xice_threshold, &
	1511	rdlai2d,usemonalb, &
	1512	br, & !?
	1513	NOAHRES, &
	1514	ids,ide, jds,jde, kds,kde, &
	1515	ims,ime, jms,jme, kms,kme, &
	1516	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
	1517	sf_urban_physics &
	1518	!Optional urban
	1519	,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif &
	1520	,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d, & !H urban
	1521	uc_urb2d, & !H urban
	1522	xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d, & !H urban
	1523	trl_urb3d,tbl_urb3d,tgl_urb3d, & !H urban
	1524	sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d, & !H urban
	1525	psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d, & !O urban
	1526	GZ1OZ0_urb2d, AKMS_URB2D, & !O urban
	1527	th2_urb2d,q2_urb2d,ust_urb2d, & !O urban
	1528	declin,coszen,hrang, & !I solar
	1529	xlat_urb2d, & !I urban
	1530	num_roof_layers, num_wall_layers, & !I urban
	1531	num_road_layers, DZR, DZB, DZG, & !I urban
	1532	FRC_URB2D, UTYPE_URB2D, & !I urban
	1533	num_urban_layers, & !I multi-layer urban
	1534	trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d, & !H multi-layer urban
	1535	tlev_urb3d,qlev_urb3d, & !H multi-layer urban
	1536	tw1lev_urb3d,tw2lev_urb3d, & !H multi-layer urban
	1537	tglev_urb3d,tflev_urb3d, & !H multi-layer urban
	1538	sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d, & !H multi-layer urban
	1539	sfvent_urb3d,lfvent_urb3d, & !H multi-layer urban
	1540	sfwin1_urb3d,sfwin2_urb3d, & !H multi-layer urban
	1541	sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d, & !H multi-layer urban
	1542	th_phy,rho,p_phy,ust, & !I multi-layer urban
	1543	gmt,julday,xlong,xlat, & !I multi-layer urban
	1544	a_u_bep,a_v_bep,a_t_bep,a_q_bep, & !O multi-layer urban
	1545	a_e_bep,b_u_bep,b_v_bep, & !O multi-layer urban
	1546	b_t_bep,b_q_bep,b_e_bep,dlg_bep, & !O multi-layer urban
	1547	dl_u_bep,sf_bep,vl_bep & !O multi-layer urban
	1548	)
	1549
	1550	IF ( FRACTIONAL_SEAICE == 1 ) THEN
	1551	! LSM Returns full land/ice values, no fractional values.
	1552	! We return to a fractional component here. SFLX currently hard-wires
	1553	! emissivity over sea ice to 0.98, the same value as over open water, so
	1554	! the fractional consideration doesn't have any effect for emissivity.
	1555	DO j=j_start(ij),j_end(ij)
	1556	DO i=i_start(ij),i_end(ij)
	1557	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
	1558	albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
	1559	emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
	1560	ENDIF
	1561	ENDDO
	1562	ENDDO
	1563
	1564	IF ( isisfc ) THEN
	1565	DO j=j_start(ij),j_end(ij)
	1566	DO i=i_start(ij),i_end(ij)
	1567	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
	1568	! Weighted average of fields between ice-cover values and open-water values.
	1569	flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
	1570	flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
	1571	cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
	1572	cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
	1573	chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
	1574	chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
	1575	qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qsfc_sea(i,j) )
	1576	qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qgh_sea(i,j) )
	1577	qz0(i,j) = ( qz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qz0_sea(i,j) )
	1578	hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j) )
	1579	qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j) )
	1580	lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j) )
	1581	tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
	1582	ENDIF
	1583	ENDDO
	1584	ENDDO
	1585	ELSE
	1586	DO j = j_start(ij) , j_end(ij)
	1587	DO i = i_start(ij) , i_end(ij)
	1588	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
	1589	! Compute TSK as the open-water and ice-cover average
	1590	tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
	1591	ENDIF
	1592	ENDDO
	1593	ENDDO
	1594	ENDIF
	1595	ENDIF
	1596	DO j=j_start(ij),j_end(ij)
	1597	DO i=i_start(ij),i_end(ij)
	1598	! CHKLOWQ(I,J)= 1.0
	1599	SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
	1600	SFCEXC(I,J)= CHS(I,J)
	1601	IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
	1602	IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
	1603	IF(PRESENT(ACGRDFLX))ACGRDFLX(I,J)=ACGRDFLX(I,J) + GRDFLX(I,J)*DT
	1604	ENDDO
	1605	ENDDO
	1606
	1607	CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2, &
	1608	PSFC,CP,R_d,RCP, &
	1609	ids,ide, jds,jde, kds,kde, &
	1610	ims,ime, jms,jme, kms,kme, &
	1611	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1612	!urban
	1613	IF(SF_URBAN_PHYSICS.eq.1) THEN
	1614	DO j=j_start(ij),j_end(ij) !urban
	1615	DO i=i_start(ij),i_end(ij) !urban
	1616	IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. & !urban
	1617	IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
	1618	U10(I,J) = U10_URB2D(I,J) !urban
	1619	V10(I,J) = V10_URB2D(I,J) !urban
	1620	PSIM(I,J) = PSIM_URB2D(I,J) !urban
	1621	PSIH(I,J) = PSIH_URB2D(I,J) !urban
	1622	GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J) !urban
	1623	!m AKHS(I,J) = AKHS_URB2D(I,J) !urban
	1624	AKHS(I,J) = CHS(I,J) !urban
	1625	AKMS(I,J) = AKMS_URB2D(I,J) !urban
	1626	END IF !urban
	1627	ENDDO !urban
	1628	ENDDO !urban
	1629	ENDIF
	1630	! urban BEP
	1631	IF((SF_URBAN_PHYSICS.eq.2).OR.(SF_URBAN_PHYSICS.eq.3)) THEN
	1632	DO j=j_start(ij),j_end(ij) !urban
	1633	DO i=i_start(ij),i_end(ij) !urban
	1634	IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. & !urban
	1635	IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
	1636	T2(I,J) = TH_PHY(i,1,j)/((1.E5/PSFC(I,J))**RCP) !urban
	1637	TH2(I,J) = TH_PHY(i,1,j) !urban
	1638	Q2(I,J) = qv_curr(i,1,j) !urban
	1639	U10(I,J) = U_phy(I,1,J) !urban
	1640	V10(I,J) = V_phy(I,1,J) !urban
	1641	END IF !urban
	1642	ENDDO !urban
	1643	ENDDO !urban
	1644	ENDIF
	1645
	1646	!------------------------------------------------------------------
	1647
	1648	ELSE
	1649	CALL wrf_error_fatal('Lacking arguments for LSM in surface driver')
	1650	ENDIF
	1651
	1652	CASE (RUCLSMSCHEME)
	1653	IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
	1654	! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
	1655	PRESENT(qsg) .AND. PRESENT(qvg) .AND. &
	1656	PRESENT(qcg) .AND. PRESENT(soilt1) .AND. &
	1657	PRESENT(tsnav) .AND. PRESENT(smfr3d) .AND. &
	1658	PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND. &
	1659	PRESENT(dew) .AND. &
	1660	.TRUE. ) THEN
	1661
	1662	IF( PRESENT(sr) ) THEN
	1663	frpcpn=.true.
	1664	ELSE
	1665	SR = 1.
	1666	ENDIF
	1667	CALL wrf_debug(100,'in RUC LSM')
	1668	IF ( FRACTIONAL_SEAICE == 1 ) THEN
	1669	! The fields passed to LSMRUC need to represent the full ice values, not
	1670	! the fractional values. Convert ALBEDO and EMISS from the blended value
	1671	! to a value representing only the sea-ice portion. Albedo over open
	1672	! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
	1673	DO j = j_start(ij) , j_end(ij)
	1674	DO i = i_start(ij) , i_end(ij)
	1675	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
	1676	ALBEDO(I,J) = (ALBEDO(I,J) - (1.-XICE(I,J))*0.08) / XICE(I,J)
	1677	EMISS(I,J) = (EMISS(I,J) - (1.-XICE(I,J))*0.98) / XICE(I,J)
	1678	ENDIF
	1679	ENDDO
	1680	ENDDO
	1681
	1682	IF ( isisfc ) THEN
	1683	!
	1684	! use surface layer routine values from the ice portion of grid point
	1685	!
	1686	ELSE
	1687	!
	1688	! don't have srfc layer routine values at this time, so just use what you have
	1689	! use ice component of TSK
	1690	!
	1691	CALL get_local_ice_tsk( ims, ime, jms, jme, &
	1692	i_start(ij), i_end(ij), &
	1693	j_start(ij), j_end(ij), &
	1694	itimestep, .false., tice2tsk_if2cold, &
	1695	XICE, XICE_THRESHOLD, &
	1696	SST, TSK, TSK_SEA, TSK_LOCAL )
	1697	DO j = j_start(ij) , j_end(ij)
	1698	DO i = i_start(ij) , i_end(ij)
	1699	TSK(i,j) = TSK_LOCAL(i,j)
	1700	ENDDO
	1701	ENDDO
	1702	ENDIF
	1703	ENDIF
	1704
	1705	CALL LSMRUC(dtbl,itimestep,num_soil_layers, &
	1706	zs,rainbl,snow,snowh,snowc,sr,frpcpn, &
	1707	dz8w,p8w,t_phy,qv_curr,qc_curr,rho, & !p8w in [pa]
	1708	glw,gsw,emiss,chklowq, &
	1709	chs,flqc,flhc,mavail,canwat,vegfra,albedo,znt, &
	1710	z0,snoalb, albbck, & !new
	1711	qsfc,qsg,qvg,qcg,dew,soilt1,tsnav, &
	1712	tmn,ivgtyp,isltyp,xland, &
	1713	isice,xice,xice_threshold, &
	1714	cp,rovcp,g,xlv,stbolt, &
	1715	smois,sh2o,smstav,smstot,tslb,tsk,hfx,qfx,lh, &
	1716	sfcrunoff,udrunoff,sfcexc, &
	1717	sfcevp,grdflx,acsnow,acsnom, &
	1718	smfr3d,keepfr3dflag, &
	1719	myj, &
	1720	ids,ide, jds,jde, kds,kde, &
	1721	ims,ime, jms,jme, kms,kme, &
	1722	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1723
	1724	IF ( FRACTIONAL_SEAICE == 1 ) THEN
	1725	! LSMRUC Returns full land/ice values, no fractional values.
	1726	! We return to a fractional component here.
	1727	DO j=j_start(ij),j_end(ij)
	1728	DO i=i_start(ij),i_end(ij)
	1729	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
	1730	albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
	1731	emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
	1732	ENDIF
	1733	ENDDO
	1734	ENDDO
	1735	if ( isisfc ) then
	1736	!
	1737	! back to ice and ocean average
	1738	!
	1739	DO j=j_start(ij),j_end(ij)
	1740	DO i=i_start(ij),i_end(ij)
	1741	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
	1742	flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * flhc_sea(i,j) )
	1743	flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * flqc_sea(i,j) )
	1744	cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * cpm_sea(i,j) )
	1745	cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * cqs2_sea(i,j) )
	1746	chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * chs2_sea(i,j) )
	1747	chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * chs_sea(i,j) )
	1748	qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * QSFC_SEA(i,j) )
	1749	qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * qgh_sea(i,j) )
	1750	hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * HFX_SEA(i,j) )
	1751	qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * QFX_SEA(i,j) )
	1752	lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * LH_SEA(i,j) )
	1753	tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * TSK_SEA(i,j) )
	1754	ENDIF
	1755	ENDDO
	1756	ENDDO
	1757	else
	1758	!
	1759	! tsk back to liquid and ice average
	1760	!
	1761	DO j = j_start(ij) , j_end(ij)
	1762	DO i = i_start(ij) , i_end(ij)
	1763	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
	1764	tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * TSK_SEA(i,j) )
	1765	ENDIF
	1766	ENDDO
	1767	ENDDO
	1768	endif
	1769	ENDIF
	1770
	1771	CALL SFCDIAGS_RUCLSM(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2, &
	1772	T_PHY,QV_CURR,RHO,P8W, &
	1773	PSFC,CP,R_d,RCP, &
	1774	ids,ide, jds,jde, kds,kde, &
	1775	ims,ime, jms,jme, kms,kme, &
	1776	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
	1777
	1778
	1779	ELSE
	1780	CALL wrf_error_fatal('Lacking arguments for RUCLSM in surface driver')
	1781	ENDIF
	1782
	1783	CASE (PXLSMSCHEME)
	1784	IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
	1785	PRESENT(emiss) .AND. PRESENT(t2) .AND. &
	1786	PRESENT(rainbl) .AND. &
	1787	.TRUE. ) THEN
	1788	IF ( FRACTIONAL_SEAICE == 1 ) THEN
	1789
	1790	CALL WRF_ERROR_FATAL("PXLSM not adapted for FRACTIONAL_SEAICE=1 option")
	1791
	1792	IF ( isisfc ) THEN
	1793	!
	1794	! use surface layer routine values from the ice portion of grid point
	1795	!
	1796	ELSE
	1797	!
	1798	! don't have srfc layer routine values at this time, so just use what you have
	1799	! use ice component of TSK
	1800	!
	1801	CALL get_local_ice_tsk( ims, ime, jms, jme, &
	1802	i_start(ij), i_end(ij), &
	1803	j_start(ij), j_end(ij), &
	1804	itimestep, .false., tice2tsk_if2cold, &
	1805	XICE, XICE_THRESHOLD, &
	1806	SST, TSK, TSK_SEA, TSK_LOCAL )
	1807	DO j = j_start(ij) , j_end(ij)
	1808	DO i=i_start(ij) , i_end(ij)
	1809	TSK(i,j) = TSK_LOCAL(i,j)
	1810	ENDDO
	1811	ENDDO
	1812	ENDIF
	1813	ENDIF
	1814	CALL wrf_debug(100,'in P-X LSM')
	1815	CALL PXLSM(u_phy, v_phy, dz8w, qv_curr, t_phy, th_phy, rho,&
	1816	psfc, gsw, glw, rainbl, emiss, &
	1817	ITIMESTEP, num_soil_layers, DT, anal_interval, &
	1818	xland, xice, albbck, albedo, snoalb, smois, tslb, &
	1819	mavail,T2, Q2, &
	1820	zs, dzs, psih, &
	1821	landusef,soilctop,soilcbot,vegfra, vegf_px, &
	1822	isltyp,ra,rs,lai,nlcat,nscat, &
	1823	hfx,qfx,lh,tsk,sst,znt,canwat, &
	1824	grdflx,shdmin,shdmax, &
	1825	snowc,pblh,rmol,ust,capg,dtbl, &
	1826	t2_ndg_old,t2_ndg_new,q2_ndg_old,q2_ndg_new, &
	1827	sn_ndg_old, sn_ndg_new, snow, snowh,snowncv, &
	1828	t2obs, q2obs, pxlsm_smois_init, pxlsm_soil_nudge, &
	1829	ids,ide, jds,jde, kds,kde, &
	1830	ims,ime, jms,jme, kms,kme, &
	1831	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
	1832	IF ( FRACTIONAL_SEAICE == 1 ) THEN
	1833	IF ( isisfc ) THEN
	1834	!
	1835	! back to ice and ocean average
	1836	!
	1837	DO j = j_start(ij) , j_end(ij)
	1838	DO i = i_start(ij) , i_end(ij)
	1839	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
	1840	flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
	1841	flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
	1842	cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
	1843	cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
	1844	chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
	1845	chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
	1846	qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QSFC_SEA(i,j) )
	1847	qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QGH_SEA(i,j) )
	1848	hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * HFX_SEA(i,j) )
	1849	qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QFX_SEA(i,j) )
	1850	lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * LH_SEA(i,j) )
	1851	tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * TSK_SEA(i,j) )
	1852	psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIH_SEA(i,j) )
	1853	pblh(i,j) = ( pblh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PBLH_SEA(i,j) )
	1854	rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * RMOL_SEA(i,j) )
	1855	ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * UST_SEA(i,j) )
	1856	ENDIF
	1857	ENDDO
	1858	ENDDO
	1859	ELSE
	1860	!
	1861	! tsk back to liquid and ice average
	1862	!
	1863	DO j=j_start(ij),j_end(ij)
	1864	DO i=i_start(ij),i_end(ij)
	1865	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
	1866	tsk(i,j)=tsk(i,j)XICE(i,j)+(1.0-XICE(i,j))TSK_SEA(i,j)
	1867	ENDIF
	1868	ENDDO
	1869	ENDDO
	1870	ENDIF
	1871	ENDIF
	1872	DO j=j_start(ij),j_end(ij)
	1873	DO i=i_start(ij),i_end(ij)
	1874	CHKLOWQ(I,J)= 1.0
	1875	TH2(I,J) = T2(I,J)(1.E5/PSFC(I,J))*RCP
	1876	SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
	1877	ENDDO
	1878	ENDDO
	1879
	1880	ELSE
	1881	CALL wrf_error_fatal('Lacking arguments for P-X LSM in surface driver')
	1882	ENDIF
	1883
	1884	CASE DEFAULT
	1885
	1886	IF ( itimestep .eq. 1 ) THEN
	1887	WRITE( message , * ) &
	1888	'No land surface physics option is used: sf_surface_physics = ', sf_surface_physics
	1889	CALL wrf_message ( message )
	1890	ENDIF
	1891
	1892	END SELECT sfc_select
	1893
	1894	ENDDO
	1895	!$OMP END PARALLEL DO
	1896
	1897	430 CONTINUE
	1898
	1899	#if ( EM_CORE==1)
	1900	IF (omlcall .EQ. 1) THEN
	1901	! simple ocean mixed layer model based Pollard, Rhines and Thompson (1973)
	1902	CALL wrf_debug( 100, 'Call OCEANML' )
	1903	!$OMP PARALLEL DO &
	1904	!$OMP PRIVATE ( ij )
	1905	DO ij = 1 , num_tiles
	1906	CALL oceanml(tml,t0ml,hml,h0ml,huml,hvml,ust,u_phy,v_phy, &
	1907	tmoml,f,g,oml_gamma, &
	1908	xland,hfx,lh,tsk,gsw,glw,emiss, &
	1909	dtbl,STBOLT, &
	1910	ids,ide, jds,jde, kds,kde, &
	1911	ims,ime, jms,jme, kms,kme, &
	1912	i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
	1913	ENDDO
	1914	!$OMP END PARALLEL DO
	1915	ENDIF
	1916	#endif
	1917
	1918	! Reset RAINBL in mm (Accumulation between PBL calls)
	1919
	1920	IF ( PRESENT( rainbl ) ) THEN
	1921	!$OMP PARALLEL DO &
	1922	!$OMP PRIVATE ( ij, i, j, k )
	1923	DO ij = 1 , num_tiles
	1924	DO j=j_start(ij),j_end(ij)
	1925	DO i=i_start(ij),i_end(ij)
	1926	RAINBL(i,j) = 0.
	1927	ENDDO
	1928	ENDDO
	1929	ENDDO
	1930	!$OMP END PARALLEL DO
	1931	ENDIF
	1932
	1933	IF( PRESENT(slope_rad).AND. radiation )THEN
	1934	! topographic slope effects removed from SWDOWN and GSW here for output
	1935	IF (slope_rad .EQ. 1) THEN
	1936
	1937	!$OMP PARALLEL DO &
	1938	!$OMP PRIVATE ( ij, i, j, k )
	1939	DO ij = 1 , num_tiles
	1940	DO j=j_start(ij),j_end(ij)
	1941	DO i=i_start(ij),i_end(ij)
	1942	IF(SWNORM(I,J) .GT. 1.E-3)THEN ! daytime
	1943	SWSAVE = SWDOWN(i,j)
	1944	! SWDOWN contains unaffected SWDOWN in output
	1945	SWDOWN(i,j) = SWNORM(i,j)
	1946	! SWNORM contains slope-affected SWDOWN in output
	1947	SWNORM(i,j) = SWSAVE
	1948	GSW(i,j) = GSWSAVE(i,j)
	1949	ENDIF
	1950	ENDDO
	1951	ENDDO
	1952	ENDDO
	1953	!$OMP END PARALLEL DO
	1954
	1955	ENDIF
	1956	ENDIF
	1957
	1958	ENDIF
	1959
	1960	END SUBROUTINE surface_driver
	1961
	1962	!-------------------------------------------------------------------------
	1963	!-------------------------------------------------------------------------
	1964
	1965	subroutine myjsfc_seaice_wrapper(ITIMESTEP,HT,DZ, &
	1966	& PMID,PINT,TH,T,QV,QC,U,V,Q2, &
	1967	& TSK,QSFC,THZ0,QZ0,UZ0,VZ0, &
	1968	& LOWLYR,XLAND,IVGTYP,ISURBAN,IZ0TLND, &
	1969	& TICE2TSK_IF2COLD, & ! Extra for wrapper
	1970	& XICE_THRESHOLD, & ! Extra for wrapper
	1971	& XICE,SST, & ! Extra for wrapper
	1972	& CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA, & ! Extra for wrapper
	1973	& FLHC_SEA, FLQC_SEA, QSFC_SEA, & ! Extra for wrapper
	1974	& QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA, & ! Extra for wrapper
	1975	& FLX_LH_SEA, TSK_SEA, & ! Extra for wrapper
	1976	& USTAR,ZNT,Z0BASE,PBLH,MAVAIL,RMOL, &
	1977	& AKHS,AKMS, &
	1978	& BR, &
	1979	& CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC, &
	1980	& QGH,CPM,CT, &
	1981	& U10,V10,T02,TH02,TSHLTR,TH10,Q02,QSHLTR,Q10,PSHLTR, &
	1982	& P1000, &
	1983	& IDS,IDE,JDS,JDE,KDS,KDE, &
	1984	& IMS,IME,JMS,JME,KMS,KME, &
	1985	& ITS,ITE,JTS,JTE,KTS,KTE )
	1986	! USE module_model_constants
	1987	USE module_sf_myjsfc
	1988
	1989	IMPLICIT NONE
	1990
	1991	INTEGER, INTENT(IN) :: ITIMESTEP
	1992	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: HT
	1993	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DZ
	1994	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PMID
	1995	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
	1996	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: TH
	1997	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: T
	1998	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: QV
	1999	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: QC
	2000	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: U
	2001	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: V
	2002	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: Q2 ! Q2 is TKE?
	2003
	2004	! REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: TSK
	2005	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: TSK
	2006
	2007	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: QSFC
	2008	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: THZ0
	2009	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: QZ0
	2010	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: UZ0
	2011	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: VZ0
	2012	INTEGER,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: LOWLYR
	2013	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: XLAND
	2014	INTEGER,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: IVGTYP
	2015	INTEGER :: ISURBAN
	2016	INTEGER :: IZ0TLND
	2017	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: XICE ! Extra for wrapper
	2018	! REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: SST ! Extra for wrapper
	2019	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: SST ! Extra for wrapper
	2020	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: BR
	2021	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS_SEA ! Extra for wrapper
	2022	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS2_SEA ! Extra for wrapper
	2023	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CQS2_SEA ! Extra for wrapper
	2024	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CPM_SEA ! Extra for wrapper
	2025	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QZ0_SEA ! Extra for wrapper
	2026	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QSFC_SEA ! Extra for wrapper
	2027	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QGH_SEA ! Extra for wrapper
	2028	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLHC_SEA ! Extra for wrapper
	2029	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLQC_SEA ! Extra for wrapper
	2030	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: HFX_SEA ! Extra for wrapper
	2031	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QFX_SEA ! Extra for wrapper
	2032	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLX_LH_SEA ! Extra for wrapper
	2033	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TSK_SEA ! Extra for wrapper
	2034	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: USTAR
	2035	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: ZNT
	2036	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: Z0BASE
	2037	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: PBLH
	2038	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: MAVAIL
	2039	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: RMOL
	2040	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: AKHS
	2041	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: AKMS
	2042	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS
	2043	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS2
	2044	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CQS2
	2045	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: HFX
	2046	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QFX
	2047	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLX_LH
	2048	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLHC
	2049	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLQC
	2050	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QGH
	2051	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CPM
	2052	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CT
	2053	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: U10
	2054	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: V10
	2055	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: T02
	2056	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TH02
	2057	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TSHLTR
	2058	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TH10
	2059	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: Q02
	2060	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QSHLTR
	2061	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: Q10
	2062	REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: PSHLTR
	2063	REAL, INTENT(IN) :: P1000
	2064	REAL, INTENT(IN) :: XICE_THRESHOLD
	2065	LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
	2066	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE, &
	2067	& IMS,IME,JMS,JME,KMS,KME, &
	2068	& ITS,ITE,JTS,JTE,KTS,KTE
	2069
	2070
	2071	! Local
	2072	INTEGER :: i
	2073	INTEGER :: j
	2074	REAL, DIMENSION( ims:ime, jms:jme ) :: ct_sea
	2075	REAL, DIMENSION( ims:ime, jms:jme ) :: u10_sea
	2076	REAL, DIMENSION( ims:ime, jms:jme ) :: v10_sea
	2077	REAL, DIMENSION( ims:ime, jms:jme ) :: t02_sea
	2078	REAL, DIMENSION( ims:ime, jms:jme ) :: th02_sea
	2079	REAL, DIMENSION( ims:ime, jms:jme ) :: tshltr_sea
	2080	REAL, DIMENSION( ims:ime, jms:jme ) :: pshltr_sea
	2081	REAL, DIMENSION( ims:ime, jms:jme ) :: qshltr_sea
	2082	REAL, DIMENSION( ims:ime, jms:jme ) :: th10_sea
	2083	REAL, DIMENSION( ims:ime, jms:jme ) :: q02_sea
	2084	REAL, DIMENSION( ims:ime, jms:jme ) :: q10_sea
	2085	REAL, DIMENSION( ims:ime, jms:jme ) :: thz0_sea
	2086	REAL, DIMENSION( ims:ime, jms:jme ) :: uz0_sea
	2087	REAL, DIMENSION( ims:ime, jms:jme ) :: vz0_sea
	2088	REAL, DIMENSION( ims:ime, jms:jme ) :: ustar_sea
	2089	REAL, DIMENSION( ims:ime, jms:jme ) :: pblh_sea
	2090	REAL, DIMENSION( ims:ime, jms:jme ) :: rmol_sea
	2091	REAL, DIMENSION( ims:ime, jms:jme ) :: akhs_sea
	2092	REAL, DIMENSION( ims:ime, jms:jme ) :: akms_sea
	2093	REAL, DIMENSION( ims:ime, jms:jme ) :: xland_sea
	2094	REAL, DIMENSION( ims:ime, jms:jme ) :: mavail_sea
	2095	REAL, DIMENSION( ims:ime, jms:jme ) :: znt_sea
	2096	REAL, DIMENSION( ims:ime, jms:jme ) :: z0base_sea
	2097	REAL, DIMENSION( ims:ime, jms:jme ) :: br_sea
	2098
	2099	REAL, DIMENSION( ims:ime, jms:jme ) :: QSFC_HOLD
	2100	REAL, DIMENSION( ims:ime, jms:jme ) :: QZ0_HOLD
	2101	REAL, DIMENSION( ims:ime, jms:jme ) :: THZ0_HOLD
	2102	REAL, DIMENSION( ims:ime, jms:jme ) :: UZ0_HOLD
	2103	REAL, DIMENSION( ims:ime, jms:jme ) :: VZ0_HOLD
	2104	REAL, DIMENSION( ims:ime, jms:jme ) :: USTAR_HOLD
	2105	REAL, DIMENSION( ims:ime, jms:jme ) :: ZNT_HOLD
	2106	REAL, DIMENSION( ims:ime, jms:jme ) :: PBLH_HOLD
	2107	REAL, DIMENSION( ims:ime, jms:jme ) :: RMOL_HOLD
	2108	REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_HOLD
	2109	REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_HOLD
	2110	REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL
	2111	REAL :: PSFC
	2112
	2113	! Set things up for the frozen-surface call to myjsfc
	2114	! Is SST local here, or are the changes to be fed back to the calling routines?
	2115
	2116	! We want a TSK valid for the ice-covered regions of the grid cell.
	2117
	2118	CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
	2119	itimestep, .true., tice2tsk_if2cold, &
	2120	XICE, XICE_THRESHOLD, &
	2121	SST, TSK, TSK_SEA, TSK_LOCAL )
	2122	DO j = JTS , JTE
	2123	DO i = ITS , ITE
	2124	TSK(i,j) = TSK_LOCAL(i,j)
	2125	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
	2126
	2127	! Over fractional sea-ice points, back out an ice portion of QSFC as well.
	2128	! QSFC_SEA calculation as done in myjsfc for open water points
	2129	PSFC = PINT(I,LOWLYR(I,J),J)
	2130	QSFC_SEA(i,j) = PQ0SEA/PSFCEXP(A2S(TSK(i,j)-A3S)/(TSK(i,j)-A4S))
	2131	QSFC(i,j) = QSFC(i,j) - (1.0-XICE(i,j)) * QSFC_SEA(i,j) / XICE(i,j)
	2132	!
	2133	HFX_SEA(i,j) = HFX(i,j)
	2134	QFX_SEA(i,j) = QFX(i,j)
	2135	FLX_LH_SEA(i,j) = FLX_LH(i,j)
	2136	ENDIF
	2137	ENDDO
	2138	ENDDO
	2139
	2140	!
	2141	! frozen ocean call for sea ice points
	2142	!
	2143
	2144	! Strictly INTENT(IN) to MYJSFC, should be unchanged by call.
	2145
	2146	! DZ
	2147	! HT
	2148	! LOWLYR
	2149	! MAVAIL
	2150	! PINT
	2151	! PMID
	2152	! QC
	2153	! QV
	2154	! Q2
	2155	! T
	2156	! TH
	2157	! TSK
	2158	! U
	2159	! V
	2160	! XLAND
	2161	! Z0BASE
	2162
	2163	! INTENT (INOUT), updated by MYJSFC. Values will need to be saved before the first call to MYJSFC, so that
	2164	! the second call to MYJSFC does not double-count the effect.
	2165
	2166	! Save INTENT(INOUT) variables before the frozen-water/true-land call to MYJSFC:
	2167	QSFC_HOLD = QSFC
	2168	QZ0_HOLD = QZ0
	2169	THZ0_HOLD = THZ0
	2170	UZ0_HOLD = UZ0
	2171	VZ0_HOLD = VZ0
	2172	USTAR_HOLD = USTAR
	2173	ZNT_HOLD = ZNT
	2174	PBLH_HOLD = PBLH
	2175	RMOL_HOLD = RMOL
	2176	AKHS_HOLD = AKHS
	2177	AKMS_HOLD = AKMS
	2178
	2179	! Strictly INTENT(OUT): Set by MYJSFC
	2180
	2181	! CHS
	2182	! CHS2
	2183	! CPM
	2184	! CQS2
	2185	! CT
	2186	! FLHC
	2187	! FLQC
	2188	! FLX_LH
	2189	! HFX
	2190	! PSHLTR
	2191	! QFX
	2192	! QGH
	2193	! QSHLTR
	2194	! Q02
	2195	! Q10
	2196	! TH02
	2197	! TH10
	2198	! TSHLTR
	2199	! T02
	2200	! U10
	2201	! V10
	2202
	2203	! Frozen-water/true-land call.
	2204	CALL MYJSFC ( ITIMESTEP, HT, DZ, & ! I,I,I,
	2205	& PMID, PINT, TH, T, QV, QC, U, V, Q2, & ! I,I,I,I,I,I,I,I,I,
	2206	& TSK, QSFC, THZ0, QZ0, UZ0, VZ0, & ! I,IO,IO,IO,IO,IO,
	2207	& LOWLYR, XLAND, IVGTYP, ISURBAN, IZ0TLND, & ! I,I,I,I,I
	2208	& USTAR, ZNT, Z0BASE, PBLH, MAVAIL, RMOL, & ! IO,IO,I,IO,I,IO,
	2209	& AKHS, AKMS, & ! IO,IO,
	2210	& BR, & ! O
	2211	& CHS, CHS2, CQS2, HFX, QFX, FLX_LH, FLHC, FLQC, & ! O,O,O,0,0,0,0,0,
	2212	& QGH, CPM, CT, U10, V10, T02, & ! 0,0,0,0,0,0,
	2213	& TH02, TSHLTR, TH10, Q02, & ! 0,0,0,0,
	2214	& QSHLTR, Q10, PSHLTR, & ! 0,0,0,
	2215	& P1000, & ! I
	2216	& ids,ide, jds,jde, kds,kde, &
	2217	& ims,ime, jms,jme, kms,kme, &
	2218	& its,ite, jts,jte, kts,kte )
	2219
	2220	! Set up things for the open ocean call.
	2221	DO j = JTS, JTE
	2222	DO i = ITS, ITE
	2223	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
	2224	XLAND_SEA(i,j)=2.
	2225	MAVAIL_SEA(I,J) = 1.
	2226	ZNT_SEA(I,J) = 0.0001
	2227	Z0BASE_SEA(I,J) = ZNT_SEA(I,J)
	2228	IF ( SST(i,j) .LT. 271.4 ) THEN
	2229	SST(i,j) = 271.4
	2230	ENDIF
	2231	TSK_SEA(i,j) = SST(i,j)
	2232	PSFC = PINT(I,LOWLYR(I,J),J)
	2233	QSFC_SEA(I,J) = PQ0SEA/PSFCEXP(A2S(TSK_SEA(i,j)-A3S)/(TSK_SEA(i,j)-A4S))
	2234	ELSE
	2235	! This should be a land point or a true open water point
	2236	XLAND_SEA(i,j)=xland(i,j)
	2237	MAVAIL_SEA(i,j) = mavail(i,j)
	2238	ZNT_SEA(I,J) = ZNT_HOLD(I,J)
	2239	Z0BASE_SEA(I,J) = Z0BASE(I,J)
	2240	TSK_SEA(i,j) = TSK(i,j)
	2241	QSFC_SEA(i,j) = QSFC_HOLD(i,j)
	2242	ENDIF
	2243	ENDDO
	2244	ENDDO
	2245
	2246	QZ0_SEA = QZ0_HOLD
	2247	THZ0_SEA = THZ0_HOLD
	2248	UZ0_SEA = UZ0_HOLD
	2249	VZ0_SEA = VZ0_HOLD
	2250	USTAR_SEA = USTAR_HOLD
	2251	PBLH_SEA = PBLH_HOLD
	2252	RMOL_SEA = RMOL_HOLD
	2253	AKHS_SEA = AKHS_HOLD
	2254	AKMS_SEA = AKMS_HOLD
	2255
	2256	!
	2257	! open water call
	2258	!
	2259	CALL MYJSFC ( ITIMESTEP, HT, DZ, & ! I,I,I,
	2260	& PMID, PINT, TH, T, QV, QC, U, V, Q2, & ! I,I,I,I,I,I,I,I,I,
	2261	& TSK_SEA, QSFC_SEA, THZ0_SEA, QZ0_SEA, UZ0_SEA, VZ0_SEA, & ! I,IO,IO,IO,IO,IO,
	2262	& LOWLYR, XLAND_SEA, IVGTYP, ISURBAN, IZ0TLND, & ! I,I,I,I,I,
	2263	& USTAR_SEA, ZNT_SEA, Z0BASE_SEA, PBLH_SEA, MAVAIL_SEA, RMOL_SEA, & ! IO,IO,I,IO,I,IO,
	2264	& AKHS_SEA, AKMS_SEA, & ! IO,IO,
	2265	& BR_SEA, & ! dummy space holder
	2266	& CHS_SEA, CHS2_SEA, CQS2_SEA, HFX_SEA, QFX_SEA, FLX_LH_SEA, FLHC_SEA, & ! 0,0,0,0,0,0,0,
	2267	& FLQC_SEA, QGH_SEA, CPM_SEA, CT_SEA, U10_SEA, V10_SEA, T02_SEA, TH02_SEA, & ! 0,0,0,0,0,0,0,0,
	2268	& TSHLTR_SEA, TH10_SEA, Q02_SEA, QSHLTR_SEA, Q10_SEA, PSHLTR_SEA, & ! 0,0,0,0,0,0,
	2269	& p1000, & ! I
	2270	& ids,ide, jds,jde, kds,kde, &
	2271	& ims,ime, jms,jme, kms,kme, &
	2272	& its,ite, jts,jte, kts,kte )
	2273
	2274	!
	2275	! Scale the appropriate terms between open-water values and ice-covered values
	2276	!
	2277
	2278	DO j = JTS, JTE
	2279	DO i = ITS, ITE
	2280	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
	2281	! Over sea-ice points, blend the results.
	2282
	2283	! INTENT(OUT) from MYJSFC
	2284	! CHS wait
	2285	! CHS2 wait
	2286	! CPM wait
	2287	! CQS2 wait
	2288	CT(i,j) = CT(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * CT_SEA (i,j)
	2289	! FLHC(i,j) = FLHC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLHC_SEA (i,j)
	2290	! FLQC(i,j) = FLQC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLQC_SEA (i,j)
	2291	! FLX_LH wait
	2292	! HFX wait
	2293	PSHLTR(i,j) = PSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * PSHLTR_SEA(i,j)
	2294	! QFX wait
	2295	! QGH wait
	2296	QSHLTR(i,j) = QSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * QSHLTR_SEA(i,j)
	2297	Q02(i,j) = Q02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * Q02_SEA(i,j)
	2298	Q10(i,j) = Q10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * Q10_SEA(i,j)
	2299	TH02(i,j) = TH02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TH02_SEA(i,j)
	2300	TH10(i,j) = TH10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TH10_SEA(i,j)
	2301	TSHLTR(i,j) = TSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TSHLTR_SEA(i,j)
	2302	T02(i,j) = T02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * T02_SEA(i,j)
	2303	U10(i,j) = U10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * U10_SEA(i,j)
	2304	V10(i,j) = V10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * V10_SEA(i,j)
	2305
	2306	! INTENT(INOUT): updated by MYJSFC
	2307	! QSFC: wait
	2308	THZ0(i,j) = THZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * THZ0_SEA(i,j)
	2309	! qz0 wait
	2310	UZ0(i,j) = UZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * UZ0_SEA(i,j)
	2311	VZ0(i,j) = VZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * VZ0_SEA(i,j)
	2312	USTAR(i,j) = USTAR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * USTAR_SEA(i,j)
	2313	! ZNT wait
	2314	PBLH(i,j) = PBLH(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * PBLH_SEA(i,j)
	2315	RMOL(i,j) = RMOL(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * RMOL_SEA(i,j)
	2316	AKHS(i,j) = AKHS(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * AKHS_SEA(i,j)
	2317	AKMS(i,j) = AKMS(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * AKMS_SEA(i,j)
	2318
	2319	! tsk(i,j) = tsk(i,j)XICE(i,j) + (1.0-XICE(i,j))TSK_SEA(i,j)
	2320	ELSE
	2321	! We're not over sea ice. Take the results from the first call.
	2322	ENDIF
	2323	ENDDO
	2324	ENDDO
	2325
	2326	END SUBROUTINE myjsfc_seaice_wrapper
	2327
	2328	!-------------------------------------------------------------------------
	2329	!-------------------------------------------------------------------------
	2330
	2331	SUBROUTINE sf_gfs_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D, &
	2332	CP,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
	2333	ZNT,UST,PSIM,PSIH, &
	2334	XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
	2335	QGH,QSFC,U10,V10, &
	2336	GZ1OZ0,WSPD,BR,ISFFLX, &
	2337	EP1,EP2,KARMAN,itimestep, &
	2338	TICE2TSK_IF2COLD, &
	2339	XICE_THRESHOLD, &
	2340	CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, &
	2341	FLHC_SEA, FLQC_SEA, &
	2342	HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA,&
	2343	UST_SEA, ZNT_SEA, SST, XICE, &
	2344	ids,ide, jds,jde, kds,kde, &
	2345	ims,ime, jms,jme, kms,kme, &
	2346	its,ite, jts,jte, kts,kte )
	2347	USE module_sf_gfs
	2348	implicit none
	2349
	2350	INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, &
	2351	ims,ime, jms,jme, kms,kme, &
	2352	its,ite, jts,jte, kts,kte, &
	2353	ISFFLX,itimestep
	2354
	2355	REAL, INTENT(IN) :: &
	2356	CP, &
	2357	EP1, &
	2358	EP2, &
	2359	KARMAN, &
	2360	R, &
	2361	ROVCP, &
	2362	XLV
	2363
	2364	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: &
	2365	P3D, &
	2366	QV3D, &
	2367	T3D, &
	2368	U3D, &
	2369	V3D
	2370
	2371	REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: &
	2372	TSK, &
	2373	PSFC, &
	2374	XLAND
	2375
	2376	REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: &
	2377	UST, &
	2378	ZNT
	2379
	2380	REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: &
	2381	BR, &
	2382	CHS, &
	2383	CHS2, &
	2384	CPM, &
	2385	CQS2, &
	2386	FLHC, &
	2387	FLQC, &
	2388	GZ1OZ0, &
	2389	HFX, &
	2390	LH, &
	2391	PSIM, &
	2392	PSIH, &
	2393	QFX, &
	2394	QGH, &
	2395	QSFC, &
	2396	U10, &
	2397	V10, &
	2398	WSPD
	2399
	2400	REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: &
	2401	XICE
	2402	REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: &
	2403	CHS_SEA, &
	2404	CHS2_SEA, &
	2405	CPM_SEA, &
	2406	CQS2_SEA, &
	2407	FLHC_SEA, &
	2408	FLQC_SEA, &
	2409	HFX_SEA, &
	2410	LH_SEA, &
	2411	QFX_SEA, &
	2412	QGH_SEA, &
	2413	QSFC_SEA, &
	2414	UST_SEA, &
	2415	ZNT_SEA
	2416	REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: &
	2417	SST
	2418
	2419	REAL, INTENT(IN) :: &
	2420	XICE_THRESHOLD
	2421	LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
	2422
	2423	!-------------------------------------------------------------------------
	2424	! Local
	2425	!-------------------------------------------------------------------------
	2426	INTEGER :: I
	2427	INTEGER :: J
	2428	REAL, DIMENSION(ims:ime, jms:jme) :: &
	2429	BR_SEA, &
	2430	GZ1OZ0_SEA, &
	2431	PSIM_SEA, &
	2432	PSIH_SEA, &
	2433	U10_SEA, &
	2434	V10_SEA, &
	2435	WSPD_SEA, &
	2436	XLAND_SEA, &
	2437	TSK_SEA, &
	2438	UST_HOLD, &
	2439	ZNT_HOLD, &
	2440	TSK_LOCAL
	2441
	2442	CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
	2443	itimestep, .true., tice2tsk_if2cold, &
	2444	XICE, XICE_THRESHOLD, &
	2445	SST, TSK, TSK_SEA, TSK_LOCAL )
	2446
	2447	!
	2448	! Set up for frozen ocean call for sea ice points
	2449	!
	2450
	2451	! Strictly INTENT(IN), Should be unchanged by SF_GFS:
	2452	! CP
	2453	! EP1
	2454	! EP2
	2455	! KARMAN
	2456	! R
	2457	! ROVCP
	2458	! XLV
	2459	! P3D
	2460	! QV3D
	2461	! T3D
	2462	! U3D
	2463	! V3D
	2464	! TSK
	2465	! PSFC
	2466	! XLAND
	2467	! ISFFLX
	2468	! ITIMESTEP
	2469
	2470
	2471	! Intent (INOUT), original value is used and changed by SF_GFS.
	2472	! UST
	2473	! ZNT
	2474
	2475	ZNT_HOLD = ZNT
	2476	UST_HOLD = UST
	2477
	2478	! Strictly INTENT (OUT), set by SF_GFS:
	2479	! BR
	2480	! CHS -- used by LSM routines
	2481	! CHS2 -- used by LSM routines
	2482	! CPM -- used by LSM routines
	2483	! CQS2 -- used by LSM routines
	2484	! FLHC
	2485	! FLQC
	2486	! GZ1OZ0
	2487	! HFX -- used by LSM routines
	2488	! LH -- used by LSM routines
	2489	! PSIM
	2490	! PSIH
	2491	! QFX -- used by LSM routines
	2492	! QGH -- used by LSM routines
	2493	! QSFC -- used by LSM routines
	2494	! U10
	2495	! V10
	2496	! WSPD
	2497
	2498	!
	2499	! Frozen ocean / true land call.
	2500	!
	2501	CALL SF_GFS(U3D,V3D,T3D,QV3D,P3D, &
	2502	CP,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM_SEA, &
	2503	ZNT,UST,PSIM,PSIH, &
	2504	XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC, &
	2505	QGH,QSFC,U10,V10, &
	2506	GZ1OZ0,WSPD,BR,ISFFLX, &
	2507	EP1,EP2,KARMAN,ITIMESTEP, &
	2508	ids,ide, jds,jde, kds,kde, &
	2509	ims,ime, jms,jme, kms,kme, &
	2510	its,ite, jts,jte, kts,kte )
	2511
	2512	! Set up for open-water call
	2513
	2514	DO j = JTS , JTE
	2515	DO i = ITS , ITE
	2516	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
	2517	! Sets up things for open ocean fraction of sea-ice points
	2518	XLAND_SEA(i,j)=2.
	2519	ZNT_SEA(I,J) = 0.0001
	2520	IF ( SST(i,j) .LT. 271.4 ) THEN
	2521	SST(i,j) = 271.4
	2522	ENDIF
	2523	TSK_SEA(i,j) = SST(i,j)
	2524	ELSE
	2525	! Fully open ocean or true land points
	2526	XLAND_SEA(i,j)=xland(i,j)
	2527	ZNT_SEA(I,J) = ZNT_HOLD(I,J)
	2528	UST_SEA(i,j) = UST_HOLD(i,j)
	2529	TSK_SEA(i,j) = TSK(i,j)
	2530	ENDIF
	2531	ENDDO
	2532	ENDDO
	2533
	2534	! Open-water call
	2535	! _SEA variables are held for later use as the result of the open-water call.
	2536	CALL SF_GFS(U3D,V3D,T3D,QV3D,P3D, &
	2537	CP,ROVCP,R,XLV,PSFC,CHS_SEA,CHS2_SEA,CQS2_SEA,CPM, &
	2538	ZNT_SEA,UST_SEA,PSIM_SEA,PSIH_SEA, &
	2539	XLAND,HFX_SEA,QFX_SEA,LH_SEA,TSK_SEA,FLHC_SEA,FLQC_SEA, &
	2540	QGH_SEA,QSFC_SEA,U10_SEA,V10_SEA, &
	2541	GZ1OZ0_SEA,WSPD_SEA,BR_SEA,ISFFLX, &
	2542	EP1,EP2,KARMAN,ITIMESTEP, &
	2543	ids,ide, jds,jde, kds,kde, &
	2544	ims,ime, jms,jme, kms,kme, &
	2545	its,ite, jts,jte, kts,kte )
	2546
	2547	! Weighting, after our two calls to SF_GFS
	2548
	2549	DO j = JTS , JTE
	2550	DO i = ITS , ITE
	2551	! Over sea-ice points, weight the results. Otherwise, just take the results from the
	2552	! first call to SF_GFS_
	2553	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
	2554	! Weight a number of fields (between open-water results
	2555	! and full ice results) by sea-ice fraction.
	2556
	2557	BR(i,j) = ( BR(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * BR_SEA(i,j) )
	2558	! CHS, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2559	! CHS2, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2560	! CPM, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2561	! CQS2, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2562	! FLHC(i,j) = ( FLHC(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * FLHC_SEA(i,j) )
	2563	! FLQC(i,j) = ( FLQC(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * FLQC_SEA(i,j) )
	2564	GZ1OZ0(i,j) = ( GZ1OZ0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * GZ1OZ0_SEA(i,j) )
	2565	! HFX, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2566	! LH, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2567	PSIM(i,j) = ( PSIM(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIM_SEA(i,j) )
	2568	PSIH(i,j) = ( PSIH(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIH_SEA(i,j) )
	2569	! QFX, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2570	! QGH, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2571	! QSFC, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2572	U10(i,j) = ( U10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * U10_SEA(i,j) )
	2573	V10(i,j) = ( V10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * V10_SEA(i,j) )
	2574	WSPD(i,j) = ( WSPD(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * WSPD_SEA(i,j) )
	2575	! UST, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2576	! ZNT, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
	2577
	2578	ENDIF
	2579	ENDDO
	2580	ENDDO
	2581
	2582	END SUBROUTINE sf_gfs_seaice_wrapper
	2583
	2584	!-------------------------------------------------------------------------
	2585	!-------------------------------------------------------------------------
	2586
	2587	SUBROUTINE sfclay_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, &
	2588	CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
	2589	ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
	2590	XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
	2591	U10,V10,TH2,T2,Q2, &
	2592	GZ1OZ0,WSPD,BR,ISFFLX,DX, &
	2593	SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
	2594	KARMAN,EOMEG,STBOLT, &
	2595	P1000, &
	2596	XICE,SST,TSK_SEA, &
	2597	CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
	2598	HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
	2599	ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD, &
	2600	ids,ide, jds,jde, kds,kde, &
	2601	ims,ime, jms,jme, kms,kme, &
	2602	its,ite, jts,jte, kts,kte, &
	2603	ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
	2604	USE module_sf_sfclay
	2605	implicit none
	2606
	2607	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
	2608	ims,ime, jms,jme, kms,kme, &
	2609	its,ite, jts,jte, kts,kte
	2610
	2611	INTEGER, INTENT(IN ) :: ISFFLX
	2612	REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
	2613	REAL, INTENT(IN ) :: EP1,EP2,KARMAN,EOMEG,STBOLT
	2614	REAL, INTENT(IN ) :: P1000
	2615
	2616	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	2617	INTENT(IN ) :: dz8w
	2618
	2619	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	2620	INTENT(IN ) :: QV3D, &
	2621	P3D, &
	2622	T3D
	2623
	2624	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2625	INTENT(IN ) :: MAVAIL, &
	2626	PBLH, &
	2627	XLAND, &
	2628	TSK
	2629	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2630	INTENT(OUT ) :: U10, &
	2631	V10, &
	2632	TH2, &
	2633	T2, &
	2634	Q2, &
	2635	QSFC
	2636	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2637	INTENT(INOUT) :: REGIME, &
	2638	HFX, &
	2639	QFX, &
	2640	LH, &
	2641	MOL,RMOL
	2642
	2643	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2644	INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
	2645	PSIM,PSIH
	2646
	2647	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	2648	INTENT(IN ) :: U3D, &
	2649	V3D
	2650
	2651	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2652	INTENT(IN ) :: PSFC
	2653
	2654	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2655	INTENT(INOUT) :: ZNT, &
	2656	ZOL, &
	2657	UST, &
	2658	CPM, &
	2659	CHS2, &
	2660	CQS2, &
	2661	CHS
	2662
	2663	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2664	INTENT(INOUT) :: FLHC,FLQC
	2665
	2666	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2667	INTENT(INOUT) :: &
	2668	QGH
	2669
	2670	REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV,DX
	2671
	2672	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , &
	2673	INTENT(OUT) :: ck,cka,cd,cda,ustm
	2674
	2675	INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX,IZ0TLND
	2676
	2677	!--------------------------------------------------------------------
	2678	! New for wrapper
	2679	!--------------------------------------------------------------------
	2680	INTEGER, INTENT(IN) :: ITIMESTEP
	2681	LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
	2682	REAL, INTENT(IN) :: XICE_THRESHOLD
	2683	REAL, DIMENSION( ims:ime, jms:jme ), &
	2684	INTENT(IN) :: XICE
	2685	REAL, DIMENSION( ims:ime, jms:jme ), &
	2686	INTENT(INOUT) :: SST
	2687	REAL, DIMENSION( ims:ime, jms:jme ), &
	2688	INTENT(OUT) :: TSK_SEA, &
	2689	CHS2_SEA, &
	2690	CHS_SEA, &
	2691	CPM_SEA, &
	2692	CQS2_SEA, &
	2693	FLHC_SEA, &
	2694	FLQC_SEA, &
	2695	HFX_SEA, &
	2696	LH_SEA, &
	2697	QFX_SEA, &
	2698	QGH_SEA, &
	2699	QSFC_SEA, &
	2700	ZNT_SEA
	2701
	2702	!--------------------------------------------------------------------
	2703	! Local
	2704	!--------------------------------------------------------------------
	2705	INTEGER :: I, J
	2706	REAL, DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA, &
	2707	MAVAIL_sea, &
	2708	TSK_LOCAL, &
	2709	BR_HOLD, &
	2710	CHS2_HOLD, &
	2711	CHS_HOLD, &
	2712	CPM_HOLD, &
	2713	CQS2_HOLD, &
	2714	FLHC_HOLD, &
	2715	FLQC_HOLD, &
	2716	GZ1OZ0_HOLD, &
	2717	HFX_HOLD, &
	2718	LH_HOLD, &
	2719	MOL_HOLD, &
	2720	PSIH_HOLD, &
	2721	PSIM_HOLD, &
	2722	QFX_HOLD, &
	2723	QGH_HOLD, &
	2724	REGIME_HOLD, &
	2725	RMOL_HOLD, &
	2726	UST_HOLD, &
	2727	WSPD_HOLD, &
	2728	ZNT_HOLD, &
	2729	ZOL_HOLD, &
	2730	CD_SEA, &
	2731	CDA_SEA, &
	2732	CK_SEA, &
	2733	CKA_SEA, &
	2734	Q2_SEA, &
	2735	T2_SEA, &
	2736	TH2_SEA, &
	2737	U10_SEA, &
	2738	USTM_SEA, &
	2739	V10_SEA
	2740
	2741	REAL, DIMENSION( ims:ime, jms:jme ) :: &
	2742	BR_SEA, &
	2743	GZ1OZ0_SEA, &
	2744	MOL_SEA, &
	2745	PSIH_SEA, &
	2746	PSIM_SEA, &
	2747	REGIME_SEA, &
	2748	RMOL_SEA, &
	2749	UST_SEA, &
	2750	WSPD_SEA, &
	2751	ZOL_SEA
	2752	! INTENT(IN) to SFCLAY; unchanged by the call
	2753	! ISFFLX
	2754	! SVP1,SVP2,SVP3,SVPT0
	2755	! EP1,EP2,KARMAN,EOMEG,STBOLT
	2756	! CP,G,ROVCP,R,XLV,DX
	2757	! ISFTCFLX,IZ0TLND
	2758	! P1000
	2759	! dz8w
	2760	! QV3D
	2761	! P3D
	2762	! T3D
	2763	! MAVAIL
	2764	! PBLH
	2765	! XLAND
	2766	! TSK
	2767	! U3D
	2768	! V3D
	2769	! PSFC
	2770
	2771	CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
	2772	itimestep, .true., tice2tsk_if2cold, &
	2773	XICE, XICE_THRESHOLD, &
	2774	SST, TSK, TSK_SEA, TSK_LOCAL )
	2775
	2776
	2777	! INTENT (INOUT) to SFCLAY: Save the variables before the first call
	2778	! (for land/frozen water) to SFCLAY, to keep from double-counting the
	2779	! effects of that routine
	2780	BR_HOLD = BR
	2781	CHS2_HOLD = CHS2
	2782	CHS_HOLD = CHS
	2783	CPM_HOLD = CPM
	2784	CQS2_HOLD = CQS2
	2785	FLHC_HOLD = FLHC
	2786	FLQC_HOLD = FLQC
	2787	GZ1OZ0_HOLD = GZ1OZ0
	2788	HFX_HOLD = HFX
	2789	LH_HOLD = LH
	2790	MOL_HOLD = MOL
	2791	PSIH_HOLD = PSIH
	2792	PSIM_HOLD = PSIM
	2793	QFX_HOLD = QFX
	2794	QGH_HOLD = QGH
	2795	REGIME_HOLD = REGIME
	2796	RMOL_HOLD = RMOL
	2797	UST_HOLD = UST
	2798	WSPD_HOLD = WSPD
	2799	ZNT_HOLD = ZNT
	2800	ZOL_HOLD = ZOL
	2801
	2802	! INTENT(OUT) from SFCLAY. Input shouldn't matter, but we'll want to
	2803	! keep things around for weighting after the second call to SFCLAY.
	2804	! CD
	2805	! CDA
	2806	! CK
	2807	! CKA
	2808	! Q2
	2809	! QSFC
	2810	! T2
	2811	! TH2
	2812	! U10
	2813	! USTM
	2814	! V10
	2815
	2816
	2817	! land/frozen-water call
	2818	call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
	2819	CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, & ! I,I,I,I,I,I,IO,IO,IO,IO,
	2820	ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
	2821	XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
	2822	U10,V10,TH2,T2,Q2, &
	2823	GZ1OZ0,WSPD,BR,ISFFLX,DX, &
	2824	SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
	2825	KARMAN,EOMEG,STBOLT, &
	2826	P1000, &
	2827	ids,ide, jds,jde, kds,kde, &
	2828	ims,ime, jms,jme, kms,kme, &
	2829	its,ite, jts,jte, kts,kte, &
	2830	ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
	2831
	2832	! Set up for open-water call
	2833	DO j = JTS , JTE
	2834	DO i = ITS , ITE
	2835	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
	2836	XLAND_SEA(i,j)=2.
	2837	MAVAIL_SEA(I,J) =1.
	2838	ZNT_SEA(I,J) = 0.0001
	2839	TSK_SEA(i,j) = SST(i,j)
	2840	IF ( SST(i,j) .LT. 271.4 ) THEN
	2841	SST(i,j) = 271.4
	2842	TSK_SEA(i,j) = SST(i,j)
	2843	ENDIF
	2844	ELSE
	2845	XLAND_SEA(i,j) = XLAND(i,j)
	2846	MAVAIL_SEA(i,j) = MAVAIL(i,j)
	2847	ZNT_SEA(i,j) = ZNT_HOLD(i,j)
	2848	TSK_SEA(i,j) = TSK_LOCAL(i,j)
	2849	ENDIF
	2850	ENDDO
	2851	ENDDO
	2852
	2853	! Restore the values from before the land/frozen-water call
	2854	BR_SEA = BR_HOLD
	2855	CHS2_SEA = CHS2_HOLD
	2856	CHS_SEA = CHS_HOLD
	2857	CPM_SEA = CPM_HOLD
	2858	CQS2_SEA = CQS2_HOLD
	2859	FLHC_SEA = FLHC_HOLD
	2860	FLQC_SEA = FLQC_HOLD
	2861	GZ1OZ0_SEA = GZ1OZ0_HOLD
	2862	HFX_SEA = HFX_HOLD
	2863	LH_SEA = LH_HOLD
	2864	MOL_SEA = MOL_HOLD
	2865	PSIH_SEA = PSIH_HOLD
	2866	PSIM_SEA = PSIM_HOLD
	2867	QFX_SEA = QFX_HOLD
	2868	QGH_SEA = QGH_HOLD
	2869	REGIME_SEA = REGIME_HOLD
	2870	RMOL_SEA = RMOL_HOLD
	2871	UST_SEA = UST_HOLD
	2872	WSPD_SEA = WSPD_HOLD
	2873	ZOL_SEA = ZOL_HOLD
	2874
	2875	! open-water call
	2876	call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
	2877	CP,G,ROVCP,R,XLV,PSFC, & ! I
	2878	CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, & ! I/O
	2879	ZNT_SEA,UST_SEA, & ! I/O
	2880	PBLH,MAVAIL_SEA, & ! I
	2881	ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, & ! I/O
	2882	XLAND_SEA, & ! I
	2883	HFX_SEA,QFX_SEA,LH_SEA, & ! I/O
	2884	TSK_SEA, & ! I
	2885	FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_sea,RMOL_SEA, & ! I/O
	2886	U10_sea,V10_sea,TH2_sea,T2_sea,Q2_sea, & ! O
	2887	GZ1OZ0_SEA,WSPD_SEA,BR_SEA, & ! I/O
	2888	ISFFLX,DX, &
	2889	SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
	2890	KARMAN,EOMEG,STBOLT, &
	2891	P1000, &
	2892	ids,ide, jds,jde, kds,kde, &
	2893	ims,ime, jms,jme, kms,kme, &
	2894	its,ite, jts,jte, kts,kte, & ! 0
	2895	ustm_sea,ck_sea,cka_sea,cd_sea,cda_sea,isftcflx,iz0tlnd )
	2896
	2897	DO j = JTS , JTE
	2898	DO i = ITS, ITE
	2899	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and.( XICE(i,j) .LE. 1.0 ) ) THEN
	2900	! weighted average for sea ice points
	2901	br(i,j) = ( br(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j) )
	2902	! CHS2 -- wait
	2903	! CHS -- wait
	2904	! CPM -- wait
	2905	! CQS2 -- wait
	2906	! FLHC -- wait
	2907	! FLQC -- wait
	2908	gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
	2909	! HFX -- wait
	2910	! LH -- wait
	2911	mol(i,j) = ( mol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j) )
	2912	psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j) )
	2913	psim(i,j) = ( psim(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j) )
	2914	! QFX -- wait
	2915	! QGH -- wait
	2916	if ( XICE(i,j).GE. 0.5 ) regime(i,j) = regime_hold(i,j)
	2917	rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j) )
	2918	ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j) )
	2919	wspd(i,j) = ( wspd(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j) )
	2920	zol(i,j) = ( zol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j) )
	2921	! INTENT(OUT) --------------------------------------------------------------------
	2922	IF ( PRESENT ( CD ) ) THEN
	2923	CD(i,j) = ( CD(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CD_sea(i,j) )
	2924	ENDIF
	2925	IF ( PRESENT ( CDA ) ) THEN
	2926	CDA(i,j) = ( CDA(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CDA_sea(i,j) )
	2927	ENDIF
	2928	IF ( PRESENT ( CK ) ) THEN
	2929	CK(i,j) = ( CK(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CK_sea(i,j) )
	2930	ENDIF
	2931	IF ( PRESENT ( CKA ) ) THEN
	2932	CKA(i,j) = ( CKA(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CKA_sea(i,j) )
	2933	ENDIF
	2934	q2(i,j) = ( q2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * q2_sea(i,j) )
	2935	! QSFC -- wait
	2936	t2(i,j) = ( t2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * t2_sea(i,j) )
	2937	th2(i,j) = ( th2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * th2_sea(i,j) )
	2938	u10(i,j) = ( u10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j) )
	2939	IF ( PRESENT ( USTM ) ) THEN
	2940	USTM(i,j) = ( USTM(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * USTM_sea(i,j) )
	2941	ENDIF
	2942	v10(i,j) = ( v10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j) )
	2943	ENDIF
	2944	END DO
	2945	END DO
	2946	!
	2947	! tsk(i,j) = tsk(i,j)XICE(i,j) + (1.0-XICE(i,j))TSK_SEA(i,j)
	2948	!
	2949	END SUBROUTINE sfclay_seaice_wrapper
	2950
	2951	!-------------------------------------------------------------------------
	2952	!-------------------------------------------------------------------------
	2953
	2954	SUBROUTINE pxsfclay_seaice_wrapper(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
	2955	CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
	2956	ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
	2957	XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
	2958	U10,V10, &
	2959	GZ1OZ0,WSPD,BR,ISFFLX,DX, &
	2960	SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
	2961	XICE, SST, ITIMESTEP, TICE2TSK_IF2COLD,XICE_THRESHOLD, &
	2962	CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, FLHC_SEA, FLQC_SEA, &
	2963	HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, TSK_SEA, &
	2964	ids,ide, jds,jde, kds,kde, &
	2965	ims,ime, jms,jme, kms,kme, &
	2966	its,ite, jts,jte, kts,kte )
	2967	USE module_sf_pxsfclay
	2968	implicit none
	2969	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
	2970	ims,ime, jms,jme, kms,kme, &
	2971	its,ite, jts,jte, kts,kte
	2972
	2973	INTEGER, INTENT(IN ) :: ISFFLX
	2974	LOGICAL, INTENT(IN ) :: TICE2TSK_IF2COLD
	2975	REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
	2976	REAL, INTENT(IN ) :: EP1,EP2,KARMAN
	2977
	2978	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	2979	INTENT(IN ) :: dz8w
	2980
	2981	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	2982	INTENT(IN ) :: QV3D, &
	2983	P3D, &
	2984	T3D, &
	2985	TH3D
	2986
	2987	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2988	INTENT(IN ) :: MAVAIL, &
	2989	PBLH, &
	2990	XLAND, &
	2991	TSK
	2992	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
	2993	INTENT(IN ) :: U3D, &
	2994	V3D
	2995
	2996	REAL, DIMENSION( ims:ime, jms:jme ) , &
	2997	INTENT(IN ) :: PSFC
	2998
	2999	REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV,DX
	3000
	3001	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3002	INTENT(OUT ) :: U10, &
	3003	V10, &
	3004	QSFC
	3005	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3006	INTENT(INOUT) :: REGIME, &
	3007	HFX, &
	3008	QFX, &
	3009	LH, &
	3010	MOL,RMOL
	3011	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3012	INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
	3013	PSIM,PSIH
	3014
	3015	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3016	INTENT(INOUT) :: ZNT, &
	3017	ZOL, &
	3018	UST, &
	3019	CPM, &
	3020	CHS2, &
	3021	CQS2, &
	3022	CHS
	3023
	3024	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3025	INTENT(INOUT) :: FLHC,FLQC
	3026
	3027	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3028	INTENT(INOUT) :: QGH
	3029
	3030	!--------------------------------------------------------------------
	3031	! For wrapper
	3032	!--------------------------------------------------------------------
	3033
	3034	INTEGER, INTENT(IN) :: ITIMESTEP
	3035	REAL, INTENT(IN) :: XICE_THRESHOLD
	3036	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3037	INTENT(IN) :: XICE
	3038	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3039	INTENT(OUT) :: TSK_SEA
	3040	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3041	INTENT(INOUT) :: SST
	3042
	3043	!--------------------------------------------------------------------
	3044	! Local
	3045	!--------------------------------------------------------------------
	3046	INTEGER :: I, J
	3047	REAL, DIMENSION( ims:ime, jms:jme ) , &
	3048	INTENT(OUT) :: CHS_SEA, &
	3049	CHS2_SEA, &
	3050	CPM_SEA, &
	3051	CQS2_SEA, &
	3052	FLHC_SEA, &
	3053	FLQC_SEA, &
	3054	HFX_SEA, &
	3055	LH_SEA, &
	3056	QFX_SEA, &
	3057	QGH_SEA, &
	3058	QSFC_SEA
	3059
	3060	REAL, DIMENSION( ims:ime, jms:jme ) :: BR_HOLD, &
	3061	CHS_HOLD, &
	3062	CHS2_HOLD, &
	3063	CPM_HOLD, &
	3064	CQS2_HOLD, &
	3065	FLHC_HOLD, &
	3066	FLQC_HOLD, &
	3067	GZ1OZ0_HOLD, &
	3068	HFX_HOLD, &
	3069	LH_HOLD, &
	3070	MOL_HOLD, &
	3071	PSIH_HOLD, &
	3072	PSIM_HOLD, &
	3073	QFX_HOLD, &
	3074	QGH_HOLD, &
	3075	REGIME_HOLD, &
	3076	RMOL_HOLD, &
	3077	UST_HOLD, &
	3078	WSPD_HOLD, &
	3079	ZNT_HOLD, &
	3080	ZOL_HOLD, &
	3081	TSK_LOCAL
	3082
	3083	REAL, DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA, &
	3084	MAVAIL_SEA, &
	3085	BR_SEA, &
	3086	GZ1OZ0_SEA, &
	3087	MOL_SEA, &
	3088	PSIH_SEA, &
	3089	PSIM_SEA, &
	3090	REGIME_SEA, &
	3091	RMOL_SEA, &
	3092	UST_SEA, &
	3093	WSPD_SEA, &
	3094	ZNT_SEA, &
	3095	ZOL_SEA, &
	3096	U10_SEA, &
	3097	V10_SEA
	3098
	3099	CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
	3100	itimestep, .true., tice2tsk_if2cold, &
	3101	XICE, XICE_THRESHOLD, &
	3102	SST, TSK, TSK_SEA, TSK_LOCAL )
	3103	!
	3104	! INTENT (INOUT) to PXSFCLAY: Save the variables before the first call
	3105	! (for land/frozen water) to SFCLAY, to keep from double-counting the
	3106	! effects of that routine
	3107	!
	3108	BR_HOLD = BR
	3109	CHS_HOLD = CHS
	3110	CHS2_HOLD = CHS2
	3111	CPM_HOLD = CPM
	3112	CQS2_HOLD = CQS2
	3113	FLHC_HOLD = FLHC
	3114	FLQC_HOLD = FLQC
	3115	GZ1OZ0_HOLD = GZ1OZ0
	3116	HFX_HOLD = HFX
	3117	LH_HOLD = LH
	3118	MOL_HOLD = MOL
	3119	PSIH_HOLD = PSIH
	3120	PSIM_HOLD = PSIM
	3121	QFX_HOLD = QFX
	3122	QGH_HOLD = QGH
	3123	REGIME_HOLD = REGIME
	3124	RMOL_HOLD = RMOL
	3125	UST_HOLD = UST
	3126	WSPD_HOLD = WSPD
	3127	ZNT_HOLD = ZNT
	3128	ZOL_HOLD = ZOL
	3129
	3130	! INTENT(OUT) from PXSFCLAY. Input shouldn't matter, but we'll want to
	3131	! keep things around for weighting after the second call to PXSFCLAY.
	3132	! U10
	3133	! V10
	3134	! QSFC
	3135
	3136	! Land/frozen-water call.
	3137	CALL pxsfclay(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
	3138	CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
	3139	ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
	3140	XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
	3141	U10,V10, &
	3142	GZ1OZ0,WSPD,BR,ISFFLX,DX, &
	3143	SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
	3144	ids,ide, jds,jde, kds,kde, &
	3145	ims,ime, jms,jme, kms,kme, &
	3146	its,ite, jts,jte, kts,kte )
	3147
	3148	DO j = JTS , JTE
	3149	DO i= ITS , ITE
	3150	IF( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
	3151	! Sets up things for open ocean.
	3152	XLAND_SEA(i,j)=2.
	3153	MAVAIL_SEA(I,J) =1.
	3154	ZNT_SEA(I,J) = 0.0001
	3155	TSK_SEA(i,j) = SST(i,j)
	3156	if ( SST(i,j) .LT. 271.4 ) then
	3157	SST(i,j) = 271.4
	3158	TSK_SEA(i,j) = SST(i,j)
	3159	endif
	3160	ELSE
	3161	XLAND_SEA(i,j)=xland(i,j)
	3162	MAVAIL_SEA(i,j) = mavail(i,j)
	3163	ZNT_SEA(I,J) = ZNT_HOLD(I,J)
	3164	TSK_SEA(i,j) = TSK(i,j)
	3165	ENDIF
	3166	ENDDO
	3167	ENDDO
	3168
	3169	! INTENT(INOUT) variables held over from before the first call to PXSFCLAY:
	3170	BR_SEA = BR_HOLD
	3171	CHS_SEA = CHS_HOLD
	3172	CHS2_SEA = CHS2_HOLD
	3173	CPM_SEA = CPM_HOLD
	3174	CQS2_SEA = CQS2_HOLD
	3175	FLHC_SEA = FLHC_HOLD
	3176	FLQC_SEA = FLQC_HOLD
	3177	GZ1OZ0_SEA = GZ1OZ0_HOLD
	3178	HFX_SEA = HFX_HOLD
	3179	LH_SEA = LH_HOLD
	3180	MOL_SEA = MOL_HOLD
	3181	PSIH_SEA = PSIH_HOLD
	3182	PSIM_SEA = PSIM_HOLD
	3183	QFX_SEA = QFX_HOLD
	3184	QGH_SEA = QGH_HOLD
	3185	REGIME_SEA = REGIME_HOLD
	3186	RMOL_SEA = RMOL_HOLD
	3187	UST_SEA = UST_HOLD
	3188	WSPD_SEA = WSPD_HOLD
	3189	ZOL_SEA = ZOL_HOLD
	3190
	3191	! Open-water call.
	3192	! Variables newly set (INTENT(OUT)) or changed (INTENT(INOUT)) by
	3193	! PXSFCLAY are here appended with the "_SEA" label.
	3194	! Special intent(IN) variables here: XLAND_SEA, MAVAIL_SEA, TSK_SEA
	3195	CALL pxsfclay(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
	3196	CP,G,ROVCP,R,XLV,PSFC,CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, &
	3197	ZNT_SEA,UST_SEA,PBLH,MAVAIL_SEA,ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, &
	3198	XLAND_SEA,HFX_SEA,QFX_SEA,LH_SEA,TSK_SEA,FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_SEA,RMOL_SEA, &
	3199	U10_SEA,V10_SEA, &
	3200	GZ1OZ0_SEA,WSPD_SEA,BR_SEA,ISFFLX,DX, &
	3201	SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
	3202	ids,ide, jds,jde, kds,kde, &
	3203	ims,ime, jms,jme, kms,kme, &
	3204	its,ite, jts,jte, kts,kte )
	3205
	3206	DO j = JTS , JTE
	3207	DO i = ITS , ITE
	3208	IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
	3209	! INTENT (INOUT) for PXSFCLAY:
	3210	br(i,j) = ( br(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j) )
	3211	gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
	3212	mol(i,j) = ( mol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j) )
	3213	psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j) )
	3214	psim(i,j) = ( psim(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j) )
	3215	rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j) )
	3216	ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j) )
	3217	wspd(i,j) = ( wspd(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j) )
	3218	zol(i,j) = ( zol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j) )
	3219	! REGIME: Special case for this variable. Just take the land values.
	3220	! CHS -- wait
	3221	! CHS2 -- wait
	3222	! CPM -- wait
	3223	! CQS2 -- wait
	3224	! FLHC -- wait
	3225	! FLQC -- wait
	3226	! HFX -- wait
	3227	! LH -- wait
	3228	! QFX -- wait
	3229	! QGH -- wait
	3230
	3231	! INTENT (OUT) from PXSFCLAY:
	3232	u10(i,j) = ( u10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j) )
	3233	v10(i,j) = ( v10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j) )
	3234	! QSFC -- wait
	3235	ENDIF
	3236	ENDDO
	3237	ENDDO
	3238
	3239	END SUBROUTINE pxsfclay_seaice_wrapper
	3240
	3241	!-------------------------------------------------------------------------
	3242
	3243	SUBROUTINE TOPO_RAD_ADJ_DRVR (XLAT,XLONG,COSZEN, &
	3244	shadowmask, &
	3245	declin, &
	3246	SWDOWN,GSW,SWNORM,GSWSAVE,solcon,hrang2d, &
	3247	slope_in,slp_azi_in, &
	3248	ids, ide, jds, jde, kds, kde, &
	3249	ims, ime, jms, jme, kms, kme, &
	3250	its, ite, jts, jte, kts, kte )
	3251	!------------------------------------------------------------------
	3252	IMPLICIT NONE
	3253	!------------------------------------------------------------------
	3254	INTEGER, INTENT(IN) :: its,ite,jts,jte,kts,kte, &
	3255	ims,ime,jms,jme,kms,kme, &
	3256	ids,ide,jds,jde,kds,kde
	3257	INTEGER, DIMENSION( ims:ime, jms:jme ), &
	3258	INTENT(IN) :: shadowmask
	3259	REAL, DIMENSION( ims:ime, jms:jme ), &
	3260	INTENT(IN ) :: XLAT,XLONG
	3261	REAL, DIMENSION( ims:ime, jms:jme ), &
	3262	INTENT(INOUT) :: SWDOWN,GSW,SWNORM,GSWSAVE
	3263	real,intent(in) :: solcon
	3264	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: hrang2d,coszen
	3265
	3266
	3267	REAL, INTENT(IN ) :: declin
	3268	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: slope_in,slp_azi_in
	3269
	3270
	3271	! LOCAL VARS
	3272	integer :: i,j
	3273	real :: pi,degrad
	3274	integer :: shadow
	3275	real :: swdown_teradj,swdown_in,xlat1,xlong1
	3276
	3277	!------------------------------------------------------------------
	3278
	3279	pi = 4.*atan(1.)
	3280	degrad=pi/180.
	3281
	3282	DO J=jts,jte
	3283	DO I=its,ite
	3284	SWNORM(i,j) = SWDOWN(i,j) ! save
	3285	IF(SWDOWN(I,J) .GT. 1.E-3)THEN ! daytime
	3286	shadow = shadowmask(i,j)
	3287
	3288	SWDOWN_IN = SWDOWN(i,j)
	3289	XLAT1 = XLAT(i,j)
	3290	XLONG1 = XLONG(i,j)
	3291	CALL TOPO_RAD_ADJ (XLAT1,XLONG1,COSZEN(i,j), &
	3292	DECLIN,DEGRAD, &
	3293	SWDOWN_IN,solcon,hrang2d(i,j),SWDOWN_teradj, &
	3294	kts,kte, &
	3295	slope_in(i,j),slp_azi_in(i,j), &
	3296	shadow , i,j &
	3297	)
	3298
	3299	GSWSAVE(I,J) = GSW(I,J) ! save
	3300	GSW(I,J) = GSW(I,J)*SWDOWN_teradj/SWDOWN(i,j)
	3301	SWDOWN(i,j) = SWDOWN_teradj
	3302
	3303	ENDIF ! daytime
	3304	ENDDO ! i_loop
	3305	ENDDO ! j_loop
	3306
	3307
	3308	END SUBROUTINE TOPO_RAD_ADJ_DRVR
	3309	!------------------------------------------------------------------
	3310	!------------------------------------------------------------------
	3311	SUBROUTINE TOPO_RAD_ADJ (XLAT1,XLONG1,COSZEN, &
	3312	DECLIN,DEGRAD, &
	3313	SWDOWN_IN,solcon,hrang,SWDOWN_teradj, &
	3314	kts,kte, &
	3315	slope,slp_azi, &
	3316	shadow &
	3317	,i,j)
	3318
	3319	!------------------------------------------------------------------
	3320	IMPLICIT NONE
	3321	!------------------------------------------------------------------
	3322	INTEGER, INTENT(IN) :: kts,kte
	3323	REAL, INTENT(IN) :: COSZEN,DECLIN, &
	3324	XLAT1,XLONG1,DEGRAD
	3325	REAL, INTENT(IN) :: SWDOWN_IN,solcon,hrang
	3326	INTEGER, INTENT(IN) :: shadow
	3327	REAL, INTENT(IN) :: slp_azi,slope
	3328
	3329	REAL, INTENT(OUT) :: SWDOWN_teradj
	3330
	3331	! LOCAL VARS
	3332	REAL :: XT24,TLOCTM,CSZA,XXLAT
	3333	REAL :: diffuse_frac,corr_fac,csza_slp
	3334	integer :: i,j
	3335
	3336
	3337	!------------------------------------------------------------------
	3338
	3339	SWDOWN_teradj=SWDOWN_IN
	3340
	3341	CSZA=COSZEN
	3342	XXLAT=XLAT1*DEGRAD
	3343
	3344	! RETURN IF NIGHT
	3345	IF(CSZA.LE.1.E-9) return
	3346
	3347	! Parameterize diffuse fraction of global solar radiation as a function of the ratio between TOA radiation and surface global radiation
	3348	diffuse_frac = min(1.,1./(max(0.1,2.1-2.8log(log(cszasolcon/max(SWDOWN_IN,1.e-3))))))
	3349	if ((slope.eq.0).or.(diffuse_frac.eq.1).or.(csza.lt.1.e-2)) then ! no topographic effects when all radiation diffuse or sun too close to horizon
	3350	corr_fac = 1
	3351	goto 140
	3352	endif
	3353
	3354	! cosine of zenith angle over sloping topography
	3355	csza_slp = ((SIN(XXLAT)COS(HRANG)) &
	3356	(-cos(slp_azi)sin(slope))-SIN(HRANG)(sin(slp_azi)*sin(slope))+ &
	3357	(COS(XXLAT)COS(HRANG))cos(slope))* &
	3358	COS(DECLIN)+(COS(XXLAT)(cos(slp_azi)sin(slope))+ &
	3359	SIN(XXLAT)cos(slope))SIN(DECLIN)
	3360	IF(csza_slp.LE.1.E-4) csza_slp = 0
	3361
	3362	! Topographic shading
	3363	if (shadow.eq.1) csza_slp = 0
	3364
	3365	! Correction factor for sloping topography; the diffuse fraction of solar radiation is assumed to be unaffected by the slope
	3366	corr_fac = diffuse_frac + (1-diffuse_frac)*csza_slp/csza
	3367
	3368	140 continue
	3369
	3370	SWDOWN_teradj=(1.)SWDOWN_INcorr_fac
	3371
	3372	END SUBROUTINE TOPO_RAD_ADJ
	3373
	3374	!=======================================================================
	3375
	3376	SUBROUTINE get_local_ice_tsk ( ims, ime, jms, jme, &
	3377	its, ite, jts, jte, &
	3378	itimestep, &
	3379	sfc_layer_values, &
	3380	tice2tsk_if2cold, &
	3381	XICE, XICE_THRESHOLD, &
	3382	SST, TSK, TSK_SEA, TSK_ICE )
	3383	!<DESCRIPTION>
	3384	!
	3385	! For grid cells with a fractional ice area, derive the ice surface
	3386	! temperature from the area-averaged surface temperature (the blended
	3387	! result of the open-water values (SST) and the ice-covered value).
	3388	!
	3389	!</DESCRIPTION>
	3390
	3391	IMPLICIT NONE
	3392
	3393	INTEGER, INTENT(IN) :: ims, ime, jms, jme !-- start/end index for i/j in memory
	3394	INTEGER, INTENT(IN) :: its, ite, jts, jte !-- start/end index for i/j in tile
	3395	INTEGER, INTENT(IN) :: itimestep !-- timestep
	3396	LOGICAL, INTENT(IN) :: sfc_layer_values !-- True if there are surface layer routine values
	3397	!-- available from the ice portion of the grid point
	3398	!-- (i.e. called from a seaice_wrapper subroutine)
	3399	LOGICAL, INTENT(IN) :: tice2tsk_if2cold !-- True to set TSK_ICE to TSK. This may be
	3400	!-- necessary to avoid unphysically low ice
	3401	!-- temperatures is there is a mis-match between
	3402	!-- ice fraction and surface temperature.
	3403
	3404	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: XICE ! Ice fraction
	3405	REAL , INTENT(IN) :: XICE_THRESHOLD
	3406	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: TSK ! Surface temperature (K)
	3407	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: SST ! Sea surface temperature (K)
	3408	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: TSK_SEA ! Sfc temp of open water portion of grid cell
	3409	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: TSK_ICE ! Sfc temp of ice oprtion of grid cell
	3410
	3411	! Local
	3412	INTEGER :: i,j
	3413
	3414	DO j = JTS , JTE
	3415	DO i = ITS , ITE
	3416	IF ( ( XICE(i,j) >= XICE_THRESHOLD ) .AND. ( XICE(I,J) <= 1.0 ) ) THEN
	3417
	3418	IF ( SST(i,j) < 271.4 ) THEN
	3419	SST(i,j) = 271.4
	3420	ENDIF
	3421
	3422	IF (sfc_layer_values) THEN
	3423	IF ( SST(i,j) > 273. .AND. itimestep <= 3) then
	3424	! Why the dependence on the time step count, here?
	3425	IF ( XICE(i,j) >= 0.6 ) THEN
	3426	SST(i,j) = 271.4
	3427	ELSEIF ( XICE(i,j) >= 0.4 ) THEN
	3428	SST(i,j) = 273.
	3429	ELSEIF (XICE(i,j) >= 0.2 .AND. SST(i,j) > 275.) THEN
	3430	SST(i,j) = 275.
	3431	ELSEIF (SST(i,j) > 278.) THEN
	3432	SST(i,j) = 278.
	3433	ENDIF
	3434	ENDIF
	3435	ENDIF
	3436	TSK_SEA(i,j) = SST(i,j)
	3437
	3438	IF ( tice2tsk_if2cold ) THEN
	3439	!------------------------------------------------------------------------------------
	3440	! This avoids unphysically low ice temperatures for grid cells with low ice fractions
	3441	! and low area-averaged temperatures. This can happen when the initial ice fraction
	3442	! and surface temperature come from different data sets.
	3443	!------------------------------------------------------------------------------------
	3444	TSK_ICE(i,j) = MIN( TSK(i,j), 273.15 )
	3445	ELSE
	3446	TSK_ICE(i,j) = ( TSK(i,j) - (1.0-XICE(i,j)) * SST(i,j) ) / XICE(i,j)
	3447	ENDIF
	3448
	3449	IF ( ( XICE(i,j) < 0.2 ) .AND. ( TSK(i,j) < 253.15 ) ) THEN
	3450	TSK_ICE(i,j) = 253.15
	3451	ENDIF
	3452	IF ( ( XICE(i,j) < 0.1 ) .AND. ( TSK(i,j) < 263.15 ) ) THEN
	3453	TSK_ICE(i,j) = 263.15
	3454	ENDIF
	3455	ELSE
	3456	! land/open-water point
	3457	TSK_SEA(i,j) = TSK(i,j)
	3458	TSK_ICE(i,j) = TSK(i,j)
	3459	ENDIF
	3460	ENDDO
	3461	ENDDO
	3462
	3463	END SUBROUTINE get_local_ice_tsk
	3464
	3465	!=======================================================================
	3466	!=======================================================================
	3467
	3468	END MODULE module_surface_driver

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

Download in other formats:

Original Format