| blob | fe8ead7badc829ba7090310034b306ba0d3784de |
1 !WRF:MEDIATION_LAYER:PHYSICS
2 !
3 MODULE module_surface_driver
4 CONTAINS
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,seaice_albedo_opt,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 &
33 & ,scm_force_skintemp,scm_force_flux,t2,emiss &
34 & ,sf_sfclay_physics,sf_surface_physics,ra_lw_physics &
35 & ,mosaic_lu,mosaic_soil &
36 & ,landusef,soilctop,soilcbot,ra,rs,nlcat,nscat,vegf_px & ! PX-LSM
37 & ,snowncv, anal_interval, lai, pxlsm_smois_init & ! PX-LSM
38 & ,pxlsm_soil_nudge & ! PX-LSM
39 & ,idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, iopt_inf &
40 & ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc &
41 & ,isnowxy ,tvxy ,tgxy ,canicexy &
42 & ,canliqxy ,eahxy ,tahxy ,cmxy ,chxy &
43 & ,fwetxy ,sneqvoxy ,alboldxy ,qsnowxy ,wslakexy ,zwtxy ,waxy &
44 & ,wtxy ,tsnoxy ,zsnsoxy ,snicexy ,snliqxy ,lfmassxy ,rtmassxy &
45 & ,stmassxy ,woodxy ,stblcpxy ,fastcpxy ,xsaixy &
46 & ,tradxy ,tsxy ,neexy ,gppxy ,nppxy ,fvegxy ,qinxy &
47 & ,runsfxy ,runsbxy ,ecanxy ,edirxy ,etranxy ,fsaxy ,firaxy &
48 & ,aparxy ,psnxy ,savxy ,sagxy &
49 & ,fsnoxy &
50 & ,t2mvxy ,t2mbxy ,chstarxy ,rssunxy ,rsshaxy ,bgapxy ,wgapxy &
51 & ,gapxy ,tgvxy ,tgbxy ,q2mvxy ,q2mbxy ,chvxy ,chbxy &
52 #if ( EM_CORE==1)
53 & ,ch,tsq,qsq,cov & ! MYNN
54 #endif
55 ! Optional urban
56 & ,slope_rad,topo_shading,shadowmask & !I solar
57 & ,swnorm,slope,slp_azi & !I solar
58 & ,declin,solcon,coszen,hrang,xlat_urb2d & !I solar/urban
59 & ,num_roof_layers, num_wall_layers & !I urban
60 & ,num_road_layers, dzr, dzb, dzg & !I urban
61 & ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d & !H urban
62 & ,uc_urb2d & !H urban
63 & ,xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d & !H urban
64 & ,trl_urb3d,tbl_urb3d,tgl_urb3d & !H urban
65 & ,sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d & !H urban
66 & ,frc_urb2d, utype_urb2d & !H urban
67 & ,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif &
68 !-----SSiB LSM (fds 06/2010)---------------------------------------------------
69 & ,alswvisdir, alswvisdif, alswnirdir, alswnirdif & ! ssib
70 & ,swvisdir, swvisdif, swnirdir, swnirdif & ! ssib
71 & ,ssib_br ,ssib_fm ,ssib_fh ,ssib_cm ,ssibxdd & ! ssib
72 & ,ssib_lhf ,ssib_shf ,ssib_ghf ,ssib_egs ,ssib_eci & ! ssib
73 & ,ssib_ect ,ssib_egi ,ssib_egt ,ssib_sdn ,ssib_sup & ! ssib
74 & ,ssib_ldn ,ssib_lup ,ssib_wat ,ssib_shc ,ssib_shg & ! ssib
75 & ,ssib_lai ,ssib_vcf ,ssib_z00 ,ssib_veg & ! ssib
76 & ,ISNOW ,SWE ,SNOWDEN ,SNOWDEPTH ,TKAIR & ! ssib-snow
77 & ,DZO1 ,WO1 ,TSSN1 ,TSSNO1 ,BWO1 ,BTO1 & ! ssib-snow
78 & ,CTO1 ,FIO1 ,FLO1 ,BIO1 ,BLO1 ,HO1 & ! ssib-snow
79 & ,DZO2 ,WO2 ,TSSN2 ,TSSNO2 ,BWO2 ,BTO2 & ! ssib-snow
80 & ,CTO2 ,FIO2 ,FLO2 ,BIO2 ,BLO2 ,HO2 & ! ssib-snow
81 & ,DZO3 ,WO3 ,TSSN3 ,TSSNO3 ,BWO3 ,BTO3 & ! ssib-snow
82 & ,CTO3 ,FIO3 ,FLO3 ,BIO3 ,BLO3 ,HO3 & ! ssib-snow
83 & ,DZO4 ,WO4 ,TSSN4 ,TSSNO4 ,BWO4 ,BTO4 & ! ssib-snow
84 & ,CTO4 ,FIO4 ,FLO4 ,BIO4 ,BLO4 ,HO4 & ! ssib-snow
85 & ,ra_sw_physics & ! ssib
86 !------------------------------------------------------------------------------
87 & , ids,ide,jds,jde,kds,kde &
88 & , ims,ime,jms,jme,kms,kme &
89 & , i_start,i_end,j_start,j_end,kts,kte,num_tiles &
90 ! Optional moisture tracers
91 & ,qv_curr, qc_curr, qr_curr &
92 & ,qi_curr, qs_curr, qg_curr &
93 ! Optional moisture tracer flags
94 & ,f_qv,f_qc,f_qr &
95 & ,f_qi,f_qs,f_qg &
96 ! Other optionals (more or less em specific)
97 & ,capg,hol,mol &
98 & ,rainncv,rainshv,rainbl,regime,thc &
99 & ,qsg,qvg,qcg,soilt1,tsnav &
100 & ,smfr3d,keepfr3dflag,dew &
101 ! Other optionals (more or less nmm specific)
102 & ,potevp,snopcx,soiltb,sr &
103 ! Optional observation PX LSM surface nudging
104 & ,t2_ndg_old, q2_ndg_old, t2_ndg_new, q2_ndg_new &
105 & ,sn_ndg_old, sn_ndg_new &
106 & ,t2obs, q2obs &
107 ! OPTIONAL, Required by TEMF surface layer 1/7/09 WA
108 & ,hd_temf,te_temf,fCor,exch_temf,wm_temf &
109 ! Required by ideal SCM surface layer 1/6/10 WA
110 & ,hfx_force,lh_force,tsk_force &
111 & ,hfx_force_tend,lh_force_tend,tsk_force_tend &
112 ! Optional observation nudging
113 & ,uratx,vratx,tratx &
114 ! Optional simple oml model
115 & ,omlcall,oml_hml0,oml_gamma &
116 & ,tml,t0ml,hml,h0ml,huml,hvml,f,tmoml &
117 & ,ustm,ck,cka,cd,cda,isftcflx,iz0tlnd &
118 & ,isurban, mminlu &
119 & ,snotime &
120 & ,rdlai2d &
121 & ,usemonalb &
122 & ,noahres &
123 ! Optional adaptive time step
124 & ,bldt,curr_secs,adapt_step_flag,bldtacttime &
125 ! Optional urban with BEP
126 & ,sf_urban_physics,gmt,xlat,xlong,julday &
127 & ,num_urban_layers & !multi-layer urban
128 & ,trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d & !multi-layer urban
129 & ,tlev_urb3d,qlev_urb3d & !multi-layer urban
130 & ,tw1lev_urb3d,tw2lev_urb3d & !multi-layer urban
131 & ,tglev_urb3d,tflev_urb3d & !multi-layer urban
132 & ,sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d & !multi-layer urban
133 & ,sfvent_urb3d,lfvent_urb3d & !multi-layer urban
134 & ,sfwin1_urb3d,sfwin2_urb3d & !multi-layer urban
135 & ,sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d & !multi-layer urban
136 & ,a_u_bep,a_v_bep,a_t_bep,a_q_bep &
137 & ,b_u_bep,b_v_bep,b_t_bep,b_q_bep &
138 & ,sf_bep,vl_bep &
139 & ,a_e_bep,b_e_bep,dlg_bep &
140 & ,dl_u_bep &
141 & ,cldfra & !ssib
142 ! Optional urban Bep end
143 & )
145 #if ( ! NMM_CORE == 1 )
146 USE module_state_description, ONLY : SFCLAYSCHEME &
147 ,SFCLAYREVSCHEME &
148 ,MYJSFCSCHEME &
149 ,QNSESFCSCHEME &
150 ,GFSSFCSCHEME &
151 ,PXSFCSCHEME &
152 ,NOAHMPSCHEME &
153 ,TEMFSFCSCHEME &
154 ,IDEALSCMSFCSCHEME &
155 ,SLABSCHEME &
156 ,LSMSCHEME &
157 ,RUCLSMSCHEME &
158 ,PXLSMSCHEME &
159 ,SSIBSCHEME & !ssib
160 ,MYNNSFCSCHEME
161 #else
162 USE module_state_description, ONLY : SFCLAYSCHEME &
163 ,SFCLAYREVSCHEME &
164 ,MYJSFCSCHEME &
165 ,QNSESFCSCHEME &
166 ,GFSSFCSCHEME &
167 ,PXSFCSCHEME &
168 ,NOAHMPSCHEME &
169 ,SLABSCHEME &
170 ,LSMSCHEME &
171 ,RUCLSMSCHEME &
172 ,PXLSMSCHEME &
173 ,TEMFSFCSCHEME &
174 ,GFDLSFCSCHEME &
175 ,SSIBSCHEME & ! ssib
176 ,GFDLSLAB
179 #endif
180 USE module_model_constants
181 ! *** add new modules of schemes here
183 USE module_sf_sfclay
184 USE module_sf_myjsfc
185 USE module_sf_qnsesfc
186 USE module_sf_gfs
187 USE module_sf_noahdrv, only : lsm
188 USE module_sf_noahmpdrv, only : noahmplsm
189 USE module_sf_noah_seaice_drv
190 USE module_sf_ssib ! ssib
191 USE module_sf_ruclsm
192 USE module_sf_pxsfclay
193 USE module_sf_pxlsm
194 USE module_sf_temfsfclay
195 USE module_sf_sfclayrev
196 USE module_sf_noah_seaice_drv
197 #if ( EM_CORE==1)
198 USE module_sf_mynn
199 USE module_sf_oml
200 USE module_sf_idealscmsfclay
201 #endif
202 USE module_sf_scmflux
203 USE module_sf_scmskintemp
205 #if ( NMM_CORE == 1 )
206 USE module_sf_gfdl
207 #endif
209 USE module_sf_slab
210 !
211 USE module_sf_sfcdiags
212 USE module_sf_sfcdiags_ruclsm
213 USE module_sf_sstskin
214 USE module_sf_tmnupdate
215 !
216 ! This driver calls subroutines for the surface parameterizations.
217 !
218 ! surface layer: (between surface and pbl)
219 ! 1. sfclay
220 ! 2. myjsfc
221 ! 7. Pleim surface layer
222 ! 5. MYNN surface layer
223 ! surface: ground temp/lsm scheme:
224 ! 1. slab
225 ! 2. Noah LSM
226 ! 7. Pleim-Xiu LSM
227 ! 11. Revised sfclay (option 1)
228 !
229 ! surface: ground temp/lsm scheme for urban:
230 ! 2. BEP
231 !
232 ! ocean mixed layer model
233 ! omlcall = 1
234 !------------------------------------------------------------------
235 IMPLICIT NONE
236 !======================================================================
237 ! Grid structure in physics part of WRF
238 !----------------------------------------------------------------------
239 ! The horizontal velocities used in the physics are unstaggered
240 ! relative to temperature/moisture variables. All predicted
241 ! variables are carried at half levels except w, which is at full
242 ! levels. Some arrays with names (*8w) are at w (full) levels.
243 !
244 !----------------------------------------------------------------------
245 ! In WRF, kms (smallest number) is the bottom level and kme (largest
246 ! number) is the top level. In your scheme, if 1 is at the top level,
247 ! then you have to reverse the order in the k direction.
248 !
249 ! kme - half level (no data at this level)
250 ! kme ----- full level
251 ! kme-1 - half level
252 ! kme-1 ----- full level
253 ! .
254 ! kms+2 - half level
255 ! kms+2 ----- full level
256 ! kms+1 - half level
257 ! kms+1 ----- full level
258 ! kms - half level
259 ! kms ----- full level
260 !
261 !======================================================================
262 ! Definitions
263 !-----------
264 ! Theta potential temperature (K)
265 ! Qv water vapor mixing ratio (kg/kg)
266 ! Qc cloud water mixing ratio (kg/kg)
267 ! Qr rain water mixing ratio (kg/kg)
268 ! Qi cloud ice mixing ratio (kg/kg)
269 ! Qs snow mixing ratio (kg/kg)
270 !-----------------------------------------------------------------
271 !-- itimestep number of time steps
272 !-- GLW downward long wave flux at ground surface (W/m^2)
273 !-- GSW net short wave flux at ground surface (W/m^2)
274 !-- SWDOWN downward short wave flux at ground surface (W/m^2)
275 !-- EMISS surface emissivity (between 0 and 1)
276 !-- TSK surface temperature (K)
277 !-- TMN soil temperature at lower boundary (K)
278 !-- TYR annual mean surface temperature of previous year (K)
279 !-- TYRA accumulated surface temperature in the current year (K)
280 !-- TLAG mean surface temperature of previous 140 days (K)
281 !-- TDLY accumulated daily mean surface temperature of the current day (K)
282 !-- XLAND land mask (1 for land, 2 for water)
283 !-- ZNT time-varying roughness length (m)
284 !-- Z0 background roughness length (m)
285 !-- MAVAIL surface moisture availability (between 0 and 1)
286 !-- UST u* in similarity theory (m/s)
287 !-- MOL T* (similarity theory) (K)
288 !-- HOL PBL height over Monin-Obukhov length
289 !-- PBLH PBL height (m)
290 !-- CAPG heat capacity for soil (J/K/m^3)
291 !-- THC thermal inertia (Cal/cm/K/s^0.5)
292 !-- SNOWC flag indicating snow coverage (1 for snow cover)
293 !-- HFX net upward heat flux at the surface (W/m^2)
294 !-- QFX net upward moisture flux at the surface (kg/m^2/s)
295 !-- TAUX RHO*U**2 for ocean coupling
296 !-- TAUY RHO*U**2 for ocean coupling
297 !-- LH net upward latent heat flux at surface (W/m^2)
298 !-- REGIME flag indicating PBL regime (stable, unstable, etc.)
299 !-- tke_pbl turbulence kinetic energy from PBL schemes (m^2/s^2)
300 !-- akhs sfc exchange coefficient of heat/moisture from MYJ
301 !-- akms sfc exchange coefficient of momentum from MYJ
302 !-- thz0 potential temperature at roughness length (K)
303 !-- uz0 u wind component at roughness length (m/s)
304 !-- vz0 v wind component at roughness length (m/s)
305 !-- qsfc specific humidity at lower boundary (kg/kg)
306 !-- uratx ratio of u over u10 (Added for obs-nudging)
307 !-- vratx ratio of v over v10 (Added for obs-nudging)
308 !-- tratx ratio of t over th2 (Added for obs-nudging)
309 !-- u10 diagnostic 10-m u component from surface layer
310 !-- v10 diagnostic 10-m v component from surface layer
311 !-- th2 diagnostic 2-m theta from surface layer and lsm
312 !-- t2 diagnostic 2-m temperature from surface layer and lsm
313 !-- q2 diagnostic 2-m mixing ratio from surface layer and lsm
314 !-- tshltr diagnostic 2-m theta from MYJ
315 !-- th10 diagnostic 10-m theta from MYJ
316 !-- qshltr diagnostic 2-m specific humidity from MYJ
317 !-- q10 diagnostic 10-m specific humidity from MYJ
318 !-- lowlyr index of lowest model layer above ground
319 !-- rr dry air density (kg/m^3)
320 !-- u_phy u-velocity interpolated to theta points (m/s)
321 !-- v_phy v-velocity interpolated to theta points (m/s)
322 !-- th_phy potential temperature (K)
323 !-- moist moisture array (4D - last index is species) (kg/kg)
324 !-- p_phy pressure (Pa)
325 !-- pi_phy exner function (dimensionless)
326 !-- pshltr diagnostic shelter (2m) pressure from MYJ (Pa)
327 !-- p8w pressure at full levels (Pa)
328 !-- t_phy temperature (K)
329 !-- dz8w dz between full levels (m)
330 !-- z height above sea level (m)
331 !-- DX horizontal space interval (m)
332 !-- DT time step (second)
333 !-- PSFC pressure at the surface (Pa)
334 !-- SST sea-surface temperature (K)
335 !-- SSTSK skin sea-surface temperature (K)
336 !-- DTW warm layer temp diff (K)
337 !-- TSLB
338 !-- ZS
339 !-- DZS
340 !-- num_soil_layers number of soil layer
341 !-- IFSNOW ifsnow=1 for snow-cover effects
342 !-- omlcall whether to call simple ocean mixed layer model from slab (1 = use oml)
343 !-- oml_hml0 initial mixed layer depth (if real-data not available, default 50 m)
344 !-- oml_gamma lapse rate below mixed layer in ocean (default 0.14 K m-1)
345 !-- ck enthalpy exchange coeff at 10 meters
346 !-- cd momentum exchange coeff at 10 meters
347 !-- cka enthalpy exchange coeff at the lowest model level
348 !-- cda momentum exchange coeff at the lowest model level
349 !!!!!!!!!!!!!!
350 !
351 !
352 !-- LANDUSEF Landuse fraction ! P-X LSM
353 !-- SOILCTOP Top soil fraction ! P-X LSM
354 !-- SOILCBOT Bottom soil fraction ! P-X LSM
355 !-- RA Aerodynamic resistence ! P-X LSM
356 !-- RS Stomatal resistence ! P-X LSM
357 !-- NLCAT Number of landuse categories ! P-X LSM
358 !-- NSCAT Number of soil categories ! P-X LSM
359 !-- ch - drag coefficient for heat/moisture ! MYNN LSM
361 !
362 !-- ids start index for i in domain
363 !-- ide end index for i in domain
364 !-- jds start index for j in domain
365 !-- jde end index for j in domain
366 !-- kds start index for k in domain
367 !-- kde end index for k in domain
368 !-- ims start index for i in memory
369 !-- ime end index for i in memory
370 !-- jms start index for j in memory
371 !-- jme end index for j in memory
372 !-- kms start index for k in memory
373 !-- kme end index for k in memory
374 !-- its start index for i in tile
375 !-- ite end index for i in tile
376 !-- jts start index for j in tile
377 !-- jte end index for j in tile
378 !-- kts start index for k in tile
379 !-- kte end index for k in tile
380 !
381 !******************************************************************
382 !------------------------------------------------------------------
384 INTEGER, INTENT(IN) :: &
385 & ids,ide,jds,jde,kds,kde &
386 & ,ims,ime,jms,jme,kms,kme &
387 & ,kts,kte,num_tiles
389 INTEGER, INTENT(IN):: FRACTIONAL_SEAICE
390 INTEGER, INTENT(IN):: SEAICE_ALBEDO_OPT
392 INTEGER, INTENT(IN):: NLCAT, mosaic_lu, mosaic_soil
393 INTEGER, INTENT(IN):: NSCAT
395 INTEGER, INTENT(IN) :: sf_sfclay_physics, sf_surface_physics, &
396 sf_urban_physics,ra_lw_physics,sst_update, &
397 ra_sw_physics
398 INTEGER, INTENT(IN),OPTIONAL :: sst_skin, tmn_update, &
399 scm_force_skintemp, scm_force_flux
401 INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
402 & i_start,i_end,j_start,j_end
404 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: ISLTYP
405 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: IVGTYP
406 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: LOWLYR
407 INTEGER, INTENT(IN ):: IFSNOW
408 INTEGER, INTENT(IN ):: ISFFLX
409 INTEGER, INTENT(IN ):: ITIMESTEP
410 INTEGER, INTENT(IN ):: NUM_SOIL_LAYERS
411 REAL, INTENT(IN ),OPTIONAL :: JULIAN_in
412 INTEGER, INTENT(IN ):: LAGDAY
413 INTEGER, INTENT(IN ):: STEPBL
414 INTEGER, INTENT(IN ):: ISICE
415 INTEGER, INTENT(IN ):: ISWATER
416 INTEGER, INTENT(IN ), OPTIONAL :: ISURBAN
417 CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: MMINLU
418 LOGICAL, INTENT(IN ):: WARM_RAIN
419 LOGICAL, INTENT(IN):: tice2tsk_if2cold
420 INTEGER, INTENT(INOUT ),OPTIONAL :: NYEAR
421 REAL , INTENT(INOUT ),OPTIONAL :: NDAY
422 INTEGER, INTENT(IN ),OPTIONAL :: YR
423 REAL , INTENT(IN ):: U_FRAME
424 REAL , INTENT(IN ):: V_FRAME
425 #if (NMM_CORE==1)
426 real , intent(IN ):: SFENTH
427 #endif
428 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SMOIS
429 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: TSLB
430 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(OUT) :: SMCREL
431 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: GLW
432 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: GSW,SWDOWN
433 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: HT
434 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: RAINCV
435 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: SST
436 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: SSTSK
437 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: DTW
438 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: TMN
439 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: TYR
440 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: TYRA
441 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: TDLY
442 REAL, DIMENSION( ims:ime , 1:lagday , jms:jme ), INTENT(INOUT ),OPTIONAL :: TLAG
443 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: VEGFRA
444 !------fds (06/2010)--------------------------
445 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XICE
446 !---------------------------------------------
447 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XLAND
448 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XICEM
449 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MAVAIL
450 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: SNOALB
451 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ACSNOW
452 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SNOTIME
453 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKHS
454 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKMS
455 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ALBEDO
456 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: CANWAT
458 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: GRDFLX
459 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: HFX
460 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: RMOL
461 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: PBLH
462 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: Q2
463 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QFX
464 #if (NMM_CORE==1)
465 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT):: TAUX
466 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT):: TAUY
467 #endif
468 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QSFC
469 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QZ0
470 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SFCRUNOFF
471 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTAV
472 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTOT
473 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOW
474 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWC
475 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWH
476 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TH2
477 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: THZ0
478 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TSK
479 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UDRUNOFF
480 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UST
481 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UZ0
482 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: VZ0
483 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: WSPD
484 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ZNT
485 !-----fds (06/2010)---------------------------------------------
486 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_LHF ! SSiB output
487 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SHF ! SSiB output
488 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_GHF ! SSiB output
489 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_EGS ! SSiB output
490 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_ECI ! SSiB output
491 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_ECT ! SSiB output
492 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_EGI ! SSiB output
493 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_EGT ! SSiB output
494 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SDN ! SSiB output
495 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SUP ! SSiB output
496 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_LDN ! SSiB output
497 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_LUP ! SSiB output
498 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_WAT ! SSiB output
499 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SHC ! SSiB output
500 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SHG ! SSiB output
501 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_LAI ! SSiB output
502 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_VCF ! SSiB output
503 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_Z00 ! SSiB output
504 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_VEG ! SSiB output
505 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: ALSWVISDIR! SSiB
506 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: ALSWVISDIF! SSiB
507 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: ALSWNIRDIR! SSiB
508 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: ALSWNIRDIF! SSiB
509 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN):: SWVISDIR! SSiB
510 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN):: SWVISDIF! SSiB
511 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN):: SWNIRDIR! SSiB
512 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN):: SWNIRDIF! SSiB
513 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiB_BR ! SSiB
514 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiB_FM ! SSiB
515 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiB_FH ! SSiB
516 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiB_CM ! SSiB
517 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiBXDD ! SSiB
518 INTEGER, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: ISNOW ! ssib-snow
519 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SWE ! ssib-snow
520 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SNOWDEN ! ssib-snow
521 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SNOWDEPTH ! ssib-snow
522 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TKAIR ! ssib-snow
523 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: DZO1 ! ssib-snow
524 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: WO1 ! ssib-snow
525 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSN1 ! ssib-snow
526 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSNO1 ! ssib-snow
527 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BWO1 ! ssib-snow
528 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BTO1 ! ssib-snow
529 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: CTO1 ! ssib-snow
530 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FIO1 ! ssib-snow
531 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FLO1 ! ssib-snow
532 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BIO1 ! ssib-snow
533 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BLO1 ! ssib-snow
534 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: HO1 ! ssib-snow
535 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: DZO2 ! ssib-snow
536 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: WO2 ! ssib-snow
537 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSN2 ! ssib-snow
538 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSNO2 ! ssib-snow
539 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BWO2 ! ssib-snow
540 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BTO2 ! ssib-snow
541 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: CTO2 ! ssib-snow
542 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FIO2 ! ssib-snow
543 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FLO2 ! ssib-snow
544 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BIO2 ! ssib-snow
545 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BLO2 ! ssib-snow
546 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: HO2 ! ssib-snow
547 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: DZO3 ! ssib-snow
548 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: WO3 ! ssib-snow
549 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSN3 ! ssib-snow
550 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSNO3 ! ssib-snow
551 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BWO3 ! ssib-snow
552 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BTO3 ! ssib-snow
553 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: CTO3 ! ssib-snow
554 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FIO3 ! ssib-snow
555 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FLO3 ! ssib-snow
556 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BIO3 ! ssib-snow
557 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BLO3 ! ssib-snow
558 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: HO3 ! ssib-snow
559 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: DZO4 ! ssib-snow
560 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: WO4 ! ssib-snow
561 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSN4 ! ssib-snow
562 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSNO4 ! ssib-snow
563 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BWO4 ! ssib-snow
564 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BTO4 ! ssib-snow
565 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: CTO4 ! ssib-snow
566 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FIO4 ! ssib-snow
567 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FLO4 ! ssib-snow
568 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BIO4 ! ssib-snow
569 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BLO4 ! ssib-snow
570 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: HO4 ! ssib-snow
571 !----------------------------------------------------------
572 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: BR
573 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: CHKLOWQ
574 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: GZ1OZ0
575 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSHLTR
576 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIH
577 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIM
578 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: Q10
579 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: QSHLTR
580 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TH10
581 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TSHLTR
582 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: U10
583 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: V10
584 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSFC
585 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: ACSNOM
586 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEVP
587 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL :: ACHFX
588 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL :: ACLHF
589 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL :: ACGRDFLX
590 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEXC
591 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLHC
592 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLQC
593 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CT
594 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: DZ8W
595 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P8W
596 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: PI_PHY
597 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P_PHY
598 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: RHO
599 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: TH_PHY
600 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: T_PHY
601 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: U_PHY
602 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: V_PHY
603 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: Z
605 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: TKE_PBL
606 REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: DZS
607 REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: ZS
608 REAL, INTENT(IN ):: DT
609 REAL, INTENT(IN ):: DX
610 REAL, INTENT(IN ),OPTIONAL :: bldt
611 REAL, INTENT(IN ),OPTIONAL :: curr_secs
612 LOGICAL, INTENT(IN ),OPTIONAL :: adapt_step_flag
613 REAL, INTENT(INOUT),OPTIONAL :: bldtacttime
615 ! arguments for NCAR surface physics
617 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: ALBBCK ! INOUT needed for NMM
618 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: EMBCK
619 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: LH
620 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SH2O
621 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMAX
622 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMIN
623 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: Z0
625 INTEGER, OPTIONAL, INTENT(IN) :: idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, iopt_stc
626 INTEGER, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: ISNOWXY
627 REAL, OPTIONAL, DIMENSION(ims:ime ,-2:num_soil_layers, jms:jme), INTENT(INOUT) :: zsnsoxy
628 REAL, OPTIONAL, DIMENSION(ims:ime ,-2:0, jms:jme), INTENT(INOUT) :: tsnoxy, snicexy, snliqxy
629 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, cmxy, chxy, &
630 fwetxy, sneqvoxy, alboldxy, qsnowxy, wslakexy, zwtxy, waxy, wtxy, lfmassxy, rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy, &
631 xsaixy, tradxy, tsxy, neexy, gppxy, nppxy, fvegxy, qinxy, runsfxy, runsbxy, ecanxy, edirxy, etranxy, fsaxy, firaxy, &
632 aparxy, psnxy, savxy, sagxy, fsnoxy, q2mvxy, q2mbxy
633 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: t2mvxy ,t2mbxy ,chstarxy, rssunxy, rsshaxy, bgapxy,wgapxy,gapxy , &
634 tgvxy ,tgbxy, chvxy, chbxy
636 ! Variables for multi-layer UCM
637 REAL, OPTIONAL, INTENT(IN ) :: GMT
638 INTEGER, OPTIONAL, INTENT(IN ) :: JULDAY
639 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) ::XLAT, XLONG
640 INTEGER, INTENT(IN ):: NUM_URBAN_LAYERS
641 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: trb_urb4d
642 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1_urb4d
643 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2_urb4d
644 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tgb_urb4d
645 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tlev_urb3d
646 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: qlev_urb3d
647 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1lev_urb3d
648 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2lev_urb3d
649 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tglev_urb3d
650 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tflev_urb3d
651 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d
652 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d
653 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d
654 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d
655 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d
656 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin1_urb3d
657 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin2_urb3d
658 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw1_urb3d
659 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw2_urb3d
660 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfr_urb3d
661 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfg_urb3d
662 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_u_bep !Implicit momemtum component X-direction
663 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_v_bep !Implicit momemtum component Y-direction
664 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_t_bep !Implicit component pot. temperature
665 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_e_bep !Implicit component TKE
666 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_q_bep !Implicit component TKE
667 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_u_bep !Explicit momentum component X-direction
668 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_v_bep !Explicit momentum component Y-direction
669 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_t_bep !Explicit component pot. temperature
670 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_e_bep !Explicit component TKE
671 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_q_bep !Explicit component TKE
672 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::vl_bep !Fraction air volume in grid cell
673 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dlg_bep !Height above ground
674 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::sf_bep !Fraction air at the face of grid cell
675 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dl_u_bep !Length scale
677 ! Optional
678 !
679 ! arguments for Ocean Mixed Layer Model
680 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT ):: TML, T0ML, HML, H0ML, HUML, HVML
681 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(IN ):: F, TMOML
682 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(OUT ):: CK, CKA, CD, CDA, USTM
684 #if ( EM_CORE==1)
685 REAL, DIMENSION( ims:ime , jms:jme ), &
686 &OPTIONAL, INTENT(INOUT ):: ch
688 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), &
689 &OPTIONAL, INTENT(IN ):: tsq,qsq,cov
690 #endif
693 INTEGER, OPTIONAL, INTENT(IN ):: slope_rad, topo_shading
694 INTEGER, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN):: shadowmask
695 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: swnorm
696 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN):: slope,slp_azi
698 INTEGER, OPTIONAL, INTENT(IN ):: ISFTCFLX,IZ0TLND
699 INTEGER, OPTIONAL, INTENT(IN ):: OMLCALL
700 REAL , OPTIONAL, INTENT(IN ):: OML_HML0
701 REAL , OPTIONAL, INTENT(IN ):: OML_GAMMA
702 !
703 ! Observation nudging
704 !
705 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: uratx !Added for obs-nudging
706 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: vratx !Added for obs-nudging
707 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: tratx !Added for obs-nudging
708 !
709 ! PX LSM Surface Grid Analysis nudging
710 !
711 INTEGER, OPTIONAL, INTENT(IN) :: pxlsm_smois_init, pxlsm_soil_nudge, ANAL_INTERVAL
712 REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , OPTIONAL, INTENT(INOUT):: LANDUSEF
713 REAL, DIMENSION( ims:ime, NSCAT, jms:jme ) , OPTIONAL, INTENT(INOUT):: SOILCTOP, SOILCBOT
714 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT):: VEGF_PX
715 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: RA
716 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: RS
717 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: LAI
718 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: T2OBS
719 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: Q2OBS
721 REAL, DIMENSION( ims:ime, jms:jme ), &
722 OPTIONAL, INTENT(INOUT) :: t2_ndg_old, &
723 q2_ndg_old, &
724 t2_ndg_new, &
725 q2_ndg_new, &
726 sn_ndg_old, &
727 sn_ndg_new
728 !
729 !
730 ! Flags relating to the optional tendency arrays declared above
731 ! Models that carry the optional tendencies will provdide the
732 ! optional arguments at compile time; these flags all the model
733 ! to determine at run-time whether a particular tracer is in
734 ! use or not.
735 !
736 LOGICAL, INTENT(IN), OPTIONAL :: &
737 f_qv &
738 ,f_qc &
739 ,f_qr &
740 ,f_qi &
741 ,f_qs &
742 ,f_qg
744 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
745 OPTIONAL, INTENT(INOUT) :: &
746 ! optional moisture tracers
747 ! 2 time levels; if only one then use CURR
748 qv_curr, qc_curr, qr_curr &
749 ,qi_curr, qs_curr, qg_curr
750 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN) :: snowncv
751 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: capg
752 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: emiss
753 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: hol
754 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: mol
755 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: regime
756 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: rainncv
757 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: rainshv
758 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: RAINBL
759 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: t2
760 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: thc
761 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qsg
762 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qvg
763 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qcg
764 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: dew
765 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soilt1
766 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: tsnav
767 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: potevp ! NMM LSM
768 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: snopcx ! NMM LSM
769 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soiltb ! NMM LSM
770 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: sr ! NMM and RUC LSM
771 REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: smfr3d
772 REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: keepfr3dflag
774 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT), OPTIONAL :: NOAHRES
776 ! Variables for TEMF surface layer
777 REAL,OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: te_temf
778 REAL,OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: hd_temf, exch_temf, wm_temf
779 REAL,OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: fCor
781 ! Variables for ideal SCM surface layer
782 REAL,OPTIONAL, INTENT(INOUT) :: hfx_force,lh_force,tsk_force
783 REAL,OPTIONAL, INTENT(IN ) :: hfx_force_tend,lh_force_tend,tsk_force_tend
785 ! LOCAL VAR
787 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
788 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
790 REAL, DIMENSION( ims:ime, jms:jme ) :: ZOL
792 REAL, DIMENSION( ims:ime, jms:jme ) :: &
793 QGH, &
794 CHS, &
795 CPM, &
796 CHS2, &
797 CQS2
798 ! SSIB local variables
799 REAL ZDIFF
800 !
801 REAL :: DTMIN,DTBL
802 !
803 INTEGER :: i,J,K,NK,jj,ij
804 INTEGER :: gfdl_ntsflg
805 LOGICAL :: radiation, myj, frpcpn, isisfc
806 LOGICAL, INTENT(in), OPTIONAL :: rdlai2d
807 LOGICAL, INTENT(in), OPTIONAL :: usemonalb
808 REAL :: total_depth,mid_point_depth
809 REAL :: tconst,tprior,tnew,yrday,deltat
810 REAL :: SWSAVE
811 REAL, DIMENSION( ims:ime, jms:jme ) :: GSWSAVE
812 !-------------------------------------------------
813 ! urban related variables are added to declaration
814 !-------------------------------------------------
815 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF
816 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF
817 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF
818 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF
819 REAL, OPTIONAL, INTENT(IN) :: DECLIN, SOLCON
820 REAL, OPTIONAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZEN
821 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: HRANG
822 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D !urban
823 INTEGER, INTENT(IN) :: num_roof_layers !urban
824 INTEGER, INTENT(IN) :: num_wall_layers !urban
825 INTEGER, INTENT(IN) :: num_road_layers !urban
826 REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZR !urban
827 REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZB !urban
828 REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZG !urban
830 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !urban
831 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !urban
832 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !urban
833 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TC_URB2D !urban
834 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: QC_URB2D !urban
835 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: UC_URB2D !urban
836 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXR_URB2D !urban
837 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXB_URB2D !urban
838 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXG_URB2D !urban
839 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXC_URB2D !urban
840 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
841 INTENT(INOUT) :: TRL_URB3D !urban
842 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
843 INTENT(INOUT) :: TBL_URB3D !urban
844 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
845 INTENT(INOUT) :: TGL_URB3D !urban
846 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !urban
847 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: LH_URB2D !urban
848 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: G_URB2D !urban
849 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: RN_URB2D !urban
850 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TS_URB2D !urban
851 !
852 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !urban
853 INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !urban
855 REAL, DIMENSION( ims:ime, jms:jme ) :: PSIM_URB2D !urban local var
856 REAL, DIMENSION( ims:ime, jms:jme ) :: PSIH_URB2D !urban local var
857 REAL, DIMENSION( ims:ime, jms:jme ) :: GZ1OZ0_URB2D !urban local var
858 !m REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_URB2D !urban local var
859 REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_URB2D !urban local var
860 REAL, DIMENSION( ims:ime, jms:jme ) :: U10_URB2D !urban local var
861 REAL, DIMENSION( ims:ime, jms:jme ) :: V10_URB2D !urban local var
862 REAL, DIMENSION( ims:ime, jms:jme ) :: TH2_URB2D !urban local var
863 REAL, DIMENSION( ims:ime, jms:jme ) :: Q2_URB2D !urban local var
864 REAL, DIMENSION( ims:ime, jms:jme ) :: UST_URB2D !urban local var
865 !--------fds (06/2010)---------------------------------------------
866 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
867 OPTIONAL, INTENT(IN) :: CLDFRA
868 REAL :: DAY, CLOUDFRAC
869 !------------------------------------------------------------------
870 !
871 REAL, DIMENSION( ims:ime, jms:jme ) :: HFX_SEA
872 REAL, DIMENSION( ims:ime, jms:jme ) :: QFX_SEA
873 REAL, DIMENSION( ims:ime, jms:jme ) :: LH_SEA
874 REAL, DIMENSION( ims:ime, jms:jme ) :: QSFC_SEA
875 REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_SEA
876 REAL, DIMENSION( ims:ime, jms:jme ) :: ZNT_SEA
878 REAL, DIMENSION( ims:ime, jms:jme ) :: CHS_SEA
879 REAL, DIMENSION( ims:ime, jms:jme ) :: CHS2_SEA
880 REAL, DIMENSION( ims:ime, jms:jme ) :: CQS2_SEA
881 REAL, DIMENSION( ims:ime, jms:jme ) :: CPM_SEA
882 REAL, DIMENSION( ims:ime, jms:jme ) :: FLHC_SEA
883 REAL, DIMENSION( ims:ime, jms:jme ) :: FLQC_SEA
884 REAL, DIMENSION( ims:ime, jms:jme ) :: QGH_SEA
885 !
886 REAL, DIMENSION( ims:ime, jms:jme ) :: PSIH_SEA
887 REAL, DIMENSION( ims:ime, jms:jme ) :: PBLH_SEA
888 REAL, DIMENSION( ims:ime, jms:jme ) :: RMOL_SEA
889 REAL, DIMENSION( ims:ime, jms:jme ) :: UST_SEA
890 REAL, DIMENSION( ims:ime, jms:jme ) :: QZ0_SEA
891 REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL
892 !
893 REAL :: xice_threshold
894 !
897 !------------------------------------------------------------------
898 CHARACTER*256 :: message
899 REAL :: next_bl_time
900 LOGICAL :: run_param , doing_adapt_dt , decided
901 LOGICAL :: do_adapt
902 !
903 !
904 !------------------------------------------------------------------
905 !
906 ! stop run if using ssib and fractional seaice=0 (fds 12/2010)
907 if(sf_surface_physics .eq. SSIBSCHEME .and. fractional_seaice .eq. 0) then
908 WRITE( message,* ) 'Please activate fractional seaice option when using SSiB model'
909 CALL wrf_error_fatal ( message )
910 endif
912 if (sf_sfclay_physics .eq. 0) return
914 if ( fractional_seaice == 0 ) then
915 xice_threshold = 0.5
916 else if ( fractional_seaice == 1 ) then
917 xice_threshold = 0.02
918 endif
921 v_phytmp = 0.
922 u_phytmp = 0.
923 ZOL = 0.
924 QGH = 0.
925 CHS = 0.
926 CPM = 0.
927 CHS2 = 0.
928 DTMIN = 0.
929 DTBL = 0.
931 ! RAINBL in mm (Accumulation between PBL calls)
933 IF ( PRESENT( rainncv ) .AND. PRESENT( rainbl ) ) THEN
934 !$OMP PARALLEL DO &
935 !$OMP PRIVATE ( ij, i, j, k )
936 DO ij = 1 , num_tiles
937 DO j=j_start(ij),j_end(ij)
938 DO i=i_start(ij),i_end(ij)
939 RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j)
940 IF ( PRESENT( rainshv ))RAINBL(i,j) = RAINBL(i,j) + RAINSHV(i,j)
941 RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
942 ENDDO
943 ENDDO
944 ENDDO
945 !$OMP END PARALLEL DO
946 ELSE IF ( PRESENT( rainbl ) ) THEN
947 !$OMP PARALLEL DO &
948 !$OMP PRIVATE ( ij, i, j, k )
949 DO ij = 1 , num_tiles
950 DO j=j_start(ij),j_end(ij)
951 DO i=i_start(ij),i_end(ij)
952 RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j)
953 IF ( PRESENT( rainshv ))RAINBL(i,j) = RAINBL(i,j) + RAINSHV(i,j)
954 RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
955 ENDDO
956 ENDDO
957 ENDDO
958 !$OMP END PARALLEL DO
959 ENDIF
960 ! Update SST
961 IF (sst_update .EQ. 1) THEN
962 !$OMP PARALLEL DO &
963 !$OMP PRIVATE ( ij, i, j, k )
964 DO ij = 1 , num_tiles
965 DO j=j_start(ij),j_end(ij)
966 DO i=i_start(ij),i_end(ij)
968 IF ( FRACTIONAL_SEAICE == 1 ) then
969 IF ( ( XICE(I,J) .NE. XICEM(I,J) ) .AND. ( XICEM(I,J) .GT. XICE_THRESHOLD ) ) THEN
970 ! Fractional values of ALBEDO and EMISSIVITY are valid according to the
971 ! earlier fractional seaice value, XICEM. Recompute them for the new
972 ! seaice value XICE.
973 ALBEDO(I,J) = 0.08 + XICE(I,J)/XICEM(I,J) * ( ALBEDO(I,J) - 0.08 )
974 EMISS (I,J) = 0.98 + XICE(I,J)/XICEM(I,J) * ( EMISS (I,J) - 0.98 )
975 ENDIF
976 ENDIF
978 IF ( XLAND(i,j) .GT. 1.5 .AND. XICE(I,J) .GE. XICE_THRESHOLD .AND. XICEM(I,J) .LT. XICE_THRESHOLD ) THEN
979 ! water point turns to sea-ice point
980 XICEM(I,J) = XICE(I,J)
981 XLAND(I,J) = 1.
982 IVGTYP(I,J) = ISICE
983 ISLTYP(I,J) = 16
984 VEGFRA(I,J) = 0.
985 TMN(I,J) = 271.4
986 ! Over new ice, initial guesses of ALBEDO and EMISS are
987 ! based on default water and ice values for albedo and
988 ! emissivity. The land-surface schemes can update these
989 ! values
990 ALBEDO(I,J) = 0.80 * XICE(I,J) + 0.08 * ( 1.0-XICE(I,J) )
991 ALBBCK(I,J) = 0.80
992 EMISS(I,J) = 0.98 * XICE(I,J) + 0.98 * ( 1.0-XICE(I,J) )
993 EMBCK(I,J) = 0.98
994 DO nk = 1, num_soil_layers
995 TSLB(I,NK,J) = TSK(I,J)
996 SMOIS(I,NK,J) = 1.0
997 SH2O(I,NK,J) = 0.0
998 ENDDO
999 ENDIF
1000 IF(XLAND(i,j) .GT. 1.5) THEN
1001 IF ( SST(i,j) .LT. 350. .and. SST(i,j) .GT. 250.) THEN
1002 TSK(i,j) =SST(i,j)
1003 TSLB(i,1,j)=SST(i,j)
1004 ENDIF
1005 ENDIF
1006 IF ( XLAND(i,j) .LT. 1.5 .AND. XICEM(I,J) .GE. XICE_THRESHOLD .AND. XICE(I,J) .LT. XICE_THRESHOLD ) THEN
1007 ! sea-ice point turns to water point
1008 XICEM(I,J) = XICE(I,J)
1009 XLAND(I,J) = 2.
1010 IVGTYP(I,J) = ISWATER
1011 ISLTYP(I,J) = 14
1012 VEGFRA(I,J) = 0.
1013 SNOW(I,J) = 0.
1014 SNOWC(I,J) = 0.
1015 SNOWH(I,J) = 0.
1016 TMN(I,J) = SST(I,J)
1017 ALBEDO(I,J) = 0.08
1018 ALBBCK(I,J) = 0.08
1019 EMISS(I,J) = 0.98
1020 EMBCK(I,J) = 0.98
1021 DO nk = 1, num_soil_layers
1022 TSLB(I,NK,J) = SST(I,J)
1023 SMOIS(I,NK,J) = 1.0
1024 SH2O(I,NK,J) = 1.0
1025 ENDDO
1026 ENDIF
1028 XICEM(i,j) = XICE(i,j)
1030 ENDDO
1031 ENDDO
1032 ENDDO
1033 !$OMP END PARALLEL DO
1034 ENDIF
1036 IF(PRESENT(SST_SKIN))THEN
1037 IF (sst_skin .EQ. 1) THEN
1038 ! Calculate skin sst based on Zeng and Beljaars (2005)
1039 CALL wrf_debug( 100, 'in SST_SKIN_UPDATE' )
1040 !$OMP PARALLEL DO &
1041 !$OMP PRIVATE ( ij, i, j, k )
1042 DO ij = 1 , num_tiles
1043 DO j=j_start(ij),j_end(ij)
1044 DO i=i_start(ij),i_end(ij)
1045 IF(XLAND(i,j) .GT. 1.5 .and. sst_update .NE. 1) THEN
1046 TSK(i,j) =SST(i,j)
1047 TSLB(i,1,j)=SST(i,j)
1048 ENDIF
1049 ENDDO
1050 ENDDO
1051 CALL sst_skin_update(xland,glw,gsw,hfx,qfx,tsk,ust, &
1052 emiss,dtw,sstsk,dt,stbolt, &
1053 ids, ide, jds, jde, kds, kde, &
1054 ims, ime, jms, jme, kms, kme, &
1055 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1056 DO j=j_start(ij),j_end(ij)
1057 DO i=i_start(ij),i_end(ij)
1058 IF(XLAND(i,j) .GT. 1.5)TSK(i,j)=SSTSK(i,j)
1059 ENDDO
1060 ENDDO
1061 ENDDO
1062 !$OMP END PARALLEL DO
1063 ENDIF
1064 ENDIF
1066 IF(PRESENT(TMN_UPDATE))THEN
1067 IF (tmn_update .EQ. 1) THEN
1068 CALL wrf_debug( 100, 'in TMN_UPDATE' )
1069 CALL tmnupdate(tsk,tmn,tlag,tyr,tyra,tdly,nday,nyear,lagday, &
1070 julian_in, dt, yr, &
1071 ids, ide, jds, jde, kds, kde, &
1072 ims, ime, jms, jme, kms, kme, &
1073 i_start,i_end, j_start,j_end, kts,kte, num_tiles )
1075 ENDIF
1076 ENDIF
1077 !
1078 ! Modified for adaptive time step
1079 !
1080 doing_adapt_dt = .FALSE.
1081 IF ( PRESENT(adapt_step_flag) ) THEN
1082 IF ( adapt_step_flag ) THEN
1083 doing_adapt_dt = .TRUE.
1084 END IF
1085 END IF
1087 ! Do we run through this scheme or not?
1089 ! Test 1: If this is the initial model time, then yes.
1090 ! ITIMESTEP=1
1091 ! Test 2: If the user asked for the surface to be run every time step, then yes.
1092 ! BLDT=0 or STEPBL=1
1093 ! Test 3: If not adaptive dt, and this is on the requested surface frequency, then yes.
1094 ! MOD(ITIMESTEP,STEPBL)=0
1095 ! Test 4: If using adaptive dt and the current time is past the last requested activate surface time, then yes.
1096 ! CURR_SECS >= BLDTACTTIME
1098 ! If we do run through the scheme, we set the flag run_param to TRUE and we set the decided flag
1099 ! to TRUE. The decided flag says that one of these tests was able to say "yes", run the scheme.
1100 ! We only proceed to other tests if the previous tests all have left decided as FALSE.
1102 run_param = .FALSE.
1103 decided = .FALSE.
1104 IF ( ( .NOT. decided ) .AND. &
1105 ( itimestep .EQ. 1 ) ) THEN
1106 run_param = .TRUE.
1107 decided = .TRUE.
1108 END IF
1110 IF ( PRESENT(bldt) )THEN
1111 IF ( ( .NOT. decided ) .AND. &
1112 ( ( bldt .EQ. 0. ) .OR. ( stepbl .EQ. 1 ) ) ) THEN
1113 run_param = .TRUE.
1114 decided = .TRUE.
1115 END IF
1116 ELSE
1117 IF ( ( .NOT. decided ) .AND. &
1118 ( stepbl .EQ. 1 ) ) THEN
1119 run_param = .TRUE.
1120 decided = .TRUE.
1121 END IF
1122 END IF
1124 IF ( ( .NOT. decided ) .AND. &
1125 ( .NOT. doing_adapt_dt ) .AND. &
1126 ( MOD(itimestep,stepbl) .EQ. 0 ) ) THEN
1127 run_param = .TRUE.
1128 decided = .TRUE.
1129 END IF
1131 IF ( ( .NOT. decided ) .AND. &
1132 ( doing_adapt_dt ) .AND. &
1133 ( curr_secs .GE. bldtacttime ) ) THEN
1134 run_param = .TRUE.
1135 decided = .TRUE.
1136 END IF
1138 IF ( run_param ) then
1140 radiation = .false.
1141 frpcpn = .false.
1142 myj = ((sf_sfclay_physics .EQ. MYJSFCSCHEME) .OR. &
1143 (sf_sfclay_physics .EQ. QNSESFCSCHEME) )
1144 isisfc = ( FRACTIONAL_SEAICE .EQ. 1 .AND. ( &
1145 (sf_sfclay_physics .EQ. SFCLAYSCHEME ) .OR. &
1146 (sf_sfclay_physics .EQ. PXSFCSCHEME ) .OR. &
1147 (sf_sfclay_physics .EQ. MYJSFCSCHEME ) .OR. &
1148 (sf_sfclay_physics .EQ. GFSSFCSCHEME ) ) &
1149 )
1151 IF (ra_lw_physics .gt. 0) radiation = .true.
1153 IF( PRESENT(slope_rad).AND. radiation )THEN
1154 ! topographic slope effects modify SWDOWN and GSW here
1155 IF (slope_rad .EQ. 1) THEN
1156 !$OMP PARALLEL DO &
1157 !$OMP PRIVATE ( ij, i, j, k )
1158 DO ij = 1 , num_tiles
1159 CALL TOPO_RAD_ADJ_DRVR (XLAT,XLONG,COSZEN, &
1160 shadowmask, &
1161 declin, &
1162 SWDOWN,GSW,SWNORM,GSWSAVE,solcon,hrang, &
1163 slope,slp_azi, &
1164 ids, ide, jds, jde, kds, kde, &
1165 ims, ime, jms, jme, kms, kme, &
1166 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1167 ENDDO
1168 !$OMP END PARALLEL DO
1170 ENDIF
1171 ENDIF
1172 !----
1173 ! CALCULATE CONSTANT
1175 DTMIN=DT/60.
1176 ! Surface schemes need PBL time step for updates and accumulations
1177 ! Assume these schemes provide no tendencies
1179 if (PRESENT(adapt_step_flag)) then
1180 if (adapt_step_flag) then
1181 do_adapt = .TRUE.
1182 else
1183 do_adapt = .FALSE.
1184 endif
1185 else
1186 do_adapt = .FALSE.
1187 endif
1189 if (PRESENT(BLDT)) then
1190 if (bldt .eq. 0) then
1191 DTBL = dt
1192 ELSE
1193 if (do_adapt) then
1194 IF ( curr_secs .LT. 2. * dt ) THEN
1195 call wrf_message("WARNING: When using an adaptive time-step the boundary layer"// &
1196 " time-step should be 0 (i.e., equivalent to model time-step)." )
1197 call wrf_message("In order to proceed, for surface calculations, the "// &
1198 "boundary layer time-step"// &
1199 " will be rounded to the nearest minute," )
1200 call wrf_message("possibly resulting in innacurate results.")
1201 END IF
1202 DTBL=bldt*60
1203 else
1204 DTBL=DT*STEPBL
1205 endif
1206 endif
1207 else
1208 DTBL=DT*STEPBL
1209 endif
1211 ! SAVE OLD VALUES
1214 !$OMP PARALLEL DO &
1215 !$OMP PRIVATE ( ij, i, j, k )
1216 DO ij = 1 , num_tiles
1217 DO j=j_start(ij),j_end(ij)
1218 DO i=i_start(ij),i_end(ij)
1219 ! PSFC : in Pa
1220 PSFC(I,J)=p8w(I,kts,J)
1221 ! REVERSE ORDER IN THE VERTICAL DIRECTION
1222 DO k=kts,kte
1223 v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
1224 u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
1225 ENDDO
1226 ENDDO
1227 ENDDO
1228 ENDDO
1229 !$OMP END PARALLEL DO
1231 !$OMP PARALLEL DO &
1232 !$OMP PRIVATE ( ij, i, j, k )
1233 DO ij = 1 , num_tiles
1234 sfclay_select: SELECT CASE(sf_sfclay_physics)
1236 CASE (SFCLAYSCHEME)
1237 ! DX varies spatially in NMM, therefore, SFCLAY cannot be called
1238 ! because it takes a scalar DX. NMM passes in a dummy value for this
1239 ! scalar. NEEDS FURTHER ATTENTION. JM 20050215
1240 IF(PRESENT(SCM_FORCE_FLUX))THEN
1241 IF (scm_force_flux .EQ. 1) THEN
1242 ! surface forcing by observed fluxes
1243 CALL scmflux(u_phytmp, v_phytmp, t_phy, qv_curr, p_phy, dz8w, &
1244 cp, rovcp, xlv, psfc, cpm, xland, &
1245 psim, psih, hfx, qfx, lh, tsk, flhc, flqc, &
1246 znt, gz1oz0, wspd, &
1247 julian_in, karman, p1000mb, &
1248 itimestep,chklowq, &
1249 ids, ide, jds, jde, kds, kde, &
1250 ims, ime, jms, jme, kms, kme, &
1251 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1252 ENDIF
1253 ENDIF
1254 IF(PRESENT(SCM_FORCE_SKINTEMP))THEN
1255 IF (scm_force_skintemp .EQ. 1) THEN
1256 ! surface forcing by observed skin temperature
1257 CALL scmskintemp(tsk, julian_in, itimestep, &
1258 ids, ide, jds, jde, kds, kde, &
1259 ims, ime, jms, jme, kms, kme, &
1260 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1261 ENDIF
1262 ! IF (scm_force_skintemp .EQ. 2) THEN
1263 ! surface forcing by gabls2 skin temperature
1264 ! CALL scmgabls2(tsk, itimestep, dt, &
1265 ! ids, ide, jds, jde, kds, kde, &
1266 ! ims, ime, jms, jme, kms, kme, &
1267 ! i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1268 ! ENDIF
1269 ENDIF
1270 IF (PRESENT(qv_curr) .AND. &
1271 PRESENT(mol) .AND. PRESENT(regime) .AND. &
1272 .TRUE. ) THEN
1273 CALL wrf_debug( 100, 'in SFCLAY' )
1274 IF ( FRACTIONAL_SEAICE == 1 ) THEN
1275 CALL SFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr,&
1276 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
1277 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
1278 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
1279 u10,v10,th2,t2,q2, &
1280 gz1oz0,wspd,br,isfflx,dx, &
1281 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
1282 P1000mb, &
1283 XICE,SST,TSK_SEA, &
1284 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
1285 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
1286 ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD, &
1287 ids,ide, jds,jde, kds,kde, &
1288 ims,ime, jms,jme, kms,kme, &
1289 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
1290 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, &
1291 sf_surface_physics )
1292 ELSE
1293 CALL SFCLAY(u_phytmp,v_phytmp,t_phy,qv_curr, &
1294 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
1295 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
1296 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
1297 u10,v10,th2,t2,q2, &
1298 gz1oz0,wspd,br,isfflx,dx, &
1299 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
1300 P1000mb, &
1301 ids,ide, jds,jde, kds,kde, &
1302 ims,ime, jms,jme, kms,kme, &
1303 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
1304 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,scm_force_flux )
1305 #if ( EM_CORE==1)
1306 DO j = j_start(ij),j_end(ij)
1307 DO i = i_start(ij),i_end(ij)
1308 ch(i,j) = chs (i,j)
1309 !! ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
1310 end do
1311 end do
1312 #endif
1313 ENDIF
1314 ELSE
1315 CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
1316 ENDIF
1318 CASE (SFCLAYREVSCHEME)
1319 ! DX varies spatially in NMM, therefore, SFCLAY cannot be called
1320 ! because it takes a scalar DX. NMM passes in a dummy value for this
1321 ! scalar. NEEDS FURTHER ATTENTION. JM 20050215
1322 IF (PRESENT(qv_curr) .AND. &
1323 PRESENT(mol) .AND. PRESENT(regime) .AND. &
1324 .TRUE. ) THEN
1325 CALL wrf_debug( 100, 'in SFCLAY' )
1326 ! IF ( FRACTIONAL_SEAICE == 1 ) THEN
1327 ! CALL SFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr,&
1328 ! p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
1329 ! znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
1330 ! xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
1331 ! u10,v10,th2,t2,q2, &
1332 ! gz1oz0,wspd,br,isfflx,dx, &
1333 ! svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
1334 ! P1000mb, &
1335 ! XICE,SST,TSK_SEA,
1336 !&
1337 ! CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA,
1338 !&
1339 ! HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA,
1340 !&
1341 ! ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD,
1342 !&
1343 ! ids,ide, jds,jde, kds,kde, &
1344 ! ims,ime, jms,jme, kms,kme, &
1345 ! i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
1346 ! ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
1347 ! ELSE
1348 CALL SFCLAYREV(u_phytmp,v_phytmp,t_phy,qv_curr,&
1349 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
1350 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
1351 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
1352 u10,v10,th2,t2,q2, &
1353 gz1oz0,wspd,br,isfflx,dx, &
1354 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
1355 P1000mb, &
1356 ids,ide, jds,jde, kds,kde, &
1357 ims,ime, jms,jme, kms,kme, &
1358 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
1359 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
1360 #if ( EM_CORE==1)
1361 DO j = j_start(ij),j_end(ij)
1362 DO i = i_start(ij),i_end(ij)
1363 ch(i,j) = chs (i,j)
1364 !! ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
1365 end do
1366 end do
1367 #endif
1368 ! ENDIF
1369 ELSE
1370 CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
1371 ENDIF
1373 CASE (PXSFCSCHEME)
1374 #if (NMM_CORE != 1)
1375 IF (PRESENT(qv_curr) .AND. &
1376 PRESENT(mol) .AND. PRESENT(regime) .AND. &
1377 .TRUE. ) THEN
1378 CALL wrf_debug( 100, 'in PX Surface Layer scheme' )
1379 IF ( FRACTIONAL_SEAICE == 1 ) THEN
1380 CALL WRF_ERROR_FATAL("PXSFCLAY not adapted for FRACTIONAL_SEAICE=1 option")
1381 CALL PXSFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
1382 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
1383 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
1384 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
1385 u10,v10, &
1386 gz1oz0,wspd,br,isfflx,dx, &
1387 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman, &
1388 XICE, SST, ITIMESTEP, TICE2TSK_IF2COLD,XICE_THRESHOLD, &
1389 CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA,FLHC_SEA,FLQC_SEA,&
1390 HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, TSK_SEA, &
1391 ids,ide, jds,jde, kds,kde, &
1392 ims,ime, jms,jme, kms,kme, &
1393 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1394 ELSE
1395 CALL PXSFCLAY(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
1396 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
1397 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
1398 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
1399 u10,v10, &
1400 gz1oz0,wspd,br,isfflx,dx, &
1401 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman, &
1402 ids,ide, jds,jde, kds,kde, &
1403 ims,ime, jms,jme, kms,kme, &
1404 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1405 ENDIF
1406 ELSE
1407 CALL wrf_error_fatal('Lacking arguments for PX Surface Layer in surface driver')
1408 ENDIF
1409 #else
1410 CALL wrf_error_fatal('PX Surface Layer scheme cannot be used with NMM')
1411 #endif
1413 CASE (MYJSFCSCHEME)
1414 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
1415 .TRUE. ) THEN
1417 CALL wrf_debug(100,'in MYJSFC')
1418 IF ( FRACTIONAL_SEAICE == 1 ) THEN
1419 CALL MYJSFC_SEAICE_WRAPPER(itimestep,ht,dz8w, &
1420 p_phy,p8w,th_phy,t_phy, &
1421 qv_curr,qc_curr, &
1422 u_phy,v_phy,tke_pbl, &
1423 tsk,qsfc,thz0,qz0,uz0,vz0, &
1424 lowlyr, &
1425 xland,ivgtyp,isurban,iz0tlnd, &
1426 TICE2TSK_IF2COLD, & ! Extra for wrapper.
1427 XICE_THRESHOLD, & ! Extra for wrapper.
1428 XICE, SST, & ! Extra for wrapper.
1429 CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA, &
1430 FLHC_SEA, FLQC_SEA, QSFC_SEA, &
1431 QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA, LH_SEA, &
1432 TSK_SEA, &
1433 ust,znt,z0,pblh,mavail,rmol, &
1434 akhs,akms, &
1435 br, &
1436 chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
1437 u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
1438 p1000mb, &
1439 ids,ide, jds,jde, kds,kde, &
1440 ims,ime, jms,jme, kms,kme, &
1441 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1442 ELSE
1443 CALL MYJSFC(itimestep,ht,dz8w, &
1444 p_phy,p8w,th_phy,t_phy, &
1445 qv_curr,qc_curr, &
1446 u_phy,v_phy,tke_pbl, &
1447 tsk,qsfc,thz0,qz0,uz0,vz0, &
1448 lowlyr, &
1449 xland,ivgtyp,isurban,iz0tlnd, &
1450 ust,znt,z0,pblh,mavail,rmol, &
1451 akhs,akms, &
1452 br, &
1453 chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
1454 u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
1455 p1000mb, &
1456 ids,ide, jds,jde, kds,kde, &
1457 ims,ime, jms,jme, kms,kme, &
1458 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1459 #if ( EM_CORE==1)
1460 DO j = j_start(ij),j_end(ij)
1461 DO i = i_start(ij),i_end(ij)
1462 wspd(i,j) = MAX(SQRT(u_phy(i,kts,j)**2+v_phy(i,kts,j)**2),0.001)
1463 ch(i,j) = chs (i,j)
1464 !! ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
1465 END DO
1466 END DO
1467 #endif
1469 ENDIF
1470 ELSE
1471 CALL wrf_error_fatal('Lacking arguments for MYJSFC in surface driver')
1472 ENDIF
1474 CASE (QNSESFCSCHEME)
1475 IF(PRESENT(SCM_FORCE_FLUX))THEN
1476 IF (scm_force_flux .EQ. 1) THEN
1477 ! surface forcing by observed fluxes
1478 CALL scmflux(u_phytmp, v_phytmp, t_phy, qv_curr, p_phy, dz8w, &
1479 cp, rovcp, xlv, psfc, cpm, xland, &
1480 psim, psih, hfx, qfx, lh, tsk, flhc, flqc, &
1481 znt, gz1oz0, wspd, &
1482 julian_in, karman, p1000mb, &
1483 itimestep,chklowq, &
1484 ids, ide, jds, jde, kds, kde, &
1485 ims, ime, jms, jme, kms, kme, &
1486 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1487 ENDIF
1488 ENDIF
1489 IF(PRESENT(SCM_FORCE_SKINTEMP))THEN
1490 IF (scm_force_skintemp .EQ. 1) THEN
1491 ! surface forcing by observed skin temperature
1492 CALL scmskintemp(tsk, julian_in, itimestep, &
1493 ids, ide, jds, jde, kds, kde, &
1494 ims, ime, jms, jme, kms, kme, &
1495 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1496 ENDIF
1497 ENDIF
1499 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
1500 .TRUE. ) THEN
1501 CALL wrf_debug(100,'in QNSESFC')
1502 CALL QNSESFC(itimestep,ht,dz8w, &
1503 p_phy,p8w,th_phy,t_phy, &
1504 qv_curr,qc_curr, &
1505 u_phy,v_phy,tke_pbl, &
1506 tsk,qsfc,thz0,qz0,uz0,vz0, &
1507 lowlyr, &
1508 xland, &
1509 ust,znt,z0,pblh,mavail,rmol, &
1510 akhs,akms, &
1511 br, &
1512 chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
1513 u10,v10,tshltr,th10,qshltr,q10,pshltr, &
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), &
1517 kts,kte,scm_force_flux )
1518 ELSE
1519 CALL wrf_error_fatal('Lacking arguments for QNSESFC in surface driver')
1520 ENDIF
1522 CASE (GFSSFCSCHEME)
1523 IF (PRESENT(qv_curr) .AND. .TRUE. ) THEN
1524 CALL wrf_debug( 100, 'in GFSSFC' )
1525 IF (FRACTIONAL_SEAICE == 1) THEN
1526 CALL SF_GFS_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr, &
1527 p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
1528 ZNT,UST,PSIM,PSIH, &
1529 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
1530 QGH,QSFC,U10,V10, &
1531 GZ1OZ0,WSPD,BR,ISFFLX, &
1532 EP_1,EP_2,KARMAN,itimestep, &
1533 TICE2TSK_IF2COLD, &
1534 XICE_THRESHOLD, &
1535 CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, &
1536 FLHC_SEA, FLQC_SEA, &
1537 HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, &
1538 UST_SEA, ZNT_SEA, SST, XICE, &
1539 ids,ide, jds,jde, kds,kde, &
1540 ims,ime, jms,jme, kms,kme, &
1541 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1542 ELSE
1543 CALL SF_GFS(u_phytmp,v_phytmp,t_phy,qv_curr, &
1544 p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
1545 ZNT,UST,PSIM,PSIH, &
1546 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
1547 QGH,QSFC,U10,V10, &
1548 GZ1OZ0,WSPD,BR,ISFFLX, &
1549 EP_1,EP_2,KARMAN,itimestep, &
1550 ids,ide, jds,jde, kds,kde, &
1551 ims,ime, jms,jme, kms,kme, &
1552 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1553 ENDIF
1554 CALL wrf_debug(100,'in SFCDIAGS')
1555 ELSE
1556 CALL wrf_error_fatal('Lacking arguments for SF_GFS in surface driver')
1557 ENDIF
1559 #if ( EM_CORE==1)
1560 CASE(MYNNSFCSCHEME)
1562 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) &
1563 & .AND. PRESENT(qcg) ) THEN
1565 CALL wrf_debug(100,'in MYNNSFC')
1567 IF (FRACTIONAL_SEAICE == 1) THEN
1568 CALL MYNN_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr, &
1569 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
1570 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
1571 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
1572 u10,v10,th2,t2,q2, &
1573 gz1oz0,wspd,br,isfflx,dx, &
1574 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
1575 &itimestep,ch,th_phy,pi_phy,qc_curr,&
1576 &tsq,qsq,cov,qcg,&
1577 XICE,SST,TSK_SEA, &
1578 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
1579 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
1580 TICE2TSK_IF2COLD,XICE_THRESHOLD, &
1581 ids,ide, jds,jde, kds,kde, &
1582 ims,ime, jms,jme, kms,kme, &
1583 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1584 ELSE
1585 CALL SFCLAY_mynn(u_phytmp,v_phytmp,t_phy,qv_curr,&
1586 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
1587 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
1588 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
1589 u10,v10,th2,t2,q2, &
1590 gz1oz0,wspd,br,isfflx,dx, &
1591 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
1592 &itimestep,ch,th_phy,pi_phy,qc_curr,&
1593 &tsq,qsq,cov,qcg,&
1594 ids,ide, jds,jde, kds,kde, &
1595 ims,ime, jms,jme, kms,kme, &
1596 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1597 ENDIF
1598 ELSE
1599 CALL wrf_error_fatal('Lacking arguments for SFCLAY_mynn in surface driver')
1601 ENDIF
1602 #endif
1604 #if ( EM_CORE==1)
1605 CASE (TEMFSFCSCHEME)
1606 IF (PRESENT(qv_curr).and.PRESENT(hd_temf)) THEN
1607 CALL wrf_debug( 100, 'in TEMFSFCLAY' )
1608 ! WA 9/7/09 must initialize Z0 and ZNT for TEMF in ideal cases
1609 ! DO J=j_start(ij),j_end(ij)
1610 ! DO I=i_start(ij),i_end(ij)
1611 ! CHKLOWQ(i,j) = 1.0
1612 ! Z0(i,j) = 0.03 ! For GABLS2
1613 ! ZNT(i,j) = 0.03 ! For GABLS2
1614 ! ENDDO
1615 ! ENDDO
1616 CALL TEMFSFCLAY(u3d=u_phytmp,v3d=v_phytmp,th3d=th_phy, &
1617 qv3d=qv_curr,p3d=p_phy,pi3d=pi_phy,rho=rho,z=z,ht=ht, &
1618 CP=cp,G=g,ROVCP=rovcp,R=r_d,XLV=xlv,psfc=psfc,chs=chs,&
1619 chs2=chs2,cqs2=cqs2,CPM=cpm,znt=znt,ust=ust, &
1620 MAVAIL=mavail,XLAND=xland,HFX=hfx,QFX=qfx,LH=lh, &
1621 TSK=tsk,FLHC=flhc,FLQC=flqc,QGH=qgh,qsfc=qsfc, &
1622 U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2, &
1623 SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0,EP1=ep_1, &
1624 EP2=ep_2,KARMAN=karman,fCor=fCor,te_temf=te_temf, &
1625 hd_temf=hd_temf,exch_temf=exch_temf,wm_temf=wm_temf,&
1626 ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde, &
1627 ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme, &
1628 its=i_start(ij),ite=i_end(ij), &
1629 jts=j_start(ij),jte=j_end(ij), kts=kts,kte=kte )
1630 ELSE
1631 CALL wrf_error_fatal('Lacking arguments for TEMFSFCLAY in surface driver')
1632 ENDIF
1634 CASE (IDEALSCMSFCSCHEME)
1635 IF (PRESENT(qv_curr)) THEN
1636 CALL wrf_debug( 100, 'in IDEALSCMSFCLAY' )
1637 CALL IDEALSCMSFCLAY(u3d=u_phytmp,v3d=v_phytmp,th3d=th_phy, &
1638 qv3d=qv_curr,p3d=p_phy,pi3d=pi_phy,rho=rho,z=z,ht=ht, &
1639 CP=cp,G=g,ROVCP=rovcp,R=r_d,XLV=xlv,psfc=psfc,chs=chs,&
1640 chs2=chs2,cqs2=cqs2,CPM=cpm,znt=znt,ust=ust, &
1641 MAVAIL=mavail,XLAND=xland,HFX=hfx,QFX=qfx,LH=lh, &
1642 TSK=tsk,FLHC=flhc,FLQC=flqc,QGH=qgh,qsfc=qsfc, &
1643 U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2, &
1644 SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0,EP1=ep_1, &
1645 EP2=ep_2,KARMAN=karman,fCor=fCor, &
1646 exch_temf=exch_temf, &
1647 hfx_force=hfx_force,lh_force=lh_force,tsk_force=tsk_force, &
1648 hfx_force_tend=hfx_force_tend, &
1649 lh_force_tend=lh_force_tend, &
1650 tsk_force_tend=tsk_force_tend, &
1651 dt=dt,itimestep=itimestep, &
1652 ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde, &
1653 ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme, &
1654 its=i_start(ij),ite=i_end(ij), &
1655 jts=j_start(ij),jte=j_end(ij), kts=kts,kte=kte )
1656 ELSE
1657 CALL wrf_error_fatal('Lacking arguments for IDEALSCMSFCLAY in surface driver')
1658 ENDIF
1659 #endif
1661 #if (NMM_CORE==1)
1663 CASE (GFDLSFCSCHEME)
1664 CALL wrf_debug( 100, 'in GFDLSFC' )
1666 IF(sf_surface_physics .eq. 88)THEN
1667 GFDL_NTSFLG=1
1668 ELSE
1669 GFDL_NTSFLG=0
1670 ENDIF
1672 CALL SF_GFDL(u_phytmp,v_phytmp,t_phy,qv_curr,p_phy, &
1673 CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
1674 DTBL, SMOIS,num_soil_layers,ISLTYP,ZNT,UST,PSIM,PSIH, & !DT & MAVAIL
1675 XLAND,HFX,QFX,TAUX,TAUY,LH,GSW,GLW,TSK,FLHC,FLQC, & ! gopal's doing for Ocean coupling
1676 QGH,QSFC,U10,V10, &
1677 GZ1OZ0,WSPD,BR,ISFFLX, &
1678 EP_1,EP_2,KARMAN,GFDL_NTSFLG,SFENTH, &
1679 ids,ide, jds,jde, kds,kde, &
1680 ims,ime, jms,jme, kms,kme, &
1681 i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte )
1682 DO j=j_start(ij),j_end(ij)
1683 DO i=i_start(ij),i_end(ij)
1684 CHKLOWQ(I,J)= 1.0
1685 ENDDO
1686 ENDDO
1688 #endif
1689 CASE DEFAULT
1691 WRITE( message , * ) &
1692 'The sfclay option does not exist: sf_sfclay_physics = ', sf_sfclay_physics
1693 CALL wrf_error_fatal ( message )
1695 END SELECT sfclay_select
1697 ! Compute uratx, vratx, tratx for obs nudging
1698 IF(PRESENT(uratx) .and. PRESENT(vratx) .and. PRESENT(tratx))THEN
1699 DO J=j_start(ij),j_end(ij)
1700 DO I=i_start(ij),i_end(ij)
1701 IF(ABS(U10(I,J)) .GT. 1.E-10) THEN
1702 uratx(I,J) = U_PHYTMP(I,1,J)/U10(I,J)
1703 ELSE
1704 uratx(I,J) = 1.2
1705 END IF
1706 IF(ABS(V10(I,J)) .GT. 1.E-10) THEN
1707 vratx(I,J) = V_PHYTMP(I,1,J)/V10(I,J)
1708 ELSE
1709 vratx(I,J) = 1.2
1710 END IF
1711 ! (Quotient P1000mb/P_PHY must be conditioned due to large value of P1000mb)
1712 tratx(I,J) = (T_PHY(I,1,J)*(P1000mb*0.001/(P_PHY(I,1,J)/1000.))**RCP) &
1713 /TH2(I,J)
1714 ENDDO
1715 ENDDO
1716 ENDIF
1718 ENDDO
1719 !$OMP END PARALLEL DO
1721 IF (ISFFLX.EQ.0 ) GOTO 430
1722 !$OMP PARALLEL DO &
1723 !$OMP PRIVATE ( ij, i, j, k )
1724 DO ij = 1 , num_tiles
1726 sfc_select: SELECT CASE(sf_surface_physics)
1728 CASE (SLABSCHEME)
1730 IF (PRESENT(qv_curr) .AND. &
1731 PRESENT(capg) .AND. &
1732 .TRUE. ) THEN
1733 DO j=j_start(ij),j_end(ij)
1734 DO i=i_start(ij),i_end(ij)
1735 ! CQS2 ACCOUNTS FOR MAVAIL FOR SFCDIAGS 2M Q
1736 CQS2(I,J)= CQS2(I,J)*MAVAIL(I,J)
1737 ENDDO
1738 ENDDO
1740 IF ( FRACTIONAL_SEAICE == 1 ) THEN
1741 CALL wrf_error_fatal('SLAB scheme cannot be used with fractional seaice')
1742 ENDIF
1743 CALL wrf_debug(100,'in SLAB')
1744 CALL SLAB(t_phy,qv_curr,p_phy,flhc,flqc, &
1745 psfc,xland,tmn,hfx,qfx,lh,tsk,qsfc,chklowq, &
1746 gsw,glw,capg,thc,snowc,emiss,mavail, &
1747 dtbl,rcp,xlv,dtmin,ifsnow, &
1748 svp1,svp2,svp3,svpt0,ep_2,karman,eomeg,stbolt, &
1749 tslb,zs,dzs,num_soil_layers,radiation, &
1750 p1000mb, &
1751 ids,ide, jds,jde, kds,kde, &
1752 ims,ime, jms,jme, kms,kme, &
1753 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
1755 DO j=j_start(ij),j_end(ij)
1756 DO i=i_start(ij),i_end(ij)
1757 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
1758 IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
1759 IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
1760 ENDDO
1761 ENDDO
1763 CALL wrf_debug(100,'in SFCDIAGS')
1764 CALL SFCDIAGS(hfx,qfx,tsk,qsfc,chs2,cqs2,t2,th2,q2, &
1765 psfc,cp,r_d,rcp, &
1766 ids,ide, jds,jde, kds,kde, &
1767 ims,ime, jms,jme, kms,kme, &
1768 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1770 ENDIF
1772 CASE (LSMSCHEME)
1774 IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
1775 ! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
1776 ! PRESENT(declin) .AND. PRESENT(coszen) .AND. &
1777 ! PRESENT(hrang) .AND. PRESENT( xlat_urb2d) .AND. &
1778 ! PRESENT(dzr) .AND. &
1779 ! PRESENT( dzb) .AND. PRESENT(dzg) .AND. &
1780 ! PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d) .AND. &
1781 ! PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND. &
1782 ! PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND. &
1783 ! PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND. &
1784 ! PRESENT(xxxg_urb2d) .AND. &
1785 ! PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND. &
1786 ! PRESENT(tbl_urb3d) .AND. PRESENT(tgl_urb3d) .AND. &
1787 ! PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d) .AND. &
1788 ! PRESENT(g_urb2d) .AND. PRESENT(rn_urb2d) .AND. &
1789 ! PRESENT(ts_urb2d) .AND. &
1790 ! PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d) .AND. &
1791 .TRUE. ) THEN
1792 !------------------------------------------------------------------
1793 IF( PRESENT(sr) ) THEN
1794 frpcpn=.true.
1795 ENDIF
1796 IF ( FRACTIONAL_SEAICE == 1) THEN
1797 ! The fields passed to LSM need to represent the full ice values, not
1798 ! the fractional values. Convert ALBEDO and EMISS from the blended value
1799 ! to a value representing only the sea-ice portion. Albedo over open
1800 ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
1801 DO j = j_start(ij) , j_end(ij)
1802 DO i = i_start(ij) , i_end(ij)
1803 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
1804 ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
1805 EMISS(I,J) = (EMISS(I,J)-(1.-XICE(I,J))*0.98)/XICE(I,J)
1806 ENDIF
1807 ENDDO
1808 ENDDO
1810 IF ( isisfc ) THEN
1811 ! Use surface layer routine values from the ice portion of grid point
1812 ELSE
1813 !
1814 ! We don't have surface layer routine values at this time, so
1815 ! just use what we have. Use ice component of TSK
1816 !
1817 CALL get_local_ice_tsk( ims, ime, jms, jme, &
1818 i_start(ij), i_end(ij), &
1819 j_start(ij), j_end(ij), &
1820 itimestep, .false., tice2tsk_if2cold, &
1821 XICE, XICE_THRESHOLD, &
1822 SST, TSK, TSK_SEA, TSK_LOCAL )
1824 DO j = j_start(ij) , j_end(ij)
1825 DO i = i_start(ij) , i_end(ij)
1826 TSK(i,j) = TSK_LOCAL(i,j)
1827 ENDDO
1828 ENDDO
1829 ENDIF
1830 ENDIF
1832 CALL wrf_debug(100,'in NOAH DRV')
1833 CALL lsm(dz8w,qv_curr,p8w,t_phy,tsk, &
1834 hfx,qfx,lh,grdflx,qgh,gsw,swdown,glw,smstav,smstot, &
1835 sfcrunoff,udrunoff,ivgtyp,isltyp,isurban,isice,vegfra, &
1836 albedo,albbck,znt,z0, tmn,xland,xice, emiss, embck, &
1837 snowc,qsfc,rainbl, &
1838 mminlu, &
1839 num_soil_layers,dtbl,dzs,itimestep, &
1840 smois,tslb,snow,canwat, &
1841 chs, chs2, cqs2, cpm,rcp,SR,chklowq,lai,qz0, &
1842 myj,frpcpn, &
1843 sh2o,snowh, & !h
1844 u_phy,v_phy, & !I
1845 snoalb,shdmin,shdmax, & !i
1846 snotime, & !o
1847 acsnom,acsnow, & !o
1848 snopcx, & !o
1849 potevp, & !o
1850 smcrel, & !o
1851 xice_threshold, &
1852 rdlai2d,usemonalb, &
1853 br, & !?
1854 NOAHRES, &
1855 ids,ide, jds,jde, kds,kde, &
1856 ims,ime, jms,jme, kms,kme, &
1857 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
1858 sf_urban_physics &
1859 !Optional urban
1860 ,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif &
1861 ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d, & !H urban
1862 uc_urb2d, & !H urban
1863 xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d, & !H urban
1864 trl_urb3d,tbl_urb3d,tgl_urb3d, & !H urban
1865 sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d, & !H urban
1866 psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d, & !O urban
1867 GZ1OZ0_urb2d, AKMS_URB2D, & !O urban
1868 th2_urb2d,q2_urb2d,ust_urb2d, & !O urban
1869 declin,coszen,hrang, & !I solar
1870 xlat_urb2d, & !I urban
1871 num_roof_layers, num_wall_layers, & !I urban
1872 num_road_layers, DZR, DZB, DZG, & !I urban
1873 FRC_URB2D, UTYPE_URB2D, & !I urban
1874 num_urban_layers, & !I multi-layer urban
1875 trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d, & !H multi-layer urban
1876 tlev_urb3d,qlev_urb3d, & !H multi-layer urban
1877 tw1lev_urb3d,tw2lev_urb3d, & !H multi-layer urban
1878 tglev_urb3d,tflev_urb3d, & !H multi-layer urban
1879 sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d, & !H multi-layer urban
1880 sfvent_urb3d,lfvent_urb3d, & !H multi-layer urban
1881 sfwin1_urb3d,sfwin2_urb3d, & !H multi-layer urban
1882 sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d, & !H multi-layer urban
1883 th_phy,rho,p_phy,ust, & !I multi-layer urban
1884 gmt,julday,xlong,xlat, & !I multi-layer urban
1885 a_u_bep,a_v_bep,a_t_bep,a_q_bep, & !O multi-layer urban
1886 a_e_bep,b_u_bep,b_v_bep, & !O multi-layer urban
1887 b_t_bep,b_q_bep,b_e_bep,dlg_bep, & !O multi-layer urban
1888 dl_u_bep,sf_bep,vl_bep & !O multi-layer urban
1889 )
1891 call seaice_noah( SEAICE_ALBEDO_OPT, &
1892 & t_phy, qv_curr, p8w, dz8w, num_soil_layers, dt, frpcpn, sr, &
1893 & glw, swdown, rainbl, snoalb, qgh, xice, xice_threshold, &
1894 & tslb, emiss, albedo, albbck, z0, tsk, snow, snowc, snowh, &
1895 & chs, chs2, cqs2, &
1896 & br, znt, lh, hfx, qfx, potevp, grdflx, qsfc, acsnow, &
1897 & acsnom, snopcx, sfcrunoff, noahres, &
1898 & sf_urban_physics, b_t_bep, b_q_bep, rho, &
1899 & ids,ide, jds,jde, kds,kde, &
1900 & ims,ime, jms,jme, kms,kme, &
1901 & i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1904 IF ( FRACTIONAL_SEAICE == 1 ) THEN
1905 ! LSM Returns full land/ice values, no fractional values.
1906 ! We return to a fractional component here. SFLX currently hard-wires
1907 ! emissivity over sea ice to 0.98, the same value as over open water, so
1908 ! the fractional consideration doesn't have any effect for emissivity.
1909 DO j=j_start(ij),j_end(ij)
1910 DO i=i_start(ij),i_end(ij)
1911 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
1912 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
1913 emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
1914 ENDIF
1915 ENDDO
1916 ENDDO
1918 IF ( isisfc ) THEN
1919 DO j=j_start(ij),j_end(ij)
1920 DO i=i_start(ij),i_end(ij)
1921 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
1922 ! Weighted average of fields between ice-cover values and open-water values.
1923 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
1924 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
1925 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
1926 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
1927 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
1928 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
1929 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qsfc_sea(i,j) )
1930 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qgh_sea(i,j) )
1931 qz0(i,j) = ( qz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qz0_sea(i,j) )
1932 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j) )
1933 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j) )
1934 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j) )
1935 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
1936 ENDIF
1937 ENDDO
1938 ENDDO
1939 ELSE
1940 DO j = j_start(ij) , j_end(ij)
1941 DO i = i_start(ij) , i_end(ij)
1942 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
1943 ! Compute TSK as the open-water and ice-cover average
1944 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
1945 ENDIF
1946 ENDDO
1947 ENDDO
1948 ENDIF
1949 ENDIF
1950 DO j=j_start(ij),j_end(ij)
1951 DO i=i_start(ij),i_end(ij)
1952 ! CHKLOWQ(I,J)= 1.0
1953 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
1954 SFCEXC(I,J)= CHS(I,J)
1955 IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
1956 IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
1957 IF(PRESENT(ACGRDFLX))ACGRDFLX(I,J)=ACGRDFLX(I,J) + GRDFLX(I,J)*DT
1958 ENDDO
1959 ENDDO
1961 CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2, &
1962 PSFC,CP,R_d,RCP, &
1963 ids,ide, jds,jde, kds,kde, &
1964 ims,ime, jms,jme, kms,kme, &
1965 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1966 !urban
1967 IF(SF_URBAN_PHYSICS.eq.1) THEN
1968 DO j=j_start(ij),j_end(ij) !urban
1969 DO i=i_start(ij),i_end(ij) !urban
1970 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. & !urban
1971 IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
1972 U10(I,J) = U10_URB2D(I,J) !urban
1973 V10(I,J) = V10_URB2D(I,J) !urban
1974 PSIM(I,J) = PSIM_URB2D(I,J) !urban
1975 PSIH(I,J) = PSIH_URB2D(I,J) !urban
1976 GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J) !urban
1977 !m AKHS(I,J) = AKHS_URB2D(I,J) !urban
1978 AKHS(I,J) = CHS(I,J) !urban
1979 AKMS(I,J) = AKMS_URB2D(I,J) !urban
1980 END IF !urban
1981 ENDDO !urban
1982 ENDDO !urban
1983 ENDIF
1984 ! urban BEP
1985 IF((SF_URBAN_PHYSICS.eq.2).OR.(SF_URBAN_PHYSICS.eq.3)) THEN
1986 DO j=j_start(ij),j_end(ij) !urban
1987 DO i=i_start(ij),i_end(ij) !urban
1988 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. & !urban
1989 IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
1990 T2(I,J) = TH_PHY(i,1,j)/((1.E5/PSFC(I,J))**RCP) !urban
1991 TH2(I,J) = TH_PHY(i,1,j) !urban
1992 Q2(I,J) = qv_curr(i,1,j) !urban
1993 U10(I,J) = U_phy(I,1,J) !urban
1994 V10(I,J) = V_phy(I,1,J) !urban
1995 END IF !urban
1996 ENDDO !urban
1997 ENDDO !urban
1998 ENDIF
2000 !------------------------------------------------------------------
2002 ELSE
2003 CALL wrf_error_fatal('Lacking arguments for LSM in surface driver')
2004 ENDIF
2006 CASE (NOAHMPSCHEME)
2007 IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
2008 ! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
2009 ! PRESENT(declin) .AND. PRESENT(coszen) .AND. &
2010 ! PRESENT(hrang) .AND. PRESENT( xlat_urb2d) .AND. &
2011 ! PRESENT(dzr) .AND. &
2012 ! PRESENT( dzb) .AND. PRESENT(dzg) .AND. &
2013 ! PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d) .AND. &
2014 ! PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND. &
2015 ! PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND. &
2016 ! PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND. &
2017 ! PRESENT(xxxg_urb2d) .AND. &
2018 ! PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND. &
2019 ! PRESENT(tbl_urb3d) .AND. PRESENT(tgl_urb3d) .AND. &
2020 ! PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d) .AND. &
2021 ! PRESENT(g_urb2d) .AND. PRESENT(rn_urb2d) .AND. &
2022 ! PRESENT(ts_urb2d) .AND. &
2023 ! PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d) .AND. &
2024 .TRUE. ) THEN
2025 !------------------------------------------------------------------
2026 IF( PRESENT(sr) ) THEN
2027 frpcpn=.true.
2028 ENDIF
2030 IF ( FRACTIONAL_SEAICE == 1) THEN
2031 ! The fields passed to LSM need to represent the full ice values, not
2032 ! the fractional values. Convert ALBEDO and EMISS from the blended value
2033 ! to a value representing only the sea-ice portion. Albedo over open
2034 ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
2035 DO j = j_start(ij) , j_end(ij)
2036 DO i = i_start(ij) , i_end(ij)
2037 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
2038 ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
2039 EMISS(I,J) = (EMISS(I,J)-(1.-XICE(I,J))*0.98)/XICE(I,J)
2040 ENDIF
2041 ENDDO
2042 ENDDO
2044 IF ( isisfc ) THEN
2045 ! Use surface layer routine values from the ice portion of grid point
2046 ELSE
2047 !
2048 ! We don't have surface layer routine values at this time, so
2049 ! just use what we have. Use ice component of TSK
2050 !
2051 CALL get_local_ice_tsk( ims, ime, jms, jme, &
2052 i_start(ij), i_end(ij), &
2053 j_start(ij), j_end(ij), &
2054 itimestep, .false., tice2tsk_if2cold, &
2055 XICE, XICE_THRESHOLD, &
2056 SST, TSK, TSK_SEA, TSK_LOCAL )
2058 DO j = j_start(ij) , j_end(ij)
2059 DO i = i_start(ij) , i_end(ij)
2060 TSK(i,j) = TSK_LOCAL(i,j)
2061 ENDDO
2062 ENDDO
2063 ENDIF
2064 ENDIF
2066 CALL wrf_debug(100,'in NOAHMP DRV')
2067 CALL noahmplsm(dz8w,qv_curr,p8w,t_phy,tsk, &
2068 hfx,qfx,lh,grdflx,qgh,gsw,swdown,glw,smstav,smstot, &
2069 sfcrunoff,udrunoff,ivgtyp,isltyp,vegfra, &
2070 albedo,albbck,znt,z0, tmn,xland,xice, xice_threshold, isice,emiss, embck, &
2071 snowc,qsfc,rainbl, &
2072 num_soil_layers,dtbl,dzs,itimestep, &
2073 smois,tslb,snow,canwat, &
2074 chs, chs2, cqs2, cpm,rcp,SR,chklowq,qz0, &
2075 myj,br,frpcpn, &
2076 sh2o,snowh, & !h
2077 u_phy,v_phy, & !I
2078 coszen, xlat_urb2d, & !I
2079 snoalb, & !I
2080 snotime, & !io
2081 acsnom,acsnow, & !o
2082 idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz ,iopt_inf , &
2083 iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot,iopt_stc , &
2084 isnowxy ,tvxy ,tgxy ,canicexy , &
2085 canliqxy ,eahxy ,tahxy ,cmxy ,chxy , &
2086 fwetxy ,sneqvoxy ,alboldxy ,qsnowxy ,wslakexy ,zwtxy ,waxy , &
2087 wtxy ,tsnoxy ,zsnsoxy ,snicexy ,snliqxy ,lfmassxy ,rtmassxy , &
2088 stmassxy ,woodxy ,stblcpxy ,fastcpxy ,lai ,xsaixy , &
2089 tradxy ,tsxy ,neexy ,gppxy ,nppxy ,fvegxy ,qinxy , &
2090 runsfxy ,runsbxy ,ecanxy ,edirxy ,etranxy ,fsaxy ,firaxy , &
2091 aparxy ,psnxy ,savxy ,sagxy , &
2092 fsnoxy ,YR ,JULIAN_IN, &
2093 potevp, & !o
2094 !jref:start
2095 qc_curr ,pblh ,isurban ,iz0tlnd ,dx , & !I
2096 chstarxy , t2mvxy ,t2mbxy ,rssunxy ,rsshaxy , bgapxy, &
2097 wgapxy , gapxy ,tgvxy ,tgbxy ,q2mvxy ,q2mbxy, shdmax ,chvxy,chbxy , & !O
2098 !jref:end
2099 ids,ide, jds,jde, kds,kde, &
2100 ims,ime, jms,jme, kms,kme, &
2101 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2103 call seaice_noah( SEAICE_ALBEDO_OPT, &
2104 & t_phy, qv_curr, p8w, dz8w, num_soil_layers, dt, frpcpn, sr, &
2105 & glw, swdown, rainbl, snoalb, qgh, xice, xice_threshold, &
2106 & tslb, emiss, albedo, albbck, z0, tsk, snow, snowc, snowh, &
2107 & chs, chs2, cqs2, &
2108 & br, znt, lh, hfx, qfx, potevp, grdflx, qsfc, acsnow, &
2109 & acsnom, snopcx, sfcrunoff, noahres, &
2110 & sf_urban_physics, b_t_bep, b_q_bep, rho, &
2111 & ids,ide, jds,jde, kds,kde, &
2112 & ims,ime, jms,jme, kms,kme, &
2113 & i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2115 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2116 ! LSM Returns full land/ice values, no fractional values.
2117 ! We return to a fractional component here. SFLX currently hard-wires
2118 ! emissivity over sea ice to 0.98, the same value as over open water, so
2119 ! the fractional consideration doesn't have any effect for emissivity.
2120 DO j=j_start(ij),j_end(ij)
2121 DO i=i_start(ij),i_end(ij)
2122 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2123 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
2124 emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
2125 ENDIF
2126 ENDDO
2127 ENDDO
2129 IF ( isisfc ) THEN
2130 DO j=j_start(ij),j_end(ij)
2131 DO i=i_start(ij),i_end(ij)
2132 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2133 ! Weighted average of fields between ice-cover values and open-water values.
2134 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
2135 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
2136 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
2137 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
2138 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
2139 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
2140 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qsfc_sea(i,j) )
2141 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qgh_sea(i,j) )
2142 qz0(i,j) = ( qz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qz0_sea(i,j) )
2143 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j) )
2144 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j) )
2145 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j) )
2146 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
2147 ENDIF
2148 ENDDO
2149 ENDDO
2150 ELSE
2151 DO j = j_start(ij) , j_end(ij)
2152 DO i = i_start(ij) , i_end(ij)
2153 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2154 ! Compute TSK as the open-water and ice-cover average
2155 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
2156 ENDIF
2157 ENDDO
2158 ENDDO
2159 ENDIF
2160 ENDIF
2161 DO j=j_start(ij),j_end(ij)
2162 DO i=i_start(ij),i_end(ij)
2163 ! CHKLOWQ(I,J)= 1.0
2164 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
2165 SFCEXC(I,J)= CHS(I,J)
2166 IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
2167 IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
2168 IF(PRESENT(ACGRDFLX))ACGRDFLX(I,J)=ACGRDFLX(I,J) + GRDFLX(I,J)*DT
2170 ! Check that SFCDIAGS can declare these as intent(out)
2171 T2(I,J) = -1.E36
2172 TH2(I,J) = -1.E36
2173 Q2(I,J) = -1.E36
2174 ENDDO
2175 ENDDO
2177 !jref: sfc diagnostics
2178 DO j=j_start(ij),j_end(ij)
2179 DO i=i_start(ij),i_end(ij)
2180 IF (IVGTYP(I,J) == ISWATER .OR. IVGTYP(I,J) == ISICE) THEN
2181 IF(CQS2(I,J).lt.1.E-5) then
2182 Q2(I,J)=QSFC(I,J)
2183 ELSE
2184 Q2(I,J) = QSFC(I,J) - QFX(I,J)/(PSFC(I,J)/(R_d * TSK(I,J))*CQS2(I,J))
2185 ENDIF
2186 IF(CHS2(I,J).lt.1.E-5) then
2187 T2(I,J) = TSK(I,J)
2188 ELSE
2189 T2(I,J) = TSK(I,J) - HFX(I,J)/(PSFC(I,J)/(R_d * TSK(I,J))*CP*CHS2(I,J))
2190 ENDIF
2191 TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**ROVCP
2192 ELSEIF (IVGTYP(I,J) == ISURBAN ) THEN
2193 Q2(I,J) = q2mbxy(i,j)
2194 T2(I,J) = t2mbxy(i,j)
2195 TH2(I,J) = T2(i,j)*(1.E5/PSFC(i,j))**RCP
2196 ELSE
2197 T2(I,J) = fvegxy(i,j)*t2mvxy(i,j) + (1.-fvegxy(i,j))*t2mbxy(i,j)
2198 Q2(I,J) = fvegxy(i,j)*q2mvxy(i,j) + (1.-fvegxy(i,j))*q2mbxy(i,j)
2199 TH2(I,J) = T2(i,j)*(1.E5/PSFC(i,j))**RCP
2200 ENDIF
2201 ENDDO
2202 ENDDO
2204 ! CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2, &
2205 ! PSFC,CP,R_d,RCP, &
2206 ! ids,ide, jds,jde, kds,kde, &
2207 ! ims,ime, jms,jme, kms,kme, &
2208 ! i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2210 !jref: sfc diagnostics end
2212 !------------------------------------------------------------------
2214 ELSE
2215 CALL wrf_error_fatal('Lacking arguments for NOAHMPLSM in surface driver')
2216 ENDIF
2218 CASE (RUCLSMSCHEME)
2219 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
2220 ! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
2221 PRESENT(qsg) .AND. PRESENT(qvg) .AND. &
2222 PRESENT(qcg) .AND. PRESENT(soilt1) .AND. &
2223 PRESENT(tsnav) .AND. PRESENT(smfr3d) .AND. &
2224 PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND. &
2225 PRESENT(dew) .AND. &
2226 .TRUE. ) THEN
2228 IF( PRESENT(sr) ) THEN
2229 frpcpn=.true.
2230 ELSE
2231 SR = 1.
2232 ENDIF
2233 CALL wrf_debug(100,'in RUC LSM')
2234 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2235 ! The fields passed to LSMRUC need to represent the full ice values, not
2236 ! the fractional values. Convert ALBEDO and EMISS from the blended value
2237 ! to a value representing only the sea-ice portion. Albedo over open
2238 ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
2239 DO j = j_start(ij) , j_end(ij)
2240 DO i = i_start(ij) , i_end(ij)
2241 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
2242 ALBEDO(I,J) = (ALBEDO(I,J) - (1.-XICE(I,J))*0.08) / XICE(I,J)
2243 EMISS(I,J) = (EMISS(I,J) - (1.-XICE(I,J))*0.98) / XICE(I,J)
2244 ENDIF
2245 ENDDO
2246 ENDDO
2248 IF ( isisfc ) THEN
2249 !
2250 ! use surface layer routine values from the ice portion of grid point
2251 !
2252 ELSE
2253 !
2254 ! don't have srfc layer routine values at this time, so just use what you have
2255 ! use ice component of TSK
2256 !
2257 CALL get_local_ice_tsk( ims, ime, jms, jme, &
2258 i_start(ij), i_end(ij), &
2259 j_start(ij), j_end(ij), &
2260 itimestep, .false., tice2tsk_if2cold, &
2261 XICE, XICE_THRESHOLD, &
2262 SST, TSK, TSK_SEA, TSK_LOCAL )
2263 DO j = j_start(ij) , j_end(ij)
2264 DO i = i_start(ij) , i_end(ij)
2265 TSK(i,j) = TSK_LOCAL(i,j)
2266 ENDDO
2267 ENDDO
2268 ENDIF
2269 ENDIF
2271 CALL LSMRUC(dtbl,itimestep,num_soil_layers, &
2272 zs,rainbl,snow,snowh,snowc,sr,frpcpn, &
2273 dz8w,p8w,t_phy,qv_curr,qc_curr,rho, & !p8w in [pa]
2274 glw,gsw,emiss,chklowq, &
2275 chs,flqc,flhc,mavail,canwat,vegfra,albedo,znt, &
2276 z0,snoalb, albbck, lai, & !new
2277 mminlu, landusef, nlcat, mosaic_lu, &
2278 mosaic_soil, soilctop, nscat, & !new
2279 qsfc,qsg,qvg,qcg,dew,soilt1,tsnav, &
2280 tmn,ivgtyp,isltyp,xland, &
2281 iswater,isice,xice,xice_threshold, &
2282 cp,rovcp,g,xlv,stbolt, &
2283 smois,sh2o,smstav,smstot,tslb,tsk,hfx,qfx,lh, &
2284 sfcrunoff,udrunoff,sfcexc, &
2285 sfcevp,grdflx,acsnow,acsnom, &
2286 smfr3d,keepfr3dflag, &
2287 myj, &
2288 ids,ide, jds,jde, kds,kde, &
2289 ims,ime, jms,jme, kms,kme, &
2290 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2292 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2293 ! LSMRUC Returns full land/ice values, no fractional values.
2294 ! We return to a fractional component here.
2295 DO j=j_start(ij),j_end(ij)
2296 DO i=i_start(ij),i_end(ij)
2297 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2298 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
2299 emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
2300 ENDIF
2301 ENDDO
2302 ENDDO
2303 if ( isisfc ) then
2304 !
2305 ! back to ice and ocean average
2306 !
2307 DO j=j_start(ij),j_end(ij)
2308 DO i=i_start(ij),i_end(ij)
2309 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
2310 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * flhc_sea(i,j) )
2311 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * flqc_sea(i,j) )
2312 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * cpm_sea(i,j) )
2313 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * cqs2_sea(i,j) )
2314 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * chs2_sea(i,j) )
2315 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * chs_sea(i,j) )
2316 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * QSFC_SEA(i,j) )
2317 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * qgh_sea(i,j) )
2318 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * HFX_SEA(i,j) )
2319 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * QFX_SEA(i,j) )
2320 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * LH_SEA(i,j) )
2321 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * TSK_SEA(i,j) )
2322 ENDIF
2323 ENDDO
2324 ENDDO
2325 else
2326 !
2327 ! tsk back to liquid and ice average
2328 !
2329 DO j = j_start(ij) , j_end(ij)
2330 DO i = i_start(ij) , i_end(ij)
2331 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
2332 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * TSK_SEA(i,j) )
2333 ENDIF
2334 ENDDO
2335 ENDDO
2336 endif
2337 ENDIF
2339 CALL SFCDIAGS_RUCLSM(HFX,QFX,TSK,QSFC,CQS2,CQS2,T2,TH2,Q2, &
2340 T_PHY,QV_CURR,RHO,P8W, &
2341 PSFC,CP,R_d,RCP, &
2342 ids,ide, jds,jde, kds,kde, &
2343 ims,ime, jms,jme, kms,kme, &
2344 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2347 ELSE
2348 CALL wrf_error_fatal('Lacking arguments for RUCLSM in surface driver')
2349 ENDIF
2351 CASE (PXLSMSCHEME)
2352 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
2353 PRESENT(emiss) .AND. PRESENT(t2) .AND. &
2354 PRESENT(rainbl) .AND. &
2355 .TRUE. ) THEN
2356 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2358 CALL WRF_ERROR_FATAL("PXLSM not adapted for FRACTIONAL_SEAICE=1 option")
2360 IF ( isisfc ) THEN
2361 !
2362 ! use surface layer routine values from the ice portion of grid point
2363 !
2364 ELSE
2365 !
2366 ! don't have srfc layer routine values at this time, so just use what you have
2367 ! use ice component of TSK
2368 !
2369 CALL get_local_ice_tsk( ims, ime, jms, jme, &
2370 i_start(ij), i_end(ij), &
2371 j_start(ij), j_end(ij), &
2372 itimestep, .false., tice2tsk_if2cold, &
2373 XICE, XICE_THRESHOLD, &
2374 SST, TSK, TSK_SEA, TSK_LOCAL )
2375 DO j = j_start(ij) , j_end(ij)
2376 DO i=i_start(ij) , i_end(ij)
2377 TSK(i,j) = TSK_LOCAL(i,j)
2378 ENDDO
2379 ENDDO
2380 ENDIF
2381 ENDIF
2382 CALL wrf_debug(100,'in P-X LSM')
2383 CALL PXLSM(u_phy, v_phy, dz8w, qv_curr, t_phy, th_phy, rho,&
2384 psfc, gsw, glw, rainbl, emiss, &
2385 ITIMESTEP, num_soil_layers, DT, anal_interval, &
2386 xland, xice, albbck, albedo, snoalb, smois, tslb, &
2387 mavail,T2, Q2, &
2388 zs, dzs, psih, &
2389 landusef,soilctop,soilcbot,vegfra, vegf_px, &
2390 isltyp,ra,rs,lai,nlcat,nscat, &
2391 hfx,qfx,lh,tsk,sst,znt,canwat, &
2392 grdflx,shdmin,shdmax, &
2393 snowc,pblh,rmol,ust,capg,dtbl, &
2394 t2_ndg_old,t2_ndg_new,q2_ndg_old,q2_ndg_new, &
2395 sn_ndg_old, sn_ndg_new, snow, snowh,snowncv, &
2396 t2obs, q2obs, pxlsm_smois_init, pxlsm_soil_nudge, &
2397 ids,ide, jds,jde, kds,kde, &
2398 ims,ime, jms,jme, kms,kme, &
2399 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
2400 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2401 IF ( isisfc ) THEN
2402 !
2403 ! back to ice and ocean average
2404 !
2405 DO j = j_start(ij) , j_end(ij)
2406 DO i = i_start(ij) , i_end(ij)
2407 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2408 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
2409 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
2410 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
2411 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
2412 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
2413 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
2414 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QSFC_SEA(i,j) )
2415 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QGH_SEA(i,j) )
2416 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * HFX_SEA(i,j) )
2417 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QFX_SEA(i,j) )
2418 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * LH_SEA(i,j) )
2419 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * TSK_SEA(i,j) )
2420 psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIH_SEA(i,j) )
2421 pblh(i,j) = ( pblh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PBLH_SEA(i,j) )
2422 rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * RMOL_SEA(i,j) )
2423 ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * UST_SEA(i,j) )
2424 ENDIF
2425 ENDDO
2426 ENDDO
2427 ELSE
2428 !
2429 ! tsk back to liquid and ice average
2430 !
2431 DO j=j_start(ij),j_end(ij)
2432 DO i=i_start(ij),i_end(ij)
2433 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2434 tsk(i,j)=tsk(i,j)*XICE(i,j)+(1.0-XICE(i,j))*TSK_SEA(i,j)
2435 ENDIF
2436 ENDDO
2437 ENDDO
2438 ENDIF
2439 ENDIF
2440 DO j=j_start(ij),j_end(ij)
2441 DO i=i_start(ij),i_end(ij)
2442 CHKLOWQ(I,J)= 1.0
2443 TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**RCP
2444 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
2445 ENDDO
2446 ENDDO
2448 ELSE
2449 CALL wrf_error_fatal('Lacking arguments for P-X LSM in surface driver')
2450 ENDIF
2452 CASE (SSIBSCHEME)
2453 IF(PRESENT(alswvisdir))THEN
2454 !---Fernando De Sales (fds 06/2010)--------------------------------------
2455 CALL wrf_debug(100,'in SSIB')
2456 !
2457 IF ( FRACTIONAL_SEAICE == 1) THEN
2458 ! The fields passed to SSIB need to represent the full ice values, not
2459 ! the fractional values. Convert ALBEDO from the blended value
2460 ! to a value representing only the sea-ice portion. Albedo over open
2461 ! water is taken to be 0.08.
2462 DO j = j_start(ij) , j_end(ij)
2463 DO i = i_start(ij) , i_end(ij)
2464 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
2465 ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
2466 ENDIF
2467 ENDDO
2468 ENDDO
2469 ELSE
2470 ! we shouldn't be here. must have fractional seaice for SSIB to work properly (fds 12/2010)
2471 ENDIF
2472 !
2473 !This stuff is not needed anymore since isisfc is always TRUE for SSIB
2474 !Keep it for later use when code is adapted for isisfc=FALSE
2475 ! IF ( isisfc ) THEN
2476 ! ! Use surface layer routine values from the ice portion of grid point
2477 ! ELSE
2478 ! !
2479 ! ! We don't have surface layer routine values at this time, so
2480 ! ! just use what we have. Use ice component of TSK
2481 ! !
2482 ! DO j = j_start(ij) , j_end(ij)
2483 ! DO i = i_start(ij) , i_end(ij)
2484 ! IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
2485 ! IF ( SST(i,j) .LT. 271.4 ) THEN
2486 ! SST(i,j) = 271.4
2487 ! ENDIF
2488 ! TSK_SEA(i,j) = SST(i,j)
2489 ! ! Convert TSK from our ice/water average value to value good for solid-ice surface.
2490 ! TSK(i,j) = ( TSK(i,j) - (1.-XICE(i,j)) *SST(i,j) ) / XICE(i,j)
2491 ! IF (XICE(i,j).lt.0.2 .and. TSK(i,j).lt.253.15) THEN
2492 ! TSK(i,j) = 253.15
2493 ! ENDIF
2494 ! IF (XICE(i,j).lt.0.1 .and. TSK(i,j).lt.263.15) THEN
2495 ! TSK(i,j) = 263.15
2496 ! ENDIF
2497 ! ELSE
2498 ! TSK_SEA(i,j) = TSK(i,j)
2499 ! ENDIF
2500 ! ENDDO
2501 ! ENDDO
2502 ! ENDIF
2503 !
2504 day=float(int(julian_in+0.01))+1.
2505 DO j=j_start(ij),j_end(ij)
2506 DO i=i_start(ij),i_end(ij)
2507 !check land mask and land-use map !fds (02/2012)
2508 ! IF(itimestep .EQ. 1 ) THEN
2509 ! IF(IVGTYP(i,j).NE.ISWATER)THEN
2510 ! XLAND(I,J)=1.0
2511 ! ELSE
2512 ! XLAND(I,J)=2.0
2513 ! ENDIF
2514 ! IF (IVGTYP(I,J).LE.0 .AND. XLAND(I,J).NE.ISWATER ) IVGTYP(I,J) = 7.0
2515 ! ENDIF
2516 !
2518 ! IF(XLAND(I,J).LT.1.5 .AND. IVGTYP(I,J).NE.ISICE) THEN !land and seaice-free points
2519 IF(XLAND(I,J).LT.1.5) THEN !land points, including land ice points
2521 CLOUDFRAC=0.
2522 IF(PRESENT(CLDFRA))THEN
2523 DO K=KMS,KME
2524 CLOUDFRAC=AMAX1(CLOUDFRAC,AMIN1(CLDFRA(I,K,J),1.0))
2525 ENDDO
2526 ENDIF
2528 CALL ssib( i, j, DTBL, itimestep, xlat_urb2d(i,j), coszen(i,j), &
2529 rainncv(i,j), raincv(i,j), glw(i,j), dz8w(i,1,j), &
2530 smois(i,1,j), smois(i,2,j), smois(i,3,j), &
2531 tslb(i,1,j), tslb(i,2,j), tslb(i,3,j), &
2532 snow(i,j), sfcrunoff(i,j), &
2533 u_phytmp(i,1,j),v_phytmp(i,1,j),qv_curr(i,1,j),t_phy(i,1,j), &
2534 p_phy(i,1,j), psfc(i,j), ivgtyp(i,j), &
2535 swdown(i,j), canwat(i,j), &
2536 alswvisdir(i,j),alswvisdif(i,j),alswnirdir(i,j),alswnirdif(i,j), &
2537 swvisdir(i,j), swvisdif(i,j), swnirdir(i,j), swnirdif(i,j), &
2538 hfx(i,j), lh(i,j), grdflx(i,j), qfx(i,j), tsk(i,j), &
2539 ust(i,j), ssib_br(i,j), ssib_fm(i,j), ssib_fh(i,j), ssib_cm(i,j), &
2540 ssib_lhf(i,j), ssib_shf(i,j), ssib_ghf(i,j), ssib_egs(i,j), &
2541 ssib_eci(i,j), ssib_ect(i,j), ssib_egi(i,j), ssib_egt(i,j), &
2542 ssib_sdn(i,j), ssib_sup(i,j), ssib_ldn(i,j), ssib_lup(i,j), &
2543 ssib_wat(i,j), ssib_shc(i,j), ssib_shg(i,j), ssib_lai(i,j), &
2544 ssib_vcf(i,j), ssib_z00(i,j), ssib_veg(i,j), ssibxdd(i,j), &
2545 isnow(i,j), swe(i,j), snowden(i,j), snowdepth(i,j),tkair(i,j), &
2546 dzo1(i,j), wo1(i,j), tssn1(i,j), tssno1(i,j), bwo1(i,j), bto1(i,j), &
2547 cto1(i,j), fio1(i,j), flo1(i,j), bio1(i,j), blo1(i,j), ho1(i,j), &
2548 dzo2(i,j), wo2(i,j), tssn2(i,j), tssno2(i,j), bwo2(i,j), bto2(i,j), &
2549 cto2(i,j), fio2(i,j), flo2(i,j), bio2(i,j), blo2(i,j), ho2(i,j), &
2550 dzo3(i,j), wo3(i,j), tssn3(i,j), tssno3(i,j), bwo3(i,j), bto3(i,j), &
2551 cto3(i,j), fio3(i,j), flo3(i,j), bio3(i,j), blo3(i,j), ho3(i,j), &
2552 dzo4(i,j), wo4(i,j), tssn4(i,j), tssno4(i,j), bwo4(i,j), bto4(i,j), &
2553 cto4(i,j), fio4(i,j), flo4(i,j), bio4(i,j), blo4(i,j), ho4(i,j), &
2554 day, cloudfrac, q2(i,j), t2(i,j), albedo(i,j), &
2555 ra_sw_physics, mminlu &
2556 )
2557 BR(i,j)=ssib_br(i,j)
2558 ZNT(i,j) = ssib_z00(i,j)
2559 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
2560 snowh(i,j) = snowdepth(i,j)
2561 IF (itimestep .ne. 1) THEN
2562 ZDIFF=(0.5*dz8w(i,1,j))-SSiBXDD(I,J)
2563 IF(ZDIFF.LE.ZNT(I,J)) ZDIFF=ZNT(I,J)+0.2
2564 GZ1OZ0(I,J)=ALOG(ZDIFF/ZNT(I,J))
2565 ENDIF
2566 ! Overwrite WSPD to remove convective velocity (wspd=wspd1 in YSU)
2567 WSPD(I,J)=sqrt( u_phytmp(i,1,j)*u_phytmp(i,1,j) + &
2568 v_phytmp(i,1,j)*v_phytmp(i,1,j) ) + 1.e-9
2570 ELSE IF (XICE(I,J) .GE. XICE_THRESHOLD) THEN !sea ice points
2572 CLOUDFRAC=0.
2573 DO K=KMS,KME
2574 CLOUDFRAC=AMAX1(CLOUDFRAC,AMIN1(CLDFRA(I,K,J),1.0))
2575 ENDDO
2577 ! CALL wrf_message ( 'Calling ssib_seaice' ) !fds
2578 CALL ssib_seaice &
2579 ( i, j, DTBL, itimestep, xlat_urb2d(i,j), coszen(i,j), &
2580 rainncv(i,j), raincv(i,j), glw(i,j), dz8w(i,1,j), &
2581 smois(i,1,j), smois(i,2,j), smois(i,3,j), &
2582 tslb(i,1,j), tslb(i,2,j), tslb(i,3,j), &
2583 snow(i,j), sfcrunoff(i,j), xicem(i,j), &
2584 u_phytmp(i,1,j),v_phytmp(i,1,j),qv_curr(i,1,j),t_phy(i,1,j), &
2585 p_phy(i,1,j), psfc(i,j), &
2586 swdown(i,j), canwat(i,j), &
2587 alswvisdir(i,j),alswvisdif(i,j),alswnirdir(i,j),alswnirdif(i,j), &
2588 swvisdir(i,j), swvisdif(i,j), swnirdir(i,j), swnirdif(i,j), &
2589 hfx(i,j), lh(i,j), grdflx(i,j), qfx(i,j), tsk(i,j), &
2590 ust(i,j), ssib_br(i,j), ssib_fm(i,j), ssib_fh(i,j), ssib_cm(i,j), &
2591 ssib_lhf(i,j), ssib_shf(i,j), ssib_ghf(i,j), &
2592 ssib_sdn(i,j), ssib_sup(i,j), ssib_ldn(i,j), ssib_lup(i,j), &
2593 ssib_wat(i,j), &
2594 ssib_z00(i,j), ssib_veg(i,j), &
2595 day, cloudfrac, q2(i,j), t2(i,j), albedo(i,j), &
2596 ra_sw_physics,xice_threshold &
2597 )
2598 BR(i,j)=ssib_br(i,j)
2599 ZNT(i,j) = ssib_z00(i,j)
2600 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
2601 t2(i,j) = tsk(i,j) !use SSiB's TGEFF as 2m temperature (Nov/2011)
2602 IF (itimestep .ne. 1) THEN
2603 ZDIFF=(0.5*dz8w(i,1,j))-SSiBXDD(I,J)
2604 IF(ZDIFF.LE.ZNT(I,J)) ZDIFF=ZNT(I,J)+0.2
2605 GZ1OZ0(I,J)=ALOG(ZDIFF/ZNT(I,J))
2606 ENDIF
2607 ! Overwrite WSPD to remove convective velocity (wspd=wspd1 in YSU)
2608 WSPD(I,J)=sqrt( u_phytmp(i,1,j)*u_phytmp(i,1,j) + &
2609 v_phytmp(i,1,j)*v_phytmp(i,1,j) ) + 1.e-9
2610 ENDIF
2611 ENDDO
2612 ENDDO
2613 !
2614 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2615 ! SSIB_seaice returns full land/ice albedo values, no fractional values.
2616 ! We return to a fractional component here.
2617 DO j=j_start(ij),j_end(ij)
2618 DO i=i_start(ij),i_end(ij)
2619 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2620 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
2621 ENDIF
2622 ENDDO
2623 ENDDO
2624 !
2625 IF ( isisfc ) THEN
2626 DO j=j_start(ij),j_end(ij)
2627 DO i=i_start(ij),i_end(ij)
2628 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2629 ! Weighted average of fields between ice-cover values and open-water values.
2630 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j) )
2631 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j) )
2632 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j) )
2633 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
2634 ENDIF
2635 ENDDO
2636 ENDDO
2637 ELSE
2638 DO j = j_start(ij) , j_end(ij)
2639 DO i = i_start(ij) , i_end(ij)
2640 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2641 ! Compute TSK as the open-water and ice-cover average
2642 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
2643 ENDIF
2644 ENDDO
2645 ENDDO
2646 ENDIF
2647 ENDIF
2648 ELSE
2649 CALL wrf_error_fatal('Lacking arguments for SSIB in surface driver')
2650 ENDIF
2651 !end ssib
2652 !-------------------------------------------------------------------
2654 CASE DEFAULT
2656 IF ( itimestep .eq. 1 ) THEN
2657 WRITE( message , * ) &
2658 'No land surface physics option is used: sf_surface_physics = ', sf_surface_physics
2659 CALL wrf_message ( message )
2660 ENDIF
2662 END SELECT sfc_select
2664 ENDDO
2665 !$OMP END PARALLEL DO
2667 430 CONTINUE
2669 #if ( EM_CORE==1)
2670 IF (omlcall .EQ. 1) THEN
2671 ! simple ocean mixed layer model based Pollard, Rhines and Thompson (1973)
2672 CALL wrf_debug( 100, 'Call OCEANML' )
2673 !$OMP PARALLEL DO &
2674 !$OMP PRIVATE ( ij )
2675 DO ij = 1 , num_tiles
2676 CALL oceanml(tml,t0ml,hml,h0ml,huml,hvml,ust,u_phy,v_phy, &
2677 tmoml,f,g,oml_gamma, &
2678 xland,hfx,lh,tsk,gsw,glw,emiss, &
2679 dtbl,STBOLT, &
2680 ids,ide, jds,jde, kds,kde, &
2681 ims,ime, jms,jme, kms,kme, &
2682 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
2683 ENDDO
2684 !$OMP END PARALLEL DO
2685 ENDIF
2686 #endif
2688 ! Reset RAINBL in mm (Accumulation between PBL calls)
2690 IF ( PRESENT( rainbl ) ) THEN
2691 !$OMP PARALLEL DO &
2692 !$OMP PRIVATE ( ij, i, j, k )
2693 DO ij = 1 , num_tiles
2694 DO j=j_start(ij),j_end(ij)
2695 DO i=i_start(ij),i_end(ij)
2696 RAINBL(i,j) = 0.
2697 ENDDO
2698 ENDDO
2699 ENDDO
2700 !$OMP END PARALLEL DO
2701 ENDIF
2703 IF( PRESENT(slope_rad).AND. radiation )THEN
2704 ! topographic slope effects removed from SWDOWN and GSW here for output
2705 IF (slope_rad .EQ. 1) THEN
2707 !$OMP PARALLEL DO &
2708 !$OMP PRIVATE ( ij, i, j, k )
2709 DO ij = 1 , num_tiles
2710 DO j=j_start(ij),j_end(ij)
2711 DO i=i_start(ij),i_end(ij)
2712 IF(SWNORM(I,J) .GT. 1.E-3)THEN ! daytime
2713 SWSAVE = SWDOWN(i,j)
2714 ! SWDOWN contains unaffected SWDOWN in output
2715 SWDOWN(i,j) = SWNORM(i,j)
2716 ! SWNORM contains slope-affected SWDOWN in output
2717 SWNORM(i,j) = SWSAVE
2718 GSW(i,j) = GSWSAVE(i,j)
2719 ENDIF
2720 ENDDO
2721 ENDDO
2722 ENDDO
2723 !$OMP END PARALLEL DO
2725 ENDIF
2726 ENDIF
2728 ENDIF
2730 END SUBROUTINE surface_driver
2732 !-------------------------------------------------------------------------
2733 !-------------------------------------------------------------------------
2735 subroutine myjsfc_seaice_wrapper(ITIMESTEP,HT,DZ, &
2736 & PMID,PINT,TH,T,QV,QC,U,V,Q2, &
2737 & TSK,QSFC,THZ0,QZ0,UZ0,VZ0, &
2738 & LOWLYR,XLAND,IVGTYP,ISURBAN,IZ0TLND, &
2739 & TICE2TSK_IF2COLD, & ! Extra for wrapper
2740 & XICE_THRESHOLD, & ! Extra for wrapper
2741 & XICE,SST, & ! Extra for wrapper
2742 & CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA, & ! Extra for wrapper
2743 & FLHC_SEA, FLQC_SEA, QSFC_SEA, & ! Extra for wrapper
2744 & QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA, & ! Extra for wrapper
2745 & FLX_LH_SEA, TSK_SEA, & ! Extra for wrapper
2746 & USTAR,ZNT,Z0BASE,PBLH,MAVAIL,RMOL, &
2747 & AKHS,AKMS, &
2748 & BR, &
2749 & CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC, &
2750 & QGH,CPM,CT, &
2751 & U10,V10,T02,TH02,TSHLTR,TH10,Q02,QSHLTR,Q10,PSHLTR, &
2752 & P1000, &
2753 & IDS,IDE,JDS,JDE,KDS,KDE, &
2754 & IMS,IME,JMS,JME,KMS,KME, &
2755 & ITS,ITE,JTS,JTE,KTS,KTE )
2756 ! USE module_model_constants
2757 USE module_sf_myjsfc
2759 IMPLICIT NONE
2761 INTEGER, INTENT(IN) :: ITIMESTEP
2762 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: HT
2763 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DZ
2764 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PMID
2765 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
2766 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: TH
2767 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: T
2768 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: QV
2769 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: QC
2770 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: U
2771 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: V
2772 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: Q2 ! Q2 is TKE?
2774 ! REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: TSK
2775 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: TSK
2777 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: QSFC
2778 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: THZ0
2779 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: QZ0
2780 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: UZ0
2781 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: VZ0
2782 INTEGER,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: LOWLYR
2783 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: XLAND
2784 INTEGER,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: IVGTYP
2785 INTEGER :: ISURBAN
2786 INTEGER :: IZ0TLND
2787 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: XICE ! Extra for wrapper
2788 ! REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: SST ! Extra for wrapper
2789 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: SST ! Extra for wrapper
2790 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: BR
2791 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS_SEA ! Extra for wrapper
2792 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS2_SEA ! Extra for wrapper
2793 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CQS2_SEA ! Extra for wrapper
2794 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CPM_SEA ! Extra for wrapper
2795 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QZ0_SEA ! Extra for wrapper
2796 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QSFC_SEA ! Extra for wrapper
2797 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QGH_SEA ! Extra for wrapper
2798 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLHC_SEA ! Extra for wrapper
2799 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLQC_SEA ! Extra for wrapper
2800 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: HFX_SEA ! Extra for wrapper
2801 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QFX_SEA ! Extra for wrapper
2802 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLX_LH_SEA ! Extra for wrapper
2803 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TSK_SEA ! Extra for wrapper
2804 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: USTAR
2805 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: ZNT
2806 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: Z0BASE
2807 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: PBLH
2808 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: MAVAIL
2809 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: RMOL
2810 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: AKHS
2811 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: AKMS
2812 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS
2813 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS2
2814 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CQS2
2815 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: HFX
2816 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QFX
2817 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLX_LH
2818 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLHC
2819 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLQC
2820 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QGH
2821 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CPM
2822 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CT
2823 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: U10
2824 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: V10
2825 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: T02
2826 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TH02
2827 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TSHLTR
2828 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TH10
2829 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: Q02
2830 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QSHLTR
2831 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: Q10
2832 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: PSHLTR
2833 REAL, INTENT(IN) :: P1000
2834 REAL, INTENT(IN) :: XICE_THRESHOLD
2835 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
2836 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE, &
2837 & IMS,IME,JMS,JME,KMS,KME, &
2838 & ITS,ITE,JTS,JTE,KTS,KTE
2841 ! Local
2842 INTEGER :: i
2843 INTEGER :: j
2844 REAL, DIMENSION( ims:ime, jms:jme ) :: ct_sea
2845 REAL, DIMENSION( ims:ime, jms:jme ) :: u10_sea
2846 REAL, DIMENSION( ims:ime, jms:jme ) :: v10_sea
2847 REAL, DIMENSION( ims:ime, jms:jme ) :: t02_sea
2848 REAL, DIMENSION( ims:ime, jms:jme ) :: th02_sea
2849 REAL, DIMENSION( ims:ime, jms:jme ) :: tshltr_sea
2850 REAL, DIMENSION( ims:ime, jms:jme ) :: pshltr_sea
2851 REAL, DIMENSION( ims:ime, jms:jme ) :: qshltr_sea
2852 REAL, DIMENSION( ims:ime, jms:jme ) :: th10_sea
2853 REAL, DIMENSION( ims:ime, jms:jme ) :: q02_sea
2854 REAL, DIMENSION( ims:ime, jms:jme ) :: q10_sea
2855 REAL, DIMENSION( ims:ime, jms:jme ) :: thz0_sea
2856 REAL, DIMENSION( ims:ime, jms:jme ) :: uz0_sea
2857 REAL, DIMENSION( ims:ime, jms:jme ) :: vz0_sea
2858 REAL, DIMENSION( ims:ime, jms:jme ) :: ustar_sea
2859 REAL, DIMENSION( ims:ime, jms:jme ) :: pblh_sea
2860 REAL, DIMENSION( ims:ime, jms:jme ) :: rmol_sea
2861 REAL, DIMENSION( ims:ime, jms:jme ) :: akhs_sea
2862 REAL, DIMENSION( ims:ime, jms:jme ) :: akms_sea
2863 REAL, DIMENSION( ims:ime, jms:jme ) :: xland_sea
2864 REAL, DIMENSION( ims:ime, jms:jme ) :: mavail_sea
2865 REAL, DIMENSION( ims:ime, jms:jme ) :: znt_sea
2866 REAL, DIMENSION( ims:ime, jms:jme ) :: z0base_sea
2867 REAL, DIMENSION( ims:ime, jms:jme ) :: br_sea
2869 REAL, DIMENSION( ims:ime, jms:jme ) :: QSFC_HOLD
2870 REAL, DIMENSION( ims:ime, jms:jme ) :: QZ0_HOLD
2871 REAL, DIMENSION( ims:ime, jms:jme ) :: THZ0_HOLD
2872 REAL, DIMENSION( ims:ime, jms:jme ) :: UZ0_HOLD
2873 REAL, DIMENSION( ims:ime, jms:jme ) :: VZ0_HOLD
2874 REAL, DIMENSION( ims:ime, jms:jme ) :: USTAR_HOLD
2875 REAL, DIMENSION( ims:ime, jms:jme ) :: ZNT_HOLD
2876 REAL, DIMENSION( ims:ime, jms:jme ) :: PBLH_HOLD
2877 REAL, DIMENSION( ims:ime, jms:jme ) :: RMOL_HOLD
2878 REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_HOLD
2879 REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_HOLD
2880 REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL
2881 REAL :: PSFC
2883 ! Set things up for the frozen-surface call to myjsfc
2884 ! Is SST local here, or are the changes to be fed back to the calling routines?
2886 ! We want a TSK valid for the ice-covered regions of the grid cell.
2888 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
2889 itimestep, .true., tice2tsk_if2cold, &
2890 XICE, XICE_THRESHOLD, &
2891 SST, TSK, TSK_SEA, TSK_LOCAL )
2892 DO j = JTS , JTE
2893 DO i = ITS , ITE
2894 TSK(i,j) = TSK_LOCAL(i,j)
2895 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
2897 ! Over fractional sea-ice points, back out an ice portion of QSFC as well.
2898 ! QSFC_SEA calculation as done in myjsfc for open water points
2899 PSFC = PINT(I,LOWLYR(I,J),J)
2900 QSFC_SEA(i,j) = PQ0SEA/PSFC*EXP(A2S*(TSK(i,j)-A3S)/(TSK(i,j)-A4S))
2901 QSFC(i,j) = QSFC(i,j) - (1.0-XICE(i,j)) * QSFC_SEA(i,j) / XICE(i,j)
2902 !
2903 HFX_SEA(i,j) = HFX(i,j)
2904 QFX_SEA(i,j) = QFX(i,j)
2905 FLX_LH_SEA(i,j) = FLX_LH(i,j)
2906 ENDIF
2907 ENDDO
2908 ENDDO
2910 !
2911 ! frozen ocean call for sea ice points
2912 !
2914 ! Strictly INTENT(IN) to MYJSFC, should be unchanged by call.
2916 ! DZ
2917 ! HT
2918 ! LOWLYR
2919 ! MAVAIL
2920 ! PINT
2921 ! PMID
2922 ! QC
2923 ! QV
2924 ! Q2
2925 ! T
2926 ! TH
2927 ! TSK
2928 ! U
2929 ! V
2930 ! XLAND
2931 ! Z0BASE
2933 ! INTENT (INOUT), updated by MYJSFC. Values will need to be saved before the first call to MYJSFC, so that
2934 ! the second call to MYJSFC does not double-count the effect.
2936 ! Save INTENT(INOUT) variables before the frozen-water/true-land call to MYJSFC:
2937 QSFC_HOLD = QSFC
2938 QZ0_HOLD = QZ0
2939 THZ0_HOLD = THZ0
2940 UZ0_HOLD = UZ0
2941 VZ0_HOLD = VZ0
2942 USTAR_HOLD = USTAR
2943 ZNT_HOLD = ZNT
2944 PBLH_HOLD = PBLH
2945 RMOL_HOLD = RMOL
2946 AKHS_HOLD = AKHS
2947 AKMS_HOLD = AKMS
2949 ! Strictly INTENT(OUT): Set by MYJSFC
2951 ! CHS
2952 ! CHS2
2953 ! CPM
2954 ! CQS2
2955 ! CT
2956 ! FLHC
2957 ! FLQC
2958 ! FLX_LH
2959 ! HFX
2960 ! PSHLTR
2961 ! QFX
2962 ! QGH
2963 ! QSHLTR
2964 ! Q02
2965 ! Q10
2966 ! TH02
2967 ! TH10
2968 ! TSHLTR
2969 ! T02
2970 ! U10
2971 ! V10
2973 ! Frozen-water/true-land call.
2974 CALL MYJSFC ( ITIMESTEP, HT, DZ, & ! I,I,I,
2975 & PMID, PINT, TH, T, QV, QC, U, V, Q2, & ! I,I,I,I,I,I,I,I,I,
2976 & TSK, QSFC, THZ0, QZ0, UZ0, VZ0, & ! I,IO,IO,IO,IO,IO,
2977 & LOWLYR, XLAND, IVGTYP, ISURBAN, IZ0TLND, & ! I,I,I,I,I
2978 & USTAR, ZNT, Z0BASE, PBLH, MAVAIL, RMOL, & ! IO,IO,I,IO,I,IO,
2979 & AKHS, AKMS, & ! IO,IO,
2980 & BR, & ! O
2981 & CHS, CHS2, CQS2, HFX, QFX, FLX_LH, FLHC, FLQC, & ! O,O,O,0,0,0,0,0,
2982 & QGH, CPM, CT, U10, V10, T02, & ! 0,0,0,0,0,0,
2983 & TH02, TSHLTR, TH10, Q02, & ! 0,0,0,0,
2984 & QSHLTR, Q10, PSHLTR, & ! 0,0,0,
2985 & P1000, & ! I
2986 & ids,ide, jds,jde, kds,kde, &
2987 & ims,ime, jms,jme, kms,kme, &
2988 & its,ite, jts,jte, kts,kte )
2990 ! Set up things for the open ocean call.
2991 DO j = JTS, JTE
2992 DO i = ITS, ITE
2993 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2994 XLAND_SEA(i,j)=2.
2995 MAVAIL_SEA(I,J) = 1.
2996 ZNT_SEA(I,J) = 0.0001
2997 Z0BASE_SEA(I,J) = ZNT_SEA(I,J)
2998 IF ( SST(i,j) .LT. 271.4 ) THEN
2999 SST(i,j) = 271.4
3000 ENDIF
3001 TSK_SEA(i,j) = SST(i,j)
3002 PSFC = PINT(I,LOWLYR(I,J),J)
3003 QSFC_SEA(I,J) = PQ0SEA/PSFC*EXP(A2S*(TSK_SEA(i,j)-A3S)/(TSK_SEA(i,j)-A4S))
3004 ELSE
3005 ! This should be a land point or a true open water point
3006 XLAND_SEA(i,j)=xland(i,j)
3007 MAVAIL_SEA(i,j) = mavail(i,j)
3008 ZNT_SEA(I,J) = ZNT_HOLD(I,J)
3009 Z0BASE_SEA(I,J) = Z0BASE(I,J)
3010 TSK_SEA(i,j) = TSK(i,j)
3011 QSFC_SEA(i,j) = QSFC_HOLD(i,j)
3012 ENDIF
3013 ENDDO
3014 ENDDO
3016 QZ0_SEA = QZ0_HOLD
3017 THZ0_SEA = THZ0_HOLD
3018 UZ0_SEA = UZ0_HOLD
3019 VZ0_SEA = VZ0_HOLD
3020 USTAR_SEA = USTAR_HOLD
3021 PBLH_SEA = PBLH_HOLD
3022 RMOL_SEA = RMOL_HOLD
3023 AKHS_SEA = AKHS_HOLD
3024 AKMS_SEA = AKMS_HOLD
3026 !
3027 ! open water call
3028 !
3029 CALL MYJSFC ( ITIMESTEP, HT, DZ, & ! I,I,I,
3030 & PMID, PINT, TH, T, QV, QC, U, V, Q2, & ! I,I,I,I,I,I,I,I,I,
3031 & TSK_SEA, QSFC_SEA, THZ0_SEA, QZ0_SEA, UZ0_SEA, VZ0_SEA, & ! I,IO,IO,IO,IO,IO,
3032 & LOWLYR, XLAND_SEA, IVGTYP, ISURBAN, IZ0TLND, & ! I,I,I,I,I,
3033 & USTAR_SEA, ZNT_SEA, Z0BASE_SEA, PBLH_SEA, MAVAIL_SEA, RMOL_SEA, & ! IO,IO,I,IO,I,IO,
3034 & AKHS_SEA, AKMS_SEA, & ! IO,IO,
3035 & BR_SEA, & ! dummy space holder
3036 & CHS_SEA, CHS2_SEA, CQS2_SEA, HFX_SEA, QFX_SEA, FLX_LH_SEA, FLHC_SEA, & ! 0,0,0,0,0,0,0,
3037 & FLQC_SEA, QGH_SEA, CPM_SEA, CT_SEA, U10_SEA, V10_SEA, T02_SEA, TH02_SEA, & ! 0,0,0,0,0,0,0,0,
3038 & TSHLTR_SEA, TH10_SEA, Q02_SEA, QSHLTR_SEA, Q10_SEA, PSHLTR_SEA, & ! 0,0,0,0,0,0,
3039 & p1000, & ! I
3040 & ids,ide, jds,jde, kds,kde, &
3041 & ims,ime, jms,jme, kms,kme, &
3042 & its,ite, jts,jte, kts,kte )
3044 !
3045 ! Scale the appropriate terms between open-water values and ice-covered values
3046 !
3048 DO j = JTS, JTE
3049 DO i = ITS, ITE
3050 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
3051 ! Over sea-ice points, blend the results.
3053 ! INTENT(OUT) from MYJSFC
3054 ! CHS wait
3055 ! CHS2 wait
3056 ! CPM wait
3057 ! CQS2 wait
3058 CT(i,j) = CT(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * CT_SEA (i,j)
3059 ! FLHC(i,j) = FLHC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLHC_SEA (i,j)
3060 ! FLQC(i,j) = FLQC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLQC_SEA (i,j)
3061 ! FLX_LH wait
3062 ! HFX wait
3063 PSHLTR(i,j) = PSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * PSHLTR_SEA(i,j)
3064 ! QFX wait
3065 ! QGH wait
3066 QSHLTR(i,j) = QSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * QSHLTR_SEA(i,j)
3067 Q02(i,j) = Q02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * Q02_SEA(i,j)
3068 Q10(i,j) = Q10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * Q10_SEA(i,j)
3069 TH02(i,j) = TH02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TH02_SEA(i,j)
3070 TH10(i,j) = TH10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TH10_SEA(i,j)
3071 TSHLTR(i,j) = TSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TSHLTR_SEA(i,j)
3072 T02(i,j) = T02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * T02_SEA(i,j)
3073 U10(i,j) = U10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * U10_SEA(i,j)
3074 V10(i,j) = V10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * V10_SEA(i,j)
3076 ! INTENT(INOUT): updated by MYJSFC
3077 ! QSFC: wait
3078 THZ0(i,j) = THZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * THZ0_SEA(i,j)
3079 ! qz0 wait
3080 UZ0(i,j) = UZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * UZ0_SEA(i,j)
3081 VZ0(i,j) = VZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * VZ0_SEA(i,j)
3082 USTAR(i,j) = USTAR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * USTAR_SEA(i,j)
3083 ! ZNT wait
3084 PBLH(i,j) = PBLH(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * PBLH_SEA(i,j)
3085 RMOL(i,j) = RMOL(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * RMOL_SEA(i,j)
3086 AKHS(i,j) = AKHS(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * AKHS_SEA(i,j)
3087 AKMS(i,j) = AKMS(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * AKMS_SEA(i,j)
3089 ! tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
3090 ELSE
3091 ! We're not over sea ice. Take the results from the first call.
3092 ENDIF
3093 ENDDO
3094 ENDDO
3096 END SUBROUTINE myjsfc_seaice_wrapper
3098 !-------------------------------------------------------------------------
3100 SUBROUTINE mynn_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, &
3101 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
3102 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
3103 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
3104 U10,V10,TH2,T2,Q2, &
3105 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
3106 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
3107 KARMAN,EOMEG,STBOLT, &
3108 &itimestep,ch,th3d,pi3d,qc3d, &
3109 &tsq,qsq,cov,qcg, &
3110 XICE,SST,TSK_SEA, &
3111 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
3112 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
3113 TICE2TSK_IF2COLD,XICE_THRESHOLD, &
3114 ids,ide, jds,jde, kds,kde, &
3115 ims,ime, jms,jme, kms,kme, &
3116 its,ite, jts,jte, kts,kte)
3117 ! ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
3118 USE module_sf_mynn, ONLY: sfclay_mynn
3119 implicit none
3121 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
3122 ims,ime, jms,jme, kms,kme, &
3123 its,ite, jts,jte, kts,kte
3125 INTEGER, INTENT(IN ) :: ISFFLX
3126 REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
3127 REAL, INTENT(IN ) :: EP1,EP2,KARMAN,EOMEG,STBOLT
3129 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
3130 INTENT(IN ) :: dz8w
3132 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
3133 INTENT(IN ) :: QV3D, &
3134 P3D, &
3135 T3D
3137 REAL, DIMENSION( ims:ime, jms:jme ) , &
3138 INTENT(IN ) :: MAVAIL, &
3139 PBLH, &
3140 XLAND
3142 REAL, DIMENSION( ims:ime, jms:jme ) , &
3143 INTENT(OUT ) :: U10, &
3144 V10, &
3145 TH2, &
3146 T2, &
3147 Q2, &
3148 QSFC
3149 REAL, DIMENSION( ims:ime, jms:jme ) , &
3150 INTENT(INOUT) :: REGIME, &
3151 HFX, &
3152 QFX, &
3153 LH, &
3154 MOL,RMOL,TSK
3156 REAL, DIMENSION( ims:ime, jms:jme ) , &
3157 INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
3158 PSIM,PSIH
3160 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
3161 INTENT(IN ) :: U3D, &
3162 V3D
3164 REAL, DIMENSION( ims:ime, jms:jme ) , &
3165 INTENT(IN ) :: PSFC
3167 REAL, DIMENSION( ims:ime, jms:jme ) , &
3168 INTENT(INOUT) :: ZNT, &
3169 ZOL, &
3170 UST, &
3171 CPM, &
3172 CHS2, &
3173 CQS2, &
3174 CHS
3176 REAL, DIMENSION( ims:ime, jms:jme ) , &
3177 INTENT(INOUT) :: FLHC,FLQC
3179 REAL, DIMENSION( ims:ime, jms:jme ) , &
3180 INTENT(INOUT) :: &
3181 QGH
3183 REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV,DX
3184 ! from mynn subroutine
3185 INTEGER, INTENT(in) :: itimestep
3186 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: qcg
3187 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ch
3188 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: &
3189 &QC3D,&
3190 &th3d,pi3d,tsq,qsq,cov
3192 ! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , &
3193 ! INTENT(OUT) :: ck,cka,cd,cda,ustm
3194 ! INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX,IZ0TLND
3196 !--------------------------------------------------------------------
3197 ! New for wrapper
3198 !--------------------------------------------------------------------
3199 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
3200 REAL, INTENT(IN) :: XICE_THRESHOLD
3201 REAL, DIMENSION( ims:ime, jms:jme ), &
3202 INTENT(IN) :: XICE
3203 REAL, DIMENSION( ims:ime, jms:jme ), &
3204 INTENT(INOUT) :: SST
3205 REAL, DIMENSION( ims:ime, jms:jme ), &
3206 INTENT(OUT) :: TSK_SEA, &
3207 CHS2_SEA, &
3208 CHS_SEA, &
3209 CPM_SEA, &
3210 CQS2_SEA, &
3211 FLHC_SEA, &
3212 FLQC_SEA, &
3213 HFX_SEA, &
3214 LH_SEA, &
3215 QFX_SEA, &
3216 QGH_SEA, &
3217 QSFC_SEA, &
3218 ZNT_SEA
3220 !--------------------------------------------------------------------
3221 ! Local
3222 !--------------------------------------------------------------------
3223 INTEGER :: I, J
3224 REAL, DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA, &
3225 MAVAIL_sea, &
3226 TSK_LOCAL, &
3227 BR_HOLD, &
3228 CHS2_HOLD, &
3229 CHS_HOLD, &
3230 CPM_HOLD, &
3231 CQS2_HOLD, &
3232 FLHC_HOLD, &
3233 FLQC_HOLD, &
3234 GZ1OZ0_HOLD, &
3235 HFX_HOLD, &
3236 LH_HOLD, &
3237 MOL_HOLD, &
3238 PSIH_HOLD, &
3239 PSIM_HOLD, &
3240 QFX_HOLD, &
3241 QGH_HOLD, &
3242 REGIME_HOLD, &
3243 RMOL_HOLD, &
3244 UST_HOLD, &
3245 WSPD_HOLD, &
3246 ZNT_HOLD, &
3247 CH_HOLD, & ! new
3248 ZOL_HOLD, &
3249 Q2_SEA, &
3250 T2_SEA, &
3251 TH2_SEA, &
3252 U10_SEA, &
3253 V10_SEA
3255 REAL, DIMENSION( ims:ime, jms:jme ) :: &
3256 BR_SEA, &
3257 GZ1OZ0_SEA, &
3258 MOL_SEA, &
3259 PSIH_SEA, &
3260 PSIM_SEA, &
3261 REGIME_SEA, &
3262 RMOL_SEA, &
3263 UST_SEA, &
3264 WSPD_SEA, &
3265 CH_SEA, & ! new
3266 ZOL_SEA
3267 ! INTENT(IN) to SFCLAY; unchanged by the call
3268 ! ISFFLX
3269 ! SVP1,SVP2,SVP3,SVPT0
3270 ! EP1,EP2,KARMAN,EOMEG,STBOLT
3271 ! CP,G,ROVCP,R,XLV,DX
3272 ! dz8w
3273 ! QV3D
3274 ! P3D
3275 ! T3D
3276 ! MAVAIL
3277 ! PBLH
3278 ! XLAND
3279 ! TSK
3280 ! U3D
3281 ! V3D
3282 ! PSFC
3284 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
3285 itimestep, .true., tice2tsk_if2cold, &
3286 XICE, XICE_THRESHOLD, &
3287 SST, TSK, TSK_SEA, TSK_LOCAL )
3289 ! DFS 8/25/10 Set TSK to ice value
3290 DO j = JTS , JTE
3291 DO i = ITS , ITE
3292 TSK(i,j) = TSK_LOCAL(i,j)
3293 ENDDO
3294 ENDDO
3296 ! INTENT (INOUT) to SFCLAY: Save the variables before the first call
3297 ! (for land/frozen water) to SFCLAY, to keep from double-counting the
3298 ! effects of that routine
3299 BR_HOLD = BR
3300 CHS2_HOLD = CHS2
3301 CHS_HOLD = CHS
3302 CPM_HOLD = CPM
3303 CQS2_HOLD = CQS2
3304 FLHC_HOLD = FLHC
3305 FLQC_HOLD = FLQC
3306 GZ1OZ0_HOLD = GZ1OZ0
3307 HFX_HOLD = HFX
3308 LH_HOLD = LH
3309 MOL_HOLD = MOL
3310 PSIH_HOLD = PSIH
3311 PSIM_HOLD = PSIM
3312 QFX_HOLD = QFX
3313 QGH_HOLD = QGH
3314 REGIME_HOLD = REGIME
3315 RMOL_HOLD = RMOL
3316 UST_HOLD = UST
3317 WSPD_HOLD = WSPD
3318 ZNT_HOLD = ZNT
3319 ZOL_HOLD = ZOL
3320 CH_HOLD = CH
3322 ! INTENT(OUT) from SFCLAY. Input shouldn't matter, but we'll want to
3323 ! keep things around for weighting after the second call to SFCLAY.
3324 ! Q2
3325 ! QSFC
3326 ! T2
3327 ! TH2
3328 ! U10
3329 ! V10
3331 ! land/frozen-water call
3332 ! call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
3333 ! CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, & !
3334 ! I,I,I,I,I,I,IO,IO,IO,IO,
3335 ! ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
3336 ! XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
3337 ! U10,V10,TH2,T2,Q2, &
3338 ! GZ1OZ0,WSPD,BR,ISFFLX,DX, &
3339 ! SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
3340 ! KARMAN,EOMEG,STBOLT, &
3341 ! P1000, &
3342 ! ids,ide, jds,jde, kds,kde, &
3343 ! ims,ime, jms,jme, kms,kme, &
3344 ! its,ite, jts,jte, kts,kte, &
3345 ! ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
3347 CALL SFCLAY_mynn(U3D,V3D,T3D,QV3D,P3D,dz8w, &
3348 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
3349 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
3350 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
3351 U10,V10,TH2,T2,Q2, &
3352 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
3353 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT, &
3354 &itimestep,ch,th3d,pi3d,qc3d, &
3355 &tsq,qsq,cov,qcg, &
3356 ids,ide, jds,jde, kds,kde, &
3357 ims,ime, jms,jme, kms,kme, &
3358 its,ite, jts,jte, kts,kte )
3359 ! Set up for open-water call
3360 DO j = JTS , JTE
3361 DO i = ITS , ITE
3362 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
3363 XLAND_SEA(i,j)=2.
3364 MAVAIL_SEA(I,J) =1.
3365 ZNT_SEA(I,J) = 0.0001
3366 TSK_SEA(i,j) = SST(i,j)
3367 IF ( SST(i,j) .LT. 271.4 ) THEN
3368 SST(i,j) = 271.4
3369 TSK_SEA(i,j) = SST(i,j)
3370 ENDIF
3371 ELSE
3372 XLAND_SEA(i,j) = XLAND(i,j)
3373 MAVAIL_SEA(i,j) = MAVAIL(i,j)
3374 ZNT_SEA(i,j) = ZNT_HOLD(i,j)
3375 TSK_SEA(i,j) = TSK_LOCAL(i,j)
3376 ENDIF
3377 ENDDO
3378 ENDDO
3380 ! Restore the values from before the land/frozen-water call
3381 BR_SEA = BR_HOLD
3382 CHS2_SEA = CHS2_HOLD
3383 CHS_SEA = CHS_HOLD
3384 CPM_SEA = CPM_HOLD
3385 CQS2_SEA = CQS2_HOLD
3386 FLHC_SEA = FLHC_HOLD
3387 FLQC_SEA = FLQC_HOLD
3388 GZ1OZ0_SEA = GZ1OZ0_HOLD
3389 HFX_SEA = HFX_HOLD
3390 LH_SEA = LH_HOLD
3391 MOL_SEA = MOL_HOLD
3392 PSIH_SEA = PSIH_HOLD
3393 PSIM_SEA = PSIM_HOLD
3394 QFX_SEA = QFX_HOLD
3395 QGH_SEA = QGH_HOLD
3396 REGIME_SEA = REGIME_HOLD
3397 RMOL_SEA = RMOL_HOLD
3398 UST_SEA = UST_HOLD
3399 WSPD_SEA = WSPD_HOLD
3400 ZOL_SEA = ZOL_HOLD
3401 CH_SEA = CH_HOLD
3403 ! open-water call
3404 ! call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
3405 ! CP,G,ROVCP,R,XLV,PSFC, & ! I
3406 ! CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, & ! I/O
3407 ! ZNT_SEA,UST_SEA, & ! I/O
3408 ! PBLH,MAVAIL_SEA, & ! I
3409 ! ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, & ! I/O
3410 ! XLAND_SEA, & ! I
3411 ! HFX_SEA,QFX_SEA,LH_SEA, & ! I/O
3412 ! TSK_SEA, & ! I
3413 ! FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_sea,RMOL_SEA, & ! I/O
3414 ! U10_sea,V10_sea,TH2_sea,T2_sea,Q2_sea, & ! O
3415 ! GZ1OZ0_SEA,WSPD_SEA,BR_SEA, & ! I/O
3416 ! ISFFLX,DX, &
3417 ! SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
3418 ! KARMAN,EOMEG,STBOLT,
3419 ! P1000, &
3420 ! ids,ide, jds,jde, kds,kde, &
3421 ! ims,ime, jms,jme, kms,kme, &
3422 ! its,ite, jts,jte, kts,kte, & ! 0
3423 ! ustm_sea,ck_sea,cka_sea,cd_sea,cda_sea,isftcflx,iz0tlnd )
3424 CALL SFCLAY_mynn(U3D,V3D,T3D,QV3D,P3D,dz8w, &
3425 CP,G,ROVCP,R,XLV,PSFC, &
3426 CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, &
3427 ZNT_SEA,UST_SEA, &
3428 PBLH,MAVAIL_SEA, &
3429 ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, &
3430 XLAND_SEA, &
3431 HFX_SEA,QFX_SEA,LH_SEA, &
3432 TSK_SEA, &
3433 FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_sea,RMOL_SEA, &
3434 U10_sea,V10_sea,TH2_sea,T2_sea,Q2_sea, &
3435 GZ1OZ0_SEA,WSPD_SEA,BR_SEA, &
3436 ISFFLX,DX, &
3437 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT, &
3438 &itimestep,CH_SEA,th3d,pi3d,qc3d, &
3439 &tsq,qsq,cov,qcg, &
3440 ids,ide, jds,jde, kds,kde, &
3441 ims,ime, jms,jme, kms,kme, &
3442 its,ite, jts,jte, kts,kte )
3444 DO j = JTS , JTE
3445 DO i = ITS, ITE
3446 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and.( XICE(i,j) .LE. 1.0 ) ) THEN
3447 ! weighted average for sea ice points
3448 br(i,j) = ( br(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j) )
3449 ! CHS2 -- wait
3450 ! CHS -- wait
3451 ! CPM -- wait
3452 ! CQS2 -- wait
3453 ! FLHC -- wait
3454 ! FLQC -- wait
3455 gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
3456 ! HFX -- wait
3457 ! LH -- wait
3458 mol(i,j) = ( mol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j) )
3459 psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j) )
3460 psim(i,j) = ( psim(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j) )
3461 ! QFX -- wait
3462 ! QGH -- wait
3463 if ( XICE(i,j).GE. 0.5 ) regime(i,j) = regime_hold(i,j)
3464 rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j) )
3465 ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j) )
3466 wspd(i,j) = ( wspd(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j) )
3467 zol(i,j) = ( zol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j) )
3468 ch(i,j) = ( ch(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ch_sea(i,j) )
3469 ! INTENT(OUT)
3470 ! --------------------------------------------------------------------
3471 q2(i,j) = ( q2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * q2_sea(i,j) )
3472 ! QSFC -- wait
3473 t2(i,j) = ( t2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * t2_sea(i,j) )
3474 th2(i,j) = ( th2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * th2_sea(i,j) )
3475 u10(i,j) = ( u10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j) )
3476 ! IF ( PRESENT ( USTM ) ) THEN
3477 ! USTM(i,j) = ( USTM(i,j) * XICE(i,j) ) + (
3478 ! (1.0-XICE(i,j)) * USTM_sea(i,j) )
3479 ! ENDIF
3480 v10(i,j) = ( v10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j) )
3481 ENDIF
3482 END DO
3483 END DO
3484 !
3485 ! tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
3486 !
3487 END SUBROUTINE mynn_seaice_wrapper
3489 !-------------------------------------------------------------------------
3491 SUBROUTINE sf_gfs_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D, &
3492 CP,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
3493 ZNT,UST,PSIM,PSIH, &
3494 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
3495 QGH,QSFC,U10,V10, &
3496 GZ1OZ0,WSPD,BR,ISFFLX, &
3497 EP1,EP2,KARMAN,itimestep, &
3498 TICE2TSK_IF2COLD, &
3499 XICE_THRESHOLD, &
3500 CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, &
3501 FLHC_SEA, FLQC_SEA, &
3502 HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA,&
3503 UST_SEA, ZNT_SEA, SST, XICE, &
3504 ids,ide, jds,jde, kds,kde, &
3505 ims,ime, jms,jme, kms,kme, &
3506 its,ite, jts,jte, kts,kte )
3507 USE module_sf_gfs
3508 implicit none
3510 INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, &
3511 ims,ime, jms,jme, kms,kme, &
3512 its,ite, jts,jte, kts,kte, &
3513 ISFFLX,itimestep
3515 REAL, INTENT(IN) :: &
3516 CP, &
3517 EP1, &
3518 EP2, &
3519 KARMAN, &
3520 R, &
3521 ROVCP, &
3522 XLV
3524 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: &
3525 P3D, &
3526 QV3D, &
3527 T3D, &
3528 U3D, &
3529 V3D
3531 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: &
3532 TSK, &
3533 PSFC, &
3534 XLAND
3536 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: &
3537 UST, &
3538 ZNT
3540 REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: &
3541 BR, &
3542 CHS, &
3543 CHS2, &
3544 CPM, &
3545 CQS2, &
3546 FLHC, &
3547 FLQC, &
3548 GZ1OZ0, &
3549 HFX, &
3550 LH, &
3551 PSIM, &
3552 PSIH, &
3553 QFX, &
3554 QGH, &
3555 QSFC, &
3556 U10, &
3557 V10, &
3558 WSPD
3560 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: &
3561 XICE
3562 REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: &
3563 CHS_SEA, &
3564 CHS2_SEA, &
3565 CPM_SEA, &
3566 CQS2_SEA, &
3567 FLHC_SEA, &
3568 FLQC_SEA, &
3569 HFX_SEA, &
3570 LH_SEA, &
3571 QFX_SEA, &
3572 QGH_SEA, &
3573 QSFC_SEA, &
3574 UST_SEA, &
3575 ZNT_SEA
3576 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: &
3577 SST
3579 REAL, INTENT(IN) :: &
3580 XICE_THRESHOLD
3581 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
3583 !-------------------------------------------------------------------------
3584 ! Local
3585 !-------------------------------------------------------------------------
3586 INTEGER :: I
3587 INTEGER :: J
3588 REAL, DIMENSION(ims:ime, jms:jme) :: &
3589 BR_SEA, &
3590 GZ1OZ0_SEA, &
3591 PSIM_SEA, &
3592 PSIH_SEA, &
3593 U10_SEA, &
3594 V10_SEA, &
3595 WSPD_SEA, &
3596 XLAND_SEA, &
3597 TSK_SEA, &
3598 UST_HOLD, &
3599 ZNT_HOLD, &
3600 TSK_LOCAL
3602 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
3603 itimestep, .true., tice2tsk_if2cold, &
3604 XICE, XICE_THRESHOLD, &
3605 SST, TSK, TSK_SEA, TSK_LOCAL )
3607 !
3608 ! Set up for frozen ocean call for sea ice points
3609 !
3611 ! Strictly INTENT(IN), Should be unchanged by SF_GFS:
3612 ! CP
3613 ! EP1
3614 ! EP2
3615 ! KARMAN
3616 ! R
3617 ! ROVCP
3618 ! XLV
3619 ! P3D
3620 ! QV3D
3621 ! T3D
3622 ! U3D
3623 ! V3D
3624 ! TSK
3625 ! PSFC
3626 ! XLAND
3627 ! ISFFLX
3628 ! ITIMESTEP
3631 ! Intent (INOUT), original value is used and changed by SF_GFS.
3632 ! UST
3633 ! ZNT
3635 ZNT_HOLD = ZNT
3636 UST_HOLD = UST
3638 ! Strictly INTENT (OUT), set by SF_GFS:
3639 ! BR
3640 ! CHS -- used by LSM routines
3641 ! CHS2 -- used by LSM routines
3642 ! CPM -- used by LSM routines
3643 ! CQS2 -- used by LSM routines
3644 ! FLHC
3645 ! FLQC
3646 ! GZ1OZ0
3647 ! HFX -- used by LSM routines
3648 ! LH -- used by LSM routines
3649 ! PSIM
3650 ! PSIH
3651 ! QFX -- used by LSM routines
3652 ! QGH -- used by LSM routines
3653 ! QSFC -- used by LSM routines
3654 ! U10
3655 ! V10
3656 ! WSPD
3658 !
3659 ! Frozen ocean / true land call.
3660 !
3661 CALL SF_GFS(U3D,V3D,T3D,QV3D,P3D, &
3662 CP,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM_SEA, &
3663 ZNT,UST,PSIM,PSIH, &
3664 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC, &
3665 QGH,QSFC,U10,V10, &
3666 GZ1OZ0,WSPD,BR,ISFFLX, &
3667 EP1,EP2,KARMAN,ITIMESTEP, &
3668 ids,ide, jds,jde, kds,kde, &
3669 ims,ime, jms,jme, kms,kme, &
3670 its,ite, jts,jte, kts,kte )
3672 ! Set up for open-water call
3674 DO j = JTS , JTE
3675 DO i = ITS , ITE
3676 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
3677 ! Sets up things for open ocean fraction of sea-ice points
3678 XLAND_SEA(i,j)=2.
3679 ZNT_SEA(I,J) = 0.0001
3680 IF ( SST(i,j) .LT. 271.4 ) THEN
3681 SST(i,j) = 271.4
3682 ENDIF
3683 TSK_SEA(i,j) = SST(i,j)
3684 ELSE
3685 ! Fully open ocean or true land points
3686 XLAND_SEA(i,j)=xland(i,j)
3687 ZNT_SEA(I,J) = ZNT_HOLD(I,J)
3688 UST_SEA(i,j) = UST_HOLD(i,j)
3689 TSK_SEA(i,j) = TSK(i,j)
3690 ENDIF
3691 ENDDO
3692 ENDDO
3694 ! Open-water call
3695 ! _SEA variables are held for later use as the result of the open-water call.
3696 CALL SF_GFS(U3D,V3D,T3D,QV3D,P3D, &
3697 CP,ROVCP,R,XLV,PSFC,CHS_SEA,CHS2_SEA,CQS2_SEA,CPM, &
3698 ZNT_SEA,UST_SEA,PSIM_SEA,PSIH_SEA, &
3699 XLAND,HFX_SEA,QFX_SEA,LH_SEA,TSK_SEA,FLHC_SEA,FLQC_SEA, &
3700 QGH_SEA,QSFC_SEA,U10_SEA,V10_SEA, &
3701 GZ1OZ0_SEA,WSPD_SEA,BR_SEA,ISFFLX, &
3702 EP1,EP2,KARMAN,ITIMESTEP, &
3703 ids,ide, jds,jde, kds,kde, &
3704 ims,ime, jms,jme, kms,kme, &
3705 its,ite, jts,jte, kts,kte )
3707 ! Weighting, after our two calls to SF_GFS
3709 DO j = JTS , JTE
3710 DO i = ITS , ITE
3711 ! Over sea-ice points, weight the results. Otherwise, just take the results from the
3712 ! first call to SF_GFS_
3713 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
3714 ! Weight a number of fields (between open-water results
3715 ! and full ice results) by sea-ice fraction.
3717 BR(i,j) = ( BR(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * BR_SEA(i,j) )
3718 ! CHS, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3719 ! CHS2, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3720 ! CPM, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3721 ! CQS2, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3722 ! FLHC(i,j) = ( FLHC(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * FLHC_SEA(i,j) )
3723 ! FLQC(i,j) = ( FLQC(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * FLQC_SEA(i,j) )
3724 GZ1OZ0(i,j) = ( GZ1OZ0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * GZ1OZ0_SEA(i,j) )
3725 ! HFX, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3726 ! LH, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3727 PSIM(i,j) = ( PSIM(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIM_SEA(i,j) )
3728 PSIH(i,j) = ( PSIH(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIH_SEA(i,j) )
3729 ! QFX, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3730 ! QGH, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3731 ! QSFC, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3732 U10(i,j) = ( U10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * U10_SEA(i,j) )
3733 V10(i,j) = ( V10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * V10_SEA(i,j) )
3734 WSPD(i,j) = ( WSPD(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * WSPD_SEA(i,j) )
3735 ! UST, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3736 ! ZNT, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
3738 ENDIF
3739 ENDDO
3740 ENDDO
3742 END SUBROUTINE sf_gfs_seaice_wrapper
3744 !-------------------------------------------------------------------------
3745 !-------------------------------------------------------------------------
3747 SUBROUTINE sfclay_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, &
3748 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
3749 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
3750 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
3751 U10,V10,TH2,T2,Q2, &
3752 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
3753 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
3754 KARMAN,EOMEG,STBOLT, &
3755 P1000, &
3756 XICE,SST,TSK_SEA, &
3757 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
3758 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
3759 ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD, &
3760 ids,ide, jds,jde, kds,kde, &
3761 ims,ime, jms,jme, kms,kme, &
3762 its,ite, jts,jte, kts,kte, &
3763 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, &
3764 sf_surface_physics )
3766 USE module_sf_sfclay
3767 implicit none
3769 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
3770 ims,ime, jms,jme, kms,kme, &
3771 its,ite, jts,jte, kts,kte
3773 INTEGER, INTENT(IN ) :: ISFFLX
3774 REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
3775 REAL, INTENT(IN ) :: EP1,EP2,KARMAN,EOMEG,STBOLT
3776 REAL, INTENT(IN ) :: P1000
3778 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
3779 INTENT(IN ) :: dz8w
3781 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
3782 INTENT(IN ) :: QV3D, &
3783 P3D, &
3784 T3D
3786 REAL, DIMENSION( ims:ime, jms:jme ) , &
3787 INTENT(IN ) :: MAVAIL, &
3788 PBLH, &
3789 XLAND, &
3790 TSK
3791 REAL, DIMENSION( ims:ime, jms:jme ) , &
3792 INTENT(OUT ) :: U10, &
3793 V10, &
3794 TH2, &
3795 T2, &
3796 Q2, &
3797 QSFC
3798 REAL, DIMENSION( ims:ime, jms:jme ) , &
3799 INTENT(INOUT) :: REGIME, &
3800 HFX, &
3801 QFX, &
3802 LH, &
3803 MOL,RMOL
3805 REAL, DIMENSION( ims:ime, jms:jme ) , &
3806 INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
3807 PSIM,PSIH
3809 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
3810 INTENT(IN ) :: U3D, &
3811 V3D
3813 REAL, DIMENSION( ims:ime, jms:jme ) , &
3814 INTENT(IN ) :: PSFC
3816 REAL, DIMENSION( ims:ime, jms:jme ) , &
3817 INTENT(INOUT) :: ZNT, &
3818 ZOL, &
3819 UST, &
3820 CPM, &
3821 CHS2, &
3822 CQS2, &
3823 CHS
3825 REAL, DIMENSION( ims:ime, jms:jme ) , &
3826 INTENT(INOUT) :: FLHC,FLQC
3828 REAL, DIMENSION( ims:ime, jms:jme ) , &
3829 INTENT(INOUT) :: &
3830 QGH
3832 REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV,DX
3834 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , &
3835 INTENT(OUT) :: ck,cka,cd,cda,ustm
3837 INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX,IZ0TLND
3839 !--------------------------------------------------------------------
3840 ! New for wrapper
3841 !--------------------------------------------------------------------
3842 INTEGER, INTENT(IN) :: ITIMESTEP, sf_surface_physics
3843 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
3844 REAL, INTENT(IN) :: XICE_THRESHOLD
3845 REAL, DIMENSION( ims:ime, jms:jme ), &
3846 INTENT(IN) :: XICE
3847 REAL, DIMENSION( ims:ime, jms:jme ), &
3848 INTENT(INOUT) :: SST
3849 REAL, DIMENSION( ims:ime, jms:jme ), &
3850 INTENT(OUT) :: TSK_SEA, &
3851 CHS2_SEA, &
3852 CHS_SEA, &
3853 CPM_SEA, &
3854 CQS2_SEA, &
3855 FLHC_SEA, &
3856 FLQC_SEA, &
3857 HFX_SEA, &
3858 LH_SEA, &
3859 QFX_SEA, &
3860 QGH_SEA, &
3861 QSFC_SEA, &
3862 ZNT_SEA
3864 !--------------------------------------------------------------------
3865 ! Local
3866 !--------------------------------------------------------------------
3867 INTEGER :: I, J
3868 REAL, DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA, &
3869 MAVAIL_sea, &
3870 TSK_LOCAL, &
3871 BR_HOLD, &
3872 CHS2_HOLD, &
3873 CHS_HOLD, &
3874 CPM_HOLD, &
3875 CQS2_HOLD, &
3876 FLHC_HOLD, &
3877 FLQC_HOLD, &
3878 GZ1OZ0_HOLD, &
3879 HFX_HOLD, &
3880 LH_HOLD, &
3881 MOL_HOLD, &
3882 PSIH_HOLD, &
3883 PSIM_HOLD, &
3884 QFX_HOLD, &
3885 QGH_HOLD, &
3886 REGIME_HOLD, &
3887 RMOL_HOLD, &
3888 UST_HOLD, &
3889 WSPD_HOLD, &
3890 ZNT_HOLD, &
3891 ZOL_HOLD, &
3892 TH2_HOLD, & !ssib
3893 T2_HOLD, & !ssib
3894 Q2_HOLD, & !ssib
3895 TSK_HOLD, & !ssib
3896 CD_SEA, &
3897 CDA_SEA, &
3898 CK_SEA, &
3899 CKA_SEA, &
3900 Q2_SEA, &
3901 T2_SEA, &
3902 TH2_SEA, &
3903 U10_SEA, &
3904 USTM_SEA, &
3905 V10_SEA
3907 REAL, DIMENSION( ims:ime, jms:jme ) :: &
3908 BR_SEA, &
3909 GZ1OZ0_SEA, &
3910 MOL_SEA, &
3911 PSIH_SEA, &
3912 PSIM_SEA, &
3913 REGIME_SEA, &
3914 RMOL_SEA, &
3915 UST_SEA, &
3916 WSPD_SEA, &
3917 ZOL_SEA
3919 ! INTENT(IN) to SFCLAY; unchanged by the call
3920 ! ISFFLX
3921 ! SVP1,SVP2,SVP3,SVPT0
3922 ! EP1,EP2,KARMAN,EOMEG,STBOLT
3923 ! CP,G,ROVCP,R,XLV,DX
3924 ! ISFTCFLX,IZ0TLND
3925 ! P1000
3926 ! dz8w
3927 ! QV3D
3928 ! P3D
3929 ! T3D
3930 ! MAVAIL
3931 ! PBLH
3932 ! XLAND
3933 ! TSK
3934 ! U3D
3935 ! V3D
3936 ! PSFC
3938 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
3939 itimestep, .true., tice2tsk_if2cold, &
3940 XICE, XICE_THRESHOLD, &
3941 SST, TSK, TSK_SEA, TSK_LOCAL )
3944 ! INTENT (INOUT) to SFCLAY: Save the variables before the first call
3945 ! (for land/frozen water) to SFCLAY, to keep from double-counting the
3946 ! effects of that routine
3947 BR_HOLD = BR
3948 CHS2_HOLD = CHS2
3949 CHS_HOLD = CHS
3950 CPM_HOLD = CPM
3951 CQS2_HOLD = CQS2
3952 FLHC_HOLD = FLHC
3953 FLQC_HOLD = FLQC
3954 GZ1OZ0_HOLD = GZ1OZ0
3955 HFX_HOLD = HFX
3956 LH_HOLD = LH
3957 MOL_HOLD = MOL
3958 PSIH_HOLD = PSIH
3959 PSIM_HOLD = PSIM
3960 QFX_HOLD = QFX
3961 QGH_HOLD = QGH
3962 REGIME_HOLD = REGIME
3963 RMOL_HOLD = RMOL
3964 UST_HOLD = UST
3965 WSPD_HOLD = WSPD
3966 ZNT_HOLD = ZNT
3967 ZOL_HOLD = ZOL
3968 !also save these variables for SSIB (fds 12/2010)
3969 TH2_HOLD = TH2
3970 T2_HOLD = T2
3971 Q2_HOLD = Q2
3972 TSK_HOLD = TSK
3974 ! INTENT(OUT) from SFCLAY. Input shouldn't matter, but we'll want to
3975 ! keep things around for weighting after the second call to SFCLAY.
3976 ! CD
3977 ! CDA
3978 ! CK
3979 ! CKA
3980 ! Q2
3981 ! QSFC
3982 ! T2
3983 ! TH2
3984 ! U10
3985 ! USTM
3986 ! V10
3989 ! land/frozen-water call
3990 call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
3991 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, & ! I,I,I,I,I,I,IO,IO,IO,IO,
3992 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
3993 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
3994 U10,V10,TH2,T2,Q2, &
3995 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
3996 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
3997 KARMAN,EOMEG,STBOLT, &
3998 P1000, &
3999 ids,ide, jds,jde, kds,kde, &
4000 ims,ime, jms,jme, kms,kme, &
4001 its,ite, jts,jte, kts,kte, &
4002 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
4003 !
4004 !Restore land-point values calculated by SSiB (fds 12/2010)
4005 IF (itimestep .gt. 1 .and. sf_surface_physics .EQ. 8) then
4006 DO j = JTS , JTE
4007 DO i = ITS, ITE
4008 IF ( XLAND(I,J) .LT. 1.5 ) THEN
4009 BR(I,J) = BR_HOLD(I,J)
4010 TH2(I,J) = TH2_HOLD(I,J)
4011 T2(I,J) = T2_HOLD(I,J)
4012 Q2(I,J) = Q2_HOLD(I,J)
4013 HFX(I,J) = HFX_HOLD(I,J)
4014 QFX(I,J) = QFX_HOLD(I,J)
4015 LH(I,J) = LH_HOLD(I,J)
4016 GZ1OZ0(I,J) = GZ1OZ0_HOLD(I,J)
4017 WSPD(I,J) = WSPD_HOLD(I,J)
4018 ZNT(I,J) = ZNT_HOLD(I,J)
4019 UST(I,J) = UST_HOLD(I,J)
4020 ! TSK(I,J) = TSK_HOLD(I,J)
4021 ENDIF
4022 ENDDO
4023 ENDDO
4024 ENDIF
4025 !
4026 ! Set up for open-water call
4027 DO j = JTS , JTE
4028 DO i = ITS , ITE
4029 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
4030 XLAND_SEA(i,j)=2.
4031 MAVAIL_SEA(I,J) =1.
4032 ZNT_SEA(I,J) = 0.0001
4033 TSK_SEA(i,j) = SST(i,j)
4034 IF ( SST(i,j) .LT. 271.4 ) THEN
4035 SST(i,j) = 271.4
4036 TSK_SEA(i,j) = SST(i,j)
4037 ENDIF
4038 ELSE
4039 XLAND_SEA(i,j) = XLAND(i,j)
4040 MAVAIL_SEA(i,j) = MAVAIL(i,j)
4041 ZNT_SEA(i,j) = ZNT_HOLD(i,j)
4042 TSK_SEA(i,j) = TSK_LOCAL(i,j)
4043 ENDIF
4044 ENDDO
4045 ENDDO
4047 ! Restore the values from before the land/frozen-water call
4048 BR_SEA = BR_HOLD
4049 CHS2_SEA = CHS2_HOLD
4050 CHS_SEA = CHS_HOLD
4051 CPM_SEA = CPM_HOLD
4052 CQS2_SEA = CQS2_HOLD
4053 FLHC_SEA = FLHC_HOLD
4054 FLQC_SEA = FLQC_HOLD
4055 GZ1OZ0_SEA = GZ1OZ0_HOLD
4056 HFX_SEA = HFX_HOLD
4057 LH_SEA = LH_HOLD
4058 MOL_SEA = MOL_HOLD
4059 PSIH_SEA = PSIH_HOLD
4060 PSIM_SEA = PSIM_HOLD
4061 QFX_SEA = QFX_HOLD
4062 QGH_SEA = QGH_HOLD
4063 REGIME_SEA = REGIME_HOLD
4064 RMOL_SEA = RMOL_HOLD
4065 UST_SEA = UST_HOLD
4066 WSPD_SEA = WSPD_HOLD
4067 ZOL_SEA = ZOL_HOLD
4068 !
4069 ! open-water call
4070 call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
4071 CP,G,ROVCP,R,XLV,PSFC, & ! I
4072 CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, & ! I/O
4073 ZNT_SEA,UST_SEA, & ! I/O
4074 PBLH,MAVAIL_SEA, & ! I
4075 ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, & ! I/O
4076 XLAND_SEA, & ! I
4077 HFX_SEA,QFX_SEA,LH_SEA, & ! I/O
4078 TSK_SEA, & ! I
4079 FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_sea,RMOL_SEA, & ! I/O
4080 U10_sea,V10_sea,TH2_sea,T2_sea,Q2_sea, & ! O
4081 GZ1OZ0_SEA,WSPD_SEA,BR_SEA, & ! I/O
4082 ISFFLX,DX, &
4083 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
4084 KARMAN,EOMEG,STBOLT, &
4085 P1000, &
4086 ids,ide, jds,jde, kds,kde, &
4087 ims,ime, jms,jme, kms,kme, &
4088 its,ite, jts,jte, kts,kte, & ! 0
4089 ustm_sea,ck_sea,cka_sea,cd_sea,cda_sea,isftcflx,iz0tlnd )
4090 !
4091 DO j = JTS , JTE
4092 DO i = ITS, ITE
4093 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and.( XICE(i,j) .LE. 1.0 ) ) THEN
4094 ! weighted average for sea ice points
4095 br(i,j) = ( br(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j) )
4096 ! CHS2 -- wait
4097 ! CHS -- wait
4098 ! CPM -- wait
4099 ! CQS2 -- wait
4100 ! FLHC -- wait
4101 ! FLQC -- wait
4102 gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
4103 ! HFX -- wait
4104 ! LH -- wait
4105 mol(i,j) = ( mol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j) )
4106 psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j) )
4107 psim(i,j) = ( psim(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j) )
4108 ! QFX -- wait
4109 ! QGH -- wait
4110 if ( XICE(i,j).GE. 0.5 ) regime(i,j) = regime_hold(i,j)
4111 rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j) )
4112 ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j) )
4113 wspd(i,j) = ( wspd(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j) )
4114 zol(i,j) = ( zol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j) )
4115 ! INTENT(OUT) --------------------------------------------------------------------
4116 IF ( PRESENT ( CD ) ) THEN
4117 CD(i,j) = ( CD(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CD_sea(i,j) )
4118 ENDIF
4119 IF ( PRESENT ( CDA ) ) THEN
4120 CDA(i,j) = ( CDA(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CDA_sea(i,j) )
4121 ENDIF
4122 IF ( PRESENT ( CK ) ) THEN
4123 CK(i,j) = ( CK(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CK_sea(i,j) )
4124 ENDIF
4125 IF ( PRESENT ( CKA ) ) THEN
4126 CKA(i,j) = ( CKA(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CKA_sea(i,j) )
4127 ENDIF
4128 q2(i,j) = ( q2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * q2_sea(i,j) )
4129 ! QSFC -- wait
4130 t2(i,j) = ( t2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * t2_sea(i,j) )
4131 th2(i,j) = ( th2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * th2_sea(i,j) )
4132 u10(i,j) = ( u10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j) )
4133 IF ( PRESENT ( USTM ) ) THEN
4134 USTM(i,j) = ( USTM(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * USTM_sea(i,j) )
4135 ENDIF
4136 v10(i,j) = ( v10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j) )
4137 ENDIF
4138 END DO
4139 END DO
4140 !
4141 ! tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
4142 !
4143 END SUBROUTINE sfclay_seaice_wrapper
4145 !-------------------------------------------------------------------------
4146 !-------------------------------------------------------------------------
4148 SUBROUTINE pxsfclay_seaice_wrapper(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
4149 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
4150 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
4151 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
4152 U10,V10, &
4153 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
4154 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
4155 XICE, SST, ITIMESTEP, TICE2TSK_IF2COLD,XICE_THRESHOLD, &
4156 CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, FLHC_SEA, FLQC_SEA, &
4157 HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, TSK_SEA, &
4158 ids,ide, jds,jde, kds,kde, &
4159 ims,ime, jms,jme, kms,kme, &
4160 its,ite, jts,jte, kts,kte )
4161 USE module_sf_pxsfclay
4162 implicit none
4163 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
4164 ims,ime, jms,jme, kms,kme, &
4165 its,ite, jts,jte, kts,kte
4167 INTEGER, INTENT(IN ) :: ISFFLX
4168 LOGICAL, INTENT(IN ) :: TICE2TSK_IF2COLD
4169 REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
4170 REAL, INTENT(IN ) :: EP1,EP2,KARMAN
4172 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
4173 INTENT(IN ) :: dz8w
4175 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
4176 INTENT(IN ) :: QV3D, &
4177 P3D, &
4178 T3D, &
4179 TH3D
4181 REAL, DIMENSION( ims:ime, jms:jme ) , &
4182 INTENT(IN ) :: MAVAIL, &
4183 PBLH, &
4184 XLAND, &
4185 TSK
4186 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
4187 INTENT(IN ) :: U3D, &
4188 V3D
4190 REAL, DIMENSION( ims:ime, jms:jme ) , &
4191 INTENT(IN ) :: PSFC
4193 REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV,DX
4195 REAL, DIMENSION( ims:ime, jms:jme ) , &
4196 INTENT(OUT ) :: U10, &
4197 V10, &
4198 QSFC
4199 REAL, DIMENSION( ims:ime, jms:jme ) , &
4200 INTENT(INOUT) :: REGIME, &
4201 HFX, &
4202 QFX, &
4203 LH, &
4204 MOL,RMOL
4205 REAL, DIMENSION( ims:ime, jms:jme ) , &
4206 INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
4207 PSIM,PSIH
4209 REAL, DIMENSION( ims:ime, jms:jme ) , &
4210 INTENT(INOUT) :: ZNT, &
4211 ZOL, &
4212 UST, &
4213 CPM, &
4214 CHS2, &
4215 CQS2, &
4216 CHS
4218 REAL, DIMENSION( ims:ime, jms:jme ) , &
4219 INTENT(INOUT) :: FLHC,FLQC
4221 REAL, DIMENSION( ims:ime, jms:jme ) , &
4222 INTENT(INOUT) :: QGH
4224 !--------------------------------------------------------------------
4225 ! For wrapper
4226 !--------------------------------------------------------------------
4228 INTEGER, INTENT(IN) :: ITIMESTEP
4229 REAL, INTENT(IN) :: XICE_THRESHOLD
4230 REAL, DIMENSION( ims:ime, jms:jme ) , &
4231 INTENT(IN) :: XICE
4232 REAL, DIMENSION( ims:ime, jms:jme ) , &
4233 INTENT(OUT) :: TSK_SEA
4234 REAL, DIMENSION( ims:ime, jms:jme ) , &
4235 INTENT(INOUT) :: SST
4237 !--------------------------------------------------------------------
4238 ! Local
4239 !--------------------------------------------------------------------
4240 INTEGER :: I, J
4241 REAL, DIMENSION( ims:ime, jms:jme ) , &
4242 INTENT(OUT) :: CHS_SEA, &
4243 CHS2_SEA, &
4244 CPM_SEA, &
4245 CQS2_SEA, &
4246 FLHC_SEA, &
4247 FLQC_SEA, &
4248 HFX_SEA, &
4249 LH_SEA, &
4250 QFX_SEA, &
4251 QGH_SEA, &
4252 QSFC_SEA
4254 REAL, DIMENSION( ims:ime, jms:jme ) :: BR_HOLD, &
4255 CHS_HOLD, &
4256 CHS2_HOLD, &
4257 CPM_HOLD, &
4258 CQS2_HOLD, &
4259 FLHC_HOLD, &
4260 FLQC_HOLD, &
4261 GZ1OZ0_HOLD, &
4262 HFX_HOLD, &
4263 LH_HOLD, &
4264 MOL_HOLD, &
4265 PSIH_HOLD, &
4266 PSIM_HOLD, &
4267 QFX_HOLD, &
4268 QGH_HOLD, &
4269 REGIME_HOLD, &
4270 RMOL_HOLD, &
4271 UST_HOLD, &
4272 WSPD_HOLD, &
4273 ZNT_HOLD, &
4274 ZOL_HOLD, &
4275 TSK_LOCAL
4277 REAL, DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA, &
4278 MAVAIL_SEA, &
4279 BR_SEA, &
4280 GZ1OZ0_SEA, &
4281 MOL_SEA, &
4282 PSIH_SEA, &
4283 PSIM_SEA, &
4284 REGIME_SEA, &
4285 RMOL_SEA, &
4286 UST_SEA, &
4287 WSPD_SEA, &
4288 ZNT_SEA, &
4289 ZOL_SEA, &
4290 U10_SEA, &
4291 V10_SEA
4293 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
4294 itimestep, .true., tice2tsk_if2cold, &
4295 XICE, XICE_THRESHOLD, &
4296 SST, TSK, TSK_SEA, TSK_LOCAL )
4297 !
4298 ! INTENT (INOUT) to PXSFCLAY: Save the variables before the first call
4299 ! (for land/frozen water) to SFCLAY, to keep from double-counting the
4300 ! effects of that routine
4301 !
4302 BR_HOLD = BR
4303 CHS_HOLD = CHS
4304 CHS2_HOLD = CHS2
4305 CPM_HOLD = CPM
4306 CQS2_HOLD = CQS2
4307 FLHC_HOLD = FLHC
4308 FLQC_HOLD = FLQC
4309 GZ1OZ0_HOLD = GZ1OZ0
4310 HFX_HOLD = HFX
4311 LH_HOLD = LH
4312 MOL_HOLD = MOL
4313 PSIH_HOLD = PSIH
4314 PSIM_HOLD = PSIM
4315 QFX_HOLD = QFX
4316 QGH_HOLD = QGH
4317 REGIME_HOLD = REGIME
4318 RMOL_HOLD = RMOL
4319 UST_HOLD = UST
4320 WSPD_HOLD = WSPD
4321 ZNT_HOLD = ZNT
4322 ZOL_HOLD = ZOL
4324 ! INTENT(OUT) from PXSFCLAY. Input shouldn't matter, but we'll want to
4325 ! keep things around for weighting after the second call to PXSFCLAY.
4326 ! U10
4327 ! V10
4328 ! QSFC
4330 ! Land/frozen-water call.
4331 CALL pxsfclay(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
4332 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
4333 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
4334 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
4335 U10,V10, &
4336 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
4337 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
4338 ids,ide, jds,jde, kds,kde, &
4339 ims,ime, jms,jme, kms,kme, &
4340 its,ite, jts,jte, kts,kte )
4342 DO j = JTS , JTE
4343 DO i= ITS , ITE
4344 IF( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
4345 ! Sets up things for open ocean.
4346 XLAND_SEA(i,j)=2.
4347 MAVAIL_SEA(I,J) =1.
4348 ZNT_SEA(I,J) = 0.0001
4349 TSK_SEA(i,j) = SST(i,j)
4350 if ( SST(i,j) .LT. 271.4 ) then
4351 SST(i,j) = 271.4
4352 TSK_SEA(i,j) = SST(i,j)
4353 endif
4354 ELSE
4355 XLAND_SEA(i,j)=xland(i,j)
4356 MAVAIL_SEA(i,j) = mavail(i,j)
4357 ZNT_SEA(I,J) = ZNT_HOLD(I,J)
4358 TSK_SEA(i,j) = TSK(i,j)
4359 ENDIF
4360 ENDDO
4361 ENDDO
4363 ! INTENT(INOUT) variables held over from before the first call to PXSFCLAY:
4364 BR_SEA = BR_HOLD
4365 CHS_SEA = CHS_HOLD
4366 CHS2_SEA = CHS2_HOLD
4367 CPM_SEA = CPM_HOLD
4368 CQS2_SEA = CQS2_HOLD
4369 FLHC_SEA = FLHC_HOLD
4370 FLQC_SEA = FLQC_HOLD
4371 GZ1OZ0_SEA = GZ1OZ0_HOLD
4372 HFX_SEA = HFX_HOLD
4373 LH_SEA = LH_HOLD
4374 MOL_SEA = MOL_HOLD
4375 PSIH_SEA = PSIH_HOLD
4376 PSIM_SEA = PSIM_HOLD
4377 QFX_SEA = QFX_HOLD
4378 QGH_SEA = QGH_HOLD
4379 REGIME_SEA = REGIME_HOLD
4380 RMOL_SEA = RMOL_HOLD
4381 UST_SEA = UST_HOLD
4382 WSPD_SEA = WSPD_HOLD
4383 ZOL_SEA = ZOL_HOLD
4385 ! Open-water call.
4386 ! Variables newly set (INTENT(OUT)) or changed (INTENT(INOUT)) by
4387 ! PXSFCLAY are here appended with the "_SEA" label.
4388 ! Special intent(IN) variables here: XLAND_SEA, MAVAIL_SEA, TSK_SEA
4389 CALL pxsfclay(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
4390 CP,G,ROVCP,R,XLV,PSFC,CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, &
4391 ZNT_SEA,UST_SEA,PBLH,MAVAIL_SEA,ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, &
4392 XLAND_SEA,HFX_SEA,QFX_SEA,LH_SEA,TSK_SEA,FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_SEA,RMOL_SEA, &
4393 U10_SEA,V10_SEA, &
4394 GZ1OZ0_SEA,WSPD_SEA,BR_SEA,ISFFLX,DX, &
4395 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
4396 ids,ide, jds,jde, kds,kde, &
4397 ims,ime, jms,jme, kms,kme, &
4398 its,ite, jts,jte, kts,kte )
4400 DO j = JTS , JTE
4401 DO i = ITS , ITE
4402 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
4403 ! INTENT (INOUT) for PXSFCLAY:
4404 br(i,j) = ( br(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j) )
4405 gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
4406 mol(i,j) = ( mol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j) )
4407 psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j) )
4408 psim(i,j) = ( psim(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j) )
4409 rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j) )
4410 ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j) )
4411 wspd(i,j) = ( wspd(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j) )
4412 zol(i,j) = ( zol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j) )
4413 ! REGIME: Special case for this variable. Just take the land values.
4414 ! CHS -- wait
4415 ! CHS2 -- wait
4416 ! CPM -- wait
4417 ! CQS2 -- wait
4418 ! FLHC -- wait
4419 ! FLQC -- wait
4420 ! HFX -- wait
4421 ! LH -- wait
4422 ! QFX -- wait
4423 ! QGH -- wait
4425 ! INTENT (OUT) from PXSFCLAY:
4426 u10(i,j) = ( u10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j) )
4427 v10(i,j) = ( v10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j) )
4428 ! QSFC -- wait
4429 ENDIF
4430 ENDDO
4431 ENDDO
4433 END SUBROUTINE pxsfclay_seaice_wrapper
4435 !-------------------------------------------------------------------------
4437 SUBROUTINE TOPO_RAD_ADJ_DRVR (XLAT,XLONG,COSZEN, &
4438 shadowmask, &
4439 declin, &
4440 SWDOWN,GSW,SWNORM,GSWSAVE,solcon,hrang2d, &
4441 slope_in,slp_azi_in, &
4442 ids, ide, jds, jde, kds, kde, &
4443 ims, ime, jms, jme, kms, kme, &
4444 its, ite, jts, jte, kts, kte )
4445 !------------------------------------------------------------------
4446 IMPLICIT NONE
4447 !------------------------------------------------------------------
4448 INTEGER, INTENT(IN) :: its,ite,jts,jte,kts,kte, &
4449 ims,ime,jms,jme,kms,kme, &
4450 ids,ide,jds,jde,kds,kde
4451 INTEGER, DIMENSION( ims:ime, jms:jme ), &
4452 INTENT(IN) :: shadowmask
4453 REAL, DIMENSION( ims:ime, jms:jme ), &
4454 INTENT(IN ) :: XLAT,XLONG
4455 REAL, DIMENSION( ims:ime, jms:jme ), &
4456 INTENT(INOUT) :: SWDOWN,GSW,SWNORM,GSWSAVE
4457 real,intent(in) :: solcon
4458 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: hrang2d,coszen
4461 REAL, INTENT(IN ) :: declin
4462 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: slope_in,slp_azi_in
4465 ! LOCAL VARS
4466 integer :: i,j
4467 real :: pi,degrad
4468 integer :: shadow
4469 real :: swdown_teradj,swdown_in,xlat1,xlong1
4471 !------------------------------------------------------------------
4473 pi = 4.*atan(1.)
4474 degrad=pi/180.
4476 DO J=jts,jte
4477 DO I=its,ite
4478 SWNORM(i,j) = SWDOWN(i,j) ! save
4479 IF(SWDOWN(I,J) .GT. 1.E-3)THEN ! daytime
4480 shadow = shadowmask(i,j)
4482 SWDOWN_IN = SWDOWN(i,j)
4483 XLAT1 = XLAT(i,j)
4484 XLONG1 = XLONG(i,j)
4485 CALL TOPO_RAD_ADJ (XLAT1,XLONG1,COSZEN(i,j), &
4486 DECLIN,DEGRAD, &
4487 SWDOWN_IN,solcon,hrang2d(i,j),SWDOWN_teradj, &
4488 kts,kte, &
4489 slope_in(i,j),slp_azi_in(i,j), &
4490 shadow , i,j &
4491 )
4493 GSWSAVE(I,J) = GSW(I,J) ! save
4494 GSW(I,J) = GSW(I,J)*SWDOWN_teradj/SWDOWN(i,j)
4495 SWDOWN(i,j) = SWDOWN_teradj
4497 ENDIF ! daytime
4498 ENDDO ! i_loop
4499 ENDDO ! j_loop
4502 END SUBROUTINE TOPO_RAD_ADJ_DRVR
4503 !------------------------------------------------------------------
4504 !------------------------------------------------------------------
4505 SUBROUTINE TOPO_RAD_ADJ (XLAT1,XLONG1,COSZEN, &
4506 DECLIN,DEGRAD, &
4507 SWDOWN_IN,solcon,hrang,SWDOWN_teradj, &
4508 kts,kte, &
4509 slope,slp_azi, &
4510 shadow &
4511 ,i,j)
4513 !------------------------------------------------------------------
4514 IMPLICIT NONE
4515 !------------------------------------------------------------------
4516 INTEGER, INTENT(IN) :: kts,kte
4517 REAL, INTENT(IN) :: COSZEN,DECLIN, &
4518 XLAT1,XLONG1,DEGRAD
4519 REAL, INTENT(IN) :: SWDOWN_IN,solcon,hrang
4520 INTEGER, INTENT(IN) :: shadow
4521 REAL, INTENT(IN) :: slp_azi,slope
4523 REAL, INTENT(OUT) :: SWDOWN_teradj
4525 ! LOCAL VARS
4526 REAL :: XT24,TLOCTM,CSZA,XXLAT
4527 REAL :: diffuse_frac,corr_fac,csza_slp
4528 integer :: i,j
4531 !------------------------------------------------------------------
4533 SWDOWN_teradj=SWDOWN_IN
4535 CSZA=COSZEN
4536 XXLAT=XLAT1*DEGRAD
4538 ! RETURN IF NIGHT
4539 IF(CSZA.LE.1.E-9) return
4541 ! Parameterize diffuse fraction of global solar radiation as a function of the ratio between TOA radiation and surface global radiation
4542 diffuse_frac = min(1.,1./(max(0.1,2.1-2.8*log(log(csza*solcon/max(SWDOWN_IN,1.e-3))))))
4543 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
4544 corr_fac = 1
4545 goto 140
4546 endif
4548 ! cosine of zenith angle over sloping topography
4549 csza_slp = ((SIN(XXLAT)*COS(HRANG))* &
4550 (-cos(slp_azi)*sin(slope))-SIN(HRANG)*(sin(slp_azi)*sin(slope))+ &
4551 (COS(XXLAT)*COS(HRANG))*cos(slope))* &
4552 COS(DECLIN)+(COS(XXLAT)*(cos(slp_azi)*sin(slope))+ &
4553 SIN(XXLAT)*cos(slope))*SIN(DECLIN)
4554 IF(csza_slp.LE.1.E-4) csza_slp = 0
4556 ! Topographic shading
4557 if (shadow.eq.1) csza_slp = 0
4559 ! Correction factor for sloping topography; the diffuse fraction of solar radiation is assumed to be unaffected by the slope
4560 corr_fac = diffuse_frac + (1-diffuse_frac)*csza_slp/csza
4562 140 continue
4564 SWDOWN_teradj=(1.)*SWDOWN_IN*corr_fac
4566 END SUBROUTINE TOPO_RAD_ADJ
4568 !=======================================================================
4570 SUBROUTINE get_local_ice_tsk ( ims, ime, jms, jme, &
4571 its, ite, jts, jte, &
4572 itimestep, &
4573 sfc_layer_values, &
4574 tice2tsk_if2cold, &
4575 XICE, XICE_THRESHOLD, &
4576 SST, TSK, TSK_SEA, TSK_ICE )
4577 !<DESCRIPTION>
4578 !
4579 ! For grid cells with a fractional ice area, derive the ice surface
4580 ! temperature from the area-averaged surface temperature (the blended
4581 ! result of the open-water values (SST) and the ice-covered value).
4582 !
4583 !</DESCRIPTION>
4585 IMPLICIT NONE
4587 INTEGER, INTENT(IN) :: ims, ime, jms, jme !-- start/end index for i/j in memory
4588 INTEGER, INTENT(IN) :: its, ite, jts, jte !-- start/end index for i/j in tile
4589 INTEGER, INTENT(IN) :: itimestep !-- timestep
4590 LOGICAL, INTENT(IN) :: sfc_layer_values !-- True if there are surface layer routine values
4591 !-- available from the ice portion of the grid point
4592 !-- (i.e. called from a seaice_wrapper subroutine)
4593 LOGICAL, INTENT(IN) :: tice2tsk_if2cold !-- True to set TSK_ICE to TSK. This may be
4594 !-- necessary to avoid unphysically low ice
4595 !-- temperatures is there is a mis-match between
4596 !-- ice fraction and surface temperature.
4598 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: XICE ! Ice fraction
4599 REAL , INTENT(IN) :: XICE_THRESHOLD
4600 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: TSK ! Surface temperature (K)
4601 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: SST ! Sea surface temperature (K)
4602 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: TSK_SEA ! Sfc temp of open water portion of grid cell
4603 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: TSK_ICE ! Sfc temp of ice oprtion of grid cell
4605 ! Local
4606 INTEGER :: i,j
4608 DO j = JTS , JTE
4609 DO i = ITS , ITE
4610 IF ( ( XICE(i,j) >= XICE_THRESHOLD ) .AND. ( XICE(I,J) <= 1.0 ) ) THEN
4612 IF ( SST(i,j) < 271.4 ) THEN
4613 SST(i,j) = 271.4
4614 ENDIF
4616 IF (sfc_layer_values) THEN
4617 IF ( SST(i,j) > 273. .AND. itimestep <= 3) then
4618 ! Why the dependence on the time step count, here?
4619 IF ( XICE(i,j) >= 0.6 ) THEN
4620 SST(i,j) = 271.4
4621 ELSEIF ( XICE(i,j) >= 0.4 ) THEN
4622 SST(i,j) = 273.
4623 ELSEIF (XICE(i,j) >= 0.2 .AND. SST(i,j) > 275.) THEN
4624 SST(i,j) = 275.
4625 ELSEIF (SST(i,j) > 278.) THEN
4626 SST(i,j) = 278.
4627 ENDIF
4628 ENDIF
4629 ENDIF
4630 TSK_SEA(i,j) = SST(i,j)
4632 IF ( tice2tsk_if2cold ) THEN
4633 !------------------------------------------------------------------------------------
4634 ! This avoids unphysically low ice temperatures for grid cells with low ice fractions
4635 ! and low area-averaged temperatures. This can happen when the initial ice fraction
4636 ! and surface temperature come from different data sets.
4637 !------------------------------------------------------------------------------------
4638 TSK_ICE(i,j) = MIN( TSK(i,j), 273.15 )
4639 ELSE
4640 TSK_ICE(i,j) = ( TSK(i,j) - (1.0-XICE(i,j)) * SST(i,j) ) / XICE(i,j)
4641 ENDIF
4643 IF ( ( XICE(i,j) < 0.2 ) .AND. ( TSK(i,j) < 253.15 ) ) THEN
4644 TSK_ICE(i,j) = 253.15
4645 ENDIF
4646 IF ( ( XICE(i,j) < 0.1 ) .AND. ( TSK(i,j) < 263.15 ) ) THEN
4647 TSK_ICE(i,j) = 263.15
4648 ENDIF
4649 ELSE
4650 ! land/open-water point
4651 TSK_SEA(i,j) = TSK(i,j)
4652 TSK_ICE(i,j) = TSK(i,j)
4653 ENDIF
4654 ENDDO
4655 ENDDO
4657 END SUBROUTINE get_local_ice_tsk
4659 !=======================================================================
4660 !=======================================================================
4662 END MODULE module_surface_driver