| blob | eefd4f9046293e451286254f76b5e12509ae7e3e |
1 ! Generated by TAPENADE (INRIA, Tropics team)
2 ! Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
3 !
4 ! Differentiation of pbl_driver in forward (tangent) mode (with options r8):
5 ! variations of useful results: rublten dusfcg dvsfcg rqvblten
6 ! dtauy3d rvblten rqcblten rthblten rqiblten dtaux3d
7 ! with respect to varying inputs: v_phy rublten dusfcg z dvsfcg
8 ! pi_phy rqvblten dtauy3d rvblten qv_curr t_phy
9 ! rqcblten rthblten u_phy rqiblten dtaux3d p8w mut
10 ! RW status of diff variables: v_phy:in rublten:in-out dusfcg:in-out
11 ! z:in dvsfcg:in-out pi_phy:in rqvblten:in-out dtauy3d:in-out
12 ! rvblten:in-out qv_curr:in t_phy:in rqcblten:in-out
13 ! rthblten:in-out u_phy:in rqiblten:in-out dtaux3d:in-out
14 ! p8w:in mut:in
15 !WRF:MEDIATION_LAYER:PHYSICS
16 !
17 MODULE g_module_pbl_driver
18 CONTAINS
19 !------------------------------------------------------------------
20 ! paj
21 ! OPTIONAL for TEMF scheme
22 ! MYNN
23 !ACF for QKE advection
24 !ACF-end
25 ! Optional
26 ! Optional gravity-wave drag
27 ! Optional moisture tracers
28 ! Optional moisture tracer flags
29 ! variables added for BEP
30 ! variables for GBM PBL
31 ! Wind Turbine Parameterizations
32 ! variables required for camuwpbl scheme
33 ! variables required for camuwpbl scheme (optional)
34 ! for grims shallow convection with ysupbl
35 SUBROUTINE G_PBL_DRIVER(itimestep, dt, u_frame, v_frame, bldt, curr_secs&
36 & , adapt_step_flag, bldtacttime, rublten, rubltend, rvblten, rvbltend, &
37 & rthblten, rthbltend, tsk, xland, znt, ht, ust, pblh, hfx, qfx, grdflx&
38 & , u_phy, u_phyd, v_phy, v_phyd, th_phy, rho, p_phy, pi_phy, pi_phyd, &
39 & p8w, p8wd, t_phy, t_phyd, dz8w, z, zd, exch_h, exch_m, akhs, akms, &
40 & thz0, qz0, uz0, vz0, qsfc, f, lowlyr, u10, v10, t2, psim, psih, fm, &
41 & fhh, gz1oz0, wspd, br, chklowq, bl_pbl_physics, ra_lw_physics, dx, &
42 & stepbl, warm_rain, kpbl, mixht, ct, lh, snow, xice, znu, znw, mut, &
43 & mutd, p_top, ctopo, ctopo2, te_temf, km_temf, kh_temf, shf_temf, &
44 & qf_temf, uw_temf, vw_temf, hd_temf, lcl_temf, hct_temf, wupd_temf, &
45 & mf_temf, thup_temf, qtup_temf, qlup_temf, exch_temf, cf3d_temf, &
46 & cfm_temf, flhc, flqc, qke, qke_adv, bl_mynn_tkeadvect, tsq, qsq, cov, &
47 & rmol, ch, qcg, grav_settling, el_mynn, dqke, qwt, qshear, qbuoy, qdiss&
48 & , bl_mynn_tkebudget, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme&
49 & , kms, kme, i_start, i_end, j_start, j_end, kts, kte, num_tiles, hol, &
50 & mol, regime, gwd_opt, dtaux3d, dtaux3dd, dtauy3d, dtauy3dd, dusfcg, &
51 & dusfcgd, dvsfcg, dvsfcgd, var2d, oc12d, oa1, oa2, oa3, oa4, ol1, ol2, &
52 & ol3, ol4, qv_curr, qv_currd, qc_curr, qr_curr, qi_curr, qs_curr, &
53 & qg_curr, rqvblten, rqvbltend, rqcblten, rqcbltend, rqiblten, rqibltend&
54 & , rqrblten, rqsblten, rqgblten, f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, &
55 & frc_urb2d, a_u_bep, a_v_bep, a_t_bep, a_q_bep, b_u_bep, b_v_bep, &
56 & b_t_bep, b_q_bep, sf_bep, vl_bep, sf_sfclay_physics, sf_urban_physics&
57 & , tke_pbl, el_pbl, wu_tur, wv_tur, wt_tur, wq_tur, exch_tke&
58 & , a_e_bep, b_e_bep, dlg_bep, dl_u_bep, mfshconv, massflux_edkf, &
59 & entr_edkf, detr_edkf, thl_up, thv_up, rt_up, rv_up, rc_up, u_up, v_up&
60 & , frac_up, rc_mf, phb, xlat_u, xlong_u, xlat_v, xlong_v, id, z_at_w, &
61 & cldfra_old_mp, cldfra, rthratenlw, tauresx2d, tauresy2d, tpert2d, &
62 & qpert2d, wpert2d, wsedl3d, turbtype3d, smaw3d, fnm, fnp, qnc_curr, &
63 & f_qnc, qni_curr, f_qni, rqniblten, wstar, delta)
65 USE module_state_description, ONLY : &
66 YSUSCHEME,MRFSCHEME,GFSSCHEME,MYJPBLSCHEME,ACMPBLSCHEME,&
67 QNSEPBLSCHEME,MYNNPBLSCHEME2,MYNNPBLSCHEME3,BOULACSCHEME,&
68 CAMUWPBLSCHEME,BEPSCHEME,BEP_BEMSCHEME,MYJSFCSCHEME, &
69 SURFDRAGSCHEME, TEMFPBLSCHEME, &
70 p_qi,param_first_scalar
72 USE module_model_constants
73 ! *** add new modules of schemes here
75 USE g_module_bl_gwdo
76 USE g_module_bl_surface_drag
78 IMPLICIT NONE
79 !======================================================================
80 ! Grid structure in physics part of WRF
81 !----------------------------------------------------------------------
82 ! The horizontal velocities used in the physics are unstaggered
83 ! relative to temperature/moisture variables. All predicted
84 ! variables are carried at half levels except w, which is at full
85 ! levels. Some arrays with names (*8w) are at w (full) levels.
86 !
87 !----------------------------------------------------------------------
88 ! In WRF, kms (smallest number) is the bottom level and kme (largest
89 ! number) is the top level. In your scheme, if 1 is at the top level,
90 ! then you have to reverse the order in the k direction.
91 !
92 ! kme - half level (no data at this level)
93 ! kme ----- full level
94 ! kme-1 - half level
95 ! kme-1 ----- full level
96 ! .
97 ! .
98 ! .
99 ! kms+2 - half level
100 ! kms+2 ----- full level
101 ! kms+1 - half level
102 ! kms+1 ----- full level
103 ! kms - half level
104 ! kms ----- full level
105 !
106 !======================================================================
107 ! Definitions
108 !-----------
109 ! Rho_d dry density (kg/m^3)
110 ! Theta_m moist potential temperature (K)
111 ! Qv water vapor mixing ratio (kg/kg)
112 ! Qc cloud water mixing ratio (kg/kg)
113 ! Qr rain water mixing ratio (kg/kg)
114 ! Qi cloud ice mixing ratio (kg/kg)
115 ! Qs snow mixing ratio (kg/kg)
116 ! QNC cloud Liq number concentration (#/kg) !For CAMUWPBL scheme
117 ! QNI cloud ice number concentration (#/kg) !For CAMUWPBL scheme
118 !-----------------------------------------------------------------
119 !-- RUBLTEN U tendency due to
120 ! PBL parameterization (m/s^2)
121 !-- RVBLTEN V tendency due to
122 ! PBL parameterization (m/s^2)
123 !-- RTHBLTEN Theta tendency due to
124 ! PBL parameterization (K/s)
125 !-- RQVBLTEN Qv tendency due to
126 ! PBL parameterization (kg/kg/s)
127 !-- RQCBLTEN Qc tendency due to
128 ! PBL parameterization (kg/kg/s)
129 !-- RQIBLTEN Qi tendency due to
130 ! PBL parameterization (kg/kg/s)
131 !-- RQNIBLTEN Qni tendency due to
132 ! PBL parameterization (#/kg/s) !For CAMUWPBL scheme
133 !-- id WRF grid id (optional, only needed by turbine drag schemes)
134 !-- itimestep number of time steps
135 !-- GLW downward long wave flux at ground surface (W/m^2)
136 !-- GSW downward short wave flux at ground surface (W/m^2)
137 !-- EMISS surface emissivity (between 0 and 1)
138 !-- TSK surface temperature (K)
139 !-- TMN soil temperature at lower boundary (K)
140 !-- XLAND land mask (1 for land, 2 for water)
141 !-- ZNT 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 upward heat flux at the surface (W/m^2)
151 !-- QFX upward moisture flux at the surface (kg/m^2/s)
152 !-- REGIME flag indicating PBL regime (stable, unstable, etc.)
153 !-- exch_m exchange coefficient for momentum, m^2/s
154 !-- exch_h exchange coefficient for heat, K m/s
155 !-- exch_tke exchange coeff. for TKE [enhanced], m^2/s (gbmpbl scheme)
156 !-- rthraten tendency from radiation, used in GBM PBL scheme
157 !-- akhs sfc exchange coefficient of heat/moisture from MYJ
158 !-- akms sfc exchange coefficient of momentum from MYJ
159 !-- tke_pbl turbulence kinetic energy from PBL schemes (m^2/s^2)
160 !-- el_pbl length scale from PBL schemes (m)
161 !-- wu_tur turbulent flux of momentum (x) (m^2/s^2)
162 !-- wv_tur turbulent flux of momentum (y) (m^2/s^2)
163 !-- wt_tur turbulent flux of potential temperature (K m/s)
164 !-- wq_tur turbulent flux of water vapor (- m/s)
165 !-- te_temf Total energy from TEMF BL scheme
166 !-- km_temf Exchange coefficient for momentum from TEMF BL scheme
167 !-- kh_temf Exchange coefficient for heat from TEMF BL scheme
168 !-- shf_temf Sensible heat flux from TEMF BL scheme
169 !-- qf_temf Water vapor flux from TEMF BL scheme
170 !-- uw_temf Momentum flux in U direction from TEMF BL scheme
171 !-- vw_temf Momentum flux in V direction from TEMF BL scheme
172 !-- wupd_temf Updraft velocity from TEMF BL scheme
173 !-- mf_temf Mass flux from TEMF BL scheme
174 !-- thup_temf Updraft thetal from TEMF BL scheme
175 !-- qtup_temf Updraft qt from TEMF BL scheme
176 !-- qlup_temf Updraft ql from TEMF BL scheme
177 !-- cf3d_temf 3D cloud fraction from TEMF PBL
178 !-- cfm_temf Column cloud fraction from TEMF PBL
179 !-- exch_temf Surface exchange coefficient (as for moisture) from TEMF surface layer scheme
180 !-- flhc Surface exchange coefficient for heat (for TEMF)
181 !-- flqc Surface exchange coefficient for moisture (for TEMF)
182 !-- thz0 potential temperature at roughness length (K)
183 !-- uz0 u wind component at roughness length (m/s)
184 !-- vz0 v wind component at roughness length (m/s)
185 !-- qsfc specific humidity at lower boundary (kg/kg)
186 !-- th2 diagnostic 2-m theta from surface layer and lsm
187 !-- t2 diagnostic 2-m temperature from surface layer and lsm
188 !-- q2 diagnostic 2-m mixing ratio from surface layer and lsm
189 !-- lowlyr index of lowest model layer above ground
190 !-- rr dry air density (kg/m^3)
191 !-- u_phy u-velocity interpolated to theta points (m/s)
192 !-- v_phy v-velocity interpolated to theta points (m/s)
193 !-- th_phy potential temperature (K)
194 !-- p_phy pressure (Pa)
195 !-- pi_phy exner function (dimensionless)
196 !-- p8w pressure at full levels (Pa)
197 !-- t_phy temperature (K)
198 !-- dz8w dz between full levels (m)
199 !-- z height above sea level (m)
200 !-- DX horizontal space interval (m)
201 !-- DT time step (second)
202 !-- n_moist number of moisture species
203 !-- PSFC pressure at the surface (Pa)
204 !-- TSLB
205 !-- ZS
206 !-- DZS
207 !-- num_soil_layers number of soil layer
208 !-- IFSNOW ifsnow=1 for snow-cover effects
209 !-- z_at_w Height above sea level at layer interfaces (m)
210 !-- cldfra Cloud fraction [unitless]
211 !-- cldfra_old_mp Cloud fraction [unitless]
212 !-- rthratenlw Tendency for LW ( K/s)
213 !-- tauresx2d X-COMP OF RESIDUAL STRESS(m^2/s^2)
214 !-- tauresy2d Y-COMP OF RESIDUAL STRESS(m^2/s^2)
215 !-- tpert2d Convective temperature excess (K)
216 !-- qpert2d Convective humidity excess (kg/kg)
217 !-- wpert2d Turbulent velocity excess (m/s)
218 !-- wsedl3d Sedimentation velocity of stratiform liquid cloud droplet (m/s)
219 !-- turbtype3d Turbulent interface types [ no unit ]
220 !-- smaw3d Normalized Galperin instability function for momentum ( 0<= <=4.964 and 1 at neutral ) [no units]
221 !
222 !-- P_QV species index for water vapor
223 !-- P_QC species index for cloud water
224 !-- P_QR species index for rain water
225 !-- P_QI species index for cloud ice
226 !-- P_QNC species index for cloud liq number concentration !For CAMUWPBL scheme
227 !-- P_QNI species index for cloud ice number concentration !For CAMUWPBL scheme
228 !-- P_QS species index for snow
229 !-- P_QG species index for graupel
230 !-- ids start index for i in domain
231 !-- ide end index for i in domain
232 !-- jds start index for j in domain
233 !-- jde end index for j in domain
234 !-- kds start index for k in domain
235 !-- kde end index for k in domain
236 !-- ims start index for i in memory
237 !-- ime end index for i in memory
238 !-- jms start index for j in memory
239 !-- jme end index for j in memory
240 !-- kms start index for k in memory
241 !-- kme end index for k in memory
242 !-- jts start index for j in tile
243 !-- jte end index for j in tile
244 !-- kts start index for k in tile
245 !-- kte end index for k in tile
246 !
247 !******************************************************************
248 !------------------------------------------------------------------
249 !
250 INTEGER, INTENT(IN) :: bl_pbl_physics, ra_lw_physics, &
251 & sf_sfclay_physics, sf_urban_physics
252 INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
253 & jme, kms, kme, kts, kte, num_tiles
254 INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, &
255 & j_end
256 INTEGER, INTENT(IN) :: itimestep, stepbl
257 INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: lowlyr
258 !
259 LOGICAL, INTENT(IN) :: warm_rain
260 !BSINGH:01/31/2013: Added for CAMUWPBL
261 REAL, DIMENSION(kms:kme), OPTIONAL, INTENT(IN) :: znu, znw
262 !
263 REAL, INTENT(IN) :: dt, dx
264 REAL, INTENT(IN), OPTIONAL :: bldt
265 REAL, INTENT(IN), OPTIONAL :: curr_secs
266 LOGICAL, INTENT(IN), OPTIONAL :: adapt_step_flag
267 REAL, INTENT(INOUT), OPTIONAL :: bldtacttime
268 ! Optional for Wind Turbine Parameterizations
269 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN), OPTIONAL :: &
270 & phb
271 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN), OPTIONAL :: xlat_u, &
272 & xlong_u, xlat_v, xlong_v
273 !
274 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: p_phy, &
275 & pi_phy, p8w, rho, t_phy, u_phy, v_phy, dz8w, z, th_phy
276 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: pi_phyd, &
277 & p8wd, t_phyd, u_phyd, v_phyd, zd
278 !1D variables required for CAMUWPBL scheme
279 REAL, DIMENSION(kms:kme), INTENT(IN), OPTIONAL :: fnm, fnp
280 !3D Variables for camuwpbl scheme
281 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN), OPTIONAL :: &
282 & z_at_w, cldfra_old_mp, cldfra, rthratenlw, wsedl3d
283 !2D Variables required by camuwpbl scheme
284 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: &
285 & tauresx2d, tauresy2d, tpert2d, qpert2d, wpert2d
286 !3D Variables for camuwpbl scheme - out
287 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT), OPTIONAL :: &
288 & turbtype3d, smaw3d
289 !
290 ! for grims shallow convection with ysupbl
291 !
292 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: wstar
293 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: delta
294 !
295 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: xland, ht, psim, psih&
296 & , fm, fhh, gz1oz0, br, f, chklowq
297 !
298 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: tsk, ust, pblh, &
299 & hfx, qfx, znt, qsfc, akhs, akms, mixht, qz0, thz0, uz0, vz0, ct, &
300 & grdflx, u10, v10, t2, wspd
301 !
302 ! for GBM PBL scheme
303 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rublten, &
304 & rvblten, rthblten, exch_h, exch_m, tke_pbl
305 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rubltend&
306 & , rvbltend, rthbltend
307 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: wu_tur, &
308 & wv_tur, wt_tur, wq_tur
309 !
310 !MYNN
311 !,k_m,k_h,k_q &
312 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
313 & tsq, qsq, cov, qke, el_mynn, dqke, qwt, qshear, qbuoy, qdiss
314 INTEGER, OPTIONAL, INTENT(IN) :: bl_mynn_tkebudget, grav_settling
315 !ACF-QKE advection start
316 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
317 & qke_adv
318 LOGICAL, OPTIONAL, INTENT(IN) :: bl_mynn_tkeadvect
319 !ACF-QKE advection end
320 ! for GBM PBL scheme
321 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
322 & exch_tke
323 INTEGER, OPTIONAL :: id
324 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: qcg, rmol, &
325 & ch
326 !
327 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: el_pbl
328 REAL, INTENT(IN) :: u_frame, v_frame
329 !
330 INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: kpbl
331 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: xice, snow, lh
332 ! Bep changes: variable added for urban
333 ! URBAN Landuse fraction
334 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
335 & frc_urb2d
336 ! Implicit component for the momemtum in X-direction
337 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
338 & a_u_bep
339 ! Implicit component for the momemtum in Y-direction
340 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
341 & a_v_bep
342 ! Implicit component for the Pot. Temp.
343 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
344 & a_t_bep
345 ! Implicit component for Moisture
346 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
347 & a_q_bep
348 ! Implicit component for the TKE
349 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
350 & a_e_bep
351 ! Explicit component for the momemtum in X-direction
352 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
353 & b_u_bep
354 ! Explicit component for the momemtum in Y-direction
355 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
356 & b_v_bep
357 ! Explicit component for the Pot. Temp.
358 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
359 & b_t_bep
360 ! Explicit component for Moisture
361 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
362 & b_q_bep
363 ! Explicit component for the TKE
364 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
365 & b_e_bep
366 ! Height above ground (L_ground in formula (24) of the BLM paper).
367 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
368 & dlg_bep
369 ! Length scale (lb in formula (22) ofthe BLM paper).
370 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
371 & dl_u_bep
372 ! urban surface and volumes
373 ! surfaces
374 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
375 & sf_bep
376 ! volumes
377 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
378 & vl_bep
379 ! Bep changes end
380 ! New variables for TEMF scheme
381 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
382 & te_temf
383 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: &
384 & km_temf, kh_temf, shf_temf, qf_temf, uw_temf, vw_temf, wupd_temf, &
385 & mf_temf, thup_temf, qtup_temf, qlup_temf, cf3d_temf
386 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: flhc, &
387 & flqc
388 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(OUT) :: hd_temf, &
389 & lcl_temf, hct_temf, cfm_temf
390 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
391 & exch_temf
392 !
393 !
394 ! Optional
395 !
396 !
397 ! Flags relating to the optional tendency arrays declared above
398 ! Models that carry the optional tendencies will provdide the
399 ! optional arguments at compile time; these flags all the model
400 ! to determine at run-time whether a particular tracer is in
401 ! use or not.
402 !
403 !used in CAMUWPBL
404 !used in CAMUWPBL
405 LOGICAL, INTENT(IN), OPTIONAL :: f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, &
406 & f_qnc, f_qni
407 ! optional moisture tracers
408 ! 2 time levels; if only one then use CURR
409 !used in CAMUWPBL
410 !rqniblten used in CAMUWPBL
411 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
412 & qv_curr, qc_curr, qr_curr, qi_curr, qs_curr, qg_curr, qnc_curr, &
413 & qni_curr, rqvblten, rqcblten, rqrblten, rqiblten, rqsblten, rqgblten, &
414 & rqniblten
415 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
416 & qv_currd, rqvbltend, rqcbltend, rqibltend
417 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: hol, mol&
418 & , regime
419 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: mut
420 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: mutd
421 !
422 INTEGER, OPTIONAL, INTENT(IN) :: gwd_opt
423 REAL, OPTIONAL, INTENT(IN) :: p_top
424 !
425 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
426 & dtaux3d, dtauy3d
427 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
428 & dtaux3dd, dtauy3dd
429 !
430 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: dusfcg, &
431 & dvsfcg
432 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: dusfcgd&
433 & , dvsfcgd
434 !
435 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: var2d, &
436 & oc12d, oa1, oa2, oa3, oa4, ol1, ol2, ol3, ol4
437 ! paj
438 !mchen
439 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: ctopo, &
440 & ctopo2
441 ! Variables and Diagnostic for QNSE and EDKF JP
442 INTEGER, INTENT(IN) :: mfshconv
443 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: &
444 & massflux_edkf, entr_edkf, detr_edkf, thl_up, thv_up, rt_up, rv_up, &
445 & rc_up, u_up, v_up, frac_up, rc_mf
446 ! LOCAL VAR
447 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: v_phytmp
448 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: v_phytmpd
449 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_phytmp
450 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_phytmpd
451 REAL, DIMENSION(ims:ime, jms:jme) :: tskold, ustold, zntold, zol, psfc
452 ! make these allocatable depending on the setting of idiff
453 ! Typically, we try to avoide allocating and deallocating local storage like this
454 ! so as not to fragment the stack. But at this point, the idiff = 1 case is disabled
455 ! (set to 0 for all cases) and has to be set manually by users who want to work with
456 ! it. When it becomes a more standard option, this should be redone, either defining
457 ! these as state with package clauses to turn them on and off and passing them in,
458 ! or pass in an integer flag that can be used to dimension the arrays to 1:1:1 as
459 ! local variables. JM 20100316
460 ! Implicit component for the momemtum in X-direction
461 REAL, DIMENSION(:, :, :), ALLOCATABLE :: a_u
462 ! Implicit component for the momemtum in Y-direction
463 REAL, DIMENSION(:, :, :), ALLOCATABLE :: a_v
464 ! Implicit component for the Pot. Temp.
465 REAL, DIMENSION(:, :, :), ALLOCATABLE :: a_t
466 ! Implicit component for the water vapor
467 REAL, DIMENSION(:, :, :), ALLOCATABLE :: a_q
468 ! Explicit component for the momemtum in X-direction
469 REAL, DIMENSION(:, :, :), ALLOCATABLE :: b_u
470 ! Explicit component for the momemtum in Y-direction
471 REAL, DIMENSION(:, :, :), ALLOCATABLE :: b_v
472 ! Explicit component for the Pot. Temp.
473 REAL, DIMENSION(:, :, :), ALLOCATABLE :: b_t
474 ! Explicit component for the water vapor
475 REAL, DIMENSION(:, :, :), ALLOCATABLE :: b_q
476 ! surfaces
477 REAL, DIMENSION(:, :, :), ALLOCATABLE :: sf
478 ! volumes
479 REAL, DIMENSION(:, :, :), ALLOCATABLE :: vl
480 REAL :: dtmin, dtbl
481 !
482 INTEGER :: initflag
483 !
484 INTEGER :: i, j, k, nk, jj, ij, its, ite, jts, jte
485 LOGICAL :: radiation
486 LOGICAL :: flag_bep
487 LOGICAL :: flag_myjsfc
488 !flag_qnc,flag_qnc are used in camuwpbl scheme
489 LOGICAL :: flag_qv, flag_qc, flag_qr, flag_qi, flag_qs, flag_qg, &
490 & flag_qnc, flag_qni
491 CHARACTER(len=256) :: message
492 REAL :: next_bl_time
493 LOGICAL :: run_param, doing_adapt_dt, decided
494 LOGICAL :: do_adapt
495 INTEGER :: iu_bep, iurb, idiff
496 REAL :: seamask, thsk, zzz, unew, vnew, tnew, qnew, umom, vmom
497 REAL :: z0, z1, z2, w1, w2
498 INTEGER :: min3
499 INTEGER :: min2
500 INTEGER :: min1
501 !------------------------------------------------------------------
502 !
503 !!!!!!!if using BEP set flag_bep to true
504 SELECT CASE (sf_urban_physics)
505 CASE (bepscheme)
506 flag_bep = .true.
507 CASE (bep_bemscheme)
508 flag_bep = .true.
509 CASE DEFAULT
510 flag_bep = .false.
511 END SELECT
512 SELECT CASE (sf_sfclay_physics)
513 CASE (myjsfcscheme)
514 flag_myjsfc = .true.
515 CASE DEFAULT
516 flag_myjsfc = .false.
517 END SELECT
518 !
519 flag_qv = .false.
520 IF (PRESENT(f_qv)) flag_qv = f_qv
521 flag_qc = .false.
522 IF (PRESENT(f_qc)) flag_qc = f_qc
523 flag_qr = .false.
524 IF (PRESENT(f_qr)) flag_qr = f_qr
525 flag_qi = .false.
526 IF (PRESENT(f_qi)) flag_qi = f_qi
527 flag_qs = .false.
528 IF (PRESENT(f_qs)) flag_qs = f_qs
529 flag_qg = .false.
530 IF (PRESENT(f_qg)) flag_qg = f_qg
531 flag_qnc = .false.
532 !Used in CAMUWPBL
533 IF (PRESENT(f_qnc)) flag_qnc = f_qnc
534 flag_qni = .false.
535 !Used in CAMUWPBL
536 IF (PRESENT(f_qni)) flag_qni = f_qni
537 IF (bl_pbl_physics .EQ. 0) THEN
538 RETURN
539 ELSE
540 ! RAINBL in mm (Accumulation between PBL calls)
541 !
542 doing_adapt_dt = .false.
543 IF (PRESENT(adapt_step_flag)) THEN
544 IF (adapt_step_flag) THEN
545 doing_adapt_dt = .true.
546 IF (bldtacttime .EQ. 0.) bldtacttime = curr_secs + bldt*60.
547 END IF
548 END IF
549 ! Do we run through this scheme or not?
550 ! Test 1: If this is the initial model time, then yes.
551 ! ITIMESTEP=1
552 ! Test 2: If the user asked for the pbl to be run every time step, then yes.
553 ! BLDT=0 or STEPBL=1
554 ! Test 3: If not adaptive dt, and this is on the requested pbl frequency, then yes.
555 ! MOD(ITIMESTEP,STEPBL)=0
556 ! Test 4: If using adaptive dt and the current time is past the last requested activate pbl time, then yes.
557 ! CURR_SECS >= BLDTACTTIME
558 ! If we do run through the scheme, we set the flag run_param to TRUE and we set the decided flag
559 ! to TRUE. The decided flag says that one of these tests was able to say "yes", run the scheme.
560 ! We only proceed to other tests if the previous tests all have left decided as FALSE.
561 ! If we set run_param to TRUE and this is adaptive time stepping, we set the time to the next
562 ! pbl run.
563 run_param = .false.
564 decided = .false.
565 IF (.NOT.decided .AND. itimestep .EQ. 1) THEN
566 run_param = .true.
567 decided = .true.
568 END IF
569 IF (PRESENT(bldt)) THEN
570 IF (.NOT.decided .AND. (bldt .EQ. 0. .OR. stepbl .EQ. 1)) THEN
571 run_param = .true.
572 decided = .true.
573 END IF
574 ELSE IF (.NOT.decided .AND. stepbl .EQ. 1) THEN
575 run_param = .true.
576 decided = .true.
577 END IF
578 IF (.NOT.decided .AND. (.NOT.doing_adapt_dt) .AND. MOD(itimestep, &
579 & stepbl) .EQ. 0) THEN
580 run_param = .true.
581 decided = .true.
582 END IF
583 IF (.NOT.decided .AND. doing_adapt_dt .AND. curr_secs .GE. &
584 & bldtacttime) THEN
585 run_param = .true.
586 decided = .true.
587 bldtacttime = curr_secs + bldt*60
588 END IF
589 IF (run_param) THEN
590 radiation = .false.
591 IF (ra_lw_physics .GT. 0) radiation = .true.
592 !----
593 ! CALCULATE CONSTANT
594 dtmin = dt/60.
595 ! PBL schemes need PBL time step for updates
596 IF (PRESENT(adapt_step_flag)) THEN
597 IF (adapt_step_flag) THEN
598 do_adapt = .true.
599 ELSE
600 do_adapt = .false.
601 END IF
602 ELSE
603 do_adapt = .false.
604 END IF
605 IF (PRESENT(bldt)) THEN
606 IF (bldt .EQ. 0) THEN
607 dtbl = dt
608 ELSE IF (do_adapt) THEN
609 IF (curr_secs .LT. 2.*dt) THEN
610 CALL WRF_MESSAGE(&
611 & 'WARNING: When using an adaptive time-step the boundary layer'&
612 & //&
613 & ' time-step should be 0 (i.e., equivalent to model time-step). '&
614 & )
615 CALL WRF_MESSAGE(&
616 & 'In order to proceed, for boundary layer calculations, the '&
617 & //'boundary layer time-step'//&
618 & ' will be rounded to the nearest minute,')
619 CALL WRF_MESSAGE('possibly resulting in innacurate results.'&
620 & )
621 END IF
622 dtbl = bldt*60
623 ELSE
624 dtbl = dt*stepbl
625 END IF
626 ELSE
627 dtbl = dt*stepbl
628 END IF
629 idiff = 0
630 u_phytmpd = 0.0_8
631 v_phytmpd = 0.0_8
632 ! SAVE OLD VALUES
633 !$OMP PARALLEL DO &
634 !$OMP PRIVATE ( ij,i,j,k )
635 DO ij=1,num_tiles
636 DO j=j_start(ij),j_end(ij)
637 DO i=i_start(ij),i_end(ij)
638 tskold(i, j) = tsk(i, j)
639 ustold(i, j) = ust(i, j)
640 zntold(i, j) = znt(i, j)
641 ! REVERSE ORDER IN THE VERTICAL DIRECTION
642 ! testing change later
643 DO k=kts,kte
644 v_phytmpd(i, k, j) = v_phyd(i, k, j)
645 v_phytmp(i, k, j) = v_phy(i, k, j) + v_frame
646 u_phytmpd(i, k, j) = u_phyd(i, k, j)
647 u_phytmp(i, k, j) = u_phy(i, k, j) + u_frame
648 END DO
649 ! PSFC : in Pa
650 psfc(i, j) = p8w(i, kms, j)
651 IF (kte + 1 .GT. kde) THEN
652 min1 = kde
653 ELSE
654 min1 = kte + 1
655 END IF
656 DO k=kts,min1
657 rthbltend(i, k, j) = 0.0_8
658 rthblten(i, k, j) = 0.
659 rubltend(i, k, j) = 0.0_8
660 rublten(i, k, j) = 0.
661 rvbltend(i, k, j) = 0.0_8
662 rvblten(i, k, j) = 0.
663 IF (PRESENT(rqcblten)) THEN
664 rqcbltend(i, k, j) = 0.0_8
665 rqcblten(i, k, j) = 0.
666 END IF
667 IF (PRESENT(rqvblten)) THEN
668 rqvbltend(i, k, j) = 0.0_8
669 rqvblten(i, k, j) = 0.
670 END IF
671 END DO
672 IF (flag_qi .AND. PRESENT(rqiblten)) THEN
673 IF (kte + 1 .GT. kde) THEN
674 min2 = kde
675 ELSE
676 min2 = kte + 1
677 END IF
678 DO k=kts,min2
679 rqibltend(i, k, j) = 0.0_8
680 rqiblten(i, k, j) = 0.
681 END DO
682 END IF
683 !Following if condition is added for CAMUWPBL scheme
684 IF (flag_qni .AND. PRESENT(rqniblten)) THEN
685 IF (kte + 1 .GT. kde) THEN
686 min3 = kde
687 ELSE
688 min3 = kte + 1
689 END IF
690 DO k=kts,min3
691 rqniblten(i, k, j) = 0.
692 END DO
693 END IF
694 END DO
695 END DO
696 END DO
697 !$OMP END PARALLEL DO
698 !
699 !$OMP PARALLEL DO &
700 !$OMP PRIVATE ( ij, i,j,k, its, ite, jts, jte, z0, z1, z2, w1, w2, message, initflag )
701 DO ij=1,num_tiles
702 its = i_start(ij)
703 ite = i_end(ij)
704 jts = j_start(ij)
705 jte = j_end(ij)
706 SELECT CASE (bl_pbl_physics)
707 CASE (surfdragscheme)
708 CALL WRF_DEBUG(100, 'in G_SURFDRAG scheme')
709 CALL G_SURFACE_DRAG(rublten=rublten, rubltend=rubltend, &
710 & rvblten=rvblten, rvbltend=rvbltend, u_phy=u_phy&
711 & , u_phyd=u_phyd, v_phy=v_phy, v_phyd=v_phyd, &
712 & xland=xland, z=z, zd=zd, ht=ht, kpbl2d=kpbl, ids&
713 & =ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=&
714 & kde, ims=ims, ime=ime, jms=jms, jme=jme, kms=kms&
715 & , kme=kme, its=its, ite=ite, jts=jts, jte=jte, &
716 & kts=kts, kte=kte)
717 CASE DEFAULT
718 WRITE(message, *) &
719 & 'The pbl option does not exist: bl_pbl_physics = ', &
720 & bl_pbl_physics
721 CALL WRF_ERROR_FATAL(message)
722 END SELECT
723 IF (PRESENT(dtaux3d)) THEN
724 IF (gwd_opt .EQ. 1) CALL G_GWDO(u3d=u_phytmp, u3dd=u_phytmpd, &
725 & v3d=v_phytmp, v3dd=v_phytmpd, t3d=&
726 & t_phy, t3dd=t_phyd, qv3d=qv_curr, &
727 & qv3dd=qv_currd, p3d=p_phy, p3di=p8w&
728 & , p3did=p8wd, pi3d=pi_phy, pi3dd=&
729 & pi_phyd, z=z, zd=zd, rublten=rublten&
730 & , rubltend=rubltend, rvblten=rvblten&
731 & , rvbltend=rvbltend, dtaux3d=dtaux3d&
732 & , dtaux3dd=dtaux3dd, dtauy3d=dtauy3d&
733 & , dtauy3dd=dtauy3dd, dusfcg=dusfcg, &
734 & dusfcgd=dusfcgd, dvsfcg=dvsfcg, &
735 & dvsfcgd=dvsfcgd, var2d=var2d, oc12d=&
736 & oc12d, oa2d1=oa1, oa2d2=oa2, oa2d3=&
737 & oa3, oa2d4=oa4, ol2d1=ol1, ol2d2=ol2&
738 & , ol2d3=ol3, ol2d4=ol4, znu=znu, znw&
739 & =znw, p_top=&
740 & p_top, cp=cp, g=g, rd=r_d, rv=r_v, &
741 & ep1=ep_1, pi=3.141592653, dt=dtbl, &
742 & dx=dx, kpbl2d=kpbl, itimestep=&
743 & itimestep, ids=ids, ide=ide, jds=jds&
744 & , jde=jde, kds=kds, kde=kde, ims=ims&
745 & , ime=ime, jms=jms, jme=jme, kms=kms&
746 & , kme=kme, its=its, ite=ite, jts=jts&
747 & , jte=jte, kts=kts, kte=kte)
748 END IF
749 END DO
750 END IF
751 END IF
752 END SUBROUTINE G_PBL_DRIVER
754 END MODULE g_module_pbl_driver