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