module_surface_driver.F
References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:PHYSICS
2 !
3 MODULE module_surface_driver
4 CONTAINS
5
6 SUBROUTINE surface_driver( &
7 & acsnom,acsnow,akhs,akms,albedo,br,canwat &
8 & ,chklowq,dt,dx,dz8w,dzs,glw &
9 & ,grdflx,gsw,swdown,gz1oz0,hfx,ht,ifsnow,isfflx &
10 & ,isltyp,itimestep,ivgtyp,lowlyr,mavail,rmol &
11 & ,num_soil_layers,p8w,pblh,pi_phy,pshltr,psih &
12 & ,psim,p_phy,q10,q2,qfx,qsfc,qshltr,qz0 &
13 & ,raincv,rho,sfcevp,sfcexc,sfcrunoff &
14 & ,smois,smstav,smstot,snoalb,snow,snowc,snowh,stepbl &
15 & ,th10,th2,thz0,th_phy,tmn,tshltr,tsk,tslb &
16 & ,t_phy,u10,udrunoff,ust,uz0,u_frame,u_phy,v10,vegfra &
17 & ,vz0,v_frame,v_phy,warm_rain,wspd,xice,xland,z,znt,zs &
18 & ,ct,tke_myj &
19 & ,albbck,lh,sh2o,shdmax,shdmin,z0 &
20 & ,flqc,flhc,psfc,sst,sst_update,t2,emiss &
21 & ,sf_sfclay_physics,sf_surface_physics,ra_lw_physics &
22 ! Optional urban
23 & ,declin_urb,cosz_urb2d,omg_urb2d,xlat_urb2d & !I urban
24 & ,num_roof_layers, num_wall_layers & !I urban
25 & ,num_road_layers, dzr, dzb, dzg & !I urban
26 & ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d & !H urban
27 & ,uc_urb2d & !H urban
28 & ,xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d & !H urban
29 & ,trl_urb3d,tbl_urb3d,tgl_urb3d & !H urban
30 & ,sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d & !H urban
31 & ,frc_urb2d, utype_urb2d & !H urban
32 & ,ucmcall & ! urban
33 & , ids,ide,jds,jde,kds,kde &
34 & , ims,ime,jms,jme,kms,kme &
35 & , i_start,i_end,j_start,j_end,kts,kte,num_tiles &
36 ! Optional moisture tracers
37 & ,qv_curr, qc_curr, qr_curr &
38 & ,qi_curr, qs_curr, qg_curr &
39 ! Optional moisture tracer flags
40 & ,f_qv,f_qc,f_qr &
41 & ,f_qi,f_qs,f_qg &
42 ! Other optionals (more or less em specific)
43 & ,capg,hol,mol &
44 & ,rainncv,rainbl,regime,thc &
45 & ,qsg,qvg,qcg,soilt1,tsnav &
46 & ,smfr3d,keepfr3dflag &
47 ! Other optionals (more or less nmm specific)
48 & ,potevp,snopcx,soiltb,sr &
49 ! Optional observation nudging
50 & ,uratx,vratx,tratx &
51 )
52
53 #if ( ! NMM_CORE == 1 )
54 USE module_state_description, ONLY : SFCLAYSCHEME &
55 ,MYJSFCSCHEME &
56 ,GFSSFCSCHEME &
57 ,SLABSCHEME &
58 ,LSMSCHEME &
59 ,RUCLSMSCHEME
60 #else
61 USE module_state_description, ONLY : SFCLAYSCHEME &
62 ,MYJSFCSCHEME &
63 ,GFSSFCSCHEME &
64 ,SLABSCHEME &
65 ,NMMLSMSCHEME &
66 ,LSMSCHEME &
67 ,RUCLSMSCHEME
68 #endif
69 USE module_model_constants
70 ! *** add new modules of schemes here
71
72 USE module_sf_sfclay
73 USE module_sf_myjsfc
74 USE module_sf_gfs
75 USE module_sf_noahlsm
76 USE module_sf_ruclsm
77 #if ( NMM_CORE == 1 )
78 USE module_sf_lsm_nmm
79 #endif
80
81 USE module_sf_slab
82 !
83 USE module_sf_sfcdiags
84 !
85
86 ! This driver calls subroutines for the surface parameterizations.
87 !
88 ! surface layer: (between surface and pbl)
89 ! 1. sfclay
90 ! 2. myjsfc
91 ! surface: ground temp/lsm scheme:
92 ! 1. slab
93 ! 2. Noah LSM
94 ! 99. NMM LSM (NMM core only)
95 !------------------------------------------------------------------
96 IMPLICIT NONE
97 !======================================================================
98 ! Grid structure in physics part of WRF
99 !----------------------------------------------------------------------
100 ! The horizontal velocities used in the physics are unstaggered
101 ! relative to temperature/moisture variables. All predicted
102 ! variables are carried at half levels except w, which is at full
103 ! levels. Some arrays with names (*8w) are at w (full) levels.
104 !
105 !----------------------------------------------------------------------
106 ! In WRF, kms (smallest number) is the bottom level and kme (largest
107 ! number) is the top level. In your scheme, if 1 is at the top level,
108 ! then you have to reverse the order in the k direction.
109 !
110 ! kme - half level (no data at this level)
111 ! kme ----- full level
112 ! kme-1 - half level
113 ! kme-1 ----- full level
114 ! .
115 ! kms+2 - half level
116 ! kms+2 ----- full level
117 ! kms+1 - half level
118 ! kms+1 ----- full level
119 ! kms - half level
120 ! kms ----- full level
121 !
122 !======================================================================
123 ! Definitions
124 !-----------
125 ! Theta potential temperature (K)
126 ! Qv water vapor mixing ratio (kg/kg)
127 ! Qc cloud water mixing ratio (kg/kg)
128 ! Qr rain water mixing ratio (kg/kg)
129 ! Qi cloud ice mixing ratio (kg/kg)
130 ! Qs snow mixing ratio (kg/kg)
131 !-----------------------------------------------------------------
132 !-- itimestep number of time steps
133 !-- GLW downward long wave flux at ground surface (W/m^2)
134 !-- GSW net short wave flux at ground surface (W/m^2)
135 !-- SWDOWN downward short wave flux at ground surface (W/m^2)
136 !-- EMISS surface emissivity (between 0 and 1)
137 !-- TSK surface temperature (K)
138 !-- TMN soil temperature at lower boundary (K)
139 !-- XLAND land mask (1 for land, 2 for water)
140 !-- ZNT time-varying roughness length (m)
141 !-- Z0 background roughness length (m)
142 !-- MAVAIL surface moisture availability (between 0 and 1)
143 !-- UST u* in similarity theory (m/s)
144 !-- MOL T* (similarity theory) (K)
145 !-- HOL PBL height over Monin-Obukhov length
146 !-- PBLH PBL height (m)
147 !-- CAPG heat capacity for soil (J/K/m^3)
148 !-- THC thermal inertia (Cal/cm/K/s^0.5)
149 !-- SNOWC flag indicating snow coverage (1 for snow cover)
150 !-- HFX net upward heat flux at the surface (W/m^2)
151 !-- QFX net upward moisture flux at the surface (kg/m^2/s)
152 !-- LH net upward latent heat flux at surface (W/m^2)
153 !-- REGIME flag indicating PBL regime (stable, unstable, etc.)
154 !-- tke_myj turbulence kinetic energy from Mellor-Yamada-Janjic (MYJ) (m^2/s^2)
155 !-- akhs sfc exchange coefficient of heat/moisture from MYJ
156 !-- akms sfc exchange coefficient of momentum from MYJ
157 !-- thz0 potential temperature at roughness length (K)
158 !-- uz0 u wind component at roughness length (m/s)
159 !-- vz0 v wind component at roughness length (m/s)
160 !-- qsfc specific humidity at lower boundary (kg/kg)
161 !-- uratx ratio of u over u10 (Added for obs-nudging)
162 !-- vratx ratio of v over v10 (Added for obs-nudging)
163 !-- tratx ratio of t over th2 (Added for obs-nudging)
164 !-- u10 diagnostic 10-m u component from surface layer
165 !-- v10 diagnostic 10-m v component from surface layer
166 !-- th2 diagnostic 2-m theta from surface layer and lsm
167 !-- t2 diagnostic 2-m temperature from surface layer and lsm
168 !-- q2 diagnostic 2-m mixing ratio from surface layer and lsm
169 !-- tshltr diagnostic 2-m theta from MYJ
170 !-- th10 diagnostic 10-m theta from MYJ
171 !-- qshltr diagnostic 2-m specific humidity from MYJ
172 !-- q10 diagnostic 10-m specific humidity from MYJ
173 !-- lowlyr index of lowest model layer above ground
174 !-- rr dry air density (kg/m^3)
175 !-- u_phy u-velocity interpolated to theta points (m/s)
176 !-- v_phy v-velocity interpolated to theta points (m/s)
177 !-- th_phy potential temperature (K)
178 !-- moist moisture array (4D - last index is species) (kg/kg)
179 !-- p_phy pressure (Pa)
180 !-- pi_phy exner function (dimensionless)
181 !-- pshltr diagnostic shelter (2m) pressure from MYJ (Pa)
182 !-- p8w pressure at full levels (Pa)
183 !-- t_phy temperature (K)
184 !-- dz8w dz between full levels (m)
185 !-- z height above sea level (m)
186 !-- DX horizontal space interval (m)
187 !-- DT time step (second)
188 !-- PSFC pressure at the surface (Pa)
189 !-- SST sea-surface temperature (K)
190 !-- TSLB
191 !-- ZS
192 !-- DZS
193 !-- num_soil_layers number of soil layer
194 !-- IFSNOW ifsnow=1 for snow-cover effects
195 !
196 !-- ids start index for i in domain
197 !-- ide end index for i in domain
198 !-- jds start index for j in domain
199 !-- jde end index for j in domain
200 !-- kds start index for k in domain
201 !-- kde end index for k in domain
202 !-- ims start index for i in memory
203 !-- ime end index for i in memory
204 !-- jms start index for j in memory
205 !-- jme end index for j in memory
206 !-- kms start index for k in memory
207 !-- kme end index for k in memory
208 !-- its start index for i in tile
209 !-- ite end index for i in tile
210 !-- jts start index for j in tile
211 !-- jte end index for j in tile
212 !-- kts start index for k in tile
213 !-- kte end index for k in tile
214 !
215 !******************************************************************
216 !------------------------------------------------------------------
217
218 INTEGER, INTENT(IN) :: &
219 & ids,ide,jds,jde,kds,kde &
220 & ,ims,ime,jms,jme,kms,kme &
221 & ,kts,kte,num_tiles
222
223 INTEGER, INTENT(IN) :: sf_sfclay_physics,sf_surface_physics,ra_lw_physics,sst_update
224
225 INTEGER, INTENT(IN) :: ucmcall !urban
226
227 INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
228 & i_start,i_end,j_start,j_end
229
230 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: ISLTYP
231 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: IVGTYP
232 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: LOWLYR
233 INTEGER, INTENT(IN ):: IFSNOW
234 INTEGER, INTENT(IN ):: ISFFLX
235 INTEGER, INTENT(IN ):: ITIMESTEP
236 INTEGER, INTENT(IN ):: NUM_SOIL_LAYERS
237 INTEGER, INTENT(IN ):: STEPBL
238 LOGICAL, INTENT(IN ):: WARM_RAIN
239 REAL , INTENT(IN ):: U_FRAME
240 REAL , INTENT(IN ):: V_FRAME
241 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SMOIS
242 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: TSLB
243 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: GLW
244 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: GSW,SWDOWN
245 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: HT
246 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: RAINCV
247 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SST
248 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: TMN
249 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: VEGFRA
250 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: XICE
251 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: XLAND
252 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MAVAIL
253 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: SNOALB
254 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ACSNOW
255 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKHS
256 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKMS
257 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ALBEDO
258 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: CANWAT
259
260
261 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: GRDFLX
262 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: HFX
263 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: RMOL
264 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: PBLH
265 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: Q2
266 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QFX
267 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QSFC
268 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QZ0
269 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SFCRUNOFF
270 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTAV
271 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTOT
272 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOW
273 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWC
274 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWH
275 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TH2
276 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: THZ0
277 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TSK
278 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UDRUNOFF
279 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UST
280 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UZ0
281 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: VZ0
282 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: WSPD
283 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ZNT
284 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: BR
285 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: CHKLOWQ
286 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: GZ1OZ0
287 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSHLTR
288 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIH
289 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIM
290 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: Q10
291 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: QSHLTR
292 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TH10
293 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TSHLTR
294 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: U10
295 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: V10
296 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSFC
297 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: ACSNOM
298 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEVP
299 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEXC
300 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLHC
301 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLQC
302 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CT
303 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: DZ8W
304 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P8W
305 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: PI_PHY
306 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P_PHY
307 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: RHO
308 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: TH_PHY
309 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: T_PHY
310 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: U_PHY
311 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: V_PHY
312 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: Z
313 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: TKE_MYJ
314 REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: DZS
315 REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: ZS
316 REAL, INTENT(IN ):: DT
317 REAL, INTENT(IN ):: DX
318
319 ! arguments for NCAR surface physics
320
321 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: ALBBCK ! INOUT needed for NMM
322 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: LH
323 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SH2O
324 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMAX
325 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMIN
326 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: Z0
327
328 !
329 ! Optional
330 !
331
332 !
333 ! Observation nudging
334 !
335 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: uratx !Added for obs-nudging
336 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: vratx !Added for obs-nudging
337 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: tratx !Added for obs-nudging
338 !
339 ! Flags relating to the optional tendency arrays declared above
340 ! Models that carry the optional tendencies will provdide the
341 ! optional arguments at compile time; these flags all the model
342 ! to determine at run-time whether a particular tracer is in
343 ! use or not.
344 !
345 LOGICAL, INTENT(IN), OPTIONAL :: &
346 f_qv &
347 ,f_qc &
348 ,f_qr &
349 ,f_qi &
350 ,f_qs &
351 ,f_qg
352
353 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
354 OPTIONAL, INTENT(INOUT) :: &
355 ! optional moisture tracers
356 ! 2 time levels; if only one then use CURR
357 qv_curr, qc_curr, qr_curr &
358 ,qi_curr, qs_curr, qg_curr
359
360 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: capg
361 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: emiss
362 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: hol
363 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: mol
364 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: regime
365 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: rainncv
366 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: RAINBL
367 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: t2
368 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: thc
369 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qsg
370 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qvg
371 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qcg
372 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soilt1
373 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: tsnav
374 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: potevp ! NMM LSM
375 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: snopcx ! NMM LSM
376 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soiltb ! NMM LSM
377 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: sr ! NMM and RUC LSM
378 REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: smfr3d
379 REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: keepfr3dflag
380
381 ! LOCAL VAR
382
383 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
384 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
385
386 REAL, DIMENSION( ims:ime, jms:jme ) :: ZOL
387
388 REAL, DIMENSION( ims:ime, jms:jme ) :: &
389 QGH, &
390 CHS, &
391 CPM, &
392 CHS2, &
393 CQS2
394
395 REAL :: DTMIN,DTBL
396 !
397 INTEGER :: i,J,K,NK,jj,ij
398 LOGICAL :: radiation, myj, frpcpn
399 !-------------------------------------------------
400 ! urban related variables are added to declaration
401 !-------------------------------------------------
402 REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB !urban
403 REAL, OPTIONAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D !urban
404 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D !urban
405 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D !urban
406 INTEGER, OPTIONAL, INTENT(IN) :: num_roof_layers !urban
407 INTEGER, OPTIONAL, INTENT(IN) :: num_wall_layers !urban
408 INTEGER, OPTIONAL, INTENT(IN) :: num_road_layers !urban
409 REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZR !urban
410 REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZB !urban
411 REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZG !urban
412
413 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !urban
414 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !urban
415 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !urban
416 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TC_URB2D !urban
417 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: QC_URB2D !urban
418 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: UC_URB2D !urban
419 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXR_URB2D !urban
420 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXB_URB2D !urban
421 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXG_URB2D !urban
422 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXC_URB2D !urban
423 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
424 INTENT(INOUT) :: TRL_URB3D !urban
425 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
426 INTENT(INOUT) :: TBL_URB3D !urban
427 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
428 INTENT(INOUT) :: TGL_URB3D !urban
429 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !urban
430 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: LH_URB2D !urban
431 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: G_URB2D !urban
432 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: RN_URB2D !urban
433 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TS_URB2D !urban
434 !
435 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !urban
436 INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !urban
437
438 REAL, DIMENSION( ims:ime, jms:jme ) :: PSIM_URB2D !urban local var
439 REAL, DIMENSION( ims:ime, jms:jme ) :: PSIH_URB2D !urban local var
440 REAL, DIMENSION( ims:ime, jms:jme ) :: GZ1OZ0_URB2D !urban local var
441 !m REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_URB2D !urban local var
442 REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_URB2D !urban local var
443 REAL, DIMENSION( ims:ime, jms:jme ) :: U10_URB2D !urban local var
444 REAL, DIMENSION( ims:ime, jms:jme ) :: V10_URB2D !urban local var
445 REAL, DIMENSION( ims:ime, jms:jme ) :: TH2_URB2D !urban local var
446 REAL, DIMENSION( ims:ime, jms:jme ) :: Q2_URB2D !urban local var
447 REAL, DIMENSION( ims:ime, jms:jme ) :: UST_URB2D !urban local var
448
449 !------------------------------------------------------------------
450 CHARACTER*256 :: message
451 !------------------------------------------------------------------
452 !
453
454 if (sf_sfclay_physics .eq. 0) return
455 ! if (sf_sfclay_physics .eq. 0 .or. sf_surface_physics.eq.0) return
456
457 v_phytmp = 0.
458 u_phytmp = 0.
459 ZOL = 0.
460 QGH = 0.
461 CHS = 0.
462 CPM = 0.
463 CHS2 = 0.
464 DTMIN = 0.
465 DTBL = 0.
466
467 ! RAINBL in mm (Accumulation between PBL calls)
468
469 IF ( PRESENT( rainncv ) .AND. PRESENT( rainbl ) ) THEN
470 !$OMP PARALLEL DO &
471 !$OMP PRIVATE ( ij, i, j, k )
472 DO ij = 1 , num_tiles
473 DO j=j_start(ij),j_end(ij)
474 DO i=i_start(ij),i_end(ij)
475 RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j)
476 RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
477 ENDDO
478 ENDDO
479 ENDDO
480 !$OMP END PARALLEL DO
481 ELSE IF ( PRESENT( rainbl ) ) THEN
482 !$OMP PARALLEL DO &
483 !$OMP PRIVATE ( ij, i, j, k )
484 DO ij = 1 , num_tiles
485 DO j=j_start(ij),j_end(ij)
486 DO i=i_start(ij),i_end(ij)
487 RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j)
488 RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
489 ENDDO
490 ENDDO
491 ENDDO
492 !$OMP END PARALLEL DO
493 ENDIF
494 ! Update SST
495 IF (sst_update .EQ. 1) THEN
496 !$OMP PARALLEL DO &
497 !$OMP PRIVATE ( ij, i, j, k )
498 DO ij = 1 , num_tiles
499 DO j=j_start(ij),j_end(ij)
500 DO i=i_start(ij),i_end(ij)
501 IF(XLAND(i,j) .GT. 1.5)TSK(i,j)=SST(i,j)
502 ENDDO
503 ENDDO
504 ENDDO
505 !$OMP END PARALLEL DO
506 ENDIF
507
508 IF (itimestep .eq. 1 .or. mod(itimestep,STEPBL) .eq. 0) THEN
509
510 radiation = .false.
511 myj = .false.
512 frpcpn = .false.
513
514 IF (ra_lw_physics .gt. 0) radiation = .true.
515
516 !----
517 ! CALCULATE CONSTANT
518
519 DTMIN=DT/60.
520 ! Surface schemes need PBL time step for updates and accumulations
521 ! Assume these schemes provide no tendencies
522 DTBL=DT*STEPBL
523
524 ! SAVE OLD VALUES
525
526
527 !$OMP PARALLEL DO &
528 !$OMP PRIVATE ( ij, i, j, k )
529 DO ij = 1 , num_tiles
530 DO j=j_start(ij),j_end(ij)
531 DO i=i_start(ij),i_end(ij)
532 ! PSFC : in Pa
533 PSFC(I,J)=p8w(I,kts,J)
534 ! REVERSE ORDER IN THE VERTICAL DIRECTION
535 DO k=kts,kte
536 v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
537 u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
538 ENDDO
539 ENDDO
540 ENDDO
541 ENDDO
542 !$OMP END PARALLEL DO
543
544 !$OMP PARALLEL DO &
545 !$OMP PRIVATE ( ij, i, j, k )
546 DO ij = 1 , num_tiles
547 sfclay_select: SELECT CASE(sf_sfclay_physics)
548
549 CASE (SFCLAYSCHEME)
550 #if (NMM_CORE != 1)
551 ! DX varies spatially in NMM, therefore, SFCLAY cannot be called
552 ! because it takes a scalar DX. NMM passes in a dummy value for this
553 ! scalar. NEEDS FURTHER ATTENTION. JM 20050215
554 IF (PRESENT(qv_curr) .AND. &
555 PRESENT(mol) .AND. PRESENT(regime) .AND. &
556 .TRUE. ) THEN
557 CALL wrf_debug( 100, 'in SFCLAY' )
558 CALL SFCLAY(u_phytmp,v_phytmp,t_phy,qv_curr,&
559 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
560 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
561 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
562 uratx,vratx,tratx, &
563 u10,v10,th2,t2,q2, &
564 gz1oz0,wspd,br,isfflx,dx, &
565 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
566 ids,ide, jds,jde, kds,kde, &
567 ims,ime, jms,jme, kms,kme, &
568 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
569 ELSE
570 CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
571 ENDIF
572
573 #else
574 CALL wrf_error_fatal('SFCLAY cannot be used with NMM')
575 #endif
576 CASE (MYJSFCSCHEME)
577 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
578 .TRUE. ) THEN
579
580 myj =.true.
581
582 CALL wrf_debug(100,'in MYJSFC')
583 CALL MYJSFC(itimestep,ht,dz8w, &
584 p_phy,p8w,th_phy,t_phy, &
585 qv_curr,qc_curr, &
586 u_phy,v_phy,tke_myj, &
587 tsk,qsfc,thz0,qz0,uz0,vz0, &
588 lowlyr, &
589 xland, &
590 ust,znt,z0,pblh,mavail,rmol, &
591 akhs,akms, &
592 chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
593 u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
594 ids,ide, jds,jde, kds,kde, &
595 ims,ime, jms,jme, kms,kme, &
596 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
597 ELSE
598 CALL wrf_error_fatal('Lacking arguments for MYJSFC in surface driver')
599 ENDIF
600
601 CASE (GFSSFCSCHEME)
602 IF (PRESENT(qv_curr) .AND. .TRUE. ) THEN
603 CALL wrf_debug( 100, 'in GFSSFC' )
604 CALL SF_GFS(u_phytmp,v_phytmp,t_phy,qv_curr, &
605 p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
606 ZNT,UST,PSIM,PSIH, &
607 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
608 QGH,QSFC,U10,V10, &
609 GZ1OZ0,WSPD,BR,ISFFLX, &
610 EP_1,EP_2,KARMAN,itimestep, &
611 ids,ide, jds,jde, kds,kde, &
612 ims,ime, jms,jme, kms,kme, &
613 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
614 CALL wrf_debug(100,'in SFCDIAGS')
615 ELSE
616 CALL wrf_error_fatal('Lacking arguments for SF_GFS in surface driver')
617 ENDIF
618
619 CASE DEFAULT
620
621 WRITE( message , * ) &
622 'The sfclay option does not exist: sf_sfclay_physics = ', sf_sfclay_physics
623 CALL wrf_error_fatal ( message )
624
625 END SELECT sfclay_select
626 ENDDO
627 !$OMP END PARALLEL DO
628
629 IF (ISFFLX.EQ.0 ) GOTO 430
630 !$OMP PARALLEL DO &
631 !$OMP PRIVATE ( ij, i, j, k )
632 DO ij = 1 , num_tiles
633
634 sfc_select: SELECT CASE(sf_surface_physics)
635
636 CASE (SLABSCHEME)
637
638 IF (PRESENT(qv_curr) .AND. &
639 PRESENT(capg) .AND. &
640 .TRUE. ) THEN
641 DO j=j_start(ij),j_end(ij)
642 DO i=i_start(ij),i_end(ij)
643 ! CQS2 ACCOUNTS FOR MAVAIL FOR SFCDIAGS 2M Q
644 CQS2(I,J)= CQS2(I,J)*MAVAIL(I,J)
645 ENDDO
646 ENDDO
647
648 CALL wrf_debug(100,'in SLAB')
649 CALL SLAB(t_phy,qv_curr,p_phy,flhc,flqc, &
650 psfc,xland,tmn,hfx,qfx,lh,tsk,qsfc,chklowq, &
651 gsw,glw,capg,thc,snowc,emiss,mavail, &
652 dtbl,rcp,xlv,dtmin,ifsnow, &
653 svp1,svp2,svp3,svpt0,ep_2,karman,eomeg,stbolt, &
654 tslb,zs,dzs,num_soil_layers,radiation, &
655 ids,ide, jds,jde, kds,kde, &
656 ims,ime, jms,jme, kms,kme, &
657 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
658
659 DO j=j_start(ij),j_end(ij)
660 DO i=i_start(ij),i_end(ij)
661 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
662 ENDDO
663 ENDDO
664
665 CALL wrf_debug(100,'in SFCDIAGS')
666 CALL SFCDIAGS(hfx,qfx,tsk,qsfc,chs2,cqs2,t2,th2,q2, &
667 psfc,cp,r_d,rcp, &
668 ids,ide, jds,jde, kds,kde, &
669 ims,ime, jms,jme, kms,kme, &
670 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
671
672 ELSE
673 CALL wrf_error_fatal('Lacking arguments for SLAB in surface driver')
674 ENDIF
675
676 #if ( NMM_CORE == 1 )
677 CASE (NMMLSMSCHEME)
678 IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
679 PRESENT(potevp) .AND. PRESENT(snopcx) .AND. &
680 PRESENT(soiltb) .AND. PRESENT(sr) .AND. &
681 .TRUE. ) THEN
682 CALL wrf_debug(100,'in NMM LSM')
683 CALL nmmlsm(dz8w,qv_curr,p8w,rho, &
684 t_phy,th_phy,tsk,chs, &
685 hfx,qfx,qgh,swdown,glw,lh,rmol, &
686 smstav,smstot,sfcrunoff, &
687 udrunoff,ivgtyp,isltyp,vegfra,sfcevp,potevp, &
688 grdflx,sfcexc,acsnow,acsnom,snopcx, &
689 albbck,tmn,xland,xice,qz0, &
690 th2,q2,snowc,cqs2,qsfc,soiltb,chklowq,rainbl, &
691 num_soil_layers,dtbl,dzs,itimestep, &
692 smois,tslb,snow,canwat,cpm,rcp,sr, & !tslb
693 albedo,snoalb,sh2o,snowh, &
694 ids,ide, jds,jde, kds,kde, &
695 ims,ime, jms,jme, kms,kme, &
696 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
697 CALL wrf_debug(100,'back from NMM LSM')
698 ELSE
699 CALL wrf_error_fatal('Lacking arguments for NMMLSM in surface driver')
700 ENDIF
701 #endif
702
703 CASE (LSMSCHEME)
704
705 IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
706 ! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
707 ! PRESENT(declin_urb) .AND. PRESENT(cosz_urb2d) .AND. &
708 ! PRESENT(omg_urb2d) .AND. PRESENT( xlat_urb2d) .AND. &
709 ! PRESENT(dzr) .AND. &
710 ! PRESENT( dzb) .AND. PRESENT(dzg) .AND. &
711 ! PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d) .AND. &
712 ! PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND. &
713 ! PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND. &
714 ! PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND. &
715 ! PRESENT(xxxg_urb2d) .AND. &
716 ! PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND. &
717 ! PRESENT(tbl_urb3d) .AND. PRESENT(tgl_urb3d) .AND. &
718 ! PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d) .AND. &
719 ! PRESENT(g_urb2d) .AND. PRESENT(rn_urb2d) .AND. &
720 ! PRESENT(ts_urb2d) .AND. &
721 ! PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d) .AND. &
722 .TRUE. ) THEN
723 !------------------------------------------------------------------
724 IF( PRESENT(sr) ) THEN
725 frpcpn=.true.
726 ENDIF
727
728 CALL wrf_debug(100,'in NOAH LSM')
729 CALL lsm(dz8w,qv_curr,p8w,t_phy,tsk, &
730 hfx,qfx,lh,grdflx,qgh,gsw,swdown,glw,smstav,smstot, &
731 sfcrunoff,udrunoff,ivgtyp,isltyp,vegfra, &
732 albedo,albbck,znt,z0, tmn,xland,xice, emiss, &
733 snowc,qsfc,rainbl, &
734 num_soil_layers,dtbl,dzs,itimestep, &
735 smois,tslb,snow,canwat, &
736 chs, chs2, cqs2, cpm,rcp,SR,chklowq,qz0, &
737 !MEk June07
738 myj,frpcpn, &
739 sh2o,snowh, & !h
740 u_phy,v_phy, & !I
741 snoalb,shdmin,shdmax, & !i
742 acsnom,acsnow, & !o
743 ! MEK MAY 2007
744 snopcx, & !o
745 ! MEK JUL2007
746 potevp, & !o
747 ids,ide, jds,jde, kds,kde, &
748 ims,ime, jms,jme, kms,kme, &
749 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
750 ucmcall &
751 !Optional urban
752 ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d, & !H urban
753 uc_urb2d, & !H urban
754 xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d, & !H urban
755 trl_urb3d,tbl_urb3d,tgl_urb3d, & !H urban
756 sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d, & !H urban
757 psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d, & !O urban
758 GZ1OZ0_urb2d, AKMS_URB2D, & !O urban
759 th2_urb2d,q2_urb2d,ust_urb2d, & !O urban
760 declin_urb,cosz_urb2d,omg_urb2d, & !I urban
761 xlat_urb2d, & !I urban
762 num_roof_layers, num_wall_layers, & !I urban
763 num_road_layers, DZR, DZB, DZG, & !I urban
764 FRC_URB2D, UTYPE_URB2D & ! urban
765 )
766
767
768 DO j=j_start(ij),j_end(ij)
769 DO i=i_start(ij),i_end(ij)
770 ! CHKLOWQ(I,J)= 1.0
771 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
772 SFCEXC(I,J)= CHS(I,J)
773 ENDDO
774 ENDDO
775
776 CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2, &
777 PSFC,CP,R_d,RCP, &
778 ids,ide, jds,jde, kds,kde, &
779 ims,ime, jms,jme, kms,kme, &
780 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
781
782 !urban
783 IF(UCMCALL.eq.1) THEN
784 DO j=j_start(ij),j_end(ij) !urban
785 DO i=i_start(ij),i_end(ij) !urban
786 IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. & !urban
787 IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
788 ! TH2(I,J) = TH2_URB2D(I,J) !urban
789 ! T2(I,J) = TH2_URB2D(I,J)/(1.E5/PSFC(I,J))**RCP !urban
790 !m T2(I,J) = TH2_URB2D(I,J) !urban
791 T2(I,J) = FRC_URB2D(i,j)*TH2_URB2D(I,J) + (1-FRC_URB2D(i,j))*T2(I,J) !urban
792 TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**RCP !urban
793 !m Q2(I,J) = Q2_URB2D(I,J) !urban
794 Q2(I,J) = FRC_URB2D(i,j)*Q2_URB2D(I,J) +(1-FRC_URB2D(i,j))* Q2(I,J) !urban
795 U10(I,J) = U10_URB2D(I,J) !urban
796 V10(I,J) = V10_URB2D(I,J) !urban
797 PSIM(I,J) = PSIM_URB2D(I,J) !urban
798 PSIH(I,J) = PSIH_URB2D(I,J) !urban
799 GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J) !urban
800 !m AKHS(I,J) = AKHS_URB2D(I,J) !urban
801 AKHS(I,J) = CHS(I,J) !urban
802 AKMS(I,J) = AKMS_URB2D(I,J) !urban
803 END IF !urban
804 ENDDO !urban
805 ENDDO !urban
806 ENDIF
807 !------------------------------------------------------------------
808
809 ELSE
810 CALL wrf_error_fatal('Lacking arguments for LSM in surface driver')
811 ENDIF
812
813 CASE (RUCLSMSCHEME)
814 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
815 ! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
816 PRESENT(qsg) .AND. PRESENT(qvg) .AND. &
817 PRESENT(qcg) .AND. PRESENT(soilt1) .AND. &
818 PRESENT(tsnav) .AND. PRESENT(smfr3d) .AND. &
819 PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND. &
820 .TRUE. ) THEN
821
822 IF( PRESENT(sr) ) THEN
823 frpcpn=.true.
824 ELSE
825 SR = 1.
826 ENDIF
827
828 CALL wrf_debug(100,'in RUC LSM')
829 CALL LSMRUC(dtbl,itimestep,num_soil_layers, &
830 zs,rainbl,snow,snowh,snowc,sr,frpcpn, &
831 dz8w,p8w,t_phy,qv_curr,qc_curr,rho, & !p8w in [pa]
832 glw,gsw,emiss,chklowq, &
833 chs,flhc,mavail,canwat,vegfra,albedo,znt, &
834 snoalb, albbck, & !new
835 qsfc,qsg,qvg,qcg,soilt1,tsnav, &
836 tmn,ivgtyp,isltyp,xland,xice, &
837 cp,g,xlv,stbolt, &
838 smois,sh2o,smstav,smstot,tslb,tsk,hfx,qfx,lh, &
839 sfcrunoff,udrunoff,sfcexc, &
840 sfcevp,grdflx,acsnow, &
841 smfr3d,keepfr3dflag, &
842 myj, &
843 ids,ide, jds,jde, kds,kde, &
844 ims,ime, jms,jme, kms,kme, &
845 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
846
847 !tgs IF(.not. MYJ) then
848
849 CALL SFCDIAGS(HFX,QFX,TSK,QVG,CHS2,CQS2,T2,TH2,Q2, &
850 PSFC,CP,R_d,RCP, &
851 ids,ide, jds,jde, kds,kde, &
852 ims,ime, jms,jme, kms,kme, &
853 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
854 !tgs ENDIF
855
856
857 ELSE
858 CALL wrf_error_fatal('Lacking arguments for RUCLSM in surface driver')
859 ENDIF
860
861 CASE DEFAULT
862
863 WRITE( message , * ) &
864 'The surface option does not exist: sf_surface_physics = ', sf_surface_physics
865 CALL wrf_error_fatal ( message )
866
867 END SELECT sfc_select
868 ENDDO
869 !$OMP END PARALLEL DO
870
871 430 CONTINUE
872
873
874 ! Reset RAINBL in mm (Accumulation between PBL calls)
875
876 IF ( PRESENT( rainbl ) ) THEN
877 !$OMP PARALLEL DO &
878 !$OMP PRIVATE ( ij, i, j, k )
879 DO ij = 1 , num_tiles
880 DO j=j_start(ij),j_end(ij)
881 DO i=i_start(ij),i_end(ij)
882 RAINBL(i,j) = 0.
883 ENDDO
884 ENDDO
885 ENDDO
886 !$OMP END PARALLEL DO
887 ENDIF
888
889 ENDIF
890
891 END SUBROUTINE surface_driver
892
893 END MODULE module_surface_driver
894