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