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