Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_surface_driver.F @ 2295

Last change on this file since 2295 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

Line
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