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