Line data Source code
1 :
2 : module advance_clubb_core_module
3 :
4 : ! Description:
5 : ! The module containing the `core' of the CLUBB parameterization.
6 : ! It advances CLUBB's equations one model time step.
7 : !
8 : ! References:
9 : ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:overview_clubb
10 : !
11 : ! ``A PDF-Based Model for Boundary Layer Clouds. Part I:
12 : ! Method and Model Description'' Golaz, et al. (2002)
13 : ! JAS, Vol. 59, pp. 3540--3551.
14 : !
15 : ! Copyright Notice:
16 : !
17 : ! This code and the source code it references are (C) 2006-2020.
18 : !
19 : ! The distribution of this code and derived works thereof
20 : ! should include this notice.
21 : !
22 : ! Portions of this code derived from other sources (Hugh Morrison,
23 : ! ACM TOMS, Numerical Recipes, et cetera) are the intellectual
24 : ! property of their respective authors as noted and are also subject
25 : ! to copyright.
26 : !
27 : !
28 : !
29 : ! Cloud Layers Unified By Binormals (CLUBB) user license
30 : ! agreement.
31 : !
32 : ! Thank you for your interest in CLUBB. We work hard to create a
33 : ! code that implements the best software engineering practices,
34 : ! is supported to the extent allowed by our limited resources,
35 : ! and is available without cost to non-commercial users. You may
36 : ! use CLUBB if, in return, you abide by these conditions:
37 : !
38 : ! 1. Please cite CLUBB in presentations and publications that
39 : ! contain results obtained using CLUBB.
40 : !
41 : ! 2. You may not use any part of CLUBB to create or modify
42 : ! another single-column (1D) model that is not called CLUBB.
43 : ! However, you may modify or augment CLUBB or parts of CLUBB if
44 : ! you include "CLUBB" in the name of the resulting single-column
45 : ! model. For example, a user at MIT might modify CLUBB and call
46 : ! the modified version "CLUBB-MIT." Or, for example, a user of
47 : ! the CLM land-surface model might interface CLM to CLUBB and
48 : ! call it "CLM-CLUBB." This naming convention recognizes the
49 : ! contributions of both sets of developers.
50 : !
51 : ! 3. You may implement CLUBB as a parameterization in a large-
52 : ! scale host model that has 2 or 3 spatial dimensions without
53 : ! including "CLUBB" in the combined model name, but please
54 : ! acknowledge in presentations and publications that CLUBB has
55 : ! been included as a parameterization.
56 : !
57 : ! 4. You may not provide all or part of CLUBB to anyone without
58 : ! prior permission from Vincent Larson (vlarson@uwm.edu). If
59 : ! you wish to share CLUBB with your collaborators without
60 : ! seeking permission, please ask your collaborators to register
61 : ! as CLUBB users at https://carson.math.uwm.edu/larson-group/clubb_site/ and to
62 : ! download CLUBB from there.
63 : !
64 : ! 5. You may not use CLUBB for commercial purposes unless you
65 : ! receive permission from Vincent Larson.
66 : !
67 : ! 6. You may not re-license all or any part of CLUBB.
68 : !
69 : ! 7. CLUBB is provided "as is" and without warranty.
70 : !
71 : ! We hope that CLUBB will develop into a community resource. We
72 : ! encourage users to contribute their CLUBB modifications or
73 : ! extensions to the CLUBB development group. We will then
74 : ! consider them for inclusion in CLUBB. Such contributions will
75 : ! benefit all CLUBB users. We would be pleased to acknowledge
76 : ! contributors and list their CLUBB-related papers on our "About
77 : ! CLUBB" webpage (https://carson.math.uwm.edu/larson-group/clubb_site/about.html) for
78 : ! those contributors who so desire.
79 : !
80 : ! Thanks so much and best wishes for your research!
81 : !
82 : ! The CLUBB Development Group
83 : ! (Present and past contributors to the source code include
84 : ! Vincent Larson, Chris Golaz, David Schanen, Brian Griffin,
85 : ! Joshua Fasching, Adam Smith, and Michael Falk).
86 : !-----------------------------------------------------------------------
87 :
88 : ! Options for the placement of the call to CLUBB's PDF.
89 : use model_flags, only: &
90 : ipdf_pre_advance_fields, & ! Call before advancing predictive fields
91 : ipdf_post_advance_fields, & ! Call after advancing predictive fields
92 : ipdf_pre_post_advance_fields ! Call both before and after advancing
93 : ! predictive fields
94 :
95 : implicit none
96 :
97 : public :: &
98 : setup_clubb_core, &
99 : advance_clubb_core, &
100 : cleanup_clubb_core, &
101 : set_Lscale_max, &
102 : calculate_thlp2_rad
103 :
104 : private ! Default Scope
105 :
106 : ! Advance subroutine ordering variables
107 : integer, parameter, private :: &
108 : order_xm_wpxp = 1, &
109 : order_xp2_xpyp = 2, &
110 : order_wp2_wp3 = 3, &
111 : order_windm = 4
112 :
113 : contains
114 :
115 : !-----------------------------------------------------------------------
116 :
117 : !#######################################################################
118 : !#######################################################################
119 : ! If you change the argument list of advance_clubb_core you also have to
120 : ! change the calls to this function in the host models CAM, WRF, SAM
121 : ! and GFDL.
122 : !#######################################################################
123 : !#######################################################################
124 352944 : subroutine advance_clubb_core ( gr, nz, ngrdcol, & ! intent(in)
125 352944 : l_implemented, dt, fcor, sfc_elevation, hydromet_dim, & ! intent(in)
126 352944 : thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & ! intent(in)
127 352944 : sclrm_forcing, edsclrm_forcing, wprtp_forcing, & ! intent(in)
128 352944 : wpthlp_forcing, rtp2_forcing, thlp2_forcing, & ! intent(in)
129 352944 : rtpthlp_forcing, wm_zm, wm_zt, & ! intent(in)
130 352944 : wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & ! intent(in)
131 352944 : wpsclrp_sfc, wpedsclrp_sfc, & ! intent(in)
132 352944 : upwp_sfc_pert, vpwp_sfc_pert, & ! intent(in)
133 352944 : rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, & ! Intent(in)
134 352944 : p_in_Pa, rho_zm, rho, exner, & ! intent(in)
135 352944 : rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in)
136 352944 : invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & ! intent(in)
137 : hydromet, & ! Unused
138 352944 : rfrzm, radf, & ! intent(in)
139 : #ifdef CLUBBND_CAM
140 : varmu, & ! intent(in)
141 : #endif
142 352944 : wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & ! intent(in)
143 352944 : host_dx, host_dy, & ! intent(in)
144 : clubb_params, nu_vert_res_dep, lmin, & ! intent(in)
145 : clubb_config_flags, & ! intent(in)
146 : stats_metadata, & ! intent(in)
147 352944 : stats_zt, stats_zm, stats_sfc, & ! intent(inout)
148 352944 : um, vm, upwp, vpwp, up2, vp2, up3, vp3, & ! intent(inout)
149 352944 : thlm, rtm, wprtp, wpthlp, & ! intent(inout)
150 352944 : wp2, wp3, rtp2, rtp3, thlp2, thlp3, rtpthlp, & ! intent(inout)
151 352944 : sclrm, & ! intent(inout)
152 : #ifdef GFDL
153 : sclrm_trsport_only, & ! h1g, 2010-06-16 ! intent(inout)
154 : #endif
155 352944 : sclrp2, sclrp3, sclrprtp, sclrpthlp, & ! intent(inout)
156 352944 : wpsclrp, edsclrm, & ! intent(inout)
157 352944 : rcm, cloud_frac, & ! intent(inout)
158 352944 : wpthvp, wp2thvp, rtpthvp, thlpthvp, & ! intent(inout)
159 352944 : sclrpthvp, & ! intent(inout)
160 352944 : wp2rtp, wp2thlp, uprcp, vprcp, rc_coef, wp4, & ! intent(inout)
161 352944 : wpup2, wpvp2, wp2up2, wp2vp2, ice_supersat_frac, & ! intent(inout)
162 352944 : um_pert, vm_pert, upwp_pert, vpwp_pert, & ! intent(inout)
163 : pdf_params, pdf_params_zm, & ! intent(inout)
164 : pdf_implicit_coefs_terms, & ! intent(inout)
165 : #ifdef GFDL
166 : RH_crit, & !h1g, 2010-06-16 ! intent(inout)
167 : do_liquid_only_in_clubb, & ! intent(in)
168 : #endif
169 352944 : Kh_zm, Kh_zt, & ! intent(out)
170 : #ifdef CLUBB_CAM
171 352944 : qclvar, & ! intent(out)
172 : #endif
173 352944 : thlprcp, wprcp, w_up_in_cloud, w_down_in_cloud, & ! intent(out)
174 352944 : cloudy_updraft_frac, cloudy_downdraft_frac, & ! intent(out)
175 352944 : rcm_in_layer, cloud_cover, invrs_tau_zm, & ! intent(out)
176 : err_code_out ) ! intent(out)
177 :
178 : ! Description:
179 : ! Subroutine to advance CLUBB one timestep
180 :
181 : ! References:
182 : ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:overview_clubb
183 : !
184 : ! ``A PDF-Based Model for Boundary Layer Clouds. Part I:
185 : ! Method and Model Description'' Golaz, et al. (2002)
186 : ! JAS, Vol. 59, pp. 3540--3551.
187 : !-----------------------------------------------------------------------
188 :
189 : ! Modules to be included
190 :
191 : use constants_clubb, only: &
192 : em_min, &
193 : thl_tol, &
194 : rt_tol, &
195 : w_tol, &
196 : w_tol_sqd, &
197 : fstderr, &
198 : zero_threshold, &
199 : three_halves, &
200 : one, &
201 : two, &
202 : zero, &
203 : unused_var, &
204 : grav, &
205 : eps, &
206 : num_hf_draw_points
207 :
208 : use parameter_indices, only: &
209 : nparams, & ! Variable(s)
210 : itaumax, &
211 : ic_K, &
212 : ic_K10, &
213 : ic_K10h, &
214 : imu, &
215 : igamma_coef, &
216 : igamma_coefb, &
217 : igamma_coefc, &
218 : iC_wp2_splat, &
219 : ixp3_coef_base, &
220 : ixp3_coef_slope, &
221 : ilambda0_stability_coef, &
222 : ibeta, &
223 : iSkw_denom_coef, &
224 : iSkw_max_mag, &
225 : iup2_sfc_coef, &
226 : ia3_coef_min, &
227 : ibv_efold
228 :
229 : use parameters_tunable, only: &
230 : nu_vertical_res_dep ! Type(s)
231 :
232 : use parameters_model, only: &
233 : sclr_dim, & ! Variable(s)
234 : edsclr_dim, &
235 : sclr_tol
236 :
237 : use model_flags, only: &
238 : clubb_config_flags_type, & ! Type
239 : l_host_applies_sfc_fluxes, & ! Variable(s)
240 : l_gamma_Skw, &
241 : l_advance_xp3, &
242 : iiPDF_ADG1
243 :
244 : use grid_class, only: &
245 : grid, & ! Type
246 : zm2zt, & ! Procedure(s)
247 : zt2zm, &
248 : ddzm, &
249 : ddzt, &
250 : zm2zt2zm
251 :
252 : use numerical_check, only: &
253 : parameterization_check, & ! Procedure(s)
254 : calculate_spurious_source
255 :
256 : use pdf_parameter_module, only: &
257 : pdf_parameter, &
258 : implicit_coefs_terms
259 :
260 : #ifdef GFDL
261 : use advance_sclrm_Nd_module, only: & ! h1g, 2010-06-16 begin mod
262 : advance_sclrm_Nd_diffusion_OG, &
263 : advance_sclrm_Nd_upwind, &
264 : advance_sclrm_Nd_semi_implicit ! h1g, 2010-06-16 end mod
265 : #endif
266 :
267 : use advance_xm_wpxp_module, only: &
268 : advance_xm_wpxp ! Compute mean/flux terms
269 :
270 : use advance_xp2_xpyp_module, only: &
271 : advance_xp2_xpyp ! Computes variance terms
272 :
273 : use sfc_varnce_module, only: &
274 : calc_sfc_varnce ! Procedure
275 :
276 : use mixing_length, only: &
277 : compute_mixing_length, & ! Procedure
278 : calc_Lscale_directly, & ! for Lscale
279 : diagnose_Lscale_from_tau ! for Lscale from tau
280 :
281 : use advance_windm_edsclrm_module, only: &
282 : advance_windm_edsclrm ! Procedure(s)
283 :
284 : use saturation, only: &
285 : ! Procedure
286 : sat_mixrat_liq ! Saturation mixing ratio
287 :
288 : use advance_wp2_wp3_module, only: &
289 : advance_wp2_wp3 ! Procedure
290 :
291 : use advance_xp3_module, only: &
292 : advance_xp3 ! Procedure(s)
293 :
294 : use calc_pressure, only: &
295 : calculate_thvm
296 :
297 : use clubb_precision, only: &
298 : core_rknd ! Variable(s)
299 :
300 : use error_code, only: &
301 : clubb_at_least_debug_level, & ! Procedure
302 : err_code, & ! Error Indicator
303 : clubb_no_error, & ! Constant
304 : clubb_fatal_error ! Constant
305 :
306 : use Skx_module, only: &
307 : Skx_func, & ! Procedure(s)
308 : xp3_LG_2005_ansatz
309 :
310 : use clip_explicit, only: &
311 : clip_covars_denom ! Procedure(s)
312 :
313 : use T_in_K_module, only: &
314 : ! Read values from namelist
315 : thlm2T_in_K ! Procedure
316 :
317 : use sigma_sqd_w_module, only: &
318 : compute_sigma_sqd_w ! Procedure(s)
319 :
320 : use stats_clubb_utilities, only: &
321 : stats_accumulate ! Procedure
322 :
323 : use stats_type_utilities, only: &
324 : stat_update_var_pt, & ! Procedure(s)
325 : stat_update_var, &
326 : stat_begin_update, &
327 : stat_begin_update_pt, &
328 : stat_end_update, &
329 : stat_end_update_pt
330 :
331 : use fill_holes, only: &
332 : fill_holes_vertical
333 :
334 : use advance_helper_module, only: &
335 : calc_stability_correction, & ! Procedure(s)
336 : compute_Cx_fnc_Richardson, &
337 : calc_brunt_vaisala_freq_sqd, &
338 : wp2_term_splat_lhs, &
339 : wp3_term_splat_lhs, &
340 : vertical_integral, &
341 : Lscale_width_vert_avg
342 :
343 : use interpolation, only: &
344 : pvertinterp
345 :
346 : use stats_type, only: stats ! Type
347 :
348 : use pdf_parameter_module, only: &
349 : copy_single_pdf_params_to_multi, &
350 : copy_multi_pdf_params_to_single, &
351 : init_pdf_params
352 :
353 : use stats_variables, only: &
354 : stats_metadata_type
355 :
356 : implicit none
357 :
358 : !!! External
359 : intrinsic :: sqrt, min, max, exp, mod, real
360 :
361 : ! Constant Parameters
362 :
363 : real( kind = core_rknd ), parameter :: &
364 : tau_const = 1000._core_rknd
365 :
366 : !--------------------------- Input Variables ---------------------------
367 : integer, intent(in) :: &
368 : nz, & ! Number of vertical levels
369 : ngrdcol ! Number of grid columns
370 :
371 : type (grid), target, intent(in) :: gr
372 :
373 : logical, intent(in) :: &
374 : l_implemented ! True if CLUBB is being run within a large-scale host model,
375 : ! rather than a standalone single-column model.
376 :
377 : real( kind = core_rknd ), intent(in) :: &
378 : dt ! Current timestep duration [s]
379 :
380 : real( kind = core_rknd ) :: &
381 : dt_advance ! General timestep duration for advance_wp2_wp3,
382 : ! advance_xm_xpwp, and advance_xp2_xpyp.
383 : ! Only differs from dt if l_lmm_stepping is used [s]
384 :
385 : real( kind = core_rknd ), intent(in), dimension(ngrdcol) :: &
386 : fcor, & ! Coriolis forcing [s^-1]
387 : sfc_elevation ! Elevation of ground level [m above MSL]
388 :
389 : integer, intent(in) :: &
390 : hydromet_dim ! Total number of hydrometeor species [#]
391 :
392 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
393 : thlm_forcing, & ! liquid potential temp. forcing (thermodynamic levels) [K/s]
394 : rtm_forcing, & ! total water forcing (thermodynamic levels) [(kg/kg)/s]
395 : um_forcing, & ! eastward wind forcing (thermodynamic levels) [m/s/s]
396 : vm_forcing, & ! northward wind forcing (thermodynamic levels) [m/s/s]
397 : wprtp_forcing, & ! total water turbulent flux forcing (momentum levels) [m*K/s^2]
398 : wpthlp_forcing, & ! liq pot temp turb flux forcing (momentum levels) [m*(kg/kg)/s^2]
399 : rtp2_forcing, & ! total water variance forcing (momentum levels) [(kg/kg)^2/s]
400 : thlp2_forcing, & ! liq pot temp variance forcing (momentum levels) [K^2/s]
401 : rtpthlp_forcing, & ! <r_t'th_l'> covariance forcing (momentum levels) [K*(kg/kg)/s]
402 : wm_zm, & ! vertical mean wind component on momentum levels [m/s]
403 : wm_zt, & ! vertical mean wind component on thermo. levels [m/s]
404 : rho_zm, & ! Air density on momentum levels [kg/m^3]
405 : rho, & ! Air density on thermodynamic levels [kg/m^3]
406 : rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3]
407 : rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3]
408 : invrs_rho_ds_zm, & ! Inverse dry, static density on momentum levs. [m^3/kg]
409 : invrs_rho_ds_zt, & ! Inverse dry, static density on thermo levs. [m^3/kg]
410 : thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K]
411 : thv_ds_zt, & ! Dry, base-state theta_v on thermo levs. [K]
412 : rfrzm ! Total ice-phase water mixing ratio [kg/kg]
413 :
414 : real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim), intent(in) :: &
415 : hydromet ! Array of hydrometeors [units vary]
416 :
417 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
418 : radf ! Buoyancy production at cloud top due to longwave radiative cooling [m^2/s^3]
419 :
420 : #ifdef CLUBBND_CAM
421 : real( kind = core_rknd ), intent(in), dimension(ngrdcol) :: &
422 : varmu
423 : #endif
424 :
425 : real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim), intent(in) :: &
426 : wphydrometp, & ! Covariance of w and a hydrometeor [(m/s) <hm units>]
427 : wp2hmp, & ! Third-order moment: < w'^2 hm' > (hm = hydrometeor) [(m/s)^2 <hm units>]
428 : rtphmp_zt, & ! Covariance of rt and hm (on thermo levs.) [(kg/kg) <hm units>]
429 : thlphmp_zt ! Covariance of thl and hm (on thermo levs.) [K <hm units>]
430 :
431 : real( kind = core_rknd ), intent(in), dimension(ngrdcol) :: &
432 : wpthlp_sfc, & ! w' theta_l' at surface [(m K)/s]
433 : wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)]
434 : upwp_sfc, & ! u'w' at surface [m^2/s^2]
435 : vpwp_sfc ! v'w' at surface [m^2/s^2]
436 :
437 : ! Passive scalar variables
438 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) :: &
439 : sclrm_forcing ! Passive scalar forcing [{units vary}/s]
440 :
441 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,sclr_dim) :: &
442 : wpsclrp_sfc ! Passive scalar flux at surface [{units vary} m/s]
443 :
444 : ! Eddy passive scalar variables
445 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,edsclr_dim) :: &
446 : edsclrm_forcing ! Eddy-diffusion passive scalar forcing [{units vary}/s]
447 :
448 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,edsclr_dim) :: &
449 : wpedsclrp_sfc ! Eddy-diffusion passive scalar flux at surface [{units vary} m/s
450 :
451 : real( kind = core_rknd ), intent(in), dimension(ngrdcol) :: &
452 : upwp_sfc_pert, & ! pertubed u'w' at surface [m^2/s^2]
453 : vpwp_sfc_pert ! pertubed v'w' at surface [m^2/s^2]
454 :
455 : ! Reference profiles (used for nudging, sponge damping, and Coriolis effect)
456 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
457 : rtm_ref, & ! Initial total water mixing ratio [kg/kg]
458 : thlm_ref, & ! Initial liquid water potential temperature [K]
459 : um_ref, & ! Initial u wind; Michael Falk [m/s]
460 : vm_ref, & ! Initial v wind; Michael Falk [m/s]
461 : ug, & ! u geostrophic wind [m/s]
462 : vg ! v geostrophic wind [m/s]
463 :
464 : ! Host model horizontal grid spacing, if part of host model.
465 : real( kind = core_rknd ), intent(in), dimension(ngrdcol) :: &
466 : host_dx, & ! East-west horizontal grid spacing [m]
467 : host_dy ! North-south horizontal grid spacing [m]
468 :
469 : real( kind = core_rknd ), dimension(nparams), intent(in) :: &
470 : clubb_params ! Array of CLUBB's tunable parameters [units vary]
471 :
472 : type(nu_vertical_res_dep), intent(in) :: &
473 : nu_vert_res_dep ! Vertical resolution dependent nu values
474 :
475 : real( kind = core_rknd ), intent(in) :: &
476 : lmin ! Min. value for the length scale [m]
477 :
478 : type( clubb_config_flags_type ), intent(in) :: &
479 : clubb_config_flags ! Derived type holding all configurable CLUBB flags
480 :
481 : type (stats_metadata_type), intent(in) :: &
482 : stats_metadata
483 :
484 : !--------------------------- Input/Output Variables ---------------------------
485 : type (stats), target, intent(inout), dimension(ngrdcol) :: &
486 : stats_zt, &
487 : stats_zm, &
488 : stats_sfc
489 :
490 : ! These are prognostic or are planned to be in the future
491 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) :: &
492 : um, & ! eastward grid-mean wind component (thermodynamic levels) [m/s]
493 : upwp, & ! u'w' (momentum levels) [m^2/s^2]
494 : vm, & ! northward grid-mean wind component (thermodynamic levels) [m/s]
495 : vpwp, & ! v'w' (momentum levels) [m^2/s^2]
496 : up2, & ! u'^2 (momentum levels) [m^2/s^2]
497 : vp2, & ! v'^2 (momentum levels) [m^2/s^2]
498 : up3, & ! u'^3 (thermodynamic levels) [m^3/s^3]
499 : vp3, & ! v'^3 (thermodynamic levels) [m^3/s^3]
500 : rtm, & ! total water mixing ratio, r_t (thermo. levels) [kg/kg]
501 : wprtp, & ! w' r_t' (momentum levels) [(kg/kg) m/s]
502 : thlm, & ! liq. water pot. temp., th_l (thermo. levels) [K]
503 : wpthlp, & ! w'th_l' (momentum levels) [(m/s) K]
504 : rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2]
505 : rtp3, & ! r_t'^3 (thermodynamic levels) [(kg/kg)^3]
506 : thlp2, & ! th_l'^2 (momentum levels) [K^2]
507 : thlp3, & ! th_l'^3 (thermodynamic levels) [K^3]
508 : rtpthlp, & ! r_t'th_l' (momentum levels) [(kg/kg) K]
509 : wp2, & ! w'^2 (momentum levels) [m^2/s^2]
510 : wp3 ! w'^3 (thermodynamic levels) [m^3/s^3]
511 :
512 : ! Passive scalar variables
513 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) :: &
514 : sclrm, & ! Passive scalar mean (thermo. levels) [units vary]
515 : wpsclrp, & ! w'sclr' (momentum levels) [{units vary} m/s]
516 : sclrp2, & ! sclr'^2 (momentum levels) [{units vary}^2]
517 : sclrp3, & ! sclr'^3 (thermodynamic levels) [{units vary}^3]
518 : sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)]
519 : sclrpthlp ! sclr'thl' (momentum levels) [{units vary} K]
520 :
521 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) :: &
522 : p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa]
523 : exner ! Exner function (thermodynamic levels) [-]
524 :
525 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) :: &
526 : rcm, & ! cloud water mixing ratio, r_c (thermo. levels) [kg/kg]
527 : cloud_frac, & ! cloud fraction (thermodynamic levels) [-]
528 : wpthvp, & ! < w' th_v' > (momentum levels) [kg/kg K]
529 : wp2thvp, & ! < w'^2 th_v' > (thermodynamic levels) [m^2/s^2 K]
530 : rtpthvp, & ! < r_t' th_v' > (momentum levels) [kg/kg K]
531 : thlpthvp ! < th_l' th_v' > (momentum levels) [K^2]
532 :
533 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) :: &
534 : sclrpthvp ! < sclr' th_v' > (momentum levels) [units vary]
535 :
536 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) :: &
537 : wp2rtp, & ! w'^2 rt' (thermodynamic levels) [m^2/s^2 kg/kg]
538 : wp2thlp, & ! w'^2 thl' (thermodynamic levels) [m^2/s^2 K]
539 : uprcp, & ! < u' r_c' > (momentum levels) [(m/s)(kg/kg)]
540 : vprcp, & ! < v' r_c' > (momentum levels) [(m/s)(kg/kg)]
541 : rc_coef, & ! Coef of X'r_c' in Eq. (34) (t-levs.) [K/(kg/kg)]
542 : wp4, & ! w'^4 (momentum levels) [m^4/s^4]
543 : wpup2, & ! w'u'^2 (thermodynamic levels) [m^3/s^3]
544 : wpvp2, & ! w'v'^2 (thermodynamic levels) [m^3/s^3]
545 : wp2up2, & ! w'^2 u'^2 (momentum levels) [m^4/s^4]
546 : wp2vp2, & ! w'^2 v'^2 (momentum levels) [m^4/s^4]
547 : ice_supersat_frac ! ice cloud fraction (thermo. levels) [-]
548 :
549 : ! Variables used to track perturbed version of winds.
550 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) :: &
551 : um_pert, & ! perturbed <u> [m/s]
552 : vm_pert, & ! perturbed <v> [m/s]
553 : upwp_pert, & ! perturbed <u'w'> [m^2/s^2]
554 : vpwp_pert ! perturbed <v'w'> [m^2/s^2]
555 :
556 : type(pdf_parameter), intent(inout) :: &
557 : pdf_params, & ! Fortran structure of PDF parameters on thermodynamic levels [units vary]
558 : pdf_params_zm ! Fortran structure of PDF parameters on momentum levels [units vary]
559 :
560 : type(implicit_coefs_terms), intent(inout) :: &
561 : pdf_implicit_coefs_terms ! Implicit coefs / explicit terms [units vary]
562 :
563 : #ifdef GFDL
564 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) :: & ! h1g, 2010-06-16
565 : sclrm_trsport_only ! Passive scalar concentration due to pure transport [{units vary}/s]
566 : #endif
567 :
568 : ! Eddy passive scalar variable
569 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,edsclr_dim) :: &
570 : edsclrm ! Eddy passive scalar grid-mean (thermo. levels) [units vary]
571 :
572 : ! Variables that need to be output for use in other parts of the CLUBB
573 : ! code, such as microphysics (rcm, pdf_params), forcings (rcm), and/or
574 : ! BUGSrad (cloud_cover).
575 : real( kind = core_rknd ), intent(out), dimension(ngrdcol,nz) :: &
576 : rcm_in_layer, & ! rcm within cloud layer [kg/kg]
577 : cloud_cover ! cloud cover [-]
578 :
579 : ! Variables that need to be output for use in host models
580 : real( kind = core_rknd ), intent(out), dimension(ngrdcol,nz) :: &
581 : wprcp, & ! w'r_c' (momentum levels) [(kg/kg) m/s]
582 : w_up_in_cloud, & ! Average cloudy updraft velocity [m/s]
583 : w_down_in_cloud, & ! Average cloudy downdraft velocity [m/s]
584 : cloudy_updraft_frac, & ! cloudy updraft fraction [-]
585 : cloudy_downdraft_frac, & ! cloudy downdraft fraction [-]
586 : invrs_tau_zm ! One divided by tau on zm levels [1/s]
587 :
588 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
589 : Kh_zt, & ! Eddy diffusivity coefficient on thermodynamic levels [m^2/s]
590 : Kh_zm ! Eddy diffusivity coefficient on momentum levels [m^2/s]
591 :
592 : #ifdef CLUBB_CAM
593 : real( kind = core_rknd), intent(out), dimension(ngrdcol,nz) :: &
594 : qclvar ! cloud water variance
595 : #endif
596 :
597 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
598 : thlprcp ! thl'rc' [K kg/kg]
599 :
600 : #ifdef GFDL
601 : ! hlg, 2010-06-16
602 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz, min(1,sclr_dim) , 2) :: &
603 : RH_crit ! critical relative humidity for droplet and ice nucleation
604 : ! ---> h1g, 2012-06-14
605 : logical, intent(in) :: do_liquid_only_in_clubb
606 : ! <--- h1g, 2012-06-14
607 : #endif
608 :
609 : !--------------------------- Local Variables ---------------------------
610 : integer :: i, k, j
611 :
612 : #ifdef CLUBB_CAM
613 : integer :: ixind
614 : #endif
615 :
616 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
617 705888 : Skw_zm, & ! Skewness of w on momentum levels [-]
618 705888 : Skw_zt, & ! Skewness of w on thermodynamic levels [-]
619 705888 : thvm, & ! Virtual potential temperature [K]
620 705888 : thvm_zm, & ! Virtual potential temperature on momentum levs. [K]
621 705888 : ddzm_thvm_zm ! d(thvm_zm)/dz, centered over thermodynamic levs. [K/m]
622 :
623 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
624 705888 : rsat ! Saturation mixing ratio ! Brian
625 :
626 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
627 705888 : rtprcp, & ! rt'rc' [kg^2/kg^2]
628 705888 : rcp2 ! rc'^2 [kg^2/kg^2]
629 :
630 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
631 705888 : wpthlp2, & ! w'thl'^2 [m K^2/s]
632 705888 : wprtp2, & ! w'rt'^2 [m kg^2/kg^2]
633 705888 : wprtpthlp, & ! w'rt'thl' [m kg K/kg s]
634 705888 : wp2rcp, & ! w'^2 rc' [m^2 kg/kg s^2]
635 705888 : wp3_zm ! w'^3 [m^3/s^3]
636 :
637 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
638 705888 : Lscale, & ! Length scale [m]
639 705888 : Lscale_up, & ! Length scale (upwards component) [m]
640 705888 : Lscale_down, & ! Length scale (downwards component) [m]
641 705888 : Lscale_zm ! Length scale on momentum levels [m]
642 :
643 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
644 705888 : em, & ! Turbulent Kinetic Energy (TKE) [m^2/s^2]
645 705888 : tau_zm, & ! Eddy dissipation time scale on momentum levels [s]
646 705888 : tau_zt ! Eddy dissipation time scale on thermodynamic levels [s]
647 :
648 : real( kind = core_rknd ), dimension(ngrdcol,nz,edsclr_dim) :: &
649 705888 : wpedsclrp ! w'edsclr'
650 :
651 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
652 705888 : sclrprcp, & ! sclr'rc'
653 705888 : wp2sclrp, & ! w'^2 sclr'
654 705888 : wpsclrp2, & ! w'sclr'^2
655 705888 : wpsclrprtp, & ! w'sclr'rt'
656 705888 : wpsclrpthlp ! w'sclr'thl'
657 :
658 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
659 705888 : wp2_zt, & ! w'^2 on thermo. grid [m^2/s^2]
660 705888 : thlp2_zt, & ! thl'^2 on thermo. grid [K^2]
661 705888 : wpthlp_zt, & ! w'thl' on thermo. grid [m K/s]
662 705888 : wprtp_zt, & ! w'rt' on thermo. grid [m kg/(kg s)]
663 705888 : rtp2_zt, & ! rt'^2 on therm. grid [(kg/kg)^2]
664 705888 : rtpthlp_zt, & ! rt'thl' on thermo. grid [kg K/kg]
665 705888 : up2_zt, & ! u'^2 on thermo. grid [m^2/s^2]
666 705888 : vp2_zt, & ! v'^2 on thermo. grid [m^2/s^2]
667 705888 : upwp_zt, & ! u'w' on thermo. grid [m^2/s^2]
668 705888 : vpwp_zt ! v'w' on thermo. grid [m^2/s^2]
669 :
670 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
671 705888 : Skw_velocity, & ! Skewness velocity [m/s]
672 705888 : a3_coef, & ! The a3 coefficient from CLUBB eqns [-]
673 705888 : a3_coef_zt ! The a3 coefficient interpolated to the zt grid [-]
674 :
675 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
676 705888 : wp3_on_wp2, & ! w'^3 / w'^2 on the zm grid [m/s]
677 705888 : wp3_on_wp2_zt ! w'^3 / w'^2 on the zt grid [m/s]
678 :
679 : ! Eric Raut declared this variable solely for output to disk
680 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
681 705888 : rc_coef_zm ! Coefficient of X'r_c' in Eq. (34) on m-levs. [K/(kg/kg)]
682 :
683 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
684 705888 : Km_zm, & ! Eddy diffusivity for momentum on zm grid levels [m^2/s]
685 705888 : Kmh_zm ! Eddy diffusivity for thermodynamic variables [m^2/s]
686 :
687 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
688 705888 : gamma_Skw_fnc, & ! Gamma as a function of skewness [-]
689 705888 : sigma_sqd_w, & ! PDF width parameter (momentum levels) [-]
690 705888 : sigma_sqd_w_tmp, &
691 705888 : sigma_sqd_w_zt, & ! PDF width parameter (thermodynamic levels) [-]
692 705888 : sqrt_em_zt, & ! sqrt( em ) on zt levels; where em is TKE [m/s]
693 705888 : xp3_coef_fnc ! Coefficient in simple xp3 equation [-]
694 : !Lscale_weight Uncomment this if you need to use this vairable at some point.
695 :
696 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
697 705888 : w_1_zm, & ! Mean w (1st PDF component) [m/s]
698 705888 : w_2_zm, & ! Mean w (2nd PDF component) [m/s]
699 705888 : varnce_w_1_zm, & ! Variance of w (1st PDF component) [m^2/s^2]
700 705888 : varnce_w_2_zm, & ! Variance of w (2nd PDF component) [m^2/s^2]
701 705888 : mixt_frac_zm ! Weight of 1st PDF component (Sk_w dependent) [-]
702 :
703 : integer :: &
704 : wprtp_cl_num, & ! Instance of w'r_t' clipping (1st or 3rd).
705 : wpthlp_cl_num, & ! Instance of w'th_l' clipping (1st or 3rd).
706 : wpsclrp_cl_num, & ! Instance of w'sclr' clipping (1st or 3rd).
707 : upwp_cl_num, & ! Instance of u'w' clipping (1st or 2nd).
708 : vpwp_cl_num ! Instance of v'w' clipping (1st or 2nd).
709 :
710 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
711 705888 : rcp2_zt, & ! r_c'^2 (on thermo. grid) [kg^2/kg^2]
712 705888 : cloud_frac_zm, & ! Cloud Fraction on momentum grid [-]
713 705888 : ice_supersat_frac_zm, & ! Ice Cloud Fraction on momentum grid [-]
714 705888 : rtm_zm, & ! Total water mixing ratio [kg/kg]
715 705888 : thlm_zm, & ! Liquid potential temperature [kg/kg]
716 705888 : rcm_zm, & ! Liquid water mixing ratio on m-levs. [kg/kg]
717 705888 : wpsclrp_zt, & ! Scalar flux on thermo. levels [un. vary]
718 705888 : sclrp2_zt ! Scalar variance on thermo.levels [un. vary]
719 :
720 : real( kind = core_rknd ), dimension(ngrdcol) :: &
721 705888 : rtm_integral_before, &
722 705888 : rtm_integral_after, &
723 705888 : rtm_integral_forcing, &
724 705888 : rtm_flux_top, &
725 705888 : rtm_flux_sfc, &
726 705888 : rtm_spur_src, &
727 705888 : thlm_integral_before, &
728 705888 : thlm_integral_after, &
729 705888 : thlm_integral_forcing, &
730 705888 : thlm_flux_top, &
731 705888 : thlm_flux_sfc, &
732 705888 : thlm_spur_src
733 :
734 : real( kind = core_rknd ), dimension(ngrdcol) :: &
735 705888 : thlm1000, &
736 705888 : thlm700
737 :
738 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
739 705888 : rcm_supersat_adj, & ! Adjustment to rcm due to spurious supersaturation
740 705888 : rel_humidity ! Relative humidity after PDF closure [-]
741 :
742 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
743 705888 : stability_correction, & ! Stability correction factor
744 705888 : invrs_tau_N2_zm, & ! Inverse tau with static stability correction applied [1/s]
745 705888 : invrs_tau_C6_zm, & ! Inverse tau values used for C6 (pr1) term in wpxp [1/s]
746 705888 : invrs_tau_C1_zm, & ! Inverse tau values used for C1 (dp1) term in wp2 [1/s]
747 705888 : invrs_tau_xp2_zm, & ! Inverse tau values used for advance_xp2_wpxp [s^-1]
748 705888 : invrs_tau_N2_iso, & ! Inverse tau values used for C4 when
749 : ! l_use_invrs_tau_N2_iso = .true. [s^-1]
750 705888 : invrs_tau_C4_zm, & ! Inverse tau values used for C4 terms [s^-1]
751 705888 : invrs_tau_C14_zm, & ! Inverse tau valuse used for C14 terms [s^-1]
752 705888 : invrs_tau_wp2_zm, & ! Inverse tau values used for advance_wp2_wpxp [s^-1]
753 705888 : invrs_tau_wpxp_zm, & ! invrs_tau_C6_zm = invrs_tau_wpxp_zm
754 705888 : invrs_tau_wp3_zm, & ! Inverse tau values used for advance_wp3_wp2 [s^-1]
755 705888 : invrs_tau_no_N2_zm, & ! One divided by tau (without N2) on zm levels [s^-1]
756 705888 : invrs_tau_bkgnd, & ! One divided by tau_wp3 [s^-1]
757 705888 : invrs_tau_shear, & ! One divided by tau with stability effects [s^-1]
758 705888 : invrs_tau_sfc, & ! One divided by tau (without N2) on zm levels [s^-1]
759 705888 : invrs_tau_zt, & ! Inverse time-scale tau on thermodynamics levels [1/s]
760 705888 : invrs_tau_wp3_zt, & ! Inverse tau wp3 at zt levels
761 705888 : Cx_fnc_Richardson, & ! Cx_fnc computed from Richardson_num [-]
762 705888 : brunt_vaisala_freq_sqd, & ! Buoyancy frequency squared, N^2 [s^-2]
763 705888 : brunt_vaisala_freq_sqd_mixed, & ! A mixture of dry and moist N^2 [s^-2]
764 705888 : brunt_vaisala_freq_sqd_dry, & ! dry N^2 [s^-2]
765 705888 : brunt_vaisala_freq_sqd_moist, & ! moist N^2 [s^-2]
766 705888 : brunt_vaisala_freq_sqd_splat, & ! [s^-2]
767 705888 : brunt_vaisala_freq_sqd_zt, & ! Buoyancy frequency squared on t-levs. [s^-2]
768 705888 : Ri_zm ! Richardson number [-]
769 :
770 :
771 : real( kind = core_rknd ), parameter :: &
772 : ufmin = 0.01_core_rknd ! minimum value of friction velocity [m/s]
773 :
774 : real( kind = core_rknd ), dimension(ngrdcol) :: &
775 705888 : Lscale_max ! Max. allowable mixing length (based on grid box size) [m]
776 :
777 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
778 705888 : tau_max_zm, & ! Max. allowable eddy dissipation time scale on m-levs [s]
779 352944 : tau_max_zt ! Max. allowable eddy dissipation time scale on t-levs [s]
780 :
781 705888 : real( kind = core_rknd ), dimension(ngrdcol) :: newmu
782 :
783 : real( kind = core_rknd ) :: below_grnd_val = 0.01_core_rknd
784 :
785 : real( kind = core_rknd ) :: &
786 : taumax, & ! CLUBB tunable parameter taumax
787 : c_K, & ! CLUBB tunable parameter c_K
788 : gamma_coef, & ! CLUBB tunable parameter gamma_coef
789 : gamma_coefb, & ! CLUBB tunable parameter gamma_coefb
790 : gamma_coefc, & ! CLUBB tunable parameter gamma_coefc
791 : xp3_coef_base, & ! CLUBB tunable parameter xp3_coef_base
792 : xp3_coef_slope, & ! CLUBB tunable parameter xp3_coef_slope
793 : beta, & ! CLUBB tunable parameter beta
794 : Skw_denom_coef, & ! CLUBB tunable parameter Skw_denom_coef
795 : Skw_max_mag, & ! CLUBB tunable parameter Skw_max_mag
796 : mu, &
797 : a3_coef_min, &
798 : C_K10, &
799 : C_K10h
800 :
801 : ! Flag to sample stats in a particular call to subroutine
802 : ! pdf_closure_driver.
803 : logical :: l_samp_stats_in_pdf_call
804 :
805 : ! Flag to determine whether invrs_tau_N2_iso is used in C4 terms.
806 : ! Important! This flag is only in use when l_diag_Lscale_from_tau = true
807 : ! Setting l_use_invrs_tau_N2_iso = true will not change anything unless
808 : ! l_diag_Lscale_from_tau is also true
809 : logical, parameter :: l_use_invrs_tau_N2_iso = .false.
810 :
811 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
812 705888 : lhs_splat_wp2, & ! LHS coefficient of wp2 splatting term [1/s]
813 705888 : lhs_splat_wp3 ! LHS coefficient of wp3 splatting term [1/s]
814 :
815 : ! Variables associated with upgradient momentum contributions due to cumuli
816 : !real( kind = core_rknd ), dimension(nz) :: &
817 : ! Km_Skw_factor ! Factor, with value < 1, that reduces eddy diffusivity,
818 : ! Km_zm, in skewed layers
819 : !real( kind = core_rknd ),parameter :: &
820 : ! Km_Skw_thresh = zero_threshold, & ! Value of Skw at which Skw correction kicks in
821 : ! Km_Skw_factor_efold = 0.5_core_rknd, & ! E-folding rate of exponential Skw correction
822 : ! Km_Skw_factor_min = 0.2_core_rknd ! Minimum value of Km_Skw_factor
823 :
824 : integer, intent(out) :: &
825 : err_code_out ! Error code indicator
826 :
827 278078832 : type(pdf_parameter) :: pdf_params_single_col(ngrdcol), &
828 277725888 : pdf_params_zm_single_col(ngrdcol)
829 :
830 : integer :: advance_order_loop_iter
831 :
832 : integer :: smth_type = 2 ! Used for Lscale_width_vert_avg
833 :
834 : !----- Begin Code -----
835 :
836 : !$acc data copyin( gr, gr%zm, gr%zt, gr%dzm, gr%dzt, gr%invrs_dzt, gr%invrs_dzm, &
837 : !$acc gr%weights_zt2zm, gr%weights_zm2zt, &
838 : !$acc nu_vert_res_dep, nu_vert_res_dep%nu2, nu_vert_res_dep%nu9, &
839 : !$acc nu_vert_res_dep%nu1, nu_vert_res_dep%nu8, nu_vert_res_dep%nu10, &
840 : !$acc nu_vert_res_dep%nu6, &
841 : !$acc pdf_params, pdf_params_zm, &
842 : !$acc fcor, sfc_elevation, thlm_forcing, rtm_forcing, um_forcing, &
843 : !$acc vm_forcing, wprtp_forcing, wpthlp_forcing, rtp2_forcing, thlp2_forcing, &
844 : !$acc rtpthlp_forcing, wm_zm, wm_zt, rho_zm, rho, rho_ds_zm, rho_ds_zt, &
845 : !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, &
846 : !$acc radf, wpthlp_sfc, &
847 : !$acc wprtp_sfc, upwp_sfc, vpwp_sfc, sclrm_forcing, wpsclrp_sfc, edsclrm_forcing, &
848 : !$acc wpedsclrp_sfc, upwp_sfc_pert, vpwp_sfc_pert, rtm_ref, thlm_ref, um_ref, &
849 : #ifdef CLUBBND_CAM
850 : !$acc varmu, &
851 : #endif
852 : !$acc vm_ref, ug, vg, host_dx, host_dy ) &
853 : !$acc copy( um, upwp, vm, vpwp, up2, vp2, up3, vp3, rtm, wprtp, thlm, wpthlp, rtp2, &
854 : !$acc rtp3, thlp2, thlp3, rtpthlp, wp2, wp3, sclrm, wpsclrp, sclrp2, sclrp3, &
855 : !$acc sclrprtp, sclrpthlp, p_in_Pa, exner, rcm, cloud_frac, wpthvp, wp2thvp, &
856 : !$acc rtpthvp, thlpthvp, sclrpthvp, wp2rtp, wp2thlp, uprcp, vprcp, rc_coef, &
857 : !$acc wp4, wpup2, wpvp2, wp2up2, wp2vp2, ice_supersat_frac, um_pert, &
858 : !$acc vm_pert, upwp_pert, vpwp_pert, &
859 : #ifdef GFDL
860 : !$acc sclrm_trsport_only, &
861 : #endif
862 : !$acc edsclrm, &
863 : !$acc pdf_params%w_1, pdf_params%w_2, &
864 : !$acc pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
865 : !$acc pdf_params%rt_1, pdf_params%rt_2, &
866 : !$acc pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, &
867 : !$acc pdf_params%thl_1, pdf_params%thl_2, &
868 : !$acc pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, &
869 : !$acc pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2, &
870 : !$acc pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2, &
871 : !$acc pdf_params%corr_rt_thl_1, pdf_params%corr_rt_thl_2,&
872 : !$acc pdf_params%alpha_thl, pdf_params%alpha_rt, &
873 : !$acc pdf_params%crt_1, pdf_params%crt_2, pdf_params%cthl_1, &
874 : !$acc pdf_params%cthl_2, pdf_params%chi_1, &
875 : !$acc pdf_params%chi_2, pdf_params%stdev_chi_1, &
876 : !$acc pdf_params%stdev_chi_2, pdf_params%stdev_eta_1, &
877 : !$acc pdf_params%stdev_eta_2, pdf_params%covar_chi_eta_1, &
878 : !$acc pdf_params%covar_chi_eta_2, pdf_params%corr_w_chi_1, &
879 : !$acc pdf_params%corr_w_chi_2, pdf_params%corr_w_eta_1, &
880 : !$acc pdf_params%corr_w_eta_2, pdf_params%corr_chi_eta_1, &
881 : !$acc pdf_params%corr_chi_eta_2, pdf_params%rsatl_1, &
882 : !$acc pdf_params%rsatl_2, pdf_params%rc_1, pdf_params%rc_2, &
883 : !$acc pdf_params%cloud_frac_1, pdf_params%cloud_frac_2, &
884 : !$acc pdf_params%mixt_frac, pdf_params%ice_supersat_frac_1, &
885 : !$acc pdf_params%ice_supersat_frac_2, &
886 : !$acc pdf_params_zm%w_1, pdf_params_zm%w_2, &
887 : !$acc pdf_params_zm%varnce_w_1, pdf_params_zm%varnce_w_2, &
888 : !$acc pdf_params_zm%rt_1, pdf_params_zm%rt_2, &
889 : !$acc pdf_params_zm%varnce_rt_1, pdf_params_zm%varnce_rt_2, &
890 : !$acc pdf_params_zm%thl_1, pdf_params_zm%thl_2, &
891 : !$acc pdf_params_zm%varnce_thl_1, pdf_params_zm%varnce_thl_2, &
892 : !$acc pdf_params_zm%corr_w_rt_1, pdf_params_zm%corr_w_rt_2, &
893 : !$acc pdf_params_zm%corr_w_thl_1, pdf_params_zm%corr_w_thl_2, &
894 : !$acc pdf_params_zm%corr_rt_thl_1, pdf_params_zm%corr_rt_thl_2,&
895 : !$acc pdf_params_zm%alpha_thl, pdf_params_zm%alpha_rt, &
896 : !$acc pdf_params_zm%crt_1, pdf_params_zm%crt_2, pdf_params_zm%cthl_1, &
897 : !$acc pdf_params_zm%cthl_2, pdf_params_zm%chi_1, &
898 : !$acc pdf_params_zm%chi_2, pdf_params_zm%stdev_chi_1, &
899 : !$acc pdf_params_zm%stdev_chi_2, pdf_params_zm%stdev_eta_1, &
900 : !$acc pdf_params_zm%stdev_eta_2, pdf_params_zm%covar_chi_eta_1, &
901 : !$acc pdf_params_zm%covar_chi_eta_2, pdf_params_zm%corr_w_chi_1, &
902 : !$acc pdf_params_zm%corr_w_chi_2, pdf_params_zm%corr_w_eta_1, &
903 : !$acc pdf_params_zm%corr_w_eta_2, pdf_params_zm%corr_chi_eta_1, &
904 : !$acc pdf_params_zm%corr_chi_eta_2, pdf_params_zm%rsatl_1, &
905 : !$acc pdf_params_zm%rsatl_2, pdf_params_zm%rc_1, pdf_params_zm%rc_2, &
906 : !$acc pdf_params_zm%cloud_frac_1, pdf_params_zm%cloud_frac_2, &
907 : !$acc pdf_params_zm%mixt_frac, pdf_params_zm%ice_supersat_frac_1, &
908 : !$acc pdf_params_zm%ice_supersat_frac_2 ) &
909 : !$acc copyout( rcm_in_layer, cloud_cover, wprcp, w_up_in_cloud, w_down_in_cloud, &
910 : !$acc cloudy_updraft_frac, cloudy_downdraft_frac, invrs_tau_zm, Kh_zt, &
911 : !$acc Kh_zm, &
912 : #ifdef CLUBB_CAM
913 : !$acc qclvar, &
914 : #endif
915 : !$acc thlprcp )
916 :
917 : !$acc enter data create( Skw_zm, Skw_zt, thvm, thvm_zm, ddzm_thvm_zm, rtprcp, rcp2, &
918 : !$acc wpthlp2, wprtp2, wprtpthlp, wp2rcp, wp3_zm, Lscale, Lscale_up, Lscale_zm, &
919 : !$acc Lscale_down, em, tau_zm, tau_zt, &
920 : !$acc wp2_zt, thlp2_zt, wpthlp_zt, &
921 : !$acc wprtp_zt, rtp2_zt, rtpthlp_zt, up2_zt, vp2_zt, upwp_zt, vpwp_zt, &
922 : !$acc Skw_velocity, a3_coef, a3_coef_zt, wp3_on_wp2, wp3_on_wp2_zt, &
923 : !$acc rc_coef_zm, Km_zm, Kmh_zm, gamma_Skw_fnc, sigma_sqd_w, sigma_sqd_w_tmp, sigma_sqd_w_zt, &
924 : !$acc sqrt_em_zt, xp3_coef_fnc, w_1_zm, w_2_zm, varnce_w_1_zm, varnce_w_2_zm, &
925 : !$acc mixt_frac_zm, rcp2_zt, cloud_frac_zm, ice_supersat_frac_zm, rtm_zm, &
926 : !$acc thlm_zm, rcm_zm, thlm1000, thlm700, &
927 : !$acc rcm_supersat_adj, stability_correction, invrs_tau_N2_zm, &
928 : !$acc invrs_tau_C6_zm, invrs_tau_C1_zm, invrs_tau_xp2_zm, invrs_tau_N2_iso, &
929 : !$acc invrs_tau_C4_zm, invrs_tau_C14_zm, invrs_tau_wp2_zm, invrs_tau_wpxp_zm, &
930 : !$acc invrs_tau_wp3_zm, invrs_tau_no_N2_zm, invrs_tau_bkgnd, invrs_tau_shear, &
931 : !$acc invrs_tau_sfc, invrs_tau_zt, invrs_tau_wp3_zt, Cx_fnc_Richardson, &
932 : !$acc brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, &
933 : !$acc brunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_moist, &
934 : !$acc brunt_vaisala_freq_sqd_splat, &
935 : !$acc brunt_vaisala_freq_sqd_zt, Ri_zm, Lscale_max, &
936 : !$acc tau_max_zm, tau_max_zt, newmu, lhs_splat_wp2, lhs_splat_wp3 )
937 :
938 : !$acc enter data if( sclr_dim > 0 ) &
939 : !$acc create( wpedsclrp, sclrprcp, wp2sclrp, &
940 : !$acc wpsclrp2, wpsclrprtp, wpsclrpthlp, wpsclrp_zt, sclrp2_zt )
941 :
942 : !$acc enter data if( sclr_dim > 0 ) &
943 : !$acc create( hydromet, wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt )
944 :
945 352944 : if ( clubb_config_flags%l_lmm_stepping ) then
946 0 : dt_advance = two * dt
947 : else
948 352944 : dt_advance = dt
949 : end if
950 :
951 352944 : err_code_out = clubb_no_error ! Initialize to no error value
952 :
953 352944 : mu = clubb_params(imu)
954 352944 : a3_coef_min = clubb_params(ia3_coef_min)
955 352944 : C_K10 = clubb_params(ic_K10)
956 352944 : C_K10h = clubb_params(ic_K10h)
957 :
958 : ! Determine the maximum allowable value for Lscale (in meters).
959 : call set_Lscale_max( ngrdcol, l_implemented, host_dx, host_dy, & ! intent(in)
960 352944 : Lscale_max ) ! intent(out)
961 :
962 352944 : if ( stats_metadata%l_stats .and. stats_metadata%l_stats_samp ) then
963 :
964 : !$acc update host( wm_zt, wm_zm, rho_ds_zt, rtm, gr%dzt, &
965 : !$acc rtm, thlm )
966 :
967 : ! Spurious source will only be calculated if rtm_ma and thlm_ma are zero.
968 : ! Therefore, wm must be zero or l_implemented must be true.
969 :
970 0 : do i = 1, ngrdcol
971 0 : if ( l_implemented .or. ( all( abs(wm_zt(i,:)) < eps ) .and. &
972 0 : all( abs(wm_zm(i,:)) < eps ) ) ) then
973 : ! Get the vertical integral of rtm and thlm before this function begins
974 : ! so that spurious source can be calculated
975 : rtm_integral_before(i) &
976 0 : = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
977 0 : rtm(i,2:nz), gr%dzt(i,2:nz) )
978 :
979 0 : thlm_integral_before(i) &
980 : = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
981 0 : thlm(i,2:nz), gr%dzt(i,2:nz) )
982 : end if
983 : end do
984 : end if
985 :
986 : !----------------------------------------------------------------
987 : ! Test input variables
988 : !----------------------------------------------------------------
989 352944 : if ( clubb_at_least_debug_level( 2 ) ) then
990 :
991 : !$acc update host( thlm_forcing, rtm_forcing, um_forcing, vm_forcing, &
992 : !$acc wm_zm, wm_zt, p_in_Pa, rho_zm, rho, exner, rho_ds_zm, &
993 : !$acc rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, &
994 : !$acc thv_ds_zt, wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, &
995 : !$acc um, upwp, vm, vpwp, up2, vp2, rtm, wprtp, thlm, wpthlp, &
996 : !$acc wp2, wp3, rtp2, thlp2, rtpthlp, wpsclrp_sfc, wpedsclrp_sfc, &
997 : !$acc sclrm, wpsclrp, sclrp2, sclrprtp, sclrpthlp, sclrm_forcing, &
998 : !$acc edsclrm, edsclrm_forcing )
999 :
1000 0 : do i = 1, ngrdcol
1001 : call parameterization_check &
1002 0 : ( nz, thlm_forcing(i,:), rtm_forcing(i,:), um_forcing(i,:), & ! intent(in)
1003 0 : vm_forcing(i,:), wm_zm(i,:), wm_zt(i,:), p_in_Pa(i,:), & ! intent(in)
1004 0 : rho_zm(i,:), rho(i,:), exner(i,:), rho_ds_zm(i,:), & ! intent(in)
1005 0 : rho_ds_zt(i,:), invrs_rho_ds_zm(i,:), invrs_rho_ds_zt(i,:), & ! intent(in)
1006 0 : thv_ds_zm(i,:), thv_ds_zt(i,:), wpthlp_sfc(i), wprtp_sfc(i), upwp_sfc(i), & ! intent(in)
1007 : vpwp_sfc(i), um(i,:), upwp(i,:), vm(i,:), vpwp(i,:), up2(i,:), vp2(i,:), & ! intent(in)
1008 0 : rtm(i,:), wprtp(i,:), thlm(i,:), wpthlp(i,:), wp2(i,:), wp3(i,:), & ! intent(in)
1009 0 : rtp2(i,:), thlp2(i,:), rtpthlp(i,:), & ! intent(in)
1010 : !rcm, &
1011 : "beginning of ", & ! intent(in)
1012 0 : wpsclrp_sfc(i,:), wpedsclrp_sfc(i,:), sclrm(i,:,:), wpsclrp(i,:,:), sclrp2(i,:,:), & ! intent(in)
1013 0 : sclrprtp(i,:,:), sclrpthlp(i,:,:), sclrm_forcing(i,:,:), edsclrm(i,:,:), edsclrm_forcing(i,:,:) ) ! intent(in)
1014 :
1015 : end do
1016 :
1017 0 : if ( err_code == clubb_fatal_error ) then
1018 0 : write(fstderr,*) "Fatal error when testing input"
1019 0 : err_code_out = err_code
1020 : !return
1021 : end if
1022 :
1023 : end if
1024 : !-----------------------------------------------------------------------
1025 :
1026 352944 : if ( stats_metadata%l_stats_samp ) then
1027 :
1028 : !$acc update host( rfrzm, wp2, vp2, up2, wprtp, wpthlp, upwp, vpwp, &
1029 : !$acc rtp2, thlp2, rtpthlp, rtm, thlm, um, vm, wp3 )
1030 :
1031 0 : do i = 1, ngrdcol
1032 :
1033 0 : call stat_update_var( stats_metadata%irfrzm, rfrzm(i,:), & ! intent(in)
1034 0 : stats_zt(i) ) ! intent(inout)
1035 :
1036 : ! Set up budget stats variables.
1037 :
1038 : !print *, "B stats_zt(i)%accum_field_values", stats_zt(i)%accum_field_values
1039 : !print *, "wp2(i,:) = ", wp2(i,:)
1040 :
1041 0 : call stat_begin_update( nz, stats_metadata%iwp2_bt, wp2(i,:) / dt, & ! intent(in)
1042 0 : stats_zm(i) ) ! intent(inout)
1043 :
1044 : !print *, "A stats_zt(i)%accum_field_values", stats_zt(i)%accum_field_values
1045 :
1046 :
1047 0 : call stat_begin_update( nz, stats_metadata%ivp2_bt, vp2(i,:) / dt, & ! intent(in)
1048 0 : stats_zm(i) ) ! intent(inout)
1049 0 : call stat_begin_update( nz, stats_metadata%iup2_bt, up2(i,:) / dt, & ! intent(in)
1050 0 : stats_zm(i) ) ! intent(inout)
1051 0 : call stat_begin_update( nz, stats_metadata%iwprtp_bt, wprtp(i,:) / dt, & ! intent(in)
1052 0 : stats_zm(i) ) ! intent(inout)
1053 0 : call stat_begin_update( nz, stats_metadata%iwpthlp_bt, wpthlp(i,:) / dt, & ! intent(in)
1054 0 : stats_zm(i) ) ! intent(inout)
1055 0 : if ( clubb_config_flags%l_predict_upwp_vpwp ) then
1056 0 : call stat_begin_update( nz, stats_metadata%iupwp_bt, upwp(i,:) / dt, & ! intent(in)
1057 0 : stats_zm(i) ) ! intent(inout)
1058 0 : call stat_begin_update( nz, stats_metadata%ivpwp_bt, vpwp(i,:) / dt, & ! intent(in)
1059 0 : stats_zm(i) ) ! intent(inout)
1060 : endif ! l_predict_upwp_vpwp
1061 0 : call stat_begin_update( nz, stats_metadata%irtp2_bt, rtp2(i,:) / dt, & ! intent(in)
1062 0 : stats_zm(i) ) ! intent(inout)
1063 0 : call stat_begin_update( nz, stats_metadata%ithlp2_bt, thlp2(i,:) / dt, & ! intent(in)
1064 0 : stats_zm(i) ) ! intent(inout)
1065 0 : call stat_begin_update( nz, stats_metadata%irtpthlp_bt, rtpthlp(i,:) / dt, & ! intent(in)
1066 0 : stats_zm(i) ) ! intent(inout)
1067 :
1068 0 : call stat_begin_update( nz, stats_metadata%irtm_bt, rtm(i,:) / dt, & ! intent(in)
1069 0 : stats_zt(i) ) ! intent(inout)
1070 0 : call stat_begin_update( nz, stats_metadata%ithlm_bt, thlm(i,:) / dt, & ! intent(in)
1071 0 : stats_zt(i) ) ! intent(inout)
1072 0 : call stat_begin_update( nz, stats_metadata%ium_bt, um(i,:) / dt, & ! intent(in)
1073 0 : stats_zt(i) ) ! intent(inout)
1074 0 : call stat_begin_update( nz, stats_metadata%ivm_bt, vm(i,:) / dt, & ! intent(in)
1075 0 : stats_zt(i) ) ! intent(inout)
1076 0 : call stat_begin_update( nz, stats_metadata%iwp3_bt, wp3(i,:) / dt, & ! intent(in)
1077 0 : stats_zt(i) ) ! intent(inout)
1078 :
1079 : end do
1080 :
1081 : end if
1082 :
1083 : ! SET SURFACE VALUES OF FLUXES (BROUGHT IN)
1084 : ! We only do this for host models that do not apply the flux
1085 : ! elsewhere in the code (e.g. WRF). In other cases the _sfc variables will
1086 : ! only be used to compute the variance at the surface. -dschanen 8 Sept 2009
1087 352944 : if ( .not. l_host_applies_sfc_fluxes ) then
1088 :
1089 : !$acc parallel loop gang vector default(present)
1090 5893344 : do i = 1, ngrdcol
1091 5540400 : wpthlp(i,1) = wpthlp_sfc(i)
1092 5540400 : wprtp(i,1) = wprtp_sfc(i)
1093 5540400 : upwp(i,1) = upwp_sfc(i)
1094 5893344 : vpwp(i,1) = vpwp_sfc(i)
1095 : end do
1096 : !$acc end parallel loop
1097 :
1098 352944 : if ( clubb_config_flags%l_linearize_pbl_winds ) then
1099 : !$acc parallel loop gang vector default(present)
1100 0 : do i = 1, ngrdcol
1101 0 : upwp_pert(i,1) = upwp_sfc_pert(i)
1102 0 : vpwp_pert(i,1) = vpwp_sfc_pert(i)
1103 : end do
1104 : !$acc end parallel loop
1105 : endif ! l_linearize_pbl_winds
1106 :
1107 : ! Set fluxes for passive scalars (if enabled)
1108 352944 : if ( sclr_dim > 0 ) then
1109 : !$acc parallel loop gang vector collapse(2) default(present)
1110 0 : do j = 1, sclr_dim
1111 0 : do i = 1, ngrdcol
1112 0 : wpsclrp(i,1,j) = wpsclrp_sfc(i,j)
1113 : end do
1114 : end do
1115 : !$acc end parallel loop
1116 : end if
1117 :
1118 352944 : if ( edsclr_dim > 0 ) then
1119 : !$acc parallel loop gang vector collapse(2) default(present)
1120 8470656 : do j = 1, edsclr_dim
1121 135899856 : do i = 1, ngrdcol
1122 135546912 : wpedsclrp(i,1,j) = wpedsclrp_sfc(i,j)
1123 : end do
1124 : end do
1125 : !$acc end parallel loop
1126 : end if
1127 :
1128 : else
1129 :
1130 : !$acc parallel loop gang vector default(present)
1131 0 : do i = 1, ngrdcol
1132 0 : wpthlp(i,1) = 0.0_core_rknd
1133 0 : wprtp(i,1) = 0.0_core_rknd
1134 0 : upwp(i,1) = 0.0_core_rknd
1135 0 : vpwp(i,1) = 0.0_core_rknd
1136 : end do
1137 : !$acc end parallel loop
1138 :
1139 : ! Set fluxes for passive scalars (if enabled)
1140 0 : if ( sclr_dim > 0 ) then
1141 : !$acc parallel loop gang vector collapse(2) default(present)
1142 0 : do j = 1, edsclr_dim
1143 0 : do i = 1, ngrdcol
1144 0 : wpsclrp(i,1,j) = 0.0_core_rknd
1145 : end do
1146 : end do
1147 : !$acc end parallel loop
1148 : end if
1149 :
1150 0 : if ( edsclr_dim > 0 ) then
1151 : !$acc parallel loop gang vector collapse(2) default(present)
1152 0 : do j = 1, edsclr_dim
1153 0 : do i = 1, ngrdcol
1154 0 : wpedsclrp(i,1,j) = 0.0_core_rknd
1155 : end do
1156 : end do
1157 : !$acc end parallel loop
1158 : end if
1159 :
1160 : end if ! ~l_host_applies_sfc_fluxes
1161 :
1162 : #ifdef CLUBBND_CAM
1163 : !$acc parallel loop gang vector default(present)
1164 : do i = 1, ngrdcol
1165 : newmu(i) = varmu(i)
1166 : end do
1167 : !$acc end parallel loop
1168 : #else
1169 : !$acc parallel loop gang vector default(present)
1170 5893344 : do i = 1, ngrdcol
1171 5893344 : newmu(i) = mu
1172 : end do
1173 : !$acc end parallel loop
1174 : #endif
1175 :
1176 : if ( clubb_config_flags%ipdf_call_placement == ipdf_pre_advance_fields &
1177 352944 : .or. clubb_config_flags%ipdf_call_placement &
1178 : == ipdf_pre_post_advance_fields ) then
1179 :
1180 : ! Sample stats in this call to subroutine pdf_closure_driver for
1181 : ! both of these options (ipdf_pre_advance_fields and
1182 : ! ipdf_pre_post_advance_fields).
1183 0 : if ( clubb_config_flags%ipdf_call_placement &
1184 : == ipdf_pre_advance_fields ) then
1185 0 : l_samp_stats_in_pdf_call = .true.
1186 0 : elseif ( clubb_config_flags%ipdf_call_placement &
1187 : == ipdf_pre_post_advance_fields ) then
1188 0 : l_samp_stats_in_pdf_call = .true.
1189 : end if
1190 :
1191 : !########################################################################
1192 : !####### CALL CLUBB's PDF #######
1193 : !####### AND OUTPUT PDF PARAMETERS AND INTEGRATED QUANTITITES #######
1194 : !########################################################################
1195 : call pdf_closure_driver( gr, nz, ngrdcol, & ! Intent(in)
1196 : dt, hydromet_dim, wprtp, & ! Intent(in)
1197 : thlm, wpthlp, rtp2, rtp3, & ! Intent(in)
1198 : thlp2, thlp3, rtpthlp, wp2, & ! Intent(in)
1199 : wp3, wm_zm, wm_zt, & ! Intent(in)
1200 : um, up2, upwp, up3, & ! Intent(in)
1201 : vm, vp2, vpwp, vp3, & ! Intent(in)
1202 : p_in_Pa, exner, & ! Intent(in)
1203 : thv_ds_zm, thv_ds_zt, rtm_ref, & ! Intent(in)
1204 : ! rfrzm, hydromet, &
1205 : wphydrometp, & ! Intent(in)
1206 : wp2hmp, rtphmp_zt, thlphmp_zt, & ! Intent(in)
1207 : sclrm, wpsclrp, sclrp2, & ! Intent(in)
1208 : sclrprtp, sclrpthlp, sclrp3, & ! Intent(in)
1209 : l_samp_stats_in_pdf_call, & ! Intent(in)
1210 : clubb_params, & ! Intent(in)
1211 : clubb_config_flags%iiPDF_type, & ! Intent(in)
1212 : clubb_config_flags%l_predict_upwp_vpwp, & ! Intent(in)
1213 : clubb_config_flags%l_rtm_nudge, & ! Intent(in)
1214 : clubb_config_flags%l_trapezoidal_rule_zt, & ! Intent(in)
1215 : clubb_config_flags%l_trapezoidal_rule_zm, & ! Intent(in)
1216 : clubb_config_flags%l_call_pdf_closure_twice, & ! Intent(in)
1217 : clubb_config_flags%l_use_cloud_cover, & ! Intent(in)
1218 : clubb_config_flags%l_rcm_supersat_adj, & ! Intent(in)
1219 : stats_metadata, & ! Intent(in)
1220 : stats_zt, stats_zm, & ! Intent(inout)
1221 : rtm, & ! Intent(inout)
1222 : pdf_implicit_coefs_terms, & ! Intent(inout)
1223 : pdf_params, pdf_params_zm, & ! Intent(inout)
1224 : #ifdef GFDL
1225 : RH_crit(k, : , :), & ! Intent(inout)
1226 : do_liquid_only_in_clubb, & ! Intent(in)
1227 : #endif
1228 : rcm, cloud_frac, & ! Intent(out)
1229 : ice_supersat_frac, wprcp, & ! Intent(out)
1230 : sigma_sqd_w, wpthvp, wp2thvp, & ! Intent(out)
1231 : rtpthvp, thlpthvp, rc_coef, & ! Intent(out)
1232 : rcm_in_layer, cloud_cover, & ! Intent(out)
1233 : rcp2_zt, thlprcp, & ! Intent(out)
1234 : rc_coef_zm, sclrpthvp, & ! Intent(out)
1235 : wpup2, wpvp2, & ! Intent(out)
1236 : wp2up2, wp2vp2, wp4, & ! Intent(out)
1237 : wp2rtp, wprtp2, wp2thlp, & ! Intent(out)
1238 : wpthlp2, wprtpthlp, wp2rcp, & ! Intent(out)
1239 : rtprcp, rcp2, & ! Intent(out)
1240 : uprcp, vprcp, & ! Intent(out)
1241 : w_up_in_cloud, w_down_in_cloud, & ! Intent(out)
1242 : cloudy_updraft_frac, & ! Intent(out)
1243 : cloudy_downdraft_frac, & ! intent(out)
1244 : Skw_velocity, & ! Intent(out)
1245 : cloud_frac_zm, & ! Intent(out)
1246 : ice_supersat_frac_zm, & ! Intent(out)
1247 : rtm_zm, thlm_zm, rcm_zm, & ! Intent(out)
1248 : rcm_supersat_adj, & ! Intent(out)
1249 : wp2sclrp, wpsclrp2, sclrprcp, & ! Intent(out)
1250 0 : wpsclrprtp, wpsclrpthlp ) ! Intent(out)
1251 :
1252 : endif ! clubb_config_flags%ipdf_call_placement == ipdf_pre_advance_fields
1253 : ! or clubb_config_flags%ipdf_call_placement
1254 : ! == ipdf_pre_post_advance_fields
1255 :
1256 : ! Interpolate wp3 to momentum levels, and wp2 to thermodynamic levels
1257 : ! and then compute Skw for m & t grid.
1258 352944 : wp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, wp2(:,:) ) ! Positive definite quantity
1259 352944 : wp3_zm(:,:) = zt2zm( nz, ngrdcol, gr, wp3(:,:) )
1260 :
1261 : !$acc parallel loop gang vector collapse(2) default(present)
1262 30353184 : do k = 1, nz
1263 501287184 : do i = 1, ngrdcol
1264 500934240 : wp2_zt(i,k) = max( wp2_zt(i,k), w_tol_sqd )
1265 : end do
1266 : end do
1267 : !$acc end parallel loop
1268 :
1269 352944 : beta = clubb_params(ibeta)
1270 352944 : Skw_denom_coef = clubb_params(iSkw_denom_coef)
1271 352944 : Skw_max_mag = clubb_params(iSkw_max_mag)
1272 :
1273 : call Skx_func( nz, ngrdcol, wp2_zt, wp3, &
1274 : w_tol, Skw_denom_coef, Skw_max_mag, &
1275 352944 : Skw_zt )
1276 :
1277 : call Skx_func( nz, ngrdcol, wp2, wp3_zm, &
1278 : w_tol, Skw_denom_coef, Skw_max_mag, &
1279 352944 : Skw_zm )
1280 :
1281 352944 : if ( clubb_config_flags%ipdf_call_placement &
1282 : == ipdf_post_advance_fields ) then
1283 :
1284 352944 : gamma_coef = clubb_params(igamma_coef)
1285 352944 : gamma_coefb = clubb_params(igamma_coefb)
1286 352944 : gamma_coefc = clubb_params(igamma_coefc)
1287 :
1288 : ! Calculate sigma_sqd_w here in order to avoid having to pass it in
1289 : ! and out of subroutine advance_clubb_core.
1290 352944 : if ( l_gamma_Skw .and. &
1291 : abs(gamma_coef-gamma_coefb) > abs(gamma_coef+gamma_coefb)*eps/2) then
1292 :
1293 : !$acc parallel loop gang vector collapse(2) default(present)
1294 0 : do k = 1, nz
1295 0 : do i = 1, ngrdcol
1296 0 : gamma_Skw_fnc(i,k) = gamma_coefb + (gamma_coef-gamma_coefb) &
1297 0 : *exp( -(1.0_core_rknd/2.0_core_rknd) * (Skw_zm(i,k)/gamma_coefc)**2 )
1298 : end do
1299 : end do
1300 : !$acc end parallel loop
1301 : else
1302 : !$acc parallel loop gang vector collapse(2) default(present)
1303 30353184 : do k = 1, nz
1304 501287184 : do i = 1, ngrdcol
1305 500934240 : gamma_Skw_fnc(i,k) = gamma_coef
1306 : end do
1307 : end do
1308 : !$acc end parallel loop
1309 : endif
1310 :
1311 : ! Compute sigma_sqd_w (dimensionless PDF width parameter)
1312 : call compute_sigma_sqd_w( nz, ngrdcol, &
1313 : gamma_Skw_fnc, wp2, thlp2, rtp2, &
1314 : up2, vp2, wpthlp, wprtp, upwp, vpwp, &
1315 : clubb_config_flags%l_predict_upwp_vpwp, &
1316 352944 : sigma_sqd_w_tmp )
1317 :
1318 : ! Smooth in the vertical using interpolation
1319 352944 : sigma_sqd_w(:,:) = zm2zt2zm( nz, ngrdcol, gr, sigma_sqd_w_tmp(:,:) )
1320 :
1321 : !$acc parallel loop gang vector collapse(2) default(present)
1322 30353184 : do k = 1, nz
1323 501287184 : do i = 1, ngrdcol
1324 500934240 : sigma_sqd_w(i,k) = max( zero_threshold, sigma_sqd_w(i,k) ) ! Pos. def. quantity
1325 : end do
1326 : end do
1327 : !$acc end parallel loop
1328 :
1329 : endif ! clubb_config_flags%ipdf_call_placement == ipdf_post_advance_fields
1330 :
1331 :
1332 : ! Compute the a3 coefficient (formula 25 in `Equations for CLUBB')
1333 : ! Note: a3 has been modified because the wp3 turbulent advection term is
1334 : ! now discretized on its own. This removes the "- 3" from the end.
1335 : ! a3_coef = 3.0_core_rknd * sigma_sqd_w*sigma_sqd_w &
1336 : ! + 6.0_core_rknd*(1.0_core_rknd-sigma_sqd_w)*sigma_sqd_w &
1337 : ! + (1.0_core_rknd-sigma_sqd_w)*(1.0_core_rknd-sigma_sqd_w)
1338 :
1339 : ! This is a simplified version of the formula above.
1340 : ! Note: a3 has been modified because the wp3 turbulent advection term is
1341 : ! now discretized on its own.
1342 : !$acc parallel loop gang vector collapse(2) default(present)
1343 30353184 : do k = 1, nz
1344 501287184 : do i = 1, ngrdcol
1345 500934240 : a3_coef(i,k) = -2._core_rknd * ( 1._core_rknd - sigma_sqd_w(i,k) )**2 + 3.0_core_rknd
1346 : end do
1347 : end do
1348 : !$acc end parallel loop
1349 :
1350 : ! We found we obtain fewer spikes in wp3 when we clip a3 to be no greater
1351 : ! than -1.4 -dschanen 4 Jan 2011
1352 : !a3_coef = max( a3_coef, -1.4_core_rknd ) ! Known magic number
1353 : !$acc parallel loop gang vector collapse(2) default(present)
1354 30353184 : do k = 1, nz
1355 501287184 : do i = 1, ngrdcol
1356 500934240 : a3_coef(i,k) = max( a3_coef(i,k), a3_coef_min )
1357 : end do
1358 : end do
1359 : !$acc end parallel loop
1360 :
1361 352944 : a3_coef_zt(:,:) = zm2zt( nz, ngrdcol, gr, a3_coef(:,:) )
1362 :
1363 : ! Interpolate thlp2, rtp2, and rtpthlp to thermodynamic levels.
1364 352944 : thlp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, thlp2(:,:) ) ! Positive def. quantity
1365 352944 : rtp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, rtp2(:,:) ) ! Positive def. quantity
1366 352944 : rtpthlp_zt(:,:) = zm2zt( nz, ngrdcol, gr, rtpthlp(:,:) )
1367 :
1368 : !$acc parallel loop gang vector collapse(2) default(present)
1369 30353184 : do k = 1, nz
1370 501287184 : do i = 1, ngrdcol
1371 470934000 : thlp2_zt(i,k) = max( thlp2_zt(i,k), thl_tol**2 )
1372 500934240 : rtp2_zt(i,k) = max( rtp2_zt(i,k), rt_tol**2 )
1373 : end do
1374 : end do
1375 : !$acc end parallel loop
1376 :
1377 : ! Compute wp3 / wp2 on zt levels. Always use the interpolated value in the
1378 : ! denominator since it's less likely to create spikes
1379 : !$acc parallel loop gang vector collapse(2) default(present)
1380 30353184 : do k = 1, nz
1381 501287184 : do i = 1, ngrdcol
1382 500934240 : wp3_on_wp2_zt(i,k) = ( wp3(i,k) / max( wp2_zt(i,k), w_tol_sqd ) )
1383 : end do
1384 : end do
1385 : !$acc end parallel loop
1386 :
1387 : ! Clip wp3_on_wp2_zt if it's too large
1388 : !$acc parallel loop gang vector collapse(2) default(present)
1389 30353184 : do k = 1, nz
1390 501287184 : do i = 1, ngrdcol
1391 500934240 : if( wp3_on_wp2_zt(i,k) < 0._core_rknd ) then
1392 363004642 : wp3_on_wp2_zt(i,k) = max( -1000._core_rknd, wp3_on_wp2_zt(i,k) )
1393 : else
1394 107929358 : wp3_on_wp2_zt(i,k) = min( 1000._core_rknd, wp3_on_wp2_zt(i,k) )
1395 : end if
1396 : end do
1397 : end do
1398 : !$acc end parallel loop
1399 :
1400 : ! Compute wp3_on_wp2 by interpolating wp3_on_wp2_zt
1401 352944 : wp3_on_wp2(:,:) = zt2zm( nz, ngrdcol, gr, wp3_on_wp2_zt(:,:) )
1402 :
1403 : ! Smooth again as above
1404 352944 : wp3_on_wp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, wp3_on_wp2(:,:) )
1405 :
1406 : !----------------------------------------------------------------
1407 : ! Compute thvm
1408 : !----------------------------------------------------------------
1409 : call calculate_thvm( nz, ngrdcol, &
1410 : thlm, rtm, rcm, exner, thv_ds_zt, &
1411 352944 : thvm )
1412 :
1413 : !----------------------------------------------------------------
1414 : ! Compute tke (turbulent kinetic energy)
1415 : !----------------------------------------------------------------
1416 352944 : if ( .not. clubb_config_flags%l_tke_aniso ) then
1417 : ! tke is assumed to be 3/2 of wp2
1418 : !$acc parallel loop gang vector collapse(2) default(present)
1419 0 : do k = 1, nz
1420 0 : do i = 1, ngrdcol
1421 0 : em(i,k) = three_halves * wp2(i,k)
1422 : end do
1423 : end do
1424 : !$acc end parallel loop
1425 : else
1426 : !$acc parallel loop gang vector collapse(2) default(present)
1427 30353184 : do k = 1, nz
1428 501287184 : do i = 1, ngrdcol
1429 500934240 : em(i,k) = 0.5_core_rknd * ( wp2(i,k) + vp2(i,k) + up2(i,k) )
1430 : end do
1431 : end do
1432 : !$acc end parallel loop
1433 : end if
1434 :
1435 352944 : sqrt_em_zt(:,:) = zm2zt( nz, ngrdcol, gr, em(:,:) )
1436 :
1437 : !$acc parallel loop gang vector collapse(2) default(present)
1438 30353184 : do k = 1, nz
1439 501287184 : do i = 1, ngrdcol
1440 500934240 : sqrt_em_zt(i,k) = sqrt( max( em_min, sqrt_em_zt(i,k) ) )
1441 : end do
1442 : end do
1443 : !$acc end parallel loop
1444 :
1445 : !----------------------------------------------------------------
1446 : ! Compute mixing length and dissipation time
1447 : !----------------------------------------------------------------
1448 :
1449 352944 : if ( .not. clubb_config_flags%l_diag_Lscale_from_tau ) then ! compute Lscale 1st, using
1450 : ! buoyant parcel calc
1451 : call calc_Lscale_directly ( ngrdcol, nz, gr, & ! intent(in)
1452 : l_implemented, p_in_Pa, & ! intent(in)
1453 : exner, rtm, thlm, thvm, & ! intent(in)
1454 : newmu, rtp2, thlp2, rtpthlp, pdf_params, em, & ! intent(in)
1455 : thv_ds_zt, Lscale_max, lmin, & ! intent(in)
1456 : clubb_params, & ! intent(in)
1457 : clubb_config_flags%l_Lscale_plume_centered, & ! intent(in)
1458 : stats_metadata, & ! intent(in)
1459 : stats_zt, & ! intent(inout)
1460 352944 : Lscale, Lscale_up, Lscale_down ) ! intent(out)
1461 :
1462 352944 : if ( clubb_at_least_debug_level( 0 ) ) then
1463 352944 : if ( err_code == clubb_fatal_error ) then
1464 0 : err_code_out = err_code
1465 0 : write(fstderr,*) "Error calling calc_Lscale_directly"
1466 : !return
1467 : end if
1468 : end if
1469 :
1470 : ! Calculate CLUBB's turbulent eddy-turnover time scale as
1471 : ! CLUBB's length scale divided by a velocity scale.
1472 352944 : taumax = clubb_params(itaumax)
1473 :
1474 : !$acc parallel loop gang vector collapse(2) default(present)
1475 30353184 : do k = 1, nz
1476 501287184 : do i = 1, ngrdcol
1477 500934240 : tau_zt(i,k) = min( Lscale(i,k) / sqrt_em_zt(i,k), taumax )
1478 : end do
1479 : end do
1480 : !$acc end parallel loop
1481 :
1482 352944 : tau_zm(:,:) = zt2zm( nz, ngrdcol, gr, Lscale(:,:) )
1483 :
1484 : !$acc parallel loop gang vector collapse(2) default(present)
1485 30353184 : do k = 1, nz
1486 501287184 : do i = 1, ngrdcol
1487 941868000 : tau_zm(i,k) = min( ( max( tau_zm(i,k), zero_threshold ) &
1488 1442802240 : / sqrt( max( em_min, em(i,k) ) ) ), taumax )
1489 : end do
1490 : end do
1491 : !$acc end parallel loop
1492 :
1493 : !$acc parallel loop gang vector collapse(2) default(present)
1494 30353184 : do k = 1, nz
1495 501287184 : do i = 1, ngrdcol
1496 470934000 : invrs_tau_zm(i,k) = one / tau_zm(i,k)
1497 470934000 : invrs_tau_zt(i,k) = one / tau_zt(i,k)
1498 470934000 : invrs_tau_wp2_zm(i,k) = invrs_tau_zm(i,k)
1499 470934000 : invrs_tau_xp2_zm(i,k) = invrs_tau_zm(i,k)
1500 470934000 : invrs_tau_wpxp_zm(i,k) = invrs_tau_zm(i,k)
1501 470934000 : invrs_tau_wp3_zt(i,k) = invrs_tau_zt(i,k)
1502 470934000 : invrs_tau_wp3_zm(i,k) = invrs_tau_zm(i,k)
1503 :
1504 470934000 : tau_max_zm(i,k) = taumax
1505 500934240 : tau_max_zt(i,k) = taumax
1506 : end do
1507 : end do
1508 : !$acc end parallel loop
1509 :
1510 : ! End Vince Larson's replacement.
1511 :
1512 : call calc_brunt_vaisala_freq_sqd( nz, ngrdcol, gr, thlm, & ! In
1513 : exner, rtm, rcm, p_in_Pa, thvm, & ! In
1514 : ice_supersat_frac, & ! In
1515 : clubb_config_flags%l_brunt_vaisala_freq_moist, & ! In
1516 : clubb_config_flags%l_use_thvm_in_bv_freq, & ! In
1517 : clubb_params(ibv_efold), & ! In
1518 : brunt_vaisala_freq_sqd, & ! Out
1519 : brunt_vaisala_freq_sqd_mixed, & ! Out
1520 : brunt_vaisala_freq_sqd_dry, & ! Out
1521 352944 : brunt_vaisala_freq_sqd_moist ) ! Out
1522 :
1523 : else ! l_diag_Lscale_from_tau = .true., diagnose simple tau and Lscale.
1524 :
1525 : call diagnose_Lscale_from_tau( nz, ngrdcol, gr, & ! In
1526 : upwp_sfc, vpwp_sfc, um, vm, & ! In
1527 : exner, p_in_Pa, & ! In
1528 : rtm, thlm, thvm, & ! In
1529 : rcm, ice_supersat_frac, & ! In
1530 : em, sqrt_em_zt, & ! In
1531 : ufmin, tau_const, & ! In
1532 : sfc_elevation, Lscale_max, & ! In
1533 : clubb_params, & ! In
1534 : clubb_config_flags%l_e3sm_config, & ! In
1535 : clubb_config_flags%l_brunt_vaisala_freq_moist, & ! In
1536 : clubb_config_flags%l_use_thvm_in_bv_freq, & ! In
1537 : clubb_config_flags%l_smooth_Heaviside_tau_wpxp, & ! In
1538 : clubb_config_flags%l_modify_limiters_for_cnvg_test, & ! In
1539 : brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, & ! Out
1540 : brunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_moist, & ! Out
1541 : Ri_zm, & ! Out
1542 : invrs_tau_zt, invrs_tau_zm, & ! Out
1543 : invrs_tau_sfc, invrs_tau_no_N2_zm, invrs_tau_bkgnd, & ! Out
1544 : invrs_tau_shear, invrs_tau_N2_iso, & ! Out
1545 : invrs_tau_wp2_zm, invrs_tau_xp2_zm, & ! Out
1546 : invrs_tau_wp3_zm, invrs_tau_wp3_zt, invrs_tau_wpxp_zm, & ! Out
1547 : tau_max_zm, tau_max_zt, tau_zm, tau_zt, & ! Out
1548 0 : Lscale, Lscale_up, Lscale_down ) ! Out
1549 : end if ! l_diag_Lscale_from_tau
1550 :
1551 :
1552 :
1553 : ! Modification to damp noise in stable region
1554 : ! Vince Larson commented out because it may prevent turbulence from
1555 : ! initiating in unstable regions. 7 Jul 2007
1556 : ! do k = 1, nz
1557 : ! if ( wp2(k) <= 0.005_core_rknd ) then
1558 : ! tau_zt(k) = taumin
1559 : ! tau_zm(k) = taumin
1560 : ! end if
1561 : ! end do
1562 : ! End Vince Larson's commenting.
1563 :
1564 : !----------------------------------------------------------------
1565 : ! Eddy diffusivity coefficient
1566 : !----------------------------------------------------------------
1567 : ! c_K is 0.548 usually (Duynkerke and Driedonks 1987)
1568 : ! CLUBB uses a smaller value to better fit empirical data.
1569 :
1570 : ! Calculate CLUBB's eddy diffusivity as
1571 : ! CLUBB's length scale times a velocity scale.
1572 352944 : c_K = clubb_params(ic_K)
1573 :
1574 : !$acc parallel loop gang vector collapse(2) default(present)
1575 30353184 : do k = 1, nz
1576 501287184 : do i = 1, ngrdcol
1577 500934240 : Kh_zt(i,k) = c_K * Lscale(i,k) * sqrt_em_zt(i,k)
1578 : end do
1579 : end do
1580 : !$acc end parallel loop
1581 :
1582 352944 : Lscale_zm(:,:) = zt2zm( nz, ngrdcol, gr, Lscale(:,:) )
1583 :
1584 : !$acc parallel loop gang vector collapse(2) default(present)
1585 30353184 : do k = 1, nz
1586 501287184 : do i = 1, ngrdcol
1587 941868000 : Kh_zm(i,k) = c_K * max( Lscale_zm(i,k), zero_threshold ) &
1588 1442802240 : * sqrt( max( em(i,k), em_min ) )
1589 : end do
1590 : end do
1591 : !$acc end parallel loop
1592 :
1593 : ! calculate Brunt-Vaisala frequency used for splatting
1594 : brunt_vaisala_freq_sqd_splat &
1595 : = Lscale_width_vert_avg( nz, ngrdcol, gr, smth_type, &
1596 : brunt_vaisala_freq_sqd_mixed, Lscale, rho_ds_zm, &
1597 352944 : below_grnd_val )
1598 :
1599 : ! Vertical compression of eddies causes gustiness (increase in up2 and vp2)
1600 : call wp2_term_splat_lhs( nz, ngrdcol, gr, clubb_params(iC_wp2_splat), & ! Intent(in)
1601 : brunt_vaisala_freq_sqd_splat, & ! Intent(in)
1602 352944 : lhs_splat_wp2 ) ! Intent(out)
1603 :
1604 : ! Vertical compression of eddies also diminishes w'3
1605 : call wp3_term_splat_lhs( nz, ngrdcol, gr, clubb_params(iC_wp2_splat), & ! Intent(in)
1606 : brunt_vaisala_freq_sqd_splat, & ! Intent(in)
1607 352944 : lhs_splat_wp3 ) ! Intent(out)
1608 :
1609 : !----------------------------------------------------------------
1610 : ! Set Surface variances
1611 : !----------------------------------------------------------------
1612 : ! Surface variances should be set here, before the call to either
1613 : ! advance_xp2_xpyp or advance_wp2_wp3.
1614 : ! Surface effects should not be included with any case where the lowest
1615 : ! level is not the ground level. Brian Griffin. December 22, 2005.
1616 :
1617 : ! Diagnose surface variances based on surface fluxes.
1618 : call calc_sfc_varnce( nz, ngrdcol, gr, dt, sfc_elevation, & ! Intent(in)
1619 : upwp_sfc, vpwp_sfc, wpthlp, wprtp_sfc, & ! Intent(in)
1620 : um, vm, Lscale_up, wpsclrp_sfc, & ! Intent(in)
1621 : lhs_splat_wp2, tau_zm, & ! Intent(in)
1622 : !wp2_splat, tau_zm, & ! Intent(in)
1623 : clubb_config_flags%l_vary_convect_depth, & ! Intent(in)
1624 : clubb_params, & ! Intent(in)
1625 : stats_metadata, & ! Intent(in)
1626 : stats_zm, & ! Intent(inout)
1627 : wp2, up2, vp2, & ! Intent(inout)
1628 : thlp2, rtp2, rtpthlp, & ! Intent(inout)
1629 352944 : sclrp2, sclrprtp, sclrpthlp ) ! Intent(inout)
1630 :
1631 352944 : if ( clubb_at_least_debug_level( 0 ) ) then
1632 352944 : if ( err_code == clubb_fatal_error ) then
1633 0 : err_code_out = err_code
1634 0 : write(fstderr, *) "Error calling calc_sfc_varnce"
1635 : !return
1636 : end if
1637 : end if
1638 :
1639 : !#######################################################################
1640 : !############## ADVANCE PROGNOSTIC VARIABLES ONE TIMESTEP ##############
1641 : !#######################################################################
1642 :
1643 352944 : if ( stats_metadata%l_stats_samp ) then
1644 :
1645 : !$acc update host( rtm, rcm, thlm, exner, p_in_Pa )
1646 :
1647 0 : do i = 1, ngrdcol
1648 0 : call stat_update_var( stats_metadata%irvm, rtm(i,:) - rcm(i,:), & !intent(in)
1649 0 : stats_zt(i) ) !intent(inout)
1650 : end do
1651 :
1652 : ! Output relative humidity (q/q∗ where q∗ is the saturation mixing ratio over liquid)
1653 : ! Added an extra check for stats_metadata%irel_humidity > 0; otherwise, if both stats_metadata%irsat = 0 and
1654 : ! stats_metadata%irel_humidity = 0, rsat is not computed, leading to a floating-point exception
1655 : ! when stat_update_var is called for rel_humidity. ldgrant
1656 0 : if ( stats_metadata%irel_humidity > 0 ) then
1657 :
1658 : rsat = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, &
1659 0 : thlm2T_in_K( nz, ngrdcol, thlm, exner, rcm ) )
1660 :
1661 : ! Recompute rsat and rel_humidity. They might have changed.
1662 0 : do i = 1, ngrdcol
1663 0 : rel_humidity(i,:) = (rtm(i,:) - rcm(i,:)) / rsat(i,:)
1664 :
1665 : call stat_update_var( stats_metadata%irel_humidity, rel_humidity(i,:), & ! intent(in)
1666 0 : stats_zt(i)) ! intent(inout)
1667 : end do
1668 : end if ! stats_metadata%irel_humidity > 0
1669 : end if ! stats_metadata%l_stats_samp
1670 :
1671 : !----------------------------------------------------------------
1672 : ! Advance rtm/wprtp and thlm/wpthlp one time step
1673 : !----------------------------------------------------------------
1674 352944 : if ( clubb_config_flags%l_call_pdf_closure_twice ) then
1675 : !$acc parallel loop gang vector collapse(2) default(present)
1676 30353184 : do k = 1, nz
1677 501287184 : do i = 1, ngrdcol
1678 470934000 : w_1_zm(i,k) = pdf_params_zm%w_1(i,k)
1679 470934000 : w_2_zm(i,k) = pdf_params_zm%w_2(i,k)
1680 470934000 : varnce_w_1_zm(i,k) = pdf_params_zm%varnce_w_1(i,k)
1681 470934000 : varnce_w_2_zm(i,k) = pdf_params_zm%varnce_w_2(i,k)
1682 500934240 : mixt_frac_zm(i,k) = pdf_params_zm%mixt_frac(i,k)
1683 : end do
1684 : end do
1685 : !$acc end parallel loop
1686 : else
1687 0 : w_1_zm(:,:) = zt2zm( nz, ngrdcol, gr, pdf_params%w_1(:,:) )
1688 0 : w_2_zm(:,:) = zt2zm( nz, ngrdcol, gr, pdf_params%w_2(:,:) )
1689 0 : varnce_w_1_zm(:,:) = zt2zm( nz, ngrdcol, gr, pdf_params%varnce_w_1(:,:) )
1690 0 : varnce_w_2_zm(:,:) = zt2zm( nz, ngrdcol, gr, pdf_params%varnce_w_2(:,:) )
1691 0 : mixt_frac_zm(:,:) = zt2zm( nz, ngrdcol, gr, pdf_params%mixt_frac(:,:) )
1692 : end if
1693 :
1694 : ! Here we determine if we're using tau_zm or tau_N2_zm, which is tau
1695 : ! that has been stability corrected for stably stratified regions.
1696 : ! -dschanen 7 Nov 2014
1697 352944 : if ( clubb_config_flags%l_stability_correct_tau_zm ) then
1698 :
1699 : ! Determine stability correction factor
1700 : call calc_stability_correction( nz, ngrdcol, gr, & ! In
1701 : thlm, Lscale, em, & ! In
1702 : exner, rtm, rcm, & ! In
1703 : p_in_Pa, thvm, ice_supersat_frac, & ! In
1704 : clubb_params(ilambda0_stability_coef), & ! In
1705 : clubb_params(ibv_efold), & ! In
1706 : clubb_config_flags%l_brunt_vaisala_freq_moist, & ! In
1707 : clubb_config_flags%l_use_thvm_in_bv_freq, & ! In
1708 352944 : stability_correction ) ! Out
1709 :
1710 352944 : if ( stats_metadata%l_stats_samp ) then
1711 : !$acc update host( stability_correction )
1712 0 : do i = 1, ngrdcol
1713 0 : call stat_update_var( stats_metadata%istability_correction, stability_correction(i,:), & ! In
1714 0 : stats_zm(i) ) ! In/Out
1715 : end do
1716 : end if
1717 :
1718 : ! Determine the static stability corrected version of tau_zm
1719 : ! Create a damping time scale that is more strongly damped at the
1720 : ! altitudes where the Brunt-Vaisala frequency (N^2) is large.
1721 : !$acc parallel loop gang vector collapse(2) default(present)
1722 30353184 : do k = 1, nz
1723 501287184 : do i = 1, ngrdcol
1724 470934000 : invrs_tau_N2_zm(i,k) = invrs_tau_zm(i,k) * stability_correction(i,k)
1725 470934000 : invrs_tau_C6_zm(i,k) = invrs_tau_N2_zm(i,k)
1726 500934240 : invrs_tau_C1_zm(i,k) = invrs_tau_N2_zm(i,k)
1727 : end do
1728 : end do
1729 : !$acc end parallel loop
1730 : else
1731 : !$acc parallel loop gang vector collapse(2) default(present)
1732 0 : do k = 1, nz
1733 0 : do i = 1, ngrdcol
1734 0 : invrs_tau_N2_zm(i,k) = unused_var
1735 0 : invrs_tau_C6_zm(i,k) = invrs_tau_wpxp_zm(i,k)
1736 0 : invrs_tau_C1_zm(i,k) = invrs_tau_wp2_zm(i,k)
1737 : end do
1738 : end do
1739 : !$acc end parallel loop
1740 : end if ! l_stability_correction
1741 :
1742 : ! Set invrs_tau variables for C4 and C14
1743 : !$acc parallel loop gang vector collapse(2) default(present)
1744 30353184 : do k = 1, nz
1745 501287184 : do i = 1, ngrdcol
1746 500934240 : invrs_tau_C14_zm(i,k) = invrs_tau_wp2_zm(i,k)
1747 : end do
1748 : end do
1749 : !$acc end parallel loop
1750 :
1751 : if ( .not. clubb_config_flags%l_diag_Lscale_from_tau .and. l_use_invrs_tau_N2_iso) then
1752 : write(fstderr,*) "Error! l_use_invrs_tau_N2_iso is not used when "// &
1753 : "l_diag_Lscale_from_tau=false."// &
1754 : "If you want to use Lscale code, go to file "// &
1755 : "src/CLUBB_core/advance_clubb_core_module.F90 and "// &
1756 : "change l_use_invrs_tau_N2_iso to false"
1757 : error stop
1758 : end if
1759 :
1760 : if ( .not. l_use_invrs_tau_N2_iso ) then
1761 : !$acc parallel loop gang vector collapse(2) default(present)
1762 30353184 : do k = 1, nz
1763 501287184 : do i = 1, ngrdcol
1764 500934240 : invrs_tau_C4_zm(i,k) = invrs_tau_wp2_zm(i,k)
1765 : end do
1766 : end do
1767 : !$acc end parallel loop
1768 : else
1769 : !$acc parallel loop gang vector collapse(2) default(present)
1770 : do k = 1, nz
1771 : do i = 1, ngrdcol
1772 : invrs_tau_C4_zm(i,k) = invrs_tau_N2_iso(i,k)
1773 : end do
1774 : end do
1775 : !$acc end parallel loop
1776 : end if
1777 :
1778 352944 : if ( stats_metadata%l_stats_samp ) then
1779 :
1780 : !$acc update host( invrs_tau_zm, invrs_tau_xp2_zm, invrs_tau_wp2_zm, invrs_tau_wpxp_zm, &
1781 : !$acc Ri_zm, invrs_tau_wp3_zm, invrs_tau_no_N2_zm, invrs_tau_bkgnd, &
1782 : !$acc invrs_tau_sfc, invrs_tau_shear, brunt_vaisala_freq_sqd, &
1783 : !$acc brunt_vaisala_freq_sqd_splat, brunt_vaisala_freq_sqd_mixed, &
1784 : !$acc brunt_vaisala_freq_sqd_moist, brunt_vaisala_freq_sqd_dry )
1785 :
1786 0 : do i = 1, ngrdcol
1787 :
1788 0 : call stat_update_var(stats_metadata%iinvrs_tau_zm, invrs_tau_zm(i,:), & ! intent(in)
1789 0 : stats_zm(i)) ! intent(inout)
1790 0 : call stat_update_var(stats_metadata%iinvrs_tau_xp2_zm, invrs_tau_xp2_zm(i,:), & ! intent(in)
1791 0 : stats_zm(i)) ! intent(inout)
1792 0 : call stat_update_var(stats_metadata%iinvrs_tau_wp2_zm, invrs_tau_wp2_zm(i,:), & ! intent(in)
1793 0 : stats_zm(i)) ! intent(inout)
1794 0 : call stat_update_var(stats_metadata%iinvrs_tau_wpxp_zm, invrs_tau_wpxp_zm(i,:), & ! intent(in)
1795 0 : stats_zm(i)) ! intent(inout)
1796 0 : call stat_update_var(stats_metadata%iRi_zm, Ri_zm(i,:), & ! intent(in)
1797 0 : stats_zm(i)) ! intent(inout)
1798 0 : call stat_update_var(stats_metadata%iinvrs_tau_wp3_zm, invrs_tau_wp3_zm(i,:), & ! intent(in)
1799 0 : stats_zm(i)) ! intent(inout)
1800 :
1801 0 : if ( clubb_config_flags%l_diag_Lscale_from_tau ) then
1802 0 : call stat_update_var(stats_metadata%iinvrs_tau_no_N2_zm, invrs_tau_no_N2_zm(i,:), & ! intent(in)
1803 0 : stats_zm(i)) ! intent(inout)
1804 0 : call stat_update_var(stats_metadata%iinvrs_tau_bkgnd, invrs_tau_bkgnd(i,:), & ! intent(in)
1805 0 : stats_zm(i)) ! intent(inout)
1806 0 : call stat_update_var(stats_metadata%iinvrs_tau_sfc, invrs_tau_sfc(i,:), & ! intent(in)
1807 0 : stats_zm(i)) ! intent(inout)
1808 0 : call stat_update_var(stats_metadata%iinvrs_tau_shear, invrs_tau_shear(i,:), & ! intent(in)
1809 0 : stats_zm(i)) ! intent(inout)
1810 : end if
1811 0 : call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd(i,:), & ! intent(in)
1812 0 : stats_zm(i))
1813 0 : call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd_splat, brunt_vaisala_freq_sqd_splat(i,:), & ! intent(in)
1814 0 : stats_zm(i)) ! intent(inout)
1815 0 : call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd_mixed, brunt_vaisala_freq_sqd_mixed(i,:), & ! intent(in)
1816 0 : stats_zm(i)) ! intent(inout)
1817 0 : call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd_moist, brunt_vaisala_freq_sqd_moist(i,:), & ! intent(in)
1818 0 : stats_zm(i)) ! intent(inout)
1819 0 : call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_dry(i,:), & ! intent(in)
1820 0 : stats_zm(i)) ! intent(inout)
1821 : end do
1822 : end if
1823 :
1824 : ! Cx_fnc_Richardson is only used if one of these flags is true,
1825 : ! otherwise its value is irrelevant, set it to 0 to avoid NaN problems
1826 352944 : if ( clubb_config_flags%l_use_C7_Richardson .or. &
1827 : clubb_config_flags%l_use_C11_Richardson ) then
1828 :
1829 : call compute_Cx_fnc_Richardson( nz, ngrdcol, gr, & ! intent(in)
1830 : thlm, um, vm, em, Lscale, exner, rtm, & ! intent(in)
1831 : rcm, p_in_Pa, thvm, rho_ds_zm, & ! intent(in)
1832 : ice_supersat_frac, & ! intent(in)
1833 : clubb_params, & ! intent(in)
1834 : clubb_config_flags%l_brunt_vaisala_freq_moist, & ! intent(in)
1835 : clubb_config_flags%l_use_thvm_in_bv_freq, & ! intent(in
1836 : clubb_config_flags%l_use_shear_Richardson, & ! intent(in)
1837 : clubb_config_flags%l_modify_limiters_for_cnvg_test, & ! intent(in)
1838 : stats_metadata, & ! intent(in)
1839 : stats_zm, & ! intent(inout)
1840 0 : Cx_fnc_Richardson ) ! intent(out)
1841 : else
1842 : !$acc parallel loop gang vector collapse(2) default(present)
1843 30353184 : do k = 1, nz
1844 501287184 : do i = 1, ngrdcol
1845 500934240 : Cx_fnc_Richardson(i,k) = 0.0
1846 : end do
1847 : end do
1848 : !$acc end parallel loop
1849 : end if
1850 :
1851 : ! Loop over the 4 main advance subroutines -- advance_xm_wpxp,
1852 : ! advance_wp2_wp3, advance_xp2_xpyp, and advance_windm_edsclrm -- in the
1853 : ! order determined by order_xm_wpxp, order_wp2_wp3, order_xp2_xpyp, and
1854 : ! order_windm.
1855 1764720 : do advance_order_loop_iter = 1, 4, 1
1856 :
1857 1764720 : if ( advance_order_loop_iter == order_xm_wpxp ) then
1858 :
1859 : ! Advance the prognostic equations for
1860 : ! the scalar grid means (rtm, thlm, sclrm) and
1861 : ! scalar turbulent fluxes (wprtp, wpthlp, and wpsclrp)
1862 : ! by one time step.
1863 : ! advance_xm_wpxp_bad_wp2 ! Test error comment, DO NOT modify or move
1864 : call advance_xm_wpxp( nz, ngrdcol, gr, dt_advance, sigma_sqd_w, wm_zm, wm_zt, wp2, & ! intent(in)
1865 : Lscale, wp3_on_wp2, wp3_on_wp2_zt, Kh_zt, Kh_zm, & ! intent(in)
1866 : invrs_tau_C6_zm, tau_max_zm, Skw_zm, wp2rtp, rtpthvp, & ! intent(in)
1867 : rtm_forcing, wprtp_forcing, rtm_ref, wp2thlp, & ! intent(in)
1868 : thlpthvp, thlm_forcing, wpthlp_forcing, thlm_ref, & ! intent(in)
1869 : rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in)
1870 : invrs_rho_ds_zt, thv_ds_zm, rtp2, thlp2, & ! intent(in)
1871 : w_1_zm, w_2_zm, varnce_w_1_zm, varnce_w_2_zm, & ! intent(in)
1872 : mixt_frac_zm, l_implemented, em, wp2sclrp, & ! intent(in)
1873 : sclrpthvp, sclrm_forcing, sclrp2, exner, rcm, & ! intent(in)
1874 : p_in_Pa, thvm, Cx_fnc_Richardson, & ! intent(in)
1875 : ice_supersat_frac, & ! intent(in)
1876 : pdf_implicit_coefs_terms, & ! intent(in)
1877 : um_forcing, vm_forcing, ug, vg, wpthvp, & ! intent(in)
1878 : fcor, um_ref, vm_ref, up2, vp2, & ! intent(in)
1879 : uprcp, vprcp, rc_coef, & ! intent(in)
1880 : clubb_params, nu_vert_res_dep, & ! intent(in)
1881 : clubb_config_flags%iiPDF_type, & ! intent(in)
1882 : clubb_config_flags%penta_solve_method, & ! intent(in)
1883 : clubb_config_flags%tridiag_solve_method, & ! intent(in)
1884 : clubb_config_flags%l_predict_upwp_vpwp, & ! intent(in)
1885 : clubb_config_flags%l_diffuse_rtm_and_thlm, & ! intent(in)
1886 : clubb_config_flags%l_stability_correct_Kh_N2_zm, & ! intent(in)
1887 : clubb_config_flags%l_godunov_upwind_wpxp_ta, & ! intent(in)
1888 : clubb_config_flags%l_upwind_xm_ma, & ! intent(in)
1889 : clubb_config_flags%l_uv_nudge, & ! intent(in)
1890 : clubb_config_flags%l_tke_aniso, & ! intent(in)
1891 : clubb_config_flags%l_diag_Lscale_from_tau, & ! intent(in)
1892 : clubb_config_flags%l_use_C7_Richardson, & ! intent(in)
1893 : clubb_config_flags%l_brunt_vaisala_freq_moist, & ! intent(in)
1894 : clubb_config_flags%l_use_thvm_in_bv_freq, & ! intent(in)
1895 : clubb_config_flags%l_lmm_stepping, & ! intent(in)
1896 : clubb_config_flags%l_enable_relaxed_clipping, & ! intent(in)
1897 : clubb_config_flags%l_linearize_pbl_winds, & ! intent(in)
1898 : clubb_config_flags%l_mono_flux_lim_thlm, & ! intent(in)
1899 : clubb_config_flags%l_mono_flux_lim_rtm, & ! intent(in)
1900 : clubb_config_flags%l_mono_flux_lim_um, & ! intent(in)
1901 : clubb_config_flags%l_mono_flux_lim_vm, & ! intent(in)
1902 : clubb_config_flags%l_mono_flux_lim_spikefix, & ! intent(in)
1903 : order_xm_wpxp, order_xp2_xpyp, order_wp2_wp3, & ! intent(in)
1904 : stats_metadata, & ! intent(in)
1905 : stats_zt, stats_zm, stats_sfc, & ! intent(i/o)
1906 : rtm, wprtp, thlm, wpthlp, & ! intent(i/o)
1907 : sclrm, wpsclrp, um, upwp, vm, vpwp, & ! intent(i/o)
1908 352944 : um_pert, vm_pert, upwp_pert, vpwp_pert ) ! intent(i/o)
1909 :
1910 352944 : if ( clubb_at_least_debug_level( 0 ) ) then
1911 352944 : if ( err_code == clubb_fatal_error ) then
1912 0 : err_code_out = err_code
1913 0 : write(fstderr,*) "Error calling advance_xm_wpxp"
1914 : !return
1915 : end if
1916 : end if
1917 :
1918 : ! Vince Larson clipped rcm in order to prevent rvm < 0. 5 Apr 2008.
1919 : ! This code won't work unless rtm >= 0 !!!
1920 : ! We do not clip rcm_in_layer because rcm_in_layer only influences
1921 : ! radiation, and we do not want to bother recomputing it. 6 Aug 2009
1922 : call clip_rcm( nz, ngrdcol, rtm, & ! intent(in)
1923 : 'rtm < rcm in advance_xm_wpxp', & ! intent(in)
1924 352944 : rcm ) ! intent(inout)
1925 :
1926 : #ifdef GFDL
1927 : do i = 1, ngrdcol
1928 : call advance_sclrm_Nd_diffusion_OG( dt, & ! h1g, 2012-06-16 ! intent(in)
1929 : sclrm(i,:,:), sclrm_trsport_only(i,:,:), & ! intent(inout)
1930 : Kh_zm(i,:), cloud_frac(i,:) ) ! intent(in)
1931 : end do
1932 : #endif
1933 :
1934 1058832 : elseif ( advance_order_loop_iter == order_xp2_xpyp ) then
1935 :
1936 : !----------------------------------------------------------------
1937 : ! Compute some of the variances and covariances. These include the
1938 : ! variance of total water (rtp2), liquid water potential temperature
1939 : ! (thlp2), their covariance (rtpthlp), and the variance of horizontal
1940 : ! wind (up2 and vp2). The variance of vertical velocity is computed
1941 : ! in a different section, which will come either earlier or later
1942 : ! depending on the chosen call order.
1943 : !----------------------------------------------------------------
1944 :
1945 : ! We found that certain cases require a time tendency to run
1946 : ! at shorter timesteps so these are prognosed now.
1947 :
1948 : ! We found that if we call advance_xp2_xpyp first, we can use a longer timestep.
1949 :
1950 : ! Advance the prognostic equations
1951 : ! for scalar variances and covariances,
1952 : ! plus the horizontal wind variances by one time step, by one time step.
1953 : call advance_xp2_xpyp( nz, ngrdcol, gr, & ! intent(in)
1954 : invrs_tau_xp2_zm, invrs_tau_C4_zm, & ! intent(in)
1955 : invrs_tau_C14_zm, wm_zm, & ! intent(in)
1956 : rtm, wprtp, thlm, wpthlp, wpthvp, um, vm, & ! intent(in)
1957 : wp2, wp2_zt, wp3, upwp, vpwp, & ! intent(in)
1958 : sigma_sqd_w, wprtp2, wpthlp2, & ! intent(in)
1959 : wprtpthlp, Kh_zt, rtp2_forcing, & ! intent(in)
1960 : thlp2_forcing, rtpthlp_forcing, & ! intent(in)
1961 : rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in)
1962 : thv_ds_zm, cloud_frac, & ! intent(in)
1963 : wp3_on_wp2, wp3_on_wp2_zt, & ! intent(in)
1964 : pdf_implicit_coefs_terms, & ! intent(in)
1965 : dt_advance, & ! intent(in)
1966 : sclrm, wpsclrp, & ! intent(in)
1967 : wpsclrp2, wpsclrprtp, wpsclrpthlp, & ! intent(in)
1968 : lhs_splat_wp2, & ! intent(in)
1969 : clubb_params, nu_vert_res_dep, & ! intent(in)
1970 : clubb_config_flags%iiPDF_type, & ! intent(in)
1971 : clubb_config_flags%tridiag_solve_method, & ! intent(in)
1972 : clubb_config_flags%l_predict_upwp_vpwp, & ! intent(in)
1973 : clubb_config_flags%l_min_xp2_from_corr_wx, & ! intent(in)
1974 : clubb_config_flags%l_C2_cloud_frac, & ! intent(in)
1975 : clubb_config_flags%l_upwind_xpyp_ta, & ! intent(in)
1976 : clubb_config_flags%l_godunov_upwind_xpyp_ta, & ! intent(in)
1977 : clubb_config_flags%l_lmm_stepping, & ! intent(in)
1978 : stats_metadata, & ! In
1979 : stats_zt, stats_zm, stats_sfc, & ! intent(inout)
1980 : rtp2, thlp2, rtpthlp, up2, vp2, & ! intent(inout)
1981 352944 : sclrp2, sclrprtp, sclrpthlp) ! intent(inout)
1982 :
1983 352944 : if ( clubb_at_least_debug_level( 0 ) ) then
1984 352944 : if ( err_code == clubb_fatal_error ) then
1985 0 : err_code_out = err_code
1986 0 : write(fstderr,*) "Error calling advance_xp2_xpyp"
1987 : !return
1988 : end if
1989 : end if
1990 :
1991 : !----------------------------------------------------------------
1992 : ! Covariance clipping for wprtp, wpthlp, wpsclrp, upwp, and vpwp
1993 : ! after subroutine advance_xp2_xpyp updated xp2.
1994 : !----------------------------------------------------------------
1995 : if ( order_xp2_xpyp < order_xm_wpxp &
1996 : .and. order_xp2_xpyp < order_wp2_wp3 ) then
1997 : wprtp_cl_num = 1 ! First instance of w'r_t' clipping.
1998 : wpthlp_cl_num = 1 ! First instance of w'th_l' clipping.
1999 : wpsclrp_cl_num = 1 ! First instance of w'sclr' clipping.
2000 : if ( clubb_config_flags%l_predict_upwp_vpwp ) then
2001 : upwp_cl_num = 1 ! First instance of u'w' clipping.
2002 : vpwp_cl_num = 1 ! First instance of v'w' clipping.
2003 : endif
2004 : elseif ( order_xp2_xpyp > order_xm_wpxp &
2005 : .and. order_xp2_xpyp > order_wp2_wp3 ) then
2006 : wprtp_cl_num = 3 ! Third instance of w'r_t' clipping.
2007 : wpthlp_cl_num = 3 ! Third instance of w'th_l' clipping.
2008 : wpsclrp_cl_num = 3 ! Third instance of w'sclr' clipping.
2009 : if ( clubb_config_flags%l_predict_upwp_vpwp ) then
2010 : upwp_cl_num = 3 ! Third instance of u'w' clipping.
2011 : vpwp_cl_num = 3 ! Third instance of v'w' clipping.
2012 : endif
2013 : else
2014 352944 : wprtp_cl_num = 2 ! Second instance of w'r_t' clipping.
2015 352944 : wpthlp_cl_num = 2 ! Second instance of w'th_l' clipping.
2016 352944 : wpsclrp_cl_num = 2 ! Second instance of w'sclr' clipping.
2017 352944 : if ( clubb_config_flags%l_predict_upwp_vpwp ) then
2018 352944 : upwp_cl_num = 2 ! Second instance of u'w' clipping.
2019 352944 : vpwp_cl_num = 2 ! Second instance of v'w' clipping.
2020 : endif
2021 : endif
2022 :
2023 352944 : if ( .not. clubb_config_flags%l_predict_upwp_vpwp ) then
2024 : if ( order_xp2_xpyp < order_wp2_wp3 &
2025 : .and. order_xp2_xpyp < order_windm ) then
2026 0 : upwp_cl_num = 1 ! First instance of u'w' clipping.
2027 0 : vpwp_cl_num = 1 ! First instance of v'w' clipping.
2028 : elseif ( order_xp2_xpyp > order_wp2_wp3 &
2029 : .and. order_xp2_xpyp > order_windm ) then
2030 : upwp_cl_num = 3 ! Third instance of u'w' clipping.
2031 : vpwp_cl_num = 3 ! Third instance of v'w' clipping.
2032 : else
2033 : upwp_cl_num = 2 ! Second instance of u'w' clipping.
2034 : vpwp_cl_num = 2 ! Second instance of v'w' clipping.
2035 : endif ! l_predict_upwp_vpwp
2036 : endif
2037 :
2038 : call clip_covars_denom( nz, ngrdcol, gr, dt, rtp2, thlp2, up2, vp2, wp2, & ! intent(in)
2039 : sclrp2, wprtp_cl_num, wpthlp_cl_num, & ! intent(in)
2040 : wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, & ! intent(in)
2041 : clubb_config_flags%l_predict_upwp_vpwp, & ! intent(in)
2042 : clubb_config_flags%l_tke_aniso, & ! intent(in)
2043 : clubb_config_flags%l_linearize_pbl_winds, & ! intent(in)
2044 : stats_metadata, & ! intent(in)
2045 : stats_zm, & ! intent(inout)
2046 : wprtp, wpthlp, upwp, vpwp, wpsclrp, & ! intent(inout)
2047 352944 : upwp_pert, vpwp_pert ) ! intent(inout)
2048 :
2049 705888 : elseif ( advance_order_loop_iter == order_wp2_wp3 ) then
2050 :
2051 : !----------------------------------------------------------------
2052 : ! Advance the 2nd- and 3rd-order moments
2053 : ! of vertical velocity (wp2, wp3) by one timestep.
2054 : !----------------------------------------------------------------
2055 :
2056 : ! advance_wp2_wp3_bad_wp2 ! Test error comment, DO NOT modify or move
2057 : call advance_wp2_wp3( nz, ngrdcol, gr, dt_advance, & ! intent(in)
2058 : sfc_elevation, sigma_sqd_w, wm_zm, & ! intent(in)
2059 : wm_zt, a3_coef, a3_coef_zt, wp3_on_wp2, & ! intent(in)
2060 : wpup2, wpvp2, wp2up2, wp2vp2, wp4, & ! intent(in)
2061 : wpthvp, wp2thvp, um, vm, upwp, vpwp, & ! intent(in)
2062 : up2, vp2, em, Kh_zm, Kh_zt, invrs_tau_C4_zm, & ! intent(in)
2063 : invrs_tau_wp3_zt, invrs_tau_C1_zm, Skw_zm, & ! intent(in)
2064 : Skw_zt, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in)
2065 : invrs_rho_ds_zt, radf, thv_ds_zm, & ! intent(in)
2066 : thv_ds_zt, pdf_params%mixt_frac, Cx_fnc_Richardson, & ! intent(in)
2067 : lhs_splat_wp2, lhs_splat_wp3, & ! intent(in)
2068 : pdf_implicit_coefs_terms, & ! intent(in)
2069 : wprtp, wpthlp, rtp2, thlp2, & ! intent(in)
2070 : clubb_params, nu_vert_res_dep, & ! intent(in)
2071 : clubb_config_flags%iiPDF_type, & ! intent(in)
2072 : clubb_config_flags%penta_solve_method, & ! intent(in)
2073 : clubb_config_flags%l_min_wp2_from_corr_wx, & ! intent(in)
2074 : clubb_config_flags%l_upwind_xm_ma, & ! intent(in)
2075 : clubb_config_flags%l_tke_aniso, & ! intent(in)
2076 : clubb_config_flags%l_standard_term_ta, & ! intent(in)
2077 : clubb_config_flags%l_partial_upwind_wp3, & ! intent(in)
2078 : clubb_config_flags%l_damp_wp2_using_em, & ! intent(in)
2079 : clubb_config_flags%l_use_C11_Richardson, & ! intent(in)
2080 : clubb_config_flags%l_damp_wp3_Skw_squared, & ! intent(in)
2081 : clubb_config_flags%l_lmm_stepping, & ! intent(in)
2082 : clubb_config_flags%l_use_tke_in_wp3_pr_turb_term, & ! intent(in)
2083 : clubb_config_flags%l_use_tke_in_wp2_wp3_K_dfsn, & ! intent(in)
2084 : clubb_config_flags%l_use_wp3_lim_with_smth_Heaviside, & ! intent(in)
2085 : stats_metadata, & ! intent(in)
2086 : stats_zt, stats_zm, stats_sfc, & ! intent(inout)
2087 352944 : wp2, wp3, wp3_zm, wp2_zt ) ! intent(inout)
2088 :
2089 352944 : if ( clubb_at_least_debug_level( 0 ) ) then
2090 352944 : if ( err_code == clubb_fatal_error ) then
2091 0 : err_code_out = err_code
2092 0 : write(fstderr,*) "Error calling advance_wp2_wp3"
2093 : !return
2094 : end if
2095 : end if
2096 :
2097 : !----------------------------------------------------------------
2098 : ! Covariance clipping for wprtp, wpthlp, wpsclrp, upwp, and vpwp
2099 : ! after subroutine advance_wp2_wp3 updated wp2.
2100 : !----------------------------------------------------------------
2101 :
2102 : if ( order_wp2_wp3 < order_xm_wpxp &
2103 : .and. order_wp2_wp3 < order_xp2_xpyp ) then
2104 : wprtp_cl_num = 1 ! First instance of w'r_t' clipping.
2105 : wpthlp_cl_num = 1 ! First instance of w'th_l' clipping.
2106 : wpsclrp_cl_num = 1 ! First instance of w'sclr' clipping.
2107 : if ( clubb_config_flags%l_predict_upwp_vpwp ) then
2108 : upwp_cl_num = 1 ! First instance of u'w' clipping.
2109 : vpwp_cl_num = 1 ! First instance of v'w' clipping.
2110 : endif
2111 : elseif ( order_wp2_wp3 > order_xm_wpxp &
2112 : .and. order_wp2_wp3 > order_xp2_xpyp ) then
2113 352944 : wprtp_cl_num = 3 ! Third instance of w'r_t' clipping.
2114 352944 : wpthlp_cl_num = 3 ! Third instance of w'th_l' clipping.
2115 352944 : wpsclrp_cl_num = 3 ! Third instance of w'sclr' clipping.
2116 352944 : if ( clubb_config_flags%l_predict_upwp_vpwp ) then
2117 352944 : upwp_cl_num = 3 ! Third instance of u'w' clipping.
2118 352944 : vpwp_cl_num = 3 ! Third instance of v'w' clipping.
2119 : endif
2120 : else
2121 : wprtp_cl_num = 2 ! Second instance of w'r_t' clipping.
2122 : wpthlp_cl_num = 2 ! Second instance of w'th_l' clipping.
2123 : wpsclrp_cl_num = 2 ! Second instance of w'sclr' clipping.
2124 : if ( clubb_config_flags%l_predict_upwp_vpwp ) then
2125 : upwp_cl_num = 2 ! Second instance of u'w' clipping.
2126 : vpwp_cl_num = 2 ! Second instance of v'w' clipping.
2127 : endif
2128 : endif
2129 :
2130 352944 : if ( .not. clubb_config_flags%l_predict_upwp_vpwp ) then
2131 : if ( order_wp2_wp3 < order_xp2_xpyp &
2132 : .and. order_wp2_wp3 < order_windm ) then
2133 : upwp_cl_num = 1 ! First instance of u'w' clipping.
2134 : vpwp_cl_num = 1 ! First instance of v'w' clipping.
2135 : elseif ( order_wp2_wp3 > order_xp2_xpyp &
2136 : .and. order_wp2_wp3 > order_windm ) then
2137 : upwp_cl_num = 3 ! Third instance of u'w' clipping.
2138 : vpwp_cl_num = 3 ! Third instance of v'w' clipping.
2139 : else
2140 0 : upwp_cl_num = 2 ! Second instance of u'w' clipping.
2141 0 : vpwp_cl_num = 2 ! Second instance of v'w' clipping.
2142 : endif ! l_predict_upwp_vpwp
2143 : endif
2144 :
2145 : call clip_covars_denom( nz, ngrdcol, gr, dt, rtp2, thlp2, up2, vp2, wp2, & ! intent(in)
2146 : sclrp2, wprtp_cl_num, wpthlp_cl_num, & ! intent(in)
2147 : wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, & ! intent(in)
2148 : clubb_config_flags%l_predict_upwp_vpwp, & ! intent(in)
2149 : clubb_config_flags%l_tke_aniso, & ! intent(in)
2150 : clubb_config_flags%l_linearize_pbl_winds, & ! intent(in)
2151 : stats_metadata, & ! intent(in)
2152 : stats_zm, & ! intent(inout)
2153 : wprtp, wpthlp, upwp, vpwp, wpsclrp, & ! intent(inout)
2154 352944 : upwp_pert, vpwp_pert ) ! intent(inout)
2155 :
2156 352944 : elseif ( advance_order_loop_iter == order_windm ) then
2157 :
2158 : !----------------------------------------------------------------
2159 : ! Advance the horizontal mean winds (um, vm),
2160 : ! the mean of the eddy-diffusivity scalars (i.e. edsclrm),
2161 : ! and their fluxes (upwp, vpwp, wpedsclrp) by one time step.
2162 : !----------------------------------------------------------------
2163 : !$acc parallel loop gang vector collapse(2) default(present)
2164 30353184 : do k = 1, nz
2165 501287184 : do i = 1, ngrdcol
2166 470934000 : Km_zm(i,k) = Kh_zm(i,k) * C_K10 ! Coefficient for momentum
2167 :
2168 500934240 : Kmh_zm(i,k) = Kh_zm(i,k) * C_K10h ! Coefficient for thermo
2169 : end do
2170 : end do
2171 : !$acc end parallel loop
2172 :
2173 352944 : if ( edsclr_dim > 1 .and. clubb_config_flags%l_do_expldiff_rtm_thlm ) then
2174 : !$acc parallel loop gang vector collapse(2) default(present)
2175 30353184 : do k = 1, nz
2176 501287184 : do i = 1, ngrdcol
2177 470934000 : edsclrm(i,k,edsclr_dim-1) = thlm(i,k)
2178 500934240 : edsclrm(i,k,edsclr_dim) = rtm(i,k)
2179 : end do
2180 : end do
2181 : !$acc end parallel loop
2182 : end if
2183 :
2184 : call advance_windm_edsclrm( nz, ngrdcol, gr, dt, & ! intent(in)
2185 : wm_zt, Km_zm, Kmh_zm, & ! intent(in)
2186 : ug, vg, um_ref, vm_ref, & ! intent(in)
2187 : wp2, up2, vp2, um_forcing, vm_forcing, & ! intent(in)
2188 : edsclrm_forcing, & ! intent(in)
2189 : rho_ds_zm, invrs_rho_ds_zt, & ! intent(in)
2190 : fcor, l_implemented, & ! intent(in)
2191 : nu_vert_res_dep, & ! intent(in)
2192 : clubb_config_flags%tridiag_solve_method, & ! intent(in)
2193 : clubb_config_flags%l_predict_upwp_vpwp, & ! intent(in)
2194 : clubb_config_flags%l_upwind_xm_ma, & ! intent(in)
2195 : clubb_config_flags%l_uv_nudge, & ! intent(in)
2196 : clubb_config_flags%l_tke_aniso, & ! intent(in)
2197 : clubb_config_flags%l_lmm_stepping, & ! intent(in)
2198 : clubb_config_flags%l_linearize_pbl_winds, & ! intent(in)
2199 : order_xp2_xpyp, order_wp2_wp3, order_windm, & ! intent(in)
2200 : stats_metadata, & ! intent(in)
2201 : stats_zt, stats_zm, stats_sfc, & ! intent(inout)
2202 : um, vm, edsclrm, & ! intent(inout)
2203 : upwp, vpwp, wpedsclrp, & ! intent(inout)
2204 352944 : um_pert, vm_pert, upwp_pert, vpwp_pert ) ! intent(inout)
2205 :
2206 352944 : if ( edsclr_dim > 1 .and. clubb_config_flags%l_do_expldiff_rtm_thlm ) then
2207 :
2208 : call pvertinterp( nz, ngrdcol, & ! intent(in)
2209 : p_in_Pa, 70000.0_core_rknd, thlm, & ! intent(in)
2210 352944 : thlm700 ) ! intent(out)
2211 :
2212 : call pvertinterp( nz, ngrdcol, & ! intent(in)
2213 : p_in_Pa, 100000.0_core_rknd, thlm, & ! intent(in)
2214 352944 : thlm1000 ) ! intent(out)
2215 :
2216 : !$acc parallel loop gang vector collapse(2) default(present)
2217 30353184 : do k = 1, nz
2218 501287184 : do i = 1, ngrdcol
2219 500934240 : if ( thlm700(i) - thlm1000(i) < 20.0_core_rknd ) then
2220 395738495 : thlm(i,k) = edsclrm(i,k,edsclr_dim-1)
2221 395738495 : rtm(i,k) = edsclrm(i,k,edsclr_dim)
2222 : end if
2223 : end do
2224 : end do
2225 : !$acc end parallel loop
2226 :
2227 : end if
2228 :
2229 : ! Eric Raut: this seems dangerous to call without any attached flag.
2230 : ! Hence the preprocessor.
2231 : #ifdef CLUBB_CAM
2232 8470656 : do ixind=1,edsclr_dim
2233 : ! upper_hf_level = nz since we are filling the zt levels
2234 : call fill_holes_vertical( nz, ngrdcol, num_hf_draw_points, zero_threshold, nz, & ! In
2235 : gr%dzt, rho_ds_zt, & ! In
2236 8470656 : edsclrm(:,:,ixind) ) ! InOut
2237 : enddo
2238 : #endif
2239 :
2240 : endif ! advance_order_loop_iter
2241 :
2242 : enddo ! advance_order_loop_iter = 1, 4, 1
2243 :
2244 : !----------------------------------------------------------------
2245 : ! Advance or otherwise calculate <thl'^3>, <rt'^3>, and
2246 : ! <sclr'^3>.
2247 : !----------------------------------------------------------------
2248 : if ( l_advance_xp3 &
2249 : .and. clubb_config_flags%iiPDF_type /= iiPDF_ADG1 ) then
2250 :
2251 : ! Advance <rt'^3>, <thl'^3>, and <sclr'^3> one model timestep using a
2252 : ! simplified form of the <x'^3> predictive equation. The simplified
2253 : ! <x'^3> equation can either be advanced from its previous value or
2254 : ! calculated using a steady-state approximation.
2255 : call advance_xp3( nz, ngrdcol, gr, dt, & ! Intent(in)
2256 : rtm, thlm, rtp2, thlp2, wprtp, & ! Intent(in)
2257 : wpthlp, wprtp2, wpthlp2, rho_ds_zm, & ! Intent(in)
2258 : invrs_rho_ds_zt, invrs_tau_zt, tau_max_zt, & ! Intent(in)
2259 : sclrm, sclrp2, wpsclrp, wpsclrp2, & ! Intent(in)
2260 : clubb_config_flags%l_lmm_stepping, & ! intent(in)
2261 : stats_metadata, & ! intent(in)
2262 : stats_zt, & ! intent(inout)
2263 : rtp3, thlp3, sclrp3 ) ! Intent(inout)
2264 :
2265 : ! Use a modified form of the Larson and Golaz (2005) ansatz for the
2266 : ! ADG1 PDF to calculate <u'^3> and <v'^3> for another type of PDF.
2267 : call Skx_func( nz, ngrdcol, wp2_zt, wp3, &
2268 : w_tol, Skw_denom_coef, Skw_max_mag, &
2269 : Skw_zt )
2270 :
2271 : upwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, upwp(:,:) )
2272 : vpwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, vpwp(:,:) )
2273 : up2_zt(:,:) = max( zm2zt( nz, ngrdcol, gr, up2(:,:) ), w_tol_sqd ) ! Positive def. quantity
2274 : vp2_zt(:,:) = max( zm2zt( nz, ngrdcol, gr, vp2(:,:) ), w_tol_sqd ) ! Positive def. quantity
2275 :
2276 : thvm_zm(:,:) = zt2zm( nz, ngrdcol, gr, thvm(:,:) )
2277 : ddzm_thvm_zm(:,:) = ddzm( nz, ngrdcol, gr, thvm_zm(:,:) )
2278 : brunt_vaisala_freq_sqd_zt(:,:) = max( ( grav / thvm(:,:) ) * ddzm_thvm_zm(:,:), zero )
2279 :
2280 : ! The xp3_coef_fnc is used in place of sigma_sqd_w_zt when the ADG1 PDF
2281 : ! is not being used. The xp3_coef_fnc provides some extra tunability to
2282 : ! the simple xp3 equation.
2283 : ! When xp3_coef_fnc goes to 0, the value of Skx goes to the smallest
2284 : ! magnitude permitted by the function. When xp3_coef_fnc goes to 1, the
2285 : ! magnitude of Skx becomes huge.
2286 : xp3_coef_base = clubb_params(ixp3_coef_base)
2287 : xp3_coef_slope = clubb_params(ixp3_coef_slope)
2288 :
2289 : do k = 1, nz
2290 : do i = 1, ngrdcol
2291 : xp3_coef_fnc(i,k) = xp3_coef_base &
2292 : + ( one - xp3_coef_base ) &
2293 : * ( one - exp( brunt_vaisala_freq_sqd_zt(i,k) / xp3_coef_slope ) )
2294 : end do
2295 : end do
2296 :
2297 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, upwp_zt, wp2_zt, &
2298 : up2_zt, xp3_coef_fnc, &
2299 : beta, Skw_denom_coef, w_tol, &
2300 : up3 )
2301 :
2302 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, vpwp_zt, wp2_zt, &
2303 : vp2_zt, xp3_coef_fnc, &
2304 : beta, Skw_denom_coef, w_tol, &
2305 : vp3 )
2306 :
2307 : else ! .not. l_advance_xp3 .or. clubb_config_flags%iiPDF_type = iiPDF_ADG1
2308 :
2309 : ! The ADG1 PDF must use this option.
2310 : call Skx_func( nz, ngrdcol, wp2_zt, wp3, &
2311 : w_tol, Skw_denom_coef, Skw_max_mag, &
2312 352944 : Skw_zt )
2313 :
2314 352944 : wpthlp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wpthlp(:,:) )
2315 352944 : wprtp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wprtp(:,:) )
2316 352944 : thlp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, thlp2(:,:) ) ! Positive def. quantity
2317 352944 : rtp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, rtp2(:,:) ) ! Positive def. quantity
2318 :
2319 352944 : upwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, upwp(:,:) )
2320 352944 : vpwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, vpwp(:,:) )
2321 352944 : up2_zt(:,:) = zm2zt( nz, ngrdcol, gr, up2(:,:) ) ! Positive def. quantity
2322 352944 : vp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, vp2(:,:) ) ! Positive def. quantity
2323 :
2324 : !$acc parallel loop gang vector collapse(2) default(present)
2325 30353184 : do k = 1, nz
2326 501287184 : do i = 1, ngrdcol
2327 470934000 : thlp2_zt(i,k) = max( thlp2_zt(i,k), thl_tol**2 )
2328 470934000 : rtp2_zt(i,k) = max( rtp2_zt(i,k), rt_tol**2 )
2329 470934000 : up2_zt(i,k) = max( up2_zt(i,k), w_tol_sqd )
2330 500934240 : vp2_zt(i,k) = max( vp2_zt(i,k), w_tol_sqd )
2331 : end do
2332 : end do
2333 : !$acc end parallel loop
2334 :
2335 352944 : if ( clubb_config_flags%iiPDF_type == iiPDF_ADG1 ) then
2336 :
2337 : ! Use the Larson and Golaz (2005) ansatz for the ADG1 PDF to
2338 : ! calculate <rt'^3>, <thl'^3>, <u'^3>, <v'^3>, and <sclr'^3>.
2339 352944 : sigma_sqd_w_zt(:,:) = zm2zt( nz, ngrdcol, gr, sigma_sqd_w(:,:) )
2340 :
2341 : !$acc parallel loop gang vector collapse(2) default(present)
2342 30353184 : do k = 1, nz
2343 501287184 : do i = 1, ngrdcol
2344 500934240 : sigma_sqd_w_zt(i,k) = max( sigma_sqd_w_zt(i,k), zero_threshold )
2345 : end do
2346 : end do
2347 : !$acc end parallel loop
2348 :
2349 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wpthlp_zt, wp2_zt, &
2350 : thlp2_zt, sigma_sqd_w_zt, &
2351 : beta, Skw_denom_coef, thl_tol, &
2352 352944 : thlp3 )
2353 :
2354 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wprtp_zt, wp2_zt, &
2355 : rtp2_zt, sigma_sqd_w_zt, &
2356 : beta, Skw_denom_coef, rt_tol, &
2357 352944 : rtp3 )
2358 :
2359 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, upwp_zt, wp2_zt, &
2360 : up2_zt, sigma_sqd_w_zt, &
2361 : beta, Skw_denom_coef, w_tol, &
2362 352944 : up3 )
2363 :
2364 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, vpwp_zt, wp2_zt, &
2365 : vp2_zt, sigma_sqd_w_zt, &
2366 : beta, Skw_denom_coef, w_tol, &
2367 352944 : vp3 )
2368 :
2369 352944 : do j = 1, sclr_dim, 1
2370 :
2371 0 : wpsclrp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wpsclrp(:,:,j) )
2372 0 : sclrp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, sclrp2(:,:,j) )
2373 :
2374 : !$acc parallel loop gang vector collapse(2) default(present)
2375 0 : do k = 1, nz
2376 0 : do i = 1, ngrdcol
2377 0 : sclrp2_zt(i,k) = max( sclrp2_zt(i,k), sclr_tol(j)**2 )
2378 : end do
2379 : end do
2380 : !$acc end parallel loop
2381 :
2382 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wpsclrp_zt, wp2_zt, &
2383 : sclrp2_zt, sigma_sqd_w_zt, &
2384 0 : beta, Skw_denom_coef, sclr_tol(j), &
2385 352944 : sclrp3 )
2386 :
2387 : enddo ! i = 1, sclr_dim
2388 :
2389 : else ! clubb_config_flags%iiPDF_type /= iiPDF_ADG1
2390 :
2391 : ! Use a modified form of the Larson and Golaz (2005) ansatz for the
2392 : ! ADG1 PDF to calculate <u'^3> and <v'^3> for another type of PDF.
2393 0 : thvm_zm(:,:) = zt2zm( nz, ngrdcol, gr, thvm(:,:) )
2394 0 : ddzm_thvm_zm(:,:) = ddzm( nz, ngrdcol, gr, thvm_zm(:,:) )
2395 0 : brunt_vaisala_freq_sqd_zt(:,:) = max( ( grav / thvm(:,:) ) * ddzm_thvm_zm(:,:), zero )
2396 :
2397 :
2398 : ! Initialize sigma_sqd_w_zt to zero so we don't break output
2399 0 : do k = 1, nz
2400 0 : do i = 1, ngrdcol
2401 0 : sigma_sqd_w_zt(i,k) = zero
2402 : end do
2403 : end do
2404 :
2405 : ! The xp3_coef_fnc is used in place of sigma_sqd_w_zt when the
2406 : ! ADG1 PDF is not being used. The xp3_coef_fnc provides some extra
2407 : ! tunability to the simple xp3 equation.
2408 : ! When xp3_coef_fnc goes to 0, the value of Skx goes to the smallest
2409 : ! magnitude permitted by the function. When xp3_coef_fnc goes to 1,
2410 : ! the magnitude of Skx becomes huge.
2411 : ! The value of Skx becomes large near cloud top, where there is a
2412 : ! higher degree of static stability. The exp{ } portion of the
2413 : ! xp3_coef_fnc allows the xp3_coef_fnc to become larger in regions
2414 : ! of high static stability, producing larger magnitude values of Skx.
2415 0 : xp3_coef_base = clubb_params(ixp3_coef_base)
2416 0 : xp3_coef_slope = clubb_params(ixp3_coef_slope)
2417 :
2418 0 : do k = 1, nz
2419 0 : do i = 1, ngrdcol
2420 0 : xp3_coef_fnc(i,k) = xp3_coef_base &
2421 : + ( one - xp3_coef_base ) &
2422 0 : * ( one - exp( brunt_vaisala_freq_sqd_zt(i,k) / xp3_coef_slope ) )
2423 : end do
2424 : end do
2425 :
2426 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wpthlp_zt, wp2_zt, &
2427 : thlp2_zt, xp3_coef_fnc, &
2428 : beta, Skw_denom_coef, thl_tol, &
2429 0 : thlp3 )
2430 :
2431 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wprtp_zt, wp2_zt, &
2432 : rtp2_zt, xp3_coef_fnc, &
2433 : beta, Skw_denom_coef, rt_tol, &
2434 0 : rtp3 )
2435 :
2436 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, upwp_zt, wp2_zt, &
2437 : up2_zt, xp3_coef_fnc, &
2438 : beta, Skw_denom_coef, w_tol, &
2439 0 : up3 )
2440 :
2441 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, vpwp_zt, wp2_zt, &
2442 : vp2_zt, xp3_coef_fnc, &
2443 : beta, Skw_denom_coef, w_tol, &
2444 0 : vp3 )
2445 :
2446 0 : do j = 1, sclr_dim, 1
2447 :
2448 0 : wpsclrp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wpsclrp(:,:,j) )
2449 0 : sclrp2_zt(:,:) = max( zm2zt( nz, ngrdcol, gr, sclrp2(:,:,j) ), sclr_tol(j)**2 )
2450 :
2451 : call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt(:,:), wpsclrp_zt(:,:), wp2_zt(:,:), &
2452 : sclrp2_zt(:,:), xp3_coef_fnc(:,:), &
2453 0 : beta, Skw_denom_coef, sclr_tol(j), &
2454 0 : sclrp3(:,:,j) )
2455 : end do ! i = 1, sclr_dim
2456 :
2457 : end if ! clubb_config_flags%iiPDF_type == iiPDF_ADG1
2458 :
2459 : end if ! l_advance_xp3 .and. clubb_config_flags%iiPDF_type /= iiPDF_ADG1
2460 :
2461 : if ( clubb_config_flags%ipdf_call_placement == ipdf_post_advance_fields &
2462 352944 : .or. clubb_config_flags%ipdf_call_placement &
2463 : == ipdf_pre_post_advance_fields ) then
2464 :
2465 : ! Sample stats in this call to subroutine pdf_closure_driver for
2466 : ! ipdf_post_advance_fields, but not for ipdf_pre_post_advance_fields
2467 : ! because stats were sampled during the first call to subroutine
2468 : ! pdf_closure_driver.
2469 352944 : if ( clubb_config_flags%ipdf_call_placement &
2470 : == ipdf_post_advance_fields ) then
2471 352944 : l_samp_stats_in_pdf_call = .true.
2472 0 : elseif ( clubb_config_flags%ipdf_call_placement &
2473 : == ipdf_pre_post_advance_fields ) then
2474 0 : l_samp_stats_in_pdf_call = .false.
2475 : endif
2476 :
2477 : !########################################################################
2478 : !####### CALL CLUBB's PDF #######
2479 : !####### AND OUTPUT PDF PARAMETERS AND INTEGRATED QUANTITITES #######
2480 : !########################################################################
2481 : ! Given CLUBB's prognosed moments, diagnose CLUBB's PDF parameters
2482 : ! and quantities integrated over that PDF, including
2483 : ! quantities related to clouds, buoyancy, and turbulent advection.
2484 : call pdf_closure_driver( gr, nz, ngrdcol, & ! Intent(in)
2485 : dt, hydromet_dim, wprtp, & ! Intent(in)
2486 : thlm, wpthlp, rtp2, rtp3, & ! Intent(in)
2487 : thlp2, thlp3, rtpthlp, wp2, & ! Intent(in)
2488 : wp3, wm_zm, wm_zt, & ! Intent(in)
2489 : um, up2, upwp, up3, & ! Intent(in)
2490 : vm, vp2, vpwp, vp3, & ! Intent(in)
2491 : p_in_Pa, exner, & ! Intent(in)
2492 : thv_ds_zm, thv_ds_zt, rtm_ref, & ! Intent(in)
2493 : ! rfrzm, hydromet, &
2494 : wphydrometp, & ! Intent(in)
2495 : wp2hmp, rtphmp_zt, thlphmp_zt, & ! Intent(in)
2496 : sclrm, wpsclrp, sclrp2, & ! Intent(in)
2497 : sclrprtp, sclrpthlp, sclrp3, & ! Intent(in)
2498 : l_samp_stats_in_pdf_call, & ! Intent(in)
2499 : clubb_params, & ! Intent(in)
2500 : clubb_config_flags%iiPDF_type, & ! Intent(in)
2501 : clubb_config_flags%l_predict_upwp_vpwp, & ! Intent(in)
2502 : clubb_config_flags%l_rtm_nudge, & ! Intent(in)
2503 : clubb_config_flags%l_trapezoidal_rule_zt, & ! Intent(in)
2504 : clubb_config_flags%l_trapezoidal_rule_zm, & ! Intent(in)
2505 : clubb_config_flags%l_call_pdf_closure_twice, & ! Intent(in)
2506 : clubb_config_flags%l_use_cloud_cover, & ! Intent(in)
2507 : clubb_config_flags%l_rcm_supersat_adj, & ! Intent(in)
2508 : stats_metadata, & ! Intent(in)
2509 : stats_zt, stats_zm, & ! Intent(inout)
2510 : rtm, & ! Intent(inout)
2511 : pdf_implicit_coefs_terms, & ! Intent(inout)
2512 : pdf_params, pdf_params_zm, & ! Intent(inout)
2513 : #ifdef GFDL
2514 : RH_crit(k, : , :), & ! Intent(inout)
2515 : do_liquid_only_in_clubb, & ! Intent(in)
2516 : #endif
2517 : rcm, cloud_frac, & ! Intent(out)
2518 : ice_supersat_frac, wprcp, & ! Intent(out)
2519 : sigma_sqd_w, wpthvp, wp2thvp, & ! Intent(out)
2520 : rtpthvp, thlpthvp, rc_coef, & ! Intent(out)
2521 : rcm_in_layer, cloud_cover, & ! Intent(out)
2522 : rcp2_zt, thlprcp, & ! Intent(out)
2523 : rc_coef_zm, sclrpthvp, & ! Intent(out)
2524 : wpup2, wpvp2, & ! Intent(out)
2525 : wp2up2, wp2vp2, wp4, & ! Intent(out)
2526 : wp2rtp, wprtp2, wp2thlp, & ! Intent(out)
2527 : wpthlp2, wprtpthlp, wp2rcp, & ! Intent(out)
2528 : rtprcp, rcp2, & ! Intent(out)
2529 : uprcp, vprcp, & ! Intent(out)
2530 : w_up_in_cloud, w_down_in_cloud, & ! Intent(out)
2531 : cloudy_updraft_frac, & ! Intent(out)
2532 : cloudy_downdraft_frac, & ! intent(out)
2533 : Skw_velocity, & ! Intent(out)
2534 : cloud_frac_zm, & ! Intent(out)
2535 : ice_supersat_frac_zm, & ! Intent(out)
2536 : rtm_zm, thlm_zm, rcm_zm, & ! Intent(out)
2537 : rcm_supersat_adj, & ! Intent(out)
2538 : wp2sclrp, wpsclrp2, sclrprcp, & ! Intent(out)
2539 352944 : wpsclrprtp, wpsclrpthlp ) ! Intent(out)
2540 :
2541 : end if ! clubb_config_flags%ipdf_call_placement == ipdf_post_advance_fields
2542 : ! or clubb_config_flags%ipdf_call_placement
2543 : ! == ipdf_pre_post_advance_fields
2544 :
2545 : #ifdef CLUBB_CAM
2546 : !$acc parallel loop gang vector collapse(2) default(present)
2547 30353184 : do k = 1, nz
2548 501287184 : do i = 1, ngrdcol
2549 500934240 : qclvar(i,k) = rcp2_zt(i,k)
2550 : end do
2551 : end do
2552 : !$acc end parallel loop
2553 : #endif
2554 :
2555 :
2556 : !#######################################################################
2557 : !############# ACCUMULATE STATISTICS #############
2558 : !#######################################################################
2559 :
2560 352944 : if ( stats_metadata%l_stats_samp ) then
2561 :
2562 : !$acc update host( wp2, vp2, up2, wprtp, wpthlp, upwp, vpwp, rtp2, thlp2, &
2563 : !$acc rtpthlp, rtm, thlm, um, vm, wp3, &
2564 : !$acc pdf_params%w_1, pdf_params%w_2, &
2565 : !$acc pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
2566 : !$acc pdf_params%rt_1, pdf_params%rt_2, &
2567 : !$acc pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, &
2568 : !$acc pdf_params%thl_1, pdf_params%thl_2, &
2569 : !$acc pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, &
2570 : !$acc pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2, &
2571 : !$acc pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2, &
2572 : !$acc pdf_params%corr_rt_thl_1, pdf_params%corr_rt_thl_2,&
2573 : !$acc pdf_params%alpha_thl, pdf_params%alpha_rt, &
2574 : !$acc pdf_params%crt_1, pdf_params%crt_2, pdf_params%cthl_1, &
2575 : !$acc pdf_params%cthl_2, pdf_params%chi_1, &
2576 : !$acc pdf_params%chi_2, pdf_params%stdev_chi_1, &
2577 : !$acc pdf_params%stdev_chi_2, pdf_params%stdev_eta_1, &
2578 : !$acc pdf_params%stdev_eta_2, pdf_params%covar_chi_eta_1, &
2579 : !$acc pdf_params%covar_chi_eta_2, pdf_params%corr_w_chi_1, &
2580 : !$acc pdf_params%corr_w_chi_2, pdf_params%corr_w_eta_1, &
2581 : !$acc pdf_params%corr_w_eta_2, pdf_params%corr_chi_eta_1, &
2582 : !$acc pdf_params%corr_chi_eta_2, pdf_params%rsatl_1, &
2583 : !$acc pdf_params%rsatl_2, pdf_params%rc_1, pdf_params%rc_2, &
2584 : !$acc pdf_params%cloud_frac_1, pdf_params%cloud_frac_2, &
2585 : !$acc pdf_params%mixt_frac, pdf_params%ice_supersat_frac_1, &
2586 : !$acc pdf_params%ice_supersat_frac_2, &
2587 : !$acc pdf_params_zm%w_1, pdf_params_zm%w_2, &
2588 : !$acc pdf_params_zm%varnce_w_1, pdf_params_zm%varnce_w_2, &
2589 : !$acc pdf_params_zm%rt_1, pdf_params_zm%rt_2, &
2590 : !$acc pdf_params_zm%varnce_rt_1, pdf_params_zm%varnce_rt_2, &
2591 : !$acc pdf_params_zm%thl_1, pdf_params_zm%thl_2, &
2592 : !$acc pdf_params_zm%varnce_thl_1, pdf_params_zm%varnce_thl_2, &
2593 : !$acc pdf_params_zm%corr_w_rt_1, pdf_params_zm%corr_w_rt_2, &
2594 : !$acc pdf_params_zm%corr_w_thl_1, pdf_params_zm%corr_w_thl_2, &
2595 : !$acc pdf_params_zm%corr_rt_thl_1, pdf_params_zm%corr_rt_thl_2,&
2596 : !$acc pdf_params_zm%alpha_thl, pdf_params_zm%alpha_rt, &
2597 : !$acc pdf_params_zm%crt_1, pdf_params_zm%crt_2, pdf_params_zm%cthl_1, &
2598 : !$acc pdf_params_zm%cthl_2, pdf_params_zm%chi_1, &
2599 : !$acc pdf_params_zm%chi_2, pdf_params_zm%stdev_chi_1, &
2600 : !$acc pdf_params_zm%stdev_chi_2, pdf_params_zm%stdev_eta_1, &
2601 : !$acc pdf_params_zm%stdev_eta_2, pdf_params_zm%covar_chi_eta_1, &
2602 : !$acc pdf_params_zm%covar_chi_eta_2, pdf_params_zm%corr_w_chi_1, &
2603 : !$acc pdf_params_zm%corr_w_chi_2, pdf_params_zm%corr_w_eta_1, &
2604 : !$acc pdf_params_zm%corr_w_eta_2, pdf_params_zm%corr_chi_eta_1, &
2605 : !$acc pdf_params_zm%corr_chi_eta_2, pdf_params_zm%rsatl_1, &
2606 : !$acc pdf_params_zm%rsatl_2, pdf_params_zm%rc_1, pdf_params_zm%rc_2, &
2607 : !$acc pdf_params_zm%cloud_frac_1, pdf_params_zm%cloud_frac_2, &
2608 : !$acc pdf_params_zm%mixt_frac, pdf_params_zm%ice_supersat_frac_1, &
2609 : !$acc pdf_params_zm%ice_supersat_frac_2, &
2610 : !$acc um, vm, upwp, vpwp, up2, vp2, &
2611 : !$acc thlm, rtm, wprtp, wpthlp, &
2612 : !$acc wp2, wp3, rtp2, rtp3, thlp2, thlp3, rtpthlp, &
2613 : !$acc wpthvp, wp2thvp, rtpthvp, thlpthvp, &
2614 : !$acc p_in_Pa, exner, rho, rho_zm, &
2615 : !$acc rho_ds_zm, rho_ds_zt, thv_ds_zm, thv_ds_zt, &
2616 : !$acc wm_zt, wm_zm, rcm, wprcp, rc_coef, rc_coef_zm, &
2617 : !$acc rcm_zm, rtm_zm, thlm_zm, cloud_frac, ice_supersat_frac, &
2618 : !$acc cloud_frac_zm, ice_supersat_frac_zm, rcm_in_layer, &
2619 : !$acc cloud_cover, rcm_supersat_adj, sigma_sqd_w, &
2620 : !$acc thvm, ug, vg, Lscale, wpthlp2, wp2thlp, wprtp2, wp2rtp, &
2621 : !$acc Lscale_up, Lscale_down, tau_zt, Kh_zt, wp2rcp, &
2622 : !$acc wprtpthlp, sigma_sqd_w_zt, wp2_zt, thlp2_zt, &
2623 : !$acc wpthlp_zt, wprtp_zt, rtp2_zt, rtpthlp_zt, up2_zt, &
2624 : !$acc vp2_zt, upwp_zt, vpwp_zt, wpup2, wpvp2, &
2625 : !$acc wp2up2, wp2vp2, wp4, &
2626 : !$acc tau_zm, Kh_zm, thlprcp, &
2627 : !$acc rtprcp, rcp2, em, a3_coef, a3_coef_zt, &
2628 : !$acc wp3_zm, wp3_on_wp2, wp3_on_wp2_zt, Skw_velocity, &
2629 : !$acc w_up_in_cloud, w_down_in_cloud, &
2630 : !$acc cloudy_updraft_frac, cloudy_downdraft_frac, &
2631 : !$acc sclrm, sclrp2, &
2632 : !$acc sclrprtp, sclrpthlp, sclrm_forcing, sclrpthvp, &
2633 : !$acc wpsclrp, sclrprcp, wp2sclrp, wpsclrp2, wpsclrprtp, &
2634 : !$acc wpsclrpthlp, wpedsclrp, edsclrm, edsclrm_forcing )
2635 :
2636 0 : do i = 1, ngrdcol
2637 :
2638 0 : call stat_end_update( nz, stats_metadata%iwp2_bt, wp2(i,:) / dt, & ! intent(in)
2639 0 : stats_zm(i) ) ! intent(inout)
2640 0 : call stat_end_update( nz, stats_metadata%ivp2_bt, vp2(i,:) / dt, & ! intent(in)
2641 0 : stats_zm(i) ) ! intent(inout)
2642 0 : call stat_end_update( nz, stats_metadata%iup2_bt, up2(i,:) / dt, & ! intent(in)
2643 0 : stats_zm(i) ) ! intent(inout)
2644 0 : call stat_end_update( nz, stats_metadata%iwprtp_bt, wprtp(i,:) / dt, & ! intent(in)
2645 0 : stats_zm(i) ) ! intent(inout)
2646 0 : call stat_end_update( nz, stats_metadata%iwpthlp_bt, wpthlp(i,:) / dt, & ! intent(in)
2647 0 : stats_zm(i) ) ! intent(inout)
2648 0 : if ( clubb_config_flags%l_predict_upwp_vpwp ) then
2649 0 : call stat_end_update( nz, stats_metadata%iupwp_bt, upwp(i,:) / dt, & ! intent(in)
2650 0 : stats_zm(i) ) ! intent(inout)
2651 0 : call stat_end_update( nz, stats_metadata%ivpwp_bt, vpwp(i,:) / dt, & ! intent(in)
2652 0 : stats_zm(i) ) ! intent(inout)
2653 : endif ! l_predict_upwp_vpwp
2654 0 : call stat_end_update( nz, stats_metadata%irtp2_bt, rtp2(i,:) / dt, & ! intent(in)
2655 0 : stats_zm(i) ) ! intent(inout)
2656 0 : call stat_end_update( nz, stats_metadata%ithlp2_bt, thlp2(i,:) / dt, & ! intent(in)
2657 0 : stats_zm(i) ) ! intent(inout)
2658 0 : call stat_end_update( nz, stats_metadata%irtpthlp_bt, rtpthlp(i,:) / dt, & ! intent(in)
2659 0 : stats_zm(i) ) ! intent(inout)
2660 :
2661 0 : call stat_end_update( nz, stats_metadata%irtm_bt, rtm(i,:) / dt, & ! intent(in)
2662 0 : stats_zt(i) ) ! intent(inout)
2663 0 : call stat_end_update( nz, stats_metadata%ithlm_bt, thlm(i,:) / dt, & ! intent(in)
2664 0 : stats_zt(i) ) ! intent(inout)
2665 0 : call stat_end_update( nz, stats_metadata%ium_bt, um(i,:) / dt, & ! intent(in)
2666 0 : stats_zt(i) ) ! intent(inout)
2667 0 : call stat_end_update( nz, stats_metadata%ivm_bt, vm(i,:) / dt, & ! intent(in)
2668 0 : stats_zt(i) ) ! intent(inout)
2669 0 : call stat_end_update( nz, stats_metadata%iwp3_bt, wp3(i,:) / dt, & ! intent(in)
2670 0 : stats_zt(i) ) ! intent(inout)
2671 : end do
2672 :
2673 0 : if ( stats_metadata%iwpthlp_zt > 0 ) then
2674 0 : wpthlp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wpthlp(:,:) )
2675 : end if
2676 :
2677 0 : if ( stats_metadata%iwprtp_zt > 0 ) then
2678 0 : wprtp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wprtp(:,:) )
2679 : end if
2680 :
2681 0 : if ( stats_metadata%iup2_zt > 0 ) then
2682 0 : up2_zt(:,:) = max( zm2zt( nz, ngrdcol, gr, up2(:,:) ), w_tol_sqd )
2683 : end if
2684 :
2685 0 : if (stats_metadata%ivp2_zt > 0 ) then
2686 0 : vp2_zt(:,:) = max( zm2zt( nz, ngrdcol, gr, vp2(:,:) ), w_tol_sqd )
2687 : end if
2688 :
2689 0 : if ( stats_metadata%iupwp_zt > 0 ) then
2690 0 : upwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, upwp(:,:) )
2691 : end if
2692 :
2693 0 : if ( stats_metadata%ivpwp_zt > 0 ) then
2694 0 : vpwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, vpwp(:,:) )
2695 : end if
2696 :
2697 0 : do i = 1, ngrdcol
2698 :
2699 : ! Allocate arrays in single column versions of pdf_params
2700 0 : call init_pdf_params( nz, 1, pdf_params_single_col(i) )
2701 0 : call init_pdf_params( nz, 1, pdf_params_zm_single_col(i) )
2702 :
2703 : ! Copy multicolumn pdf_params to single column version
2704 : call copy_multi_pdf_params_to_single( pdf_params, i, &
2705 0 : pdf_params_single_col(i) )
2706 :
2707 : call copy_multi_pdf_params_to_single( pdf_params_zm, i, &
2708 0 : pdf_params_zm_single_col(i) )
2709 :
2710 : call stats_accumulate( &
2711 0 : nz, gr%invrs_dzm(i,:), gr%zt(i,:), gr%dzm(i,:), gr%dzt(i,:), dt, & ! intent(in)
2712 0 : um(i,:), vm(i,:), upwp(i,:), vpwp(i,:), up2(i,:), vp2(i,:), & ! intent(in)
2713 0 : thlm(i,:), rtm(i,:), wprtp(i,:), wpthlp(i,:), & ! intent(in)
2714 0 : wp2(i,:), wp3(i,:), rtp2(i,:), rtp3(i,:), thlp2(i,:), thlp3(i,:), rtpthlp(i,:), & ! intent(in)
2715 0 : wpthvp(i,:), wp2thvp(i,:), rtpthvp(i,:), thlpthvp(i,:), & ! intent(in)
2716 0 : p_in_Pa(i,:), exner(i,:), rho(i,:), rho_zm(i,:), & ! intent(in)
2717 0 : rho_ds_zm(i,:), rho_ds_zt(i,:), thv_ds_zm(i,:), thv_ds_zt(i,:), & ! intent(in)
2718 0 : wm_zt(i,:), wm_zm(i,:), rcm(i,:), wprcp(i,:), rc_coef(i,:), rc_coef_zm(i,:), & ! intent(in)
2719 0 : rcm_zm(i,:), rtm_zm(i,:), thlm_zm(i,:), cloud_frac(i,:), ice_supersat_frac(i,:),& ! intent(in)
2720 0 : cloud_frac_zm(i,:), ice_supersat_frac_zm(i,:), rcm_in_layer(i,:), & ! intent(in)
2721 0 : cloud_cover(i,:), rcm_supersat_adj(i,:), sigma_sqd_w(i,:), & ! intent(in)
2722 0 : thvm(i,:), ug(i,:), vg(i,:), Lscale(i,:), wpthlp2(i,:), wp2thlp(i,:), wprtp2(i,:), wp2rtp(i,:),& ! intent(in)
2723 0 : Lscale_up(i,:), Lscale_down(i,:), tau_zt(i,:), Kh_zt(i,:), wp2rcp(i,:), & ! intent(in)
2724 0 : wprtpthlp(i,:), sigma_sqd_w_zt(i,:), rsat(i,:), wp2_zt(i,:), thlp2_zt(i,:), & ! intent(in)
2725 0 : wpthlp_zt(i,:), wprtp_zt(i,:), rtp2_zt(i,:), rtpthlp_zt(i,:), up2_zt(i,:), & ! intent(in)
2726 0 : vp2_zt(i,:), upwp_zt(i,:), vpwp_zt(i,:), wpup2(i,:), wpvp2(i,:), & ! intent(in)
2727 0 : wp2up2(i,:), wp2vp2(i,:), wp4(i,:), & ! intent(in)
2728 0 : tau_zm(i,:), Kh_zm(i,:), thlprcp(i,:), & ! intent(in)
2729 0 : rtprcp(i,:), rcp2(i,:), em(i,:), a3_coef(i,:), a3_coef_zt(i,:), & ! intent(in)
2730 0 : wp3_zm(i,:), wp3_on_wp2(i,:), wp3_on_wp2_zt(i,:), Skw_velocity(i,:), & ! intent(in)
2731 0 : w_up_in_cloud(i,:), w_down_in_cloud(i,:), & ! intent(in)
2732 0 : cloudy_updraft_frac(i,:), cloudy_downdraft_frac(i,:), & ! intent(in)
2733 0 : pdf_params_single_col(i), pdf_params_zm_single_col(i), sclrm(i,:,:), sclrp2(i,:,:), & ! intent(in)
2734 : sclrprtp(i,:,:), sclrpthlp(i,:,:), sclrm_forcing(i,:,:), sclrpthvp(i,:,:), & ! intent(in)
2735 : wpsclrp(i,:,:), sclrprcp(i,:,:), wp2sclrp(i,:,:), wpsclrp2(i,:,:), wpsclrprtp(i,:,:), & ! intent(in)
2736 : wpsclrpthlp(i,:,:), wpedsclrp(i,:,:), edsclrm(i,:,:), edsclrm_forcing(i,:,:), & ! intent(in)
2737 : stats_metadata, & ! intent(in)
2738 0 : stats_zt(i), stats_zm(i), stats_sfc(i) ) ! intent(inout)
2739 : end do
2740 : endif ! stats_metadata%l_stats_samp
2741 :
2742 352944 : if ( clubb_at_least_debug_level( 2 ) ) then
2743 :
2744 : !$acc update host( thlm_forcing, rtm_forcing, um_forcing, &
2745 : !$acc vm_forcing, wm_zm, wm_zt, p_in_Pa, &
2746 : !$acc rho_zm, rho, exner, rho_ds_zm, &
2747 : !$acc rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt, &
2748 : !$acc thv_ds_zm, thv_ds_zt, wpthlp_sfc, wprtp_sfc, upwp_sfc, &
2749 : !$acc vpwp_sfc, um, upwp, vm, vpwp, up2, vp2, &
2750 : !$acc rtm, wprtp, thlm, wpthlp, wp2, wp3, &
2751 : !$acc rtp2, thlp2, rtpthlp, &
2752 : !$acc wpsclrp_sfc, wpedsclrp_sfc, sclrm, wpsclrp, sclrp2, &
2753 : !$acc sclrprtp, sclrpthlp, sclrm_forcing, edsclrm, edsclrm_forcing )
2754 :
2755 0 : do i = 1, ngrdcol
2756 : call parameterization_check( &
2757 0 : nz, thlm_forcing(i,:), rtm_forcing(i,:), um_forcing(i,:), & ! intent(in)
2758 0 : vm_forcing(i,:), wm_zm(i,:), wm_zt(i,:), p_in_Pa(i,:), & ! intent(in)
2759 0 : rho_zm(i,:), rho(i,:), exner(i,:), rho_ds_zm(i,:), & ! intent(in)
2760 0 : rho_ds_zt(i,:), invrs_rho_ds_zm(i,:), invrs_rho_ds_zt(i,:), & ! intent(in)
2761 0 : thv_ds_zm(i,:), thv_ds_zt(i,:), wpthlp_sfc(i), wprtp_sfc(i), upwp_sfc(i), & ! intent(in)
2762 : vpwp_sfc(i), um(i,:), upwp(i,:), vm(i,:), vpwp(i,:), up2(i,:), vp2(i,:), & ! intent(in)
2763 0 : rtm(i,:), wprtp(i,:), thlm(i,:), wpthlp(i,:), wp2(i,:), wp3(i,:), & ! intent(in)
2764 0 : rtp2(i,:), thlp2(i,:), rtpthlp(i,:), & ! intent(in)
2765 : !rcm, &
2766 : "end of ", & ! intent(in)
2767 0 : wpsclrp_sfc(i,:), wpedsclrp_sfc(i,:), sclrm(i,:,:), wpsclrp(i,:,:), sclrp2(i,:,:), & ! intent(in)
2768 0 : sclrprtp(i,:,:), sclrpthlp(i,:,:), sclrm_forcing(i,:,:), edsclrm(i,:,:), edsclrm_forcing(i,:,:) ) ! intent(in)
2769 : end do
2770 :
2771 0 : if ( err_code == clubb_fatal_error ) then
2772 : write(fstderr,*) "Error occurred during parameterization_check at"// &
2773 0 : " end of advance_clubb_core"
2774 0 : err_code_out = err_code
2775 : !return
2776 : end if
2777 :
2778 : end if
2779 :
2780 352944 : if ( stats_metadata%l_stats .and. stats_metadata%l_stats_samp ) then
2781 :
2782 : !$acc update host( wm_zt, wm_zm, rho_ds_zm, wprtp, wprtp_sfc, rho_ds_zt, &
2783 : !$acc rtm, rtm_forcing, thlm, thlm_forcing )
2784 :
2785 : ! Spurious source will only be calculated if rtm_ma and thlm_ma are zero.
2786 : ! Therefore, wm must be zero or l_implemented must be true.
2787 0 : do i = 1, ngrdcol
2788 0 : if ( l_implemented .or. &
2789 0 : (all( abs(wm_zt(i,:)) < eps ) .and. all( abs(wm_zm(i,:)) < eps ))) then
2790 : ! Calculate the spurious source for rtm
2791 0 : rtm_flux_top(i) = rho_ds_zm(i,nz) * wprtp(i,nz)
2792 :
2793 0 : if ( .not. l_host_applies_sfc_fluxes ) then
2794 0 : rtm_flux_sfc(i) = rho_ds_zm(i,1) * wprtp_sfc(i)
2795 : else
2796 0 : rtm_flux_sfc(i) = 0.0_core_rknd
2797 : end if
2798 :
2799 : rtm_integral_after(i) &
2800 0 : = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
2801 0 : rtm(i,2:nz), gr%dzt(i,2:nz) )
2802 :
2803 0 : rtm_integral_forcing(i) &
2804 : = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
2805 0 : rtm_forcing(i,2:nz), gr%dzt(i,2:nz) )
2806 :
2807 0 : rtm_spur_src(i) &
2808 : = calculate_spurious_source( rtm_integral_after(i), &
2809 : rtm_integral_before(i), &
2810 : rtm_flux_top(i), rtm_flux_sfc(i), &
2811 : rtm_integral_forcing(i), &
2812 0 : dt )
2813 :
2814 : ! Calculate the spurious source for thlm
2815 0 : thlm_flux_top(i) = rho_ds_zm(i,nz) * wpthlp(i,nz)
2816 :
2817 0 : if ( .not. l_host_applies_sfc_fluxes ) then
2818 0 : thlm_flux_sfc(i) = rho_ds_zm(i,1) * wpthlp_sfc(i)
2819 : else
2820 0 : thlm_flux_sfc(i) = 0.0_core_rknd
2821 : end if
2822 :
2823 : thlm_integral_after(i) &
2824 : = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
2825 0 : thlm(i,2:nz), gr%dzt(i,2:nz) )
2826 :
2827 0 : thlm_integral_forcing(i) &
2828 : = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
2829 0 : thlm_forcing(i,2:nz), gr%dzt(i,2:nz) )
2830 :
2831 0 : thlm_spur_src(i) &
2832 : = calculate_spurious_source( thlm_integral_after(i), &
2833 : thlm_integral_before(i), &
2834 : thlm_flux_top(i), thlm_flux_sfc(i), &
2835 : thlm_integral_forcing(i), &
2836 0 : dt )
2837 : else ! If l_implemented is false, we don't want spurious source output
2838 0 : rtm_spur_src(i) = -9999.0_core_rknd
2839 0 : thlm_spur_src(i) = -9999.0_core_rknd
2840 : end if
2841 : end do
2842 :
2843 : ! Write the var to stats
2844 0 : do i = 1, ngrdcol
2845 0 : call stat_update_var_pt( stats_metadata%irtm_spur_src, 1, rtm_spur_src(i), & ! intent(in)
2846 0 : stats_sfc(i) ) ! intent(inout)
2847 0 : call stat_update_var_pt( stats_metadata%ithlm_spur_src, 1, thlm_spur_src(i), & ! intent(in)
2848 0 : stats_sfc(i) ) ! intent(inout)
2849 : end do
2850 : end if
2851 :
2852 : !$acc end data
2853 :
2854 : !$acc exit data delete( Skw_zm, Skw_zt, thvm, thvm_zm, ddzm_thvm_zm, rtprcp, rcp2, &
2855 : !$acc wpthlp2, wprtp2, wprtpthlp, wp2rcp, wp3_zm, Lscale, Lscale_up, &
2856 : !$acc Lscale_zm, Lscale_down, em, tau_zm, tau_zt, sigma_sqd_w_zt, &
2857 : !$acc wp2_zt, thlp2_zt, wpthlp_zt, &
2858 : !$acc wprtp_zt, rtp2_zt, rtpthlp_zt, up2_zt, vp2_zt, upwp_zt, vpwp_zt, &
2859 : !$acc Skw_velocity, a3_coef, a3_coef_zt, wp3_on_wp2, wp3_on_wp2_zt, &
2860 : !$acc rc_coef_zm, Km_zm, Kmh_zm, gamma_Skw_fnc, sigma_sqd_w, sigma_sqd_w_tmp, &
2861 : !$acc sqrt_em_zt, xp3_coef_fnc, w_1_zm, w_2_zm, varnce_w_1_zm, varnce_w_2_zm, &
2862 : !$acc mixt_frac_zm, rcp2_zt, cloud_frac_zm, ice_supersat_frac_zm, rtm_zm, &
2863 : !$acc thlm_zm, rcm_zm, thlm1000, thlm700, &
2864 : !$acc rcm_supersat_adj, stability_correction, invrs_tau_N2_zm, &
2865 : !$acc invrs_tau_C6_zm, invrs_tau_C1_zm, invrs_tau_xp2_zm, invrs_tau_N2_iso, &
2866 : !$acc invrs_tau_C4_zm, invrs_tau_C14_zm, invrs_tau_wp2_zm, invrs_tau_wpxp_zm, &
2867 : !$acc invrs_tau_wp3_zm, invrs_tau_no_N2_zm, invrs_tau_bkgnd, invrs_tau_shear, &
2868 : !$acc invrs_tau_sfc, invrs_tau_zt, invrs_tau_wp3_zt, Cx_fnc_Richardson, &
2869 : !$acc brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, &
2870 : !$acc brunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_moist, &
2871 : !$acc brunt_vaisala_freq_sqd_splat, &
2872 : !$acc brunt_vaisala_freq_sqd_zt, Ri_zm, Lscale_max, &
2873 : !$acc tau_max_zm, tau_max_zt, newmu, lhs_splat_wp2, lhs_splat_wp3 )
2874 :
2875 : !$acc exit data if( sclr_dim > 0 ) &
2876 : !$acc delete( wpedsclrp, sclrprcp, wp2sclrp, &
2877 : !$acc wpsclrp2, wpsclrprtp, wpsclrpthlp, wpsclrp_zt, sclrp2_zt )
2878 :
2879 : !$acc exit data if( sclr_dim > 0 ) &
2880 : !$acc delete( hydromet, wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt )
2881 :
2882 352944 : return
2883 :
2884 531878400 : end subroutine advance_clubb_core
2885 :
2886 : !=============================================================================
2887 352944 : subroutine pdf_closure_driver( gr, nz, ngrdcol, & ! Intent(in)
2888 352944 : dt, hydromet_dim, wprtp, & ! Intent(in)
2889 352944 : thlm, wpthlp, rtp2, rtp3, & ! Intent(in)
2890 352944 : thlp2, thlp3, rtpthlp, wp2, & ! Intent(in)
2891 352944 : wp3, wm_zm, wm_zt, & ! Intent(in)
2892 352944 : um, up2, upwp, up3, & ! Intent(in)
2893 352944 : vm, vp2, vpwp, vp3, & ! Intent(in)
2894 352944 : p_in_Pa, exner, & ! Intent(in)
2895 352944 : thv_ds_zm, thv_ds_zt, rtm_ref, & ! Intent(in)
2896 : ! rfrzm, hydromet, &
2897 352944 : wphydrometp, & ! Intent(in)
2898 352944 : wp2hmp, rtphmp_zt, thlphmp_zt, & ! Intent(in)
2899 352944 : sclrm, wpsclrp, sclrp2, & ! Intent(in)
2900 352944 : sclrprtp, sclrpthlp, sclrp3, & ! Intent(in)
2901 : l_samp_stats_in_pdf_call, & ! Intent(in)
2902 : clubb_params, & ! Intent(in)
2903 : iiPDF_type, & ! Intent(in)
2904 : l_predict_upwp_vpwp, & ! Intent(in)
2905 : l_rtm_nudge, & ! Intent(in)
2906 : l_trapezoidal_rule_zt, & ! Intent(in)
2907 : l_trapezoidal_rule_zm, & ! Intent(in)
2908 : l_call_pdf_closure_twice, & ! Intent(in)
2909 : l_use_cloud_cover, & ! Intent(in)
2910 : l_rcm_supersat_adj, & ! Intent(in)
2911 : stats_metadata, & ! Intent(in)
2912 352944 : stats_zt, stats_zm, & ! Intent(inout)
2913 352944 : rtm, & ! Intent(inout)
2914 : pdf_implicit_coefs_terms, & ! Intent(inout)
2915 : pdf_params, pdf_params_zm, & ! Intent(inout)
2916 : #ifdef GFDL
2917 : RH_crit(k, : , :), & ! Intent(inout)
2918 : do_liquid_only_in_clubb, & ! Intent(in)
2919 : #endif
2920 352944 : rcm, cloud_frac, & ! Intent(out)
2921 352944 : ice_supersat_frac, wprcp, & ! Intent(out)
2922 352944 : sigma_sqd_w, wpthvp, wp2thvp, & ! Intent(out)
2923 352944 : rtpthvp, thlpthvp, rc_coef, & ! Intent(out)
2924 352944 : rcm_in_layer, cloud_cover, & ! Intent(out)
2925 352944 : rcp2_zt, thlprcp, & ! Intent(out)
2926 352944 : rc_coef_zm, sclrpthvp, & ! Intent(out)
2927 352944 : wpup2, wpvp2, & ! Intent(out)
2928 352944 : wp2up2, wp2vp2, wp4, & ! Intent(out)
2929 352944 : wp2rtp, wprtp2, wp2thlp, & ! Intent(out)
2930 352944 : wpthlp2, wprtpthlp, wp2rcp, & ! Intent(out)
2931 352944 : rtprcp, rcp2, & ! Intent(out)
2932 352944 : uprcp, vprcp, & ! Intent(out)
2933 352944 : w_up_in_cloud, w_down_in_cloud,& ! Intent(out)
2934 352944 : cloudy_updraft_frac, & ! Intent(out)
2935 352944 : cloudy_downdraft_frac, & ! intent(out)
2936 352944 : Skw_velocity, & ! Intent(out)
2937 352944 : cloud_frac_zm, & ! Intent(out)
2938 352944 : ice_supersat_frac_zm, & ! Intent(out)
2939 352944 : rtm_zm, thlm_zm, rcm_zm, & ! Intent(out)
2940 352944 : rcm_supersat_adj, & ! Intent(out)
2941 352944 : wp2sclrp, wpsclrp2, sclrprcp, & ! Intent(out)
2942 352944 : wpsclrprtp, wpsclrpthlp ) ! Intent(out)
2943 :
2944 : use grid_class, only: &
2945 : grid, & ! Type
2946 : zt2zm, & ! Procedure(s)
2947 : zm2zt, &
2948 : zm2zt2zm
2949 :
2950 : use constants_clubb, only: &
2951 : one_half, & ! Variable(s)
2952 : w_tol, &
2953 : w_tol_sqd, &
2954 : rt_tol, &
2955 : thl_tol, &
2956 : p0, &
2957 : kappa, &
2958 : fstderr, &
2959 : zero, &
2960 : zero_threshold, &
2961 : eps
2962 :
2963 : use pdf_parameter_module, only: &
2964 : pdf_parameter, & ! Variable Type
2965 : implicit_coefs_terms, & ! Variable Type
2966 : init_pdf_implicit_coefs_terms ! Procedure
2967 :
2968 : use parameters_model, only: &
2969 : sclr_dim, & ! Variable(s)
2970 : sclr_tol, &
2971 : ts_nudge, &
2972 : rtm_min, &
2973 : rtm_nudge_max_altitude
2974 :
2975 : use parameter_indices, only: &
2976 : nparams, & ! Variable(s)
2977 : igamma_coef, &
2978 : igamma_coefb, &
2979 : igamma_coefc, &
2980 : iSkw_denom_coef, &
2981 : iSkw_max_mag
2982 :
2983 : use pdf_closure_module, only: &
2984 : pdf_closure ! Procedure(s)
2985 :
2986 : use Skx_module, only: &
2987 : Skx_func ! Procedure(s)
2988 :
2989 : use sigma_sqd_w_module, only: &
2990 : compute_sigma_sqd_w ! Procedure(s)
2991 :
2992 : use pdf_utilities, only: &
2993 : compute_mean_binormal ! Procedure(s)
2994 :
2995 : use T_in_K_module, only: &
2996 : thlm2T_in_K ! Procedure(s)
2997 :
2998 : use saturation, only: &
2999 : sat_mixrat_liq ! Procedure(s)
3000 :
3001 : use model_flags, only: &
3002 : l_gamma_Skw, & ! Variable(s)
3003 : iiPDF_new, & ! new PDF
3004 : iiPDF_new_hybrid ! new hybrid PDF
3005 :
3006 : use error_code, only: &
3007 : clubb_at_least_debug_level, & ! Procedure
3008 : err_code, & ! Error Indicator
3009 : clubb_fatal_error ! Constant
3010 :
3011 : use stats_type_utilities, only: &
3012 : stat_update_var, & ! Procedure(s)
3013 : stat_update_var_pt
3014 :
3015 : use stats_variables, only: &
3016 : stats_metadata_type
3017 :
3018 : use clubb_precision, only: &
3019 : core_rknd ! Variable(s)
3020 :
3021 : use stats_type, only: stats ! Type
3022 :
3023 : implicit none
3024 :
3025 : !------------------------------- Input Variables -------------------------------
3026 : type (grid), target, intent(in) :: &
3027 : gr
3028 :
3029 : integer, intent(in) :: &
3030 : nz, &
3031 : ngrdcol
3032 :
3033 : real( kind = core_rknd ), intent(in) :: &
3034 : dt ! Current timestep duration [s]
3035 :
3036 : integer, intent(in) :: &
3037 : hydromet_dim ! Total number of hydrometeors [#]
3038 :
3039 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3040 : !rtm, & ! total water mixing ratio, r_t (thermo. levels) [kg/kg]
3041 : wprtp, & ! w' r_t' (momentum levels) [(kg/kg)m/s]
3042 : thlm, & ! liq. water pot. temp., th_l (thermo. levels) [K]
3043 : wpthlp, & ! w' th_l' (momentum levels) [(m/s) K]
3044 : rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2]
3045 : rtp3, & ! r_t'^3 (thermodynamic levels) [(kg/kg)^3]
3046 : thlp2, & ! th_l'^2 (momentum levels) [K^2]
3047 : thlp3, & ! th_l'^3 (thermodynamic levels) [K^3]
3048 : rtpthlp, & ! r_t' th_l' (momentum levels) [(kg/kg) K]
3049 : wp2, & ! w'^2 (momentum levels) [m^2/s^2]
3050 : wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3]
3051 : wm_zm, & ! w mean wind component on momentum levels [m/s]
3052 : wm_zt, & ! w mean wind component on thermo. levels [m/s]
3053 : p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa]
3054 : exner, & ! Exner function (thermodynamic levels) [-]
3055 : thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K]
3056 : thv_ds_zt, & ! Dry, base-state theta_v on thermo. levs. [K]
3057 : rtm_ref!, & ! Initial total water mixing ratio [kg/kg]
3058 : !rfrzm ! Total ice-phase water mixing ratio [kg/kg]
3059 :
3060 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3061 : um, & ! Grid-mean eastward wind [m/s]
3062 : up2, & ! u'^2 [(m/s)^2]
3063 : upwp, & ! u'w' [(m/s)^2]
3064 : up3, & ! u'^3 [(m/s)^3]
3065 : vm, & ! Grid-mean northward wind [m/s]
3066 : vp2, & ! v'^2 [(m/s)^2]
3067 : vpwp, & ! v'w' [(m/s)^2]
3068 : vp3 ! v'^3 [(m/s)^3]
3069 :
3070 : ! Hydrometeor variables
3071 : !real( kind = core_rknd ), dimension(gr%nz,hydromet_dim), intent(in) :: &
3072 : !hydromet ! Mean of hydrometeor fields [units vary]
3073 :
3074 : real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim), intent(in) :: &
3075 : wphydrometp, & ! Covariance of w and a hydrometeor [(m/s) <hm units>]
3076 : wp2hmp, & ! Third-order moment: < w'^2 hm' > [(m/s)^2 <hm units>]
3077 : rtphmp_zt, & ! Covariance of rt and hm (on t-levs.) [(kg/kg) <hm units>]
3078 : thlphmp_zt ! Covariance of thl and hm (on t-levs.) [K <hm units>]
3079 :
3080 : ! Passive scalar variables
3081 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(in) :: &
3082 : sclrm, & ! Passive scalar mean (thermo. levels) [units vary]
3083 : wpsclrp, & ! w'sclr' (momentum levels) [{units vary} m/s]
3084 : sclrp2, & ! sclr'^2 (momentum levels) [{units vary}^2]
3085 : sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)]
3086 : sclrpthlp, & ! sclr'thl' (momentum levels) [{units vary} K]
3087 : sclrp3 ! sclr'^3 (thermodynamic levels) [{units vary}^3]
3088 :
3089 : logical, intent(in) :: &
3090 : l_samp_stats_in_pdf_call ! Sample stats in this call to this subroutine
3091 :
3092 : real( kind = core_rknd ), dimension(nparams), intent(in) :: &
3093 : clubb_params ! Array of CLUBB's tunable parameters [units vary]
3094 :
3095 : integer, intent(in) :: &
3096 : iiPDF_type ! Selected option for the two-component normal (double
3097 : ! Gaussian) PDF type to use for the w, rt, and theta-l (or
3098 : ! w, chi, and eta) portion of CLUBB's multivariate,
3099 : ! two-component PDF.
3100 :
3101 : logical, intent(in) :: &
3102 : l_predict_upwp_vpwp, & ! Flag to predict <u'w'> and <v'w'> along with <u> and <v>
3103 : ! alongside the advancement of <rt>, <w'rt'>, <thl>, <wpthlp>,
3104 : ! <sclr>, and <w'sclr'> in subroutine advance_xm_wpxp.
3105 : ! Otherwise, <u'w'> and <v'w'> are still approximated by eddy
3106 : ! diffusivity when <u> and <v> are advanced in subroutine
3107 : ! advance_windm_edsclrm.
3108 : l_rtm_nudge, & ! For rtm nudging
3109 : l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the
3110 : ! thermodynamic-level variables output from pdf_closure.
3111 : l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three
3112 : ! momentum-level variables – wpthvp, thlpthvp, and rtpthvp -
3113 : ! output from pdf_closure.
3114 : l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call subroutine
3115 : ! pdf_closure twice. If true, pdf_closure is called first on
3116 : ! thermodynamic levels and then on momentum levels so that each
3117 : ! variable is computed on its native level. If false,
3118 : ! pdf_closure is only called on thermodynamic levels, and
3119 : ! variables which belong on momentum levels are interpolated.
3120 : l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac and
3121 : ! rcm to help increase cloudiness at coarser grid resolutions.
3122 : l_rcm_supersat_adj ! Add excess supersaturated vapor to cloud water
3123 :
3124 : type (stats_metadata_type), intent(in) :: &
3125 : stats_metadata
3126 :
3127 : !------------------------------- InOut Variables -------------------------------
3128 : type (stats), target, dimension(ngrdcol), intent(inout) :: &
3129 : stats_zt, &
3130 : stats_zm
3131 :
3132 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
3133 : rtm ! total water mixing ratio, r_t (thermo. levels) [kg/kg]
3134 :
3135 : type(implicit_coefs_terms), intent(inout) :: &
3136 : pdf_implicit_coefs_terms ! Implicit coefs / explicit terms [units vary]
3137 :
3138 : ! Variable being passed back to and out of advance_clubb_core.
3139 : type(pdf_parameter), intent(inout) :: &
3140 : pdf_params, & ! PDF parameters [units vary]
3141 : pdf_params_zm ! PDF parameters [units vary]
3142 :
3143 : #ifdef GFDL
3144 : ! hlg, 2010-06-16
3145 : real( kind = core_rknd ), dimension(ngrdcol,nz, min(1,sclr_dim) , 2), intent(inout) :: &
3146 : RH_crit ! critical relative humidity for droplet and ice nucleation
3147 : ! ---> h1g, 2012-06-14
3148 : logical, intent(in) :: do_liquid_only_in_clubb
3149 : ! <--- h1g, 2012-06-14
3150 : #endif
3151 :
3152 : !------------------------------- Output Variables -------------------------------
3153 : ! Variables being passed back to and out of advance_clubb_core.
3154 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3155 : rcm, & ! mean r_c (thermodynamic levels) [kg/kg]
3156 : cloud_frac, & ! cloud fraction (thermodynamic levels) [-]
3157 : ice_supersat_frac, & ! ice supersat. frac. (thermo. levels) [-]
3158 : wprcp, & ! < w'r_c' > (momentum levels) [m/s kg/kg]
3159 : sigma_sqd_w, & ! PDF width parameter (momentum levels) [-]
3160 : wpthvp, & ! < w' th_v' > (momentum levels) [kg/kg K]
3161 : wp2thvp, & ! < w'^2 th_v' > (thermodynamic levels) [m^2/s^2 K]
3162 : rtpthvp, & ! < r_t' th_v' > (momentum levels) [kg/kg K]
3163 : thlpthvp, & ! < th_l' th_v' > (momentum levels) [K^2]
3164 : rc_coef, & ! Coefficient of X'r_c' (thermo. levs.) [K/(kg/kg)]
3165 : rcm_in_layer, & ! rcm in cloud layer [kg/kg]
3166 : cloud_cover, & ! cloud cover [-]
3167 : rcp2_zt, & ! r_c'^2 (on thermo. grid) [kg^2/kg^2]
3168 : thlprcp, & ! < th_l' r_c' > (momentum levels) [K kg/kg]
3169 : rc_coef_zm ! Coefficient of X'r_c' on m-levs. [K/(kg/kg)]
3170 :
3171 : ! Variable being passed back to and out of advance_clubb_core.
3172 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(out) :: &
3173 : sclrpthvp ! < sclr' th_v' > (momentum levels) [units vary]
3174 :
3175 : ! Variables being passed back to only advance_clubb_core (for statistics).
3176 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3177 : wpup2, & ! < w'u'^2 > (thermodynamic levels) [m^3/s^3]
3178 : wpvp2, & ! < w'v'^2 > (thermodynamic levels) [m^3/s^3]
3179 : wp2up2, & ! < w'^2u'^2 > (momentum levels) [m^4/s^4]
3180 : wp2vp2, & ! < w'^2v'^2 > (momentum levels) [m^4/s^4]
3181 : wp4, & ! < w'^4 > (momentum levels) [m^4/s^4]
3182 : wp2rtp, & ! < w'^2 r_t' > (thermodynamic levels) [m^2/s^2 kg/kg]
3183 : wprtp2, & ! < w' r_t'^2 > (thermodynamic levels) [m/s kg^2/kg^2]
3184 : wp2thlp, & ! < w'^2 th_l' > (thermodynamic levels) [m^2/s^2 K]
3185 : wpthlp2, & ! < w' th_l'^2 > (thermodynamic levels) [m/s K^2]
3186 : wprtpthlp, & ! < w' r_t' th_l' > (thermodynamic levels) [m/s kg/kg K]
3187 : wp2rcp, & ! < w'^2 r_c' > (thermodynamic levels) [m^2/s^2 kg/kg]
3188 : rtprcp, & ! < r_t' r_c' > (momentum levels) [kg^2/kg^2]
3189 : rcp2 ! Variance of r_c (momentum levels) [kg^2/kg^2]
3190 :
3191 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3192 : uprcp, & ! < u' r_c' > [(m kg)/(s kg)]
3193 : vprcp, & ! < v' r_c' > [(m kg)/(s kg)]
3194 : w_up_in_cloud, & ! mean cloudy updraft vel [m/s]
3195 : w_down_in_cloud, & ! mean cloudy downdraft vel [m/s]
3196 : cloudy_updraft_frac, & ! cloudy updraft fraction [-]
3197 : cloudy_downdraft_frac ! cloudy downdraft fraction [-]
3198 :
3199 : ! Variables being passed back to only advance_clubb_core (for statistics).
3200 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3201 : Skw_velocity, & ! Skewness velocity [m/s]
3202 : cloud_frac_zm, & ! Cloud Fraction on momentum levels [-]
3203 : ice_supersat_frac_zm, & ! Ice supersat. frac. on momentum levels [-]
3204 : rtm_zm, & ! Total water mixing ratio at mom. levs. [kg/kg]
3205 : thlm_zm, & ! Liquid water pot. temp. at mom. levs. [K]
3206 : rcm_zm, & ! rcm at momentum levels [kg/kg]
3207 : rcm_supersat_adj ! Adjust. to rcm due to spurious supersat. [kg/kg]
3208 :
3209 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(out) :: &
3210 : wp2sclrp, & ! < w'^2 sclr' > (thermodynamic levels) [units vary]
3211 : wpsclrp2, & ! < w' sclr'^2 > (thermodynamic levels) [units vary]
3212 : sclrprcp, & ! < sclr' r_c' > (momentum levels) [units vary]
3213 : wpsclrprtp, & ! < w' sclr' r_t' > (thermodynamic levels) [units vary]
3214 : wpsclrpthlp ! < w' sclr' th_l' > (thermodynamic levels) [units vary]
3215 :
3216 : !------------------------------- Local Variables -------------------------------
3217 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3218 705888 : wp2_zt, & ! wp2 interpolated to thermodynamic levels [m^2/s^2]
3219 705888 : wp3_zm, & ! wp3 interpolated to momentum levels [m^3/s^3]
3220 705888 : rtp2_zt, & ! rtp2 interpolated to thermodynamic levels [kg^2/kg^2]
3221 705888 : rtp3_zm, & ! rtp3 interpolated to momentum levels [kg^3/kg^3]
3222 705888 : thlp2_zt, & ! thlp2 interpolated to thermodynamic levels [K^2]
3223 705888 : thlp3_zm, & ! thlp3 interpolated to momentum levels [K^3]
3224 705888 : wprtp_zt, & ! wprtp interpolated to thermodynamic levels [m/s kg/kg]
3225 705888 : wpthlp_zt, & ! wpthlp interpolated to thermodynamic levs. [m/s K]
3226 705888 : rtpthlp_zt, & ! rtpthlp interp. to thermodynamic levels [kg/kg K]
3227 705888 : up2_zt, & ! up2 interpolated to thermodynamic levels [m^2/s^2]
3228 705888 : up3_zm, & ! up3 interpolated to momentum levels [m^3/s^3]
3229 705888 : vp2_zt, & ! vp2 interpolated to thermodynamic levels [m^2/s^2]
3230 705888 : vp3_zm, & ! vp3 interpolated to momentum levels [m^3/s^3]
3231 705888 : upwp_zt, & ! upwp interpolated to thermodynamic levels [m^2/s^2]
3232 705888 : vpwp_zt, & ! vpwp interpolated to thermodynamic levels [m^2/s^2]
3233 705888 : gamma_Skw_fnc, & ! Gamma as a function of skewness [-]
3234 705888 : gamma_Skw_fnc_zt, & ! Gamma as a function of skewness (t-levs.) [-]
3235 705888 : sigma_sqd_w_zt, & ! PDF width parameter (thermodynamic levels) [-]
3236 705888 : Skw_zt, & ! Skewness of w on thermodynamic levels [-]
3237 705888 : Skw_zm, & ! Skewness of w on momentum levels [-]
3238 705888 : Skrt_zt, & ! Skewness of rt on thermodynamic levels [-]
3239 705888 : Skrt_zm, & ! Skewness of rt on momentum levels [-]
3240 705888 : Skthl_zt, & ! Skewness of thl on thermodynamic levels [-]
3241 705888 : Skthl_zm, & ! Skewness of thl on momentum levels [-]
3242 705888 : Sku_zt, & ! Skewness of u on thermodynamic levels [-]
3243 705888 : Sku_zm, & ! Skewness of u on momentum levels [-]
3244 705888 : Skv_zt, & ! Skewness of v on thermodynamic levels [-]
3245 705888 : Skv_zm ! Skewness of v on momentum levels [-]
3246 :
3247 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3248 705888 : w_up_in_cloud_zm, & ! Avg. cloudy updraft velocity; m-levs [m/s]
3249 705888 : w_down_in_cloud_zm, & ! Avg. cloudy downdraft velocity; m-levs [m/s]
3250 705888 : cloudy_updraft_frac_zm, & ! cloudy updraft fraction; m-levs [-]
3251 705888 : cloudy_downdraft_frac_zm ! cloudy downdraft fraction; m-levs [-]
3252 :
3253 : ! Interpolated values for optional second call to PDF closure.
3254 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3255 705888 : p_in_Pa_zm, & ! Pressure interpolated to momentum levels [Pa]
3256 705888 : exner_zm ! Exner interpolated to momentum levels [-]
3257 :
3258 : real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim) :: &
3259 705888 : wphydrometp_zt, & ! Covariance of w and hm (on t-levs.) [(m/s) <hm units>]
3260 705888 : wp2hmp_zm, & ! Moment <w'^2 hm'> (on m-levs.) [(m/s)^2 <hm units>]
3261 705888 : rtphmp, & ! Covariance of rt and hm [(kg/kg) <hm units>]
3262 705888 : thlphmp ! Covariance of thl and hm [K <hm units>]
3263 :
3264 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
3265 705888 : wpsclrp_zt, & ! w' sclr' interpolated to thermo. levels
3266 705888 : sclrp2_zt, & ! sclr'^2 interpolated to thermo. levels
3267 705888 : sclrp3_zm, & ! sclr'^3 interpolated to momentum levels
3268 705888 : sclrprtp_zt, & ! sclr' r_t' interpolated to thermo. levels
3269 705888 : sclrpthlp_zt, & ! sclr' th_l' interpolated thermo. levels
3270 705888 : Sksclr_zt, & ! Skewness of sclr on thermodynamic levels [-]
3271 705888 : Sksclr_zm ! Skewness of sclr on momentum levels [-]
3272 :
3273 : ! These local variables are declared because they originally belong on the
3274 : ! momentum grid levels, but pdf_closure outputs them on the thermodynamic
3275 : ! grid levels.
3276 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3277 705888 : wpup2_zm, & ! w'u'^2 (on momentum grid) [m^3/s^3]
3278 705888 : wpvp2_zm, & ! w'v'^2 (on momentum grid) [m^3/s^3]
3279 705888 : wp2up2_zt, & ! w'^2u'^2 (on thermo. grid) [m^4/s^4]
3280 705888 : wp2vp2_zt, & ! w'^2v'^2 (on thermo. grid) [m^4/s^4]
3281 705888 : wp4_zt, & ! w'^4 (on thermo. grid) [m^4/s^4]
3282 705888 : wpthvp_zt, & ! Buoyancy flux (on thermo. grid) [(K m)/s]
3283 705888 : rtpthvp_zt, & ! r_t' th_v' (on thermo. grid) [(kg K)/kg]
3284 705888 : thlpthvp_zt, & ! th_l' th_v' (on thermo. grid) [K^2]
3285 705888 : wprcp_zt, & ! w' r_c' (on thermo. grid) [(m kg)/(s kg)]
3286 705888 : rtprcp_zt, & ! r_t' r_c' (on thermo. grid) [(kg^2)/(kg^2)]
3287 705888 : thlprcp_zt, & ! th_l' r_c' (on thermo. grid) [(K kg)/kg]
3288 705888 : uprcp_zt, & ! u' r_c' (on thermo. grid) [(m kg)/(s kg)]
3289 705888 : vprcp_zt ! v' r_c' (on thermo. grid) [(m kg)/(s kg)]
3290 :
3291 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
3292 705888 : sclrpthvp_zt, & ! sclr'th_v' (on thermo. grid)
3293 705888 : sclrprcp_zt ! sclr'rc' (on thermo. grid)
3294 :
3295 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3296 705888 : wprtp2_zm, & ! < w' r_t'^2 > on momentum levels [m/s kg^2/kg^2]
3297 705888 : wp2rtp_zm, & ! < w'^2 r_t' > on momentum levels [m^2/s^2 kg/kg]
3298 705888 : wpthlp2_zm, & ! < w' th_l'^2 > on momentum levels [m/s K^2]
3299 705888 : wp2thlp_zm, & ! < w'^2 th_l' > on momentum levels [m^2/s^2 K]
3300 705888 : wprtpthlp_zm, & ! < w' r_t' th_l' > on momentum levels [m/s kg/kg K]
3301 705888 : wp2thvp_zm, & ! < w'^2 th_v' > on momentum levels [m^2/s^2 K]
3302 705888 : wp2rcp_zm ! < w'^2 r_c' > on momentum levles [m^2/s^2 kg/kg]
3303 :
3304 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
3305 705888 : wpsclrprtp_zm, & ! w'sclr'rt' on momentum grid
3306 705888 : wpsclrp2_zm, & ! w'sclr'^2 on momentum grid
3307 705888 : wpsclrpthlp_zm, & ! w'sclr'thl' on momentum grid
3308 705888 : wp2sclrp_zm, & ! w'^2 sclr' on momentum grid
3309 705888 : sclrm_zm ! Passive scalar mean on momentum grid
3310 :
3311 : ! Output from new PDF for recording statistics.
3312 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3313 705888 : F_w, & ! Parameter for the spread of the PDF component means of w [-]
3314 705888 : F_rt, & ! Parameter for the spread of the PDF component means of rt [-]
3315 705888 : F_thl ! Parameter for the spread of the PDF component means of thl [-]
3316 :
3317 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3318 705888 : min_F_w, & ! Minimum allowable value of parameter F_w [-]
3319 705888 : max_F_w, & ! Maximum allowable value of parameter F_w [-]
3320 705888 : min_F_rt, & ! Minimum allowable value of parameter F_rt [-]
3321 705888 : max_F_rt, & ! Maximum allowable value of parameter F_rt [-]
3322 705888 : min_F_thl, & ! Minimum allowable value of parameter F_thl [-]
3323 705888 : max_F_thl ! Maximum allowable value of parameter F_thl [-]
3324 :
3325 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3326 705888 : F_w_zm, &
3327 705888 : F_rt_zm, &
3328 705888 : F_thl_zm, &
3329 705888 : min_F_w_zm, &
3330 705888 : max_F_w_zm, &
3331 705888 : min_F_rt_zm, &
3332 705888 : max_F_rt_zm, &
3333 705888 : min_F_thl_zm, &
3334 705888 : max_F_thl_zm
3335 :
3336 : type(implicit_coefs_terms) :: &
3337 352944 : pdf_implicit_coefs_terms_zm
3338 :
3339 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3340 705888 : rsat, & ! Saturation mixing ratio from mean rt and thl.
3341 705888 : rel_humidity ! Relative humidity after PDF closure [-]
3342 :
3343 : real( kind = core_rknd ) :: &
3344 : gamma_coef, & ! CLUBB tunable parameter gamma_coef
3345 : gamma_coefb, & ! CLUBB tunable parameter gamma_coefb
3346 : gamma_coefc, & ! CLUBB tunable parameter gamma_coefc
3347 : Skw_denom_coef, & ! CLUBB tunable parameter Skw_denom_coef
3348 : Skw_max_mag ! CLUBB tunable parameter Skw_max_mag
3349 :
3350 : real( kind = core_rknd ), dimension(ngrdcol, nz) :: &
3351 705888 : um_zm, &
3352 705888 : vm_zm, &
3353 705888 : T_in_K, &
3354 705888 : sigma_sqd_w_tmp
3355 :
3356 : logical :: l_spur_supersat ! Spurious supersaturation?
3357 :
3358 : integer :: i, k, j
3359 :
3360 : !-------------------------------------- Begin Code --------------------------------------
3361 :
3362 : !$acc enter data create( wp2_zt,wp3_zm, rtp2_zt,rtp3_zm, thlp2_zt, thlp3_zm, &
3363 : !$acc wprtp_zt, wpthlp_zt, rtpthlp_zt, up2_zt, up3_zm, &
3364 : !$acc vp2_zt, vp3_zm, upwp_zt, vpwp_zt, gamma_Skw_fnc, &
3365 : !$acc gamma_Skw_fnc_zt,sigma_sqd_w_zt, Skw_zt, Skw_zm, &
3366 : !$acc Skrt_zt, Skrt_zm, Skthl_zt, Skthl_zm, Sku_zt, &
3367 : !$acc Sku_zm, Skv_zt, Skv_zm, wp2up2_zt, &
3368 : !$acc wp2vp2_zt, wp4_zt, wpthvp_zt, rtpthvp_zt, thlpthvp_zt, &
3369 : !$acc wprcp_zt, rtprcp_zt, thlprcp_zt, uprcp_zt, vprcp_zt, &
3370 : !$acc rsat, rel_humidity, um_zm, vm_zm, T_in_K, sigma_sqd_w_tmp )
3371 :
3372 : !$acc enter data if( l_call_pdf_closure_twice ) &
3373 : !$acc create( w_up_in_cloud_zm, wpup2_zm, wpvp2_zm, &
3374 : !$acc w_down_in_cloud_zm, cloudy_updraft_frac_zm, &
3375 : !$acc cloudy_downdraft_frac_zm, p_in_Pa_zm, exner_zm, &
3376 : !$acc wprtp2_zm, wp2rtp_zm, wpthlp2_zm, &
3377 : !$acc wp2thlp_zm, wprtpthlp_zm, wp2thvp_zm, wp2rcp_zm )
3378 :
3379 : !$acc enter data if( sclr_dim > 0 ) &
3380 : !$acc create( wpsclrp_zt, sclrp2_zt, sclrp3_zm, sclrprtp_zt, sclrpthlp_zt, &
3381 : !$acc Sksclr_zt, Sksclr_zm, sclrpthvp_zt, sclrprcp_zt, wpsclrprtp_zm, &
3382 : !$acc wpsclrp2_zm, wpsclrpthlp_zm, wp2sclrp_zm, sclrm_zm )
3383 :
3384 : !$acc enter data if( hydromet_dim > 0 ) create( wphydrometp_zt, wp2hmp_zm, rtphmp, thlphmp )
3385 :
3386 : !---------------------------------------------------------------------------
3387 : ! Interpolate wp3, rtp3, thlp3, up3, vp3, and sclrp3 to momentum levels, and
3388 : ! wp2, rtp2, thlp2, up2, vp2, and sclrp2 to thermodynamic levels, and then
3389 : ! compute Skw, Skrt, Skthl, Sku, Skv, and Sksclr for both the momentum and
3390 : ! thermodynamic grid levels.
3391 : !---------------------------------------------------------------------------
3392 352944 : wp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, wp2(:,:) ) ! Positive definite quantity
3393 352944 : wp3_zm(:,:) = zt2zm( nz, ngrdcol, gr, wp3(:,:) )
3394 352944 : thlp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, thlp2(:,:) ) ! Positive definite quantity
3395 352944 : thlp3_zm(:,:) = zt2zm( nz, ngrdcol, gr, thlp3(:,:) )
3396 352944 : rtp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, rtp2(:,:) ) ! Positive definite quantity
3397 352944 : rtp3_zm(:,:) = zt2zm( nz, ngrdcol, gr, rtp3(:,:) )
3398 352944 : up2_zt(:,:) = zm2zt( nz, ngrdcol, gr, up2(:,:) ) ! Positive definite quantity
3399 352944 : up3_zm(:,:) = zt2zm( nz, ngrdcol, gr, up3(:,:) )
3400 352944 : vp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, vp2(:,:) ) ! Positive definite quantity
3401 352944 : vp3_zm(:,:) = zt2zm( nz, ngrdcol, gr, vp3(:,:) )
3402 :
3403 : !$acc parallel loop gang vector collapse(2) default(present)
3404 30353184 : do k = 1, nz
3405 501287184 : do i = 1, ngrdcol
3406 470934000 : wp2_zt(i,k) = max( wp2_zt(i,k), w_tol_sqd )
3407 470934000 : thlp2_zt(i,k) = max( thlp2_zt(i,k), thl_tol**2 )
3408 470934000 : rtp2_zt(i,k) = max( rtp2_zt(i,k), rt_tol**2 )
3409 470934000 : up2_zt(i,k) = max( up2_zt(i,k), w_tol_sqd )
3410 500934240 : vp2_zt(i,k) = max( vp2_zt(i,k), w_tol_sqd )
3411 : end do
3412 : end do
3413 : !$acc end parallel loop
3414 :
3415 352944 : do j = 1, sclr_dim, 1
3416 0 : sclrp2_zt(:,:,j) = zm2zt( nz, ngrdcol, gr, sclrp2(:,:,j) ) ! Pos. def. quantity
3417 0 : sclrp3_zm(:,:,j) = zt2zm( nz, ngrdcol, gr, sclrp3(:,:,j) )
3418 :
3419 : !$acc parallel loop gang vector collapse(2) default(present)
3420 352944 : do k = 1, nz
3421 0 : do i = 1, ngrdcol
3422 0 : sclrp2_zt(i,k,j) = max( sclrp2_zt(i,k,j), sclr_tol(j)**2 )
3423 : end do
3424 : end do
3425 : !$acc end parallel loop
3426 :
3427 : end do ! i = 1, sclr_dim, 1
3428 :
3429 352944 : Skw_denom_coef = clubb_params(iSkw_denom_coef)
3430 352944 : Skw_max_mag = clubb_params(iSkw_max_mag)
3431 :
3432 : call Skx_func( nz, ngrdcol, wp2_zt, wp3, &
3433 : w_tol, Skw_denom_coef, Skw_max_mag, &
3434 352944 : Skw_zt )
3435 :
3436 : call Skx_func( nz, ngrdcol, wp2, wp3_zm, &
3437 : w_tol, Skw_denom_coef, Skw_max_mag, &
3438 352944 : Skw_zm )
3439 :
3440 : call Skx_func( nz, ngrdcol, thlp2_zt, thlp3, &
3441 : thl_tol, Skw_denom_coef, Skw_max_mag, &
3442 352944 : Skthl_zt )
3443 :
3444 : call Skx_func( nz, ngrdcol, thlp2, thlp3_zm, &
3445 : thl_tol, Skw_denom_coef, Skw_max_mag, &
3446 352944 : Skthl_zm )
3447 :
3448 : call Skx_func( nz, ngrdcol, rtp2_zt, rtp3, &
3449 : rt_tol, Skw_denom_coef, Skw_max_mag, &
3450 352944 : Skrt_zt )
3451 :
3452 : call Skx_func( nz, ngrdcol, rtp2, rtp3_zm, &
3453 : rt_tol, Skw_denom_coef, Skw_max_mag, &
3454 352944 : Skrt_zm )
3455 :
3456 : call Skx_func( nz, ngrdcol, up2_zt, up3, &
3457 : w_tol, Skw_denom_coef, Skw_max_mag, &
3458 352944 : Sku_zt )
3459 :
3460 : call Skx_func( nz, ngrdcol, up2, up3_zm, &
3461 : w_tol, Skw_denom_coef, Skw_max_mag, &
3462 352944 : Sku_zm )
3463 :
3464 : call Skx_func( nz, ngrdcol, vp2_zt, vp3, &
3465 : w_tol, Skw_denom_coef, Skw_max_mag, &
3466 352944 : Skv_zt )
3467 :
3468 : call Skx_func( nz, ngrdcol, vp2, vp3_zm, &
3469 : w_tol, Skw_denom_coef, Skw_max_mag, &
3470 352944 : Skv_zm )
3471 :
3472 352944 : do j = 1, sclr_dim
3473 :
3474 : call Skx_func( nz, ngrdcol, sclrp2_zt(:,:,j), sclrp3(:,:,j), &
3475 0 : sclr_tol(j), Skw_denom_coef, Skw_max_mag, &
3476 0 : Sksclr_zt(:,:,j) )
3477 :
3478 : call Skx_func( nz, ngrdcol, sclrp2(:,:,j), sclrp3_zm(:,:,j), &
3479 0 : sclr_tol(j), Skw_denom_coef, Skw_max_mag, &
3480 352944 : Sksclr_zm(:,:,j) )
3481 :
3482 : end do ! i = 1, sclr_dim, 1
3483 :
3484 352944 : if ( stats_metadata%l_stats_samp .and. l_samp_stats_in_pdf_call ) then
3485 :
3486 : !$acc update host( Skw_zt, Skw_zm, Skthl_zt, Skrt_zt, Skrt_zm, Skthl_zm )
3487 :
3488 0 : do i = 1, ngrdcol
3489 0 : call stat_update_var( stats_metadata%iSkw_zt, Skw_zt(i,:), & ! In
3490 0 : stats_zt(i) ) ! In/Out
3491 : call stat_update_var( stats_metadata%iSkw_zm, Skw_zm(i,:), &
3492 0 : stats_zm(i) ) ! In/Out
3493 : call stat_update_var( stats_metadata%iSkthl_zt, Skthl_zt(i,:), &
3494 0 : stats_zt(i) ) ! In/Out
3495 : call stat_update_var( stats_metadata%iSkthl_zm, Skthl_zm(i,:), &
3496 0 : stats_zm(i) ) ! In/Out
3497 : call stat_update_var( stats_metadata%iSkrt_zt, Skrt_zt(i,:), &
3498 0 : stats_zt(i) ) ! In/Out
3499 : call stat_update_var( stats_metadata%iSkrt_zm, Skrt_zm(i,:), &
3500 0 : stats_zm(i) ) ! In/Out
3501 : end do
3502 : end if
3503 :
3504 352944 : gamma_coef = clubb_params(igamma_coef)
3505 352944 : gamma_coefb = clubb_params(igamma_coefb)
3506 352944 : gamma_coefc = clubb_params(igamma_coefc)
3507 :
3508 : ! The right hand side of this conjunction is only for reducing cpu time,
3509 : ! since the more complicated formula is mathematically equivalent
3510 : if ( l_gamma_Skw &
3511 352944 : .and. abs( gamma_coef - gamma_coefb ) > abs( gamma_coef + gamma_coefb ) * eps/2 ) then
3512 :
3513 : !----------------------------------------------------------------
3514 : ! Compute gamma as a function of Skw - 14 April 06 dschanen
3515 : !----------------------------------------------------------------
3516 : !$acc parallel loop gang vector collapse(2) default(present)
3517 0 : do k = 1, nz
3518 0 : do i = 1, ngrdcol
3519 0 : gamma_Skw_fnc(i,k) = gamma_coefb &
3520 : + ( gamma_coef - gamma_coefb ) &
3521 0 : * exp( -one_half * ( Skw_zm(i,k) / gamma_coefc )**2 )
3522 :
3523 : gamma_Skw_fnc_zt(i,k) = gamma_coefb &
3524 : + ( gamma_coef - gamma_coefb ) &
3525 0 : * exp( -one_half * ( Skw_zt(i,k) / gamma_coefc )**2 )
3526 : end do
3527 : end do
3528 : !$acc end parallel loop
3529 :
3530 : else
3531 :
3532 : !$acc parallel loop gang vector collapse(2) default(present)
3533 30353184 : do k = 1, nz
3534 501287184 : do i = 1, ngrdcol
3535 470934000 : gamma_Skw_fnc(i,k) = gamma_coef
3536 500934240 : gamma_Skw_fnc_zt(i,k) = gamma_coef
3537 : end do
3538 : end do
3539 : !$acc end parallel loop
3540 :
3541 : end if
3542 :
3543 352944 : if ( stats_metadata%l_stats_samp .and. l_samp_stats_in_pdf_call ) then
3544 : !$acc update host(gamma_Skw_fnc)
3545 0 : do i = 1, ngrdcol
3546 0 : call stat_update_var( stats_metadata%igamma_Skw_fnc, gamma_Skw_fnc(i,:), & ! intent(in)
3547 0 : stats_zm(i) ) ! intent(inout)
3548 : end do
3549 : endif
3550 :
3551 : ! Compute sigma_sqd_w (dimensionless PDF width parameter)
3552 : call compute_sigma_sqd_w( nz, ngrdcol, &
3553 : gamma_Skw_fnc, wp2, thlp2, rtp2, &
3554 : up2, vp2, wpthlp, wprtp, upwp, vpwp, &
3555 : l_predict_upwp_vpwp, &
3556 352944 : sigma_sqd_w_tmp )
3557 :
3558 : ! Smooth in the vertical using interpolation
3559 352944 : sigma_sqd_w(:,:) = zm2zt2zm( nz, ngrdcol, gr, sigma_sqd_w_tmp(:,:) ) ! Pos. def. quantity
3560 :
3561 :
3562 : ! Interpolate the the stats_zt grid
3563 352944 : sigma_sqd_w_zt(:,:) = zm2zt( nz, ngrdcol, gr, sigma_sqd_w(:,:) ) ! Pos. def. quantity
3564 :
3565 : !$acc parallel loop gang vector collapse(2) default(present)
3566 30353184 : do k = 1, nz
3567 501287184 : do i = 1, ngrdcol
3568 470934000 : sigma_sqd_w(i,k) = max( zero_threshold, sigma_sqd_w(i,k) ) ! Pos. def. quantity
3569 500934240 : sigma_sqd_w_zt(i,k) = max( sigma_sqd_w_zt(i,k), zero_threshold ) ! Pos. def. quantity
3570 : end do
3571 : end do
3572 : !$acc end parallel loop
3573 :
3574 : !---------------------------------------------------------------------------
3575 : ! Interpolate thlp2, rtp2, and rtpthlp to thermodynamic levels,
3576 : !---------------------------------------------------------------------------
3577 :
3578 : ! Interpolate variances to the stats_zt grid (statistics and closure)
3579 352944 : rtp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, rtp2(:,:) ) ! Positive def. quantity
3580 352944 : thlp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, thlp2(:,:) ) ! Positive def. quantity
3581 352944 : up2_zt(:,:) = zm2zt( nz, ngrdcol, gr, up2(:,:) ) ! Positive def. quantity
3582 352944 : vp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, vp2(:,:) ) ! Positive def. quantity
3583 352944 : wprtp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wprtp(:,:) )
3584 352944 : wpthlp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wpthlp(:,:) )
3585 352944 : rtpthlp_zt(:,:) = zm2zt( nz, ngrdcol, gr, rtpthlp(:,:) )
3586 352944 : upwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, upwp(:,:) )
3587 352944 : vpwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, vpwp(:,:) )
3588 :
3589 : !$acc parallel loop gang vector collapse(2) default(present)
3590 30353184 : do k = 1, nz
3591 501287184 : do i = 1, ngrdcol
3592 470934000 : rtp2_zt(i,k) = max( rtp2_zt(i,k), rt_tol**2 ) ! Positive def. quantity
3593 470934000 : thlp2_zt(i,k) = max( thlp2_zt(i,k), thl_tol**2 ) ! Positive def. quantity
3594 470934000 : up2_zt(i,k) = max( up2_zt(i,k), w_tol_sqd ) ! Positive def. quantity
3595 500934240 : vp2_zt(i,k) = max( vp2_zt(i,k), w_tol_sqd ) ! Positive def. quantity
3596 : end do
3597 : end do
3598 : !$acc end parallel loop
3599 :
3600 : ! Compute skewness velocity for stats output purposes
3601 352944 : if ( stats_metadata%iSkw_velocity > 0 ) then
3602 : !$acc parallel loop gang vector collapse(2) default(present)
3603 0 : do k = 1, nz
3604 0 : do i = 1, ngrdcol
3605 0 : Skw_velocity(i,k) = ( 1.0_core_rknd / ( 1.0_core_rknd - sigma_sqd_w(i,k) ) ) &
3606 0 : * ( wp3_zm(i,k) / max( wp2(i,k), w_tol_sqd ) )
3607 : end do
3608 : end do
3609 : !$acc end parallel loop
3610 : end if
3611 :
3612 : !----------------------------------------------------------------
3613 : ! Call closure scheme
3614 : !----------------------------------------------------------------
3615 :
3616 : ! Put passive scalar input on the t grid for the PDF
3617 352944 : do j = 1, sclr_dim
3618 0 : wpsclrp_zt(:,:,j) = zm2zt( nz, ngrdcol, gr, wpsclrp(:,:,j) )
3619 0 : sclrp2_zt(:,:,j) = zm2zt( nz, ngrdcol, gr, sclrp2(:,:,j) ) ! Pos. def. quantity
3620 0 : sclrprtp_zt(:,:,j) = zm2zt( nz, ngrdcol, gr, sclrprtp(:,:,j) )
3621 0 : sclrpthlp_zt(:,:,j) = zm2zt( nz, ngrdcol, gr, sclrpthlp(:,:,j) )
3622 :
3623 : !$acc parallel loop gang vector collapse(2) default(present)
3624 352944 : do k = 1, nz
3625 0 : do i = 1, ngrdcol
3626 0 : sclrp2_zt(i,k,j) = max( sclrp2_zt(i,k,j), sclr_tol(j)**2 ) ! Pos. def. quantity
3627 : end do
3628 : end do
3629 : !$acc end parallel loop
3630 :
3631 : end do ! i = 1, sclr_dim, 1
3632 :
3633 : ! Interpolate hydrometeor mixed moments to momentum levels.
3634 352944 : do j = 1, hydromet_dim
3635 352944 : wphydrometp_zt(:,:,j) = zm2zt( nz, ngrdcol, gr, wphydrometp(:,:,j) )
3636 : end do ! i = 1, hydromet_dim, 1
3637 :
3638 : call pdf_closure( nz, ngrdcol, & ! intent(in)
3639 : hydromet_dim, p_in_Pa, exner, thv_ds_zt, & ! intent(in)
3640 : wm_zt, wp2_zt, wp3, & ! intent(in)
3641 : Skw_zt, Skthl_zt, Skrt_zt, Sku_zt, Skv_zt, & ! intent(in)
3642 : rtm, rtp2_zt, wprtp_zt, & ! intent(in)
3643 : thlm, thlp2_zt, wpthlp_zt, & ! intent(in)
3644 : um, up2_zt, upwp_zt, & ! intent(in)
3645 : vm, vp2_zt, vpwp_zt, & ! intent(in)
3646 : rtpthlp_zt, & ! intent(in)
3647 : sclrm, wpsclrp_zt, sclrp2_zt, & ! intent(in)
3648 : sclrprtp_zt, sclrpthlp_zt, Sksclr_zt, & ! intent(in)
3649 : gamma_Skw_fnc_zt, & ! intent(in)
3650 : #ifdef GFDL
3651 : RH_crit, & ! intent(inout)
3652 : do_liquid_only_in_clubb, & ! intent(in)
3653 : #endif
3654 : wphydrometp_zt, wp2hmp, & ! intent(in)
3655 : rtphmp_zt, thlphmp_zt, & ! intent(in)
3656 : clubb_params, & ! intent(in)
3657 : stats_metadata, & ! intent(in)
3658 : iiPDF_type, & ! intent(in)
3659 : sigma_sqd_w_zt, & ! intent(inout)
3660 : pdf_params, pdf_implicit_coefs_terms, & ! intent(inout)
3661 : wpup2, wpvp2, & ! intent(out)
3662 : wp2up2_zt, wp2vp2_zt, wp4_zt, & ! intent(out)
3663 : wprtp2, wp2rtp, & ! intent(out)
3664 : wpthlp2, wp2thlp, wprtpthlp, & ! intent(out)
3665 : cloud_frac, ice_supersat_frac, & ! intent(out)
3666 : rcm, wpthvp_zt, wp2thvp, rtpthvp_zt, & ! intent(out)
3667 : thlpthvp_zt, wprcp_zt, wp2rcp, rtprcp_zt, & ! intent(out)
3668 : thlprcp_zt, rcp2_zt, & ! intent(out)
3669 : uprcp_zt, vprcp_zt, & ! intent(out)
3670 : w_up_in_cloud, w_down_in_cloud, & ! intent(out)
3671 : cloudy_updraft_frac, cloudy_downdraft_frac, & ! intent(out)
3672 : F_w, F_rt, F_thl, & ! intent(out)
3673 : min_F_w, max_F_w, & ! intent(out)
3674 : min_F_rt, max_F_rt, & ! intent(out)
3675 : min_F_thl, max_F_thl, & ! intent(out)
3676 : wpsclrprtp, wpsclrp2, sclrpthvp_zt, & ! intent(out)
3677 : wpsclrpthlp, sclrprcp_zt, wp2sclrp, & ! intent(out)
3678 352944 : rc_coef ) ! intent(out)
3679 :
3680 : ! Subroutine may produce NaN values, and if so, return
3681 352944 : if ( clubb_at_least_debug_level( 0 ) ) then
3682 352944 : if ( err_code == clubb_fatal_error ) then
3683 0 : write(fstderr,*) "After pdf_closure"
3684 0 : return
3685 : endif
3686 : endif
3687 :
3688 : ! Stats output
3689 352944 : if ( stats_metadata%l_stats_samp .and. l_samp_stats_in_pdf_call ) then
3690 :
3691 0 : do i = 1, ngrdcol
3692 0 : call stat_update_var( stats_metadata%iF_w, F_w(i,:), & ! intent(in)
3693 0 : stats_zt(i) ) ! intent(inout)
3694 : call stat_update_var( stats_metadata%iF_rt, F_rt(i,:), & ! intent(in)
3695 0 : stats_zt(i) ) ! intent(inout)
3696 : call stat_update_var( stats_metadata%iF_thl, F_thl(i,:), & ! intent(in)
3697 0 : stats_zt(i) ) ! intent(inout)
3698 : call stat_update_var( stats_metadata%imin_F_w, min_F_w(i,:), & ! intent(in)
3699 0 : stats_zt(i) ) ! intent(inout)
3700 : call stat_update_var( stats_metadata%imax_F_w, max_F_w(i,:), & ! intent(in)
3701 0 : stats_zt(i) ) ! intent(inout)
3702 : call stat_update_var( stats_metadata%imin_F_rt, min_F_rt(i,:), & ! intent(in)
3703 0 : stats_zt(i) ) ! intent(inout)
3704 : call stat_update_var( stats_metadata%imax_F_rt, max_F_rt(i,:), & ! intent(in)
3705 0 : stats_zt(i) ) ! intent(inout)
3706 : call stat_update_var( stats_metadata%imin_F_thl, min_F_thl(i,:), & ! intent(in)
3707 0 : stats_zt(i) ) ! intent(inout)
3708 : call stat_update_var( stats_metadata%imax_F_thl, max_F_thl(i,:), & ! intent(in)
3709 0 : stats_zt(i) ) ! intent(inout)
3710 : end do
3711 : end if
3712 :
3713 352944 : if( l_rtm_nudge ) then
3714 : ! Nudge rtm to prevent excessive drying
3715 : !$acc parallel loop gang vector collapse(2) default(present)
3716 0 : do k = 1, nz
3717 0 : do i = 1, ngrdcol
3718 0 : if ( rtm(i,k) < rtm_min .and. gr%zt(i,k) < rtm_nudge_max_altitude ) then
3719 0 : rtm(i,k) = rtm(i,k) + (rtm_ref(i,k) - rtm(i,k)) * ( dt / ts_nudge )
3720 : end if
3721 : end do
3722 : end do
3723 : !$acc end parallel loop
3724 : end if
3725 :
3726 352944 : if ( l_call_pdf_closure_twice ) then
3727 :
3728 : ! Call pdf_closure a second time on momentum levels, to
3729 : ! output (rather than interpolate) the variables which
3730 : ! belong on the momentum levels.
3731 :
3732 : ! Interpolate sclrm to the momentum level for use in
3733 : ! the second call to pdf_closure
3734 352944 : do j = 1, sclr_dim
3735 0 : sclrm_zm(:,:,j) = zt2zm( nz, ngrdcol, gr, sclrm(:,:,j) )
3736 :
3737 : ! Clip if extrap. causes sclrm_zm to be less than sclr_tol
3738 :
3739 : !$acc parallel loop gang vector default(present)
3740 352944 : do i = 1, ngrdcol
3741 0 : sclrm_zm(i,nz,j) = max( sclrm_zm(i,nz,j), sclr_tol(j) )
3742 : end do
3743 : !$acc end parallel loop
3744 :
3745 : end do ! i = 1, sclr_dim
3746 :
3747 : ! Interpolate pressure, p_in_Pa, to momentum levels.
3748 : ! The pressure at thermodynamic level k = 1 has been set to be the surface
3749 : ! (or model lower boundary) pressure. Since the surface (or model lower
3750 : ! boundary) is located at momentum level k = 1, the pressure there is
3751 : ! p_sfc, which is p_in_Pa(1). Thus, p_in_Pa_zm(1) = p_in_Pa(1).
3752 352944 : p_in_Pa_zm(:,:) = zt2zm( nz, ngrdcol, gr, p_in_Pa(:,:) )
3753 :
3754 : !$acc parallel loop gang vector default(present)
3755 5893344 : do i = 1, ngrdcol
3756 5540400 : p_in_Pa_zm(i,1) = p_in_Pa(i,1)
3757 :
3758 : ! Clip pressure if the extrapolation leads to a negative value of pressure
3759 5893344 : p_in_Pa_zm(i,nz) = max( p_in_Pa_zm(i,nz), 0.5_core_rknd*p_in_Pa(i,nz) )
3760 : end do
3761 : !$acc end parallel loop
3762 :
3763 : ! Set exner at momentum levels, exner_zm, based on p_in_Pa_zm.
3764 : !$acc parallel loop gang vector collapse(2) default(present)
3765 30353184 : do k = 1, nz
3766 501287184 : do i = 1, ngrdcol
3767 500934240 : exner_zm(i,k) = (p_in_Pa_zm(i,k)/p0)**kappa
3768 : end do
3769 : end do
3770 : !$acc end parallel loop
3771 :
3772 352944 : rtm_zm(:,:) = zt2zm( nz, ngrdcol, gr, rtm(:,:) )
3773 352944 : thlm_zm(:,:) = zt2zm( nz, ngrdcol, gr, thlm(:,:) )
3774 :
3775 : !$acc parallel loop gang vector default(present)
3776 5893344 : do i = 1, ngrdcol
3777 : ! Clip if extrapolation at the top level causes rtm_zm to be < rt_tol
3778 5540400 : rtm_zm(i,nz) = max( rtm_zm(i,nz), rt_tol )
3779 :
3780 : ! Clip if extrapolation at the top level causes thlm_zm to be < thl_tol
3781 5893344 : thlm_zm(i,nz) = max( thlm_zm(i,nz), thl_tol )
3782 : end do
3783 : !$acc end parallel loop
3784 :
3785 : ! Interpolate hydrometeor mixed moments to momentum levels.
3786 352944 : do j = 1, hydromet_dim
3787 0 : rtphmp(:,:,j) = zt2zm( nz, ngrdcol, gr, rtphmp_zt(:,:,j) )
3788 0 : thlphmp(:,:,j) = zt2zm( nz, ngrdcol, gr, thlphmp_zt(:,:,j) )
3789 352944 : wp2hmp_zm(:,:,j) = zt2zm( nz, ngrdcol, gr, wp2hmp(:,:,j) )
3790 : end do ! i = 1, hydromet_dim, 1
3791 :
3792 352944 : um_zm(:,:) = zt2zm( nz, ngrdcol, gr, um(:,:) )
3793 352944 : vm_zm(:,:) = zt2zm( nz, ngrdcol, gr, vm(:,:) )
3794 :
3795 : ! pdf_implicit_coefs_terms is only used in the iiPDF_new and iiPDF_new_hybrid closures.
3796 : ! So we only need to initialize our local _zm version if we're working with one of those.
3797 352944 : if ( iiPDF_type == iiPDF_new .or. iiPDF_type == iiPDF_new_hybrid ) then
3798 : call init_pdf_implicit_coefs_terms( nz, ngrdcol, sclr_dim, & ! Intent(in)
3799 0 : pdf_implicit_coefs_terms_zm ) ! Intent(out)
3800 : end if
3801 :
3802 : ! Call pdf_closure to output the variables which belong on the momentum grid.
3803 : call pdf_closure( nz, ngrdcol, & ! intent(in)
3804 : hydromet_dim, p_in_Pa_zm, exner_zm, thv_ds_zm, & ! intent(in)
3805 : wm_zm, wp2, wp3_zm, & ! intent(in)
3806 : Skw_zm, Skthl_zm, Skrt_zm, Sku_zm, Skv_zm, & ! intent(in)
3807 : rtm_zm, rtp2, wprtp, & ! intent(in)
3808 : thlm_zm, thlp2, wpthlp, & ! intent(in)
3809 : um_zm, up2, upwp, & ! intent(in)
3810 : vm_zm, vp2, vpwp, & ! intent(in)
3811 : rtpthlp, & ! intent(in)
3812 : sclrm_zm, wpsclrp, sclrp2, & ! intent(in)
3813 : sclrprtp, sclrpthlp, Sksclr_zm, & ! intent(in)
3814 : gamma_Skw_fnc, & ! intent(in)
3815 : #ifdef GFDL
3816 : RH_crit, & ! intent(inout)
3817 : do_liquid_only_in_clubb, & ! intent(in)
3818 : #endif
3819 : wphydrometp, wp2hmp_zm, & ! intent(in)
3820 : rtphmp, thlphmp, & ! intent(in)
3821 : clubb_params, & ! intent(in)
3822 : stats_metadata, & ! intent(in)
3823 : iiPDF_type, & ! intent(in)
3824 : sigma_sqd_w, & ! intent(inout)
3825 : pdf_params_zm, pdf_implicit_coefs_terms_zm, & ! intent(inout)
3826 : wpup2_zm, wpvp2_zm, & ! intent(out)
3827 : wp2up2, wp2vp2, wp4, & ! intent(out)
3828 : wprtp2_zm, wp2rtp_zm, & ! intent(out)
3829 : wpthlp2_zm, wp2thlp_zm, wprtpthlp_zm, & ! intent(out)
3830 : cloud_frac_zm, ice_supersat_frac_zm, & ! intent(out)
3831 : rcm_zm, wpthvp, wp2thvp_zm, rtpthvp, & ! intent(out)
3832 : thlpthvp, wprcp, wp2rcp_zm, rtprcp, & ! intent(out)
3833 : thlprcp, rcp2, & ! intent(out)
3834 : uprcp, vprcp, & ! intent(out)
3835 : w_up_in_cloud_zm, w_down_in_cloud_zm, & ! intent(out)
3836 : cloudy_updraft_frac_zm, cloudy_downdraft_frac_zm, & ! intent(out)
3837 : F_w_zm, F_rt_zm, F_thl_zm, & ! intent(out)
3838 : min_F_w_zm, max_F_w_zm, & ! intent(out)
3839 : min_F_rt_zm, max_F_rt_zm, & ! intent(out)
3840 : min_F_thl_zm, max_F_thl_zm, & ! intent(out)
3841 : wpsclrprtp_zm, wpsclrp2_zm, sclrpthvp, & ! intent(out)
3842 : wpsclrpthlp_zm, sclrprcp, wp2sclrp_zm, & ! intent(out)
3843 352944 : rc_coef_zm ) ! intent(out)
3844 :
3845 : ! Subroutine may produce NaN values, and if so, return
3846 352944 : if ( clubb_at_least_debug_level( 0 ) ) then
3847 352944 : if ( err_code == clubb_fatal_error ) then
3848 0 : write(fstderr,*) "After pdf_closure"
3849 0 : return
3850 : endif
3851 : endif
3852 :
3853 : else ! l_call_pdf_closure_twice is false
3854 :
3855 : ! Interpolate momentum variables output from the first call to
3856 : ! pdf_closure back to momentum grid.
3857 0 : wp4(:,:) = zt2zm( nz, ngrdcol, gr, wp4_zt(:,:) ) ! Pos. def. quantity
3858 :
3859 : !$acc parallel loop gang vector collapse(2) default(present)
3860 0 : do k = 1, nz
3861 0 : do i = 1, ngrdcol
3862 0 : wp4(i,k) = max( wp4(i,k), zero_threshold ) ! Pos. def. quantity
3863 : end do
3864 : end do
3865 : !$acc end parallel loop
3866 :
3867 : !$acc parallel loop gang vector default(present)
3868 0 : do i = 1, ngrdcol
3869 : ! Since top momentum level is higher than top thermo level,
3870 : ! set variables at top momentum level to 0.
3871 0 : wp4(i,nz) = zero
3872 : ! Set wp4 to 0 at the lowest momentum level (momentum level 1).
3873 : ! The value of wp4 at momentum level 1 is found by interpolation of
3874 : ! the values produced by the PDF for wp4_zt at thermodynamic levels
3875 : ! 1 and 2. This value is unreliable at thermodynamic level 1.
3876 0 : wp4(i,1) = zero
3877 : end do
3878 : !$acc end parallel loop
3879 :
3880 : #ifndef CLUBB_CAM
3881 : ! CAM-CLUBB needs cloud water variance thus always compute this
3882 : if ( stats_metadata%ircp2 > 0 ) then
3883 : #endif
3884 0 : rcp2(:,:) = zt2zm( nz, ngrdcol, gr, rcp2_zt(:,:) ) ! Pos. def. quantity
3885 :
3886 : !$acc parallel loop gang vector collapse(2) default(present)
3887 0 : do k = 1, nz
3888 0 : do i = 1, ngrdcol
3889 0 : rcp2(i,k) = max( rcp2(i,k), zero_threshold )
3890 : end do
3891 : end do
3892 : !$acc end parallel loop
3893 : #ifndef CLUBB_CAM
3894 : !$acc parallel loop gang vector default(present)
3895 : do i = 1, ngrdcol
3896 : rcp2(i,nz) = zero
3897 : end do
3898 : !$acc end parallel loop
3899 : endif
3900 : #endif
3901 :
3902 0 : wpthvp(:,:) = zt2zm( nz, ngrdcol, gr, wpthvp_zt(:,:) )
3903 0 : thlpthvp(:,:) = zt2zm( nz, ngrdcol, gr, thlpthvp_zt(:,:) )
3904 0 : rtpthvp(:,:) = zt2zm( nz, ngrdcol, gr, rtpthvp_zt(:,:) )
3905 0 : wprcp(:,:) = zt2zm( nz, ngrdcol, gr, wprcp_zt(:,:) )
3906 0 : rc_coef_zm(:,:) = zt2zm( nz, ngrdcol, gr, rc_coef(:,:) )
3907 0 : rtprcp(:,:) = zt2zm( nz, ngrdcol, gr, rtprcp_zt(:,:) )
3908 0 : thlprcp(:,:) = zt2zm( nz, ngrdcol, gr, thlprcp_zt(:,:) )
3909 0 : uprcp(:,:) = zt2zm( nz, ngrdcol, gr, uprcp_zt(:,:) )
3910 0 : vprcp(:,:) = zt2zm( nz, ngrdcol, gr, vprcp_zt(:,:) )
3911 0 : wp2up2(:,:) = zt2zm( nz, ngrdcol, gr, wp2up2_zt(:,:) )
3912 0 : wp2vp2(:,:) = zt2zm( nz, ngrdcol, gr, wp2vp2_zt(:,:) )
3913 :
3914 : !$acc parallel loop gang vector default(present)
3915 0 : do i = 1, ngrdcol
3916 0 : wpthvp(i,nz) = 0.0_core_rknd
3917 0 : thlpthvp(i,nz) = 0.0_core_rknd
3918 0 : rtpthvp(i,nz) = 0.0_core_rknd
3919 0 : wprcp(i,nz) = 0.0_core_rknd
3920 0 : rc_coef_zm(i,nz) = 0.0_core_rknd
3921 0 : rtprcp(i,nz) = 0.0_core_rknd
3922 0 : thlprcp(i,nz) = 0.0_core_rknd
3923 0 : uprcp(i,nz) = 0.0_core_rknd
3924 0 : vprcp(i,nz) = 0.0_core_rknd
3925 0 : wp2up2(i,nz) = 0.0_core_rknd
3926 0 : wp2vp2(i,nz) = 0.0_core_rknd
3927 : end do
3928 : !$acc end parallel loop
3929 :
3930 : ! Initialize variables to avoid uninitialized variables.
3931 : !$acc parallel loop gang vector collapse(2) default(present)
3932 0 : do k = 1, nz
3933 0 : do i = 1, ngrdcol
3934 0 : cloud_frac_zm(i,k) = 0.0_core_rknd
3935 0 : ice_supersat_frac_zm(i,k) = 0.0_core_rknd
3936 0 : rcm_zm(i,k) = 0.0_core_rknd
3937 0 : rtm_zm(i,k) = 0.0_core_rknd
3938 0 : thlm_zm(i,k) = 0.0_core_rknd
3939 : end do
3940 : end do
3941 : !$acc end parallel loop
3942 :
3943 : ! Interpolate passive scalars back onto the m grid
3944 0 : do j = 1, sclr_dim
3945 0 : sclrpthvp(:,:,j) = zt2zm( nz, ngrdcol, gr, sclrpthvp_zt(:,:,j) )
3946 0 : sclrprcp(:,:,j) = zt2zm( nz, ngrdcol, gr, sclrprcp_zt(:,:,j) )
3947 :
3948 : !$acc parallel loop gang vector default(present)
3949 0 : do k = 1, nz
3950 0 : do i = 1, ngrdcol
3951 0 : sclrpthvp(i,nz,j) = 0.0_core_rknd
3952 0 : sclrprcp(i,nz,j) = 0.0_core_rknd
3953 : end do
3954 : end do
3955 : !$acc end parallel loop
3956 :
3957 : end do ! i=1, sclr_dim
3958 :
3959 : end if ! l_call_pdf_closure_twice
3960 :
3961 352944 : if ( stats_metadata%l_stats_samp .and. l_samp_stats_in_pdf_call ) then
3962 : !$acc update host( uprcp, vprcp )
3963 0 : do i = 1, ngrdcol
3964 0 : call stat_update_var( stats_metadata%iuprcp, uprcp(i,:), & ! intent(in)
3965 0 : stats_zm(i) ) ! intent(inout)
3966 : call stat_update_var( stats_metadata%ivprcp, vprcp(i,:), & ! intent(in)
3967 0 : stats_zm(i) ) ! intent(inout)
3968 : end do
3969 : end if
3970 :
3971 : ! If l_trapezoidal_rule_zt is true, call trapezoidal_rule_zt for
3972 : ! thermodynamic-level variables output from pdf_closure.
3973 : ! ldgrant June 2009
3974 352944 : if ( l_trapezoidal_rule_zt ) then
3975 : call trapezoidal_rule_zt( nz, ngrdcol, gr, l_call_pdf_closure_twice, & ! intent(in)
3976 : stats_metadata, & ! intent(in)
3977 : wprtp2, wpthlp2, & ! intent(inout)
3978 : wprtpthlp, cloud_frac, ice_supersat_frac, & ! intent(inout)
3979 : rcm, wp2thvp, wpsclrprtp, wpsclrp2, & ! intent(inout)
3980 : wpsclrpthlp, & ! intent(inout)
3981 : wprtp2_zm, wpthlp2_zm, & ! intent(inout)
3982 : wprtpthlp_zm, cloud_frac_zm, & ! intent(inout)
3983 : ice_supersat_frac_zm, rcm_zm, wp2thvp_zm, & ! intent(inout)
3984 352944 : wpsclrprtp_zm, wpsclrp2_zm, wpsclrpthlp_zm ) ! intent(inout)
3985 : end if ! l_trapezoidal_rule_zt
3986 :
3987 : ! If l_trapezoidal_rule_zm is true, call trapezoidal_rule_zm for
3988 : ! the important momentum-level variabes output from pdf_closure.
3989 : ! ldgrant Feb. 2010
3990 352944 : if ( l_trapezoidal_rule_zm ) then
3991 : call trapezoidal_rule_zm( nz, ngrdcol, gr, & ! intent(in)
3992 : wpthvp_zt, thlpthvp_zt, rtpthvp_zt, & ! intent(in)
3993 352944 : wpthvp, thlpthvp, rtpthvp ) ! intent(inout)
3994 : end if ! l_trapezoidal_rule_zm
3995 :
3996 :
3997 : ! Vince Larson clipped rcm in order to prevent rvm < 0. 5 Apr 2008.
3998 : ! This code won't work unless rtm >= 0 !!!
3999 : ! We do not clip rcm_in_layer because rcm_in_layer only influences
4000 : ! radiation, and we do not want to bother recomputing it.
4001 : ! Code is duplicated from below to ensure that relative humidity
4002 : ! is calculated properly. 3 Sep 2009
4003 : call clip_rcm( nz, ngrdcol, rtm, & ! intent(in)
4004 : 'rtm < rcm after pdf_closure', & ! intent(in)
4005 352944 : rcm ) ! intent(inout)
4006 :
4007 : ! Compute variables cloud_cover and rcm_in_layer.
4008 : ! Added July 2009
4009 : call compute_cloud_cover( gr, nz, ngrdcol, & ! intent(in)
4010 : pdf_params, cloud_frac, rcm, & ! intent(in)
4011 352944 : cloud_cover, rcm_in_layer ) ! intent(out)
4012 :
4013 352944 : if ( l_use_cloud_cover ) then
4014 : ! Use cloud_cover and rcm_in_layer to help boost cloud_frac and rcm to help
4015 : ! increase cloudiness at coarser grid resolutions.
4016 : !$acc parallel loop gang vector collapse(2) default(present)
4017 30353184 : do k = 1, nz
4018 501287184 : do i = 1, ngrdcol
4019 470934000 : cloud_frac(i,k) = cloud_cover(i,k)
4020 500934240 : rcm(i,k) = rcm_in_layer(i,k)
4021 : end do
4022 : end do
4023 : !$acc end parallel loop
4024 : end if
4025 :
4026 : !$acc parallel loop gang vector collapse(2) default(present)
4027 30353184 : do k = 1, nz
4028 501287184 : do i = 1, ngrdcol
4029 : ! Clip cloud fraction here if it still exceeds 1.0 due to round off
4030 470934000 : cloud_frac(i,k) = min( 1.0_core_rknd, cloud_frac(i,k) )
4031 : ! Ditto with ice cloud fraction
4032 500934240 : ice_supersat_frac(i,k) = min( 1.0_core_rknd, ice_supersat_frac(i,k) )
4033 : end do
4034 : end do
4035 : !$acc end parallel loop
4036 :
4037 352944 : T_in_K = thlm2T_in_K( nz, ngrdcol, thlm, exner, rcm )
4038 352944 : rsat = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, T_in_K )
4039 :
4040 : !$acc parallel loop gang vector collapse(2) default(present)
4041 30353184 : do k = 1, nz
4042 501287184 : do i = 1, ngrdcol
4043 470934000 : rel_humidity(i,k) = (rtm(i,k) - rcm(i,k)) / rsat(i,k)
4044 500934240 : rcm_supersat_adj(i,k) = zero
4045 : end do
4046 : end do
4047 : !$acc end parallel loop
4048 :
4049 352944 : if ( l_rcm_supersat_adj ) then
4050 : ! +PAB mods, take remaining supersaturation that may exist
4051 : ! after CLUBB PDF call and add it to rcm. Supersaturation
4052 : ! may exist after PDF call due to issues with calling PDF on the
4053 : ! thermo grid and momentum grid and the interpolation between the two
4054 : l_spur_supersat = .false.
4055 :
4056 :
4057 : !$acc parallel loop gang vector collapse(2) default(present)
4058 0 : do k = 2, nz
4059 0 : do i = 1, ngrdcol
4060 0 : if (rel_humidity(i,k) > 1.0_core_rknd) then
4061 0 : rcm_supersat_adj(i,k) = (rtm(i,k) - rcm(i,k)) - rsat(i,k)
4062 0 : rcm(i,k) = rcm(i,k) + rcm_supersat_adj(i,k)
4063 0 : l_spur_supersat = .true.
4064 : end if
4065 : end do
4066 : end do
4067 : !$acc end parallel loop
4068 :
4069 0 : if ( clubb_at_least_debug_level( 1 ) .and. l_spur_supersat ) then
4070 0 : write(fstderr,*) 'Warning: spurious supersaturation was removed after pdf_closure!'
4071 : end if
4072 :
4073 : end if ! l_rcm_supersat_adj
4074 :
4075 : !$acc exit data delete( wp2_zt,wp3_zm, rtp2_zt,rtp3_zm, thlp2_zt, thlp3_zm, &
4076 : !$acc wprtp_zt, wpthlp_zt, rtpthlp_zt, up2_zt, up3_zm, &
4077 : !$acc vp2_zt, vp3_zm, upwp_zt, vpwp_zt, gamma_Skw_fnc, &
4078 : !$acc gamma_Skw_fnc_zt,sigma_sqd_w_zt, Skw_zt, Skw_zm, &
4079 : !$acc Skrt_zt, Skrt_zm, Skthl_zt, Skthl_zm, Sku_zt, &
4080 : !$acc Sku_zm, Skv_zt, Skv_zm, wp2up2_zt, &
4081 : !$acc wp2vp2_zt, wp4_zt, wpthvp_zt, rtpthvp_zt, thlpthvp_zt, &
4082 : !$acc wprcp_zt, rtprcp_zt, thlprcp_zt, uprcp_zt, vprcp_zt, &
4083 : !$acc rsat, rel_humidity, um_zm, vm_zm, T_in_K, sigma_sqd_w_tmp )
4084 :
4085 : !$acc exit data if( l_call_pdf_closure_twice ) &
4086 : !$acc delete( w_up_in_cloud_zm, wpup2_zm, wpvp2_zm, &
4087 : !$acc w_down_in_cloud_zm, cloudy_updraft_frac_zm, &
4088 : !$acc cloudy_downdraft_frac_zm, p_in_Pa_zm, exner_zm, &
4089 : !$acc wprtp2_zm, wp2rtp_zm, wpthlp2_zm, &
4090 : !$acc wp2thlp_zm, wprtpthlp_zm, wp2thvp_zm, wp2rcp_zm )
4091 :
4092 : !$acc exit data if( sclr_dim > 0 ) &
4093 : !$acc delete( wpsclrp_zt, sclrp2_zt, sclrp3_zm, sclrprtp_zt, sclrpthlp_zt, &
4094 : !$acc Sksclr_zt, Sksclr_zm, sclrpthvp_zt, sclrprcp_zt, wpsclrprtp_zm, &
4095 : !$acc wpsclrp2_zm, wpsclrpthlp_zm, wp2sclrp_zm, sclrm_zm )
4096 :
4097 : !$acc exit data if( hydromet_dim > 0 ) delete( wphydrometp_zt, wp2hmp_zm, rtphmp, thlphmp )
4098 :
4099 : return
4100 :
4101 352944 : end subroutine pdf_closure_driver
4102 :
4103 : !=============================================================================
4104 1536 : subroutine setup_clubb_core &
4105 : ( nzmax, T0_in, ts_nudge_in, & ! intent(in)
4106 : hydromet_dim_in, sclr_dim_in, & ! intent(in)
4107 1536 : sclr_tol_in, edsclr_dim_in, params, & ! intent(in)
4108 : l_host_applies_sfc_fluxes, & ! intent(in)
4109 : saturation_formula, & ! intent(in)
4110 : l_input_fields, & ! intent(in)
4111 : #ifdef GFDL
4112 : I_sat_sphum, & ! intent(in) h1g, 2010-06-16
4113 : #endif
4114 : clubb_config_flags, & ! intent(in)
4115 :
4116 : #ifdef GFDL
4117 : cloud_frac_min, & ! intent(in) h1g, 2010-06-16
4118 : #endif
4119 : err_code_out ) ! intent(out)
4120 :
4121 : ! Description:
4122 : ! Subroutine to set up the model for execution.
4123 : !
4124 : ! References:
4125 : ! None
4126 : !---------------------------------------------------------------------
4127 :
4128 : use grid_class, only: &
4129 : grid ! Type
4130 :
4131 : use parameter_indices, only: &
4132 : nparams, & ! Variable(s)
4133 : iC1, & ! Constant(s)
4134 : iC1b, &
4135 : iC2rt, &
4136 : iC2thl, &
4137 : iC2rtthl, &
4138 : iC6rt, &
4139 : iC6rtb, &
4140 : iC6thl, &
4141 : iC6thlb, &
4142 : iC14, &
4143 : iSkw_max_mag
4144 :
4145 : use parameters_tunable, only: &
4146 : setup_parameters, & ! Procedure
4147 : nu_vertical_res_dep ! Type(s)
4148 :
4149 : use parameters_model, only: &
4150 : setup_parameters_model ! Procedure
4151 :
4152 : use constants_clubb, only: &
4153 : fstderr, & ! Variable(s)
4154 : one, &
4155 : eps
4156 :
4157 : use error_code, only: &
4158 : clubb_at_least_debug_level, & ! Procedures
4159 : initialize_error_headers, &
4160 : err_code, & ! Error Indicator
4161 : clubb_no_error, & ! Constant
4162 : clubb_fatal_error ! Constant
4163 :
4164 : use model_flags, only: &
4165 : clubb_config_flags_type, & ! Type
4166 : setup_model_flags, & ! Subroutine
4167 : iiPDF_ADG1, & ! Variable(s)
4168 : iiPDF_ADG2, &
4169 : iiPDF_3D_Luhar, &
4170 : iiPDF_new, &
4171 : iiPDF_TSDADG, &
4172 : iiPDF_LY93, &
4173 : iiPDF_new_hybrid, &
4174 : lapack, &
4175 : l_explicit_turbulent_adv_wpxp
4176 :
4177 : use clubb_precision, only: &
4178 : core_rknd ! Variable(s)
4179 :
4180 : implicit none
4181 :
4182 : ! Input Variables
4183 :
4184 : ! Grid definition
4185 : integer, intent(in) :: nzmax ! Vertical grid levels [#]
4186 : ! Only true when used in a host model
4187 : ! CLUBB determines what nzmax should be
4188 : ! given zm_init and zm_top when
4189 : ! running in standalone mode.
4190 :
4191 : ! Model parameters
4192 : real( kind = core_rknd ), intent(in) :: &
4193 : T0_in, ts_nudge_in
4194 :
4195 : integer, intent(in) :: &
4196 : hydromet_dim_in, & ! Number of hydrometeor species
4197 : sclr_dim_in, & ! Number of passive scalars
4198 : edsclr_dim_in ! Number of eddy-diff. passive scalars
4199 :
4200 : real( kind = core_rknd ), intent(in), dimension(sclr_dim_in) :: &
4201 : sclr_tol_in ! Thresholds for passive scalars
4202 :
4203 : real( kind = core_rknd ), intent(in), dimension(nparams) :: &
4204 : params ! Including C1, nu1, nu2, etc.
4205 :
4206 : ! Flags
4207 : logical, intent(in) :: &
4208 : l_host_applies_sfc_fluxes ! Whether to apply for the surface flux
4209 :
4210 : character(len=*), intent(in) :: &
4211 : saturation_formula ! Approximation for saturation vapor pressure
4212 :
4213 : logical, intent(in) :: &
4214 : l_input_fields ! Flag for whether LES input fields are being used
4215 :
4216 : type(clubb_config_flags_type), intent(in) :: &
4217 : clubb_config_flags
4218 :
4219 :
4220 : #ifdef GFDL
4221 : logical, intent(in) :: & ! h1g, 2010-06-16 begin mod
4222 : I_sat_sphum
4223 :
4224 : real( kind = core_rknd ), intent(in) :: &
4225 : cloud_frac_min ! h1g, 2010-06-16 end mod
4226 : #endif
4227 :
4228 : integer, intent(out) :: &
4229 : err_code_out ! Error code indicator
4230 :
4231 : !----- Begin Code -----
4232 :
4233 1536 : err_code_out = clubb_no_error ! Initialize to no error value
4234 1536 : call initialize_error_headers
4235 :
4236 : #ifdef _OPENACC
4237 : if ( clubb_config_flags%penta_solve_method == lapack ) then
4238 : write(fstderr,*) "WARNING: The penta-diagonal lapack solver is not GPU accelerated"
4239 : write(fstderr,*) " Set penta_solve_method = 2, to use an accelerated penta-diagonal solver"
4240 : end if
4241 :
4242 : if ( clubb_config_flags%tridiag_solve_method == lapack ) then
4243 : write(fstderr,*) "WARNING: The tri-diagonal lapack solver is not GPU accelerated"
4244 : write(fstderr,*) " Set tridiag_solve_method = 2, to use an accelerated tri-diagonal solver"
4245 : end if
4246 : #endif
4247 :
4248 : ! Sanity check
4249 1536 : if ( clubb_at_least_debug_level( 0 ) ) then
4250 :
4251 1536 : if ( clubb_config_flags%l_damp_wp2_using_em .and. &
4252 : (abs(params(iC1) - params(iC14)) > abs(params(iC1) + params(iC14)) / 2 * eps .or. &
4253 : clubb_config_flags%l_stability_correct_tau_zm) ) then
4254 : write(fstderr,*) "l_damp_wp2_using_em = T requires C1=C14 and" &
4255 0 : // " l_stability_correct_tau_zm = F"
4256 0 : write(fstderr,*) "C1 = ", params(iC1)
4257 0 : write(fstderr,*) "C14 = ", params(iC14)
4258 0 : write(fstderr,*) "l_stability_correct_tau_zm = ", clubb_config_flags%l_stability_correct_tau_zm
4259 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4260 0 : err_code = clubb_fatal_error
4261 0 : err_code_out = clubb_fatal_error
4262 0 : return
4263 : end if
4264 :
4265 : end if
4266 :
4267 : ! Sanity check for the saturation formula
4268 3072 : select case ( trim( saturation_formula ) )
4269 : case ( "bolton", "Bolton" )
4270 : ! Using the Bolton 1980 approximations for SVP over vapor/ice
4271 :
4272 : case ( "flatau", "Flatau" )
4273 : ! Using the Flatau, et al. polynomial approximation for SVP over vapor/ice
4274 :
4275 : case ( "gfdl", "GFDL" ) ! h1g, 2010-06-16
4276 : ! Using the GFDL SVP formula (Goff-Gratch)
4277 :
4278 : ! Add new saturation formulas after this
4279 :
4280 : case ( "lookup" )
4281 : ! Using the lookup table
4282 :
4283 : case default
4284 : write(fstderr,*) "Unknown approx. of saturation vapor pressure: "// &
4285 0 : trim( saturation_formula )
4286 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4287 0 : err_code = clubb_fatal_error
4288 0 : err_code_out = clubb_fatal_error
4289 3072 : return
4290 : end select
4291 :
4292 : ! Check for the type of two component normal (double Gaussian) PDF being
4293 : ! used for w, rt, and theta-l (or w, chi, and eta).
4294 : if ( clubb_config_flags%iiPDF_type < iiPDF_ADG1 &
4295 1536 : .or. clubb_config_flags%iiPDF_type > iiPDF_new_hybrid ) then
4296 0 : write(fstderr,*) "Unknown type of double Gaussian PDF selected: ", clubb_config_flags%iiPDF_type
4297 0 : write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
4298 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4299 0 : err_code = clubb_fatal_error
4300 0 : err_code_out = clubb_fatal_error
4301 0 : return
4302 : endif ! iiPDF_type < iiPDF_ADG1 or iiPDF_type > iiPDF_lY93
4303 :
4304 : ! The ADG2 and 3D Luhar PDFs can only be used as part of input fields.
4305 1536 : if ( clubb_config_flags%iiPDF_type == iiPDF_ADG2 ) then
4306 0 : if ( .not. l_input_fields ) then
4307 : write(fstderr,*) "The ADG2 PDF can only be used with" &
4308 0 : // " input fields (l_input_fields = .true.)."
4309 0 : write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
4310 0 : write(fstderr,*) "l_input_fields = ", l_input_fields
4311 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4312 0 : err_code = clubb_fatal_error
4313 0 : err_code_out = clubb_fatal_error
4314 0 : return
4315 : endif ! .not. l_input_fields
4316 : endif ! iiPDF_type == iiPDF_ADG2
4317 :
4318 1536 : if ( clubb_config_flags%iiPDF_type == iiPDF_3D_Luhar ) then
4319 0 : if ( .not. l_input_fields ) then
4320 : write(fstderr,*) "The 3D Luhar PDF can only be used with" &
4321 0 : // " input fields (l_input_fields = .true.)."
4322 0 : write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
4323 0 : write(fstderr,*) "l_input_fields = ", l_input_fields
4324 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4325 0 : err_code = clubb_fatal_error
4326 0 : err_code_out = clubb_fatal_error
4327 0 : return
4328 : endif ! .not. l_input_fields
4329 : endif ! iiPDF_type == iiPDF_3D_Luhar
4330 :
4331 : ! This also currently applies to the new PDF until it has been fully
4332 : ! implemented.
4333 1536 : if ( clubb_config_flags%iiPDF_type == iiPDF_new ) then
4334 0 : if ( .not. l_input_fields ) then
4335 : write(fstderr,*) "The new PDF can only be used with" &
4336 0 : // " input fields (l_input_fields = .true.)."
4337 0 : write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
4338 0 : write(fstderr,*) "l_input_fields = ", l_input_fields
4339 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4340 0 : err_code = clubb_fatal_error
4341 0 : err_code_out = clubb_fatal_error
4342 0 : return
4343 : endif ! .not. l_input_fields
4344 : endif ! iiPDF_type == iiPDF_new
4345 :
4346 : ! This also currently applies to the TSDADG PDF until it has been fully
4347 : ! implemented.
4348 1536 : if ( clubb_config_flags%iiPDF_type == iiPDF_TSDADG ) then
4349 0 : if ( .not. l_input_fields ) then
4350 : write(fstderr,*) "The new TSDADG PDF can only be used with" &
4351 0 : // " input fields (l_input_fields = .true.)."
4352 0 : write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
4353 0 : write(fstderr,*) "l_input_fields = ", l_input_fields
4354 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4355 0 : err_code = clubb_fatal_error
4356 0 : err_code_out = clubb_fatal_error
4357 0 : return
4358 : endif ! .not. l_input_fields
4359 : endif ! iiPDF_type == iiPDF_TSDADG
4360 :
4361 : ! This also applies to Lewellen and Yoh (1993).
4362 1536 : if ( clubb_config_flags%iiPDF_type == iiPDF_LY93 ) then
4363 0 : if ( .not. l_input_fields ) then
4364 : write(fstderr,*) "The Lewellen and Yoh PDF can only be used with" &
4365 0 : // " input fields (l_input_fields = .true.)."
4366 0 : write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
4367 0 : write(fstderr,*) "l_input_fields = ", l_input_fields
4368 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4369 0 : err_code = clubb_fatal_error
4370 0 : err_code_out = clubb_fatal_error
4371 0 : return
4372 : endif ! .not. l_input_fields
4373 : endif ! iiPDF_type == iiPDF_LY93
4374 :
4375 : ! Check the option for the placement of the call to CLUBB's PDF.
4376 : if ( clubb_config_flags%ipdf_call_placement < ipdf_pre_advance_fields &
4377 1536 : .or. clubb_config_flags%ipdf_call_placement > ipdf_pre_post_advance_fields ) then
4378 0 : write(fstderr,*) "Invalid option selected for ipdf_call_placement: ", &
4379 0 : clubb_config_flags%ipdf_call_placement
4380 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4381 0 : err_code = clubb_fatal_error
4382 0 : err_code_out = clubb_fatal_error
4383 0 : return
4384 : endif
4385 :
4386 : ! The l_predict_upwp_vpwp flag requires that the ADG1 PDF is used
4387 : ! implicitly in subroutine advance_xm_wpxp.
4388 1536 : if ( clubb_config_flags%l_predict_upwp_vpwp ) then
4389 :
4390 : ! When l_predict_upwp_vpwp is enabled, the
4391 : ! l_explicit_turbulent_adv_wpxp flag must be turned off.
4392 : ! Otherwise, explicit turbulent advection would require PDF parameters
4393 : ! for u and v to be calculated in PDF closure. These would be needed
4394 : ! to calculate integrated fields such as wp2up, etc.
4395 : if ( l_explicit_turbulent_adv_wpxp ) then
4396 : write(fstderr,*) "The l_explicit_turbulent_adv_wpxp option" &
4397 : // " is not currently set up for use with the" &
4398 : // " l_predict_upwp_vpwp code."
4399 : write(fstderr,*) "Fatal error in setup_clubb_core"
4400 : err_code = clubb_fatal_error
4401 : err_code_out = clubb_fatal_error
4402 : return
4403 : endif ! l_explicit_turbulent_adv_wpxp
4404 :
4405 : ! When l_predict_upwp_vpwp is enabled, the PDF type must be set to
4406 : ! the ADG1 PDF or the new hybrid PDF. The other PDFs are not currently
4407 : ! set up to calculate variables needed for implicit or semi-implicit
4408 : ! turbulent advection, such as coef_wp2up_implicit, etc.
4409 : if ( ( clubb_config_flags%iiPDF_type /= iiPDF_ADG1 ) &
4410 1536 : .and. ( clubb_config_flags%iiPDF_type /= iiPDF_new_hybrid ) ) then
4411 : write(fstderr,*) "Currently, only the ADG1 PDF and the new hybrid" &
4412 : // " PDF are set up for use with the" &
4413 0 : // " l_predict_upwp_vpwp code."
4414 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4415 0 : err_code = clubb_fatal_error
4416 0 : err_code_out = clubb_fatal_error
4417 0 : return
4418 : endif ! iiPDF_type /= iiPDF_ADG1
4419 :
4420 : endif ! l_predict_upwp_vpwp
4421 :
4422 : ! The flags l_min_xp2_from_corr_wx and l_enable_relaxed_clipping must
4423 : ! have opposite values.
4424 : if ( ( clubb_config_flags%l_min_xp2_from_corr_wx ) &
4425 1536 : .and. ( clubb_config_flags%l_enable_relaxed_clipping ) ) then
4426 : write(fstderr,*) "Invalid configuration: l_min_xp2_from_corr_wx = T " &
4427 0 : // "and l_enable_relaxed_clipping = T"
4428 0 : write(fstderr,*) "They must have opposite values"
4429 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4430 0 : err_code = clubb_fatal_error
4431 0 : err_code_out = clubb_fatal_error
4432 0 : return
4433 : elseif ( ( .not. clubb_config_flags%l_min_xp2_from_corr_wx ) &
4434 1536 : .and. ( .not. clubb_config_flags%l_enable_relaxed_clipping ) ) then
4435 : write(fstderr,*) "Invalid configuration: l_min_xp2_from_corr_wx = F " &
4436 0 : // "and l_enable_relaxed_clipping = F"
4437 0 : write(fstderr,*) "They must have opposite values"
4438 0 : write(fstderr,*) "Fatal error in setup_clubb_core"
4439 : !err_code = clubb_fatal_error
4440 : !err_code_out = clubb_fatal_error
4441 : !return
4442 : endif
4443 :
4444 : ! Checking for the code that orders CLUBB's advance_ subroutines
4445 : if ( order_xm_wpxp < 1 .or. order_xm_wpxp > 4 ) then
4446 : write(fstderr,*) "The variable order_xm_wpxp must have a value " &
4447 : // "between 1 and 4"
4448 : write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
4449 : write(fstderr,*) "Fatal error in setup_clubb_core"
4450 : err_code = clubb_fatal_error
4451 : err_code_out = clubb_fatal_error
4452 : return
4453 : elseif ( order_xm_wpxp == order_wp2_wp3 &
4454 : .or. order_xm_wpxp == order_xp2_xpyp &
4455 : .or. order_xm_wpxp == order_windm ) then
4456 : write(fstderr,*) "The variable order_xm_wpxp has the same value " &
4457 : // "as another order_ variable. Please give each " &
4458 : // "order index a unique value."
4459 : write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
4460 : write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
4461 : write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
4462 : write(fstderr,*) "order_windm = ", order_windm
4463 : write(fstderr,*) "Fatal error in setup_clubb_core"
4464 : err_code = clubb_fatal_error
4465 : err_code_out = clubb_fatal_error
4466 : return
4467 : endif
4468 :
4469 : if ( order_wp2_wp3 < 1 .or. order_wp2_wp3 > 4 ) then
4470 : write(fstderr,*) "The variable order_wp2_wp3 must have a value " &
4471 : // "between 1 and 4"
4472 : write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
4473 : write(fstderr,*) "Fatal error in setup_clubb_core"
4474 : err_code = clubb_fatal_error
4475 : err_code_out = clubb_fatal_error
4476 : return
4477 : elseif ( order_wp2_wp3 == order_xm_wpxp &
4478 : .or. order_wp2_wp3 == order_xp2_xpyp &
4479 : .or. order_wp2_wp3 == order_windm ) then
4480 : write(fstderr,*) "The variable order_wp2_wp3 has the same value " &
4481 : // "as another order_ variable. Please give each " &
4482 : // "order index a unique value."
4483 : write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
4484 : write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
4485 : write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
4486 : write(fstderr,*) "order_windm = ", order_windm
4487 : write(fstderr,*) "Fatal error in setup_clubb_core"
4488 : err_code = clubb_fatal_error
4489 : err_code_out = clubb_fatal_error
4490 : return
4491 : endif
4492 :
4493 : if ( order_xp2_xpyp < 1 .or. order_xp2_xpyp > 4 ) then
4494 : write(fstderr,*) "The variable order_xp2_xpyp must have a value " &
4495 : // "between 1 and 4"
4496 : write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
4497 : write(fstderr,*) "Fatal error in setup_clubb_core"
4498 : err_code = clubb_fatal_error
4499 : err_code_out = clubb_fatal_error
4500 : return
4501 : elseif ( order_xp2_xpyp == order_wp2_wp3 &
4502 : .or. order_xp2_xpyp == order_xm_wpxp &
4503 : .or. order_xp2_xpyp == order_windm ) then
4504 : write(fstderr,*) "The variable order_xp2_xpyp has the same value " &
4505 : // "as another order_ variable. Please give each " &
4506 : // "order index a unique value."
4507 : write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
4508 : write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
4509 : write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
4510 : write(fstderr,*) "order_windm = ", order_windm
4511 : write(fstderr,*) "Fatal error in setup_clubb_core"
4512 : err_code = clubb_fatal_error
4513 : err_code_out = clubb_fatal_error
4514 : return
4515 : endif
4516 :
4517 : if ( order_windm < 1 .or. order_windm > 4 ) then
4518 : write(fstderr,*) "The variable order_windm must have a value " &
4519 : // "between 1 and 4"
4520 : write(fstderr,*) "order_windm = ", order_windm
4521 : write(fstderr,*) "Fatal error in setup_clubb_core"
4522 : err_code = clubb_fatal_error
4523 : err_code_out = clubb_fatal_error
4524 : return
4525 : elseif ( order_windm == order_wp2_wp3 &
4526 : .or. order_windm == order_xp2_xpyp &
4527 : .or. order_windm == order_xm_wpxp ) then
4528 : write(fstderr,*) "The variable order_windm has the same value " &
4529 : // "as another order_ variable. Please give each " &
4530 : // "order index a unique value."
4531 : write(fstderr,*) "order_windm = ", order_windm
4532 : write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
4533 : write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
4534 : write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
4535 : write(fstderr,*) "Fatal error in setup_clubb_core"
4536 : err_code = clubb_fatal_error
4537 : err_code_out = clubb_fatal_error
4538 : return
4539 : endif
4540 :
4541 : ! Checking that when the l_diag_Lscale_from_tau is enabled, the
4542 : ! relevant Cx tunable parameters are all set to a value of 1 (as
4543 : ! you're supposed to tune the C_invrs_tau_ parameters instead).
4544 1536 : if ( clubb_config_flags%l_diag_Lscale_from_tau ) then
4545 :
4546 : ! Note: someday when we can successfully run with all these parameters
4547 : ! having a value of 1, the "Warning" messages should be removed and the
4548 : ! "Fatal error" messages should be uncommented.
4549 :
4550 : ! C1 must have a value of 1
4551 0 : if ( params(iC1) > one .or. params(iC1) < one ) then
4552 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4553 0 : // "enabled, C1 must have a value of 1."
4554 0 : write(fstderr,*) "C1 = ", params(iC1)
4555 0 : write(fstderr,*) "Warning in setup_clubb_core"
4556 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4557 : !err_code = clubb_fatal_error
4558 : !err_code_out = clubb_fatal_error
4559 : endif ! C1 check
4560 :
4561 : ! C1b must have a value of 1
4562 0 : if ( params(iC1b) > one .or. params(iC1b) < one ) then
4563 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4564 0 : // "enabled, C1b must have a value of 1."
4565 0 : write(fstderr,*) "C1b = ", params(iC1b)
4566 0 : write(fstderr,*) "Warning in setup_clubb_core"
4567 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4568 : !err_code = clubb_fatal_error
4569 : !err_code_out = clubb_fatal_error
4570 : endif ! C1b check
4571 :
4572 : ! C2rt must have a value of 1
4573 0 : if ( params(iC2rt) > one .or. params(iC2rt) < one ) then
4574 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4575 0 : // "enabled, C2rt must have a value of 1."
4576 0 : write(fstderr,*) "C2rt = ", params(iC2rt)
4577 0 : write(fstderr,*) "Warning in setup_clubb_core"
4578 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4579 : !err_code = clubb_fatal_error
4580 : !err_code_out = clubb_fatal_error
4581 : endif ! C2rt check
4582 :
4583 : ! C2thl must have a value of 1
4584 0 : if ( params(iC2thl) > one .or. params(iC2thl) < one ) then
4585 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4586 0 : // "enabled, C2thl must have a value of 1."
4587 0 : write(fstderr,*) "C2thl = ", params(iC2thl)
4588 0 : write(fstderr,*) "Warning in setup_clubb_core"
4589 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4590 : !err_code = clubb_fatal_error
4591 : !err_code_out = clubb_fatal_error
4592 : endif ! C2thl check
4593 :
4594 : ! C2rtthl must have a value of 1
4595 0 : if ( params(iC2rtthl) > one .or. params(iC2rtthl) < one ) then
4596 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4597 0 : // "enabled, C2rtthl must have a value of 1."
4598 0 : write(fstderr,*) "C2rtthl = ", params(iC2rtthl)
4599 0 : write(fstderr,*) "Warning in setup_clubb_core"
4600 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4601 : !err_code = clubb_fatal_error
4602 : !err_code_out = clubb_fatal_error
4603 : endif ! C2rtthl check
4604 :
4605 : ! C6rt must have a value of 1
4606 0 : if ( params(iC6rt) > one .or. params(iC6rt) < one ) then
4607 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4608 0 : // "enabled, C6rt must have a value of 1."
4609 0 : write(fstderr,*) "C6rt = ", params(iC6rt)
4610 0 : write(fstderr,*) "Warning in setup_clubb_core"
4611 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4612 : !err_code = clubb_fatal_error
4613 : !err_code_out = clubb_fatal_error
4614 : endif ! C6rt check
4615 :
4616 : ! C6rtb must have a value of 1
4617 0 : if ( params(iC6rtb) > one .or. params(iC6rtb) < one ) then
4618 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4619 0 : // "enabled, C6rtb must have a value of 1."
4620 0 : write(fstderr,*) "C6rtb = ", params(iC6rtb)
4621 0 : write(fstderr,*) "Warning in setup_clubb_core"
4622 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4623 : !err_code = clubb_fatal_error
4624 : !err_code_out = clubb_fatal_error
4625 : endif ! C6rtb check
4626 :
4627 : ! C6thl must have a value of 1
4628 0 : if ( params(iC6thl) > one .or. params(iC6thl) < one ) then
4629 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4630 0 : // "enabled, C6thl must have a value of 1."
4631 0 : write(fstderr,*) "C6thl = ", params(iC6thl)
4632 0 : write(fstderr,*) "Warning in setup_clubb_core"
4633 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4634 : !err_code = clubb_fatal_error
4635 : !err_code_out = clubb_fatal_error
4636 : endif ! C6thl check
4637 :
4638 : ! C6thlb must have a value of 1
4639 0 : if ( params(iC6thlb) > one .or. params(iC6thlb) < one ) then
4640 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4641 0 : // "enabled, C6thlb must have a value of 1."
4642 0 : write(fstderr,*) "C6thlb = ", params(iC6thlb)
4643 0 : write(fstderr,*) "Warning in setup_clubb_core"
4644 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4645 : !err_code = clubb_fatal_error
4646 : !err_code_out = clubb_fatal_error
4647 : endif ! C6thlb check
4648 :
4649 : ! C14 must have a value of 1
4650 0 : if ( params(iC14) > one .or. params(iC14) < one ) then
4651 : write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
4652 0 : // "enabled, C14 must have a value of 1."
4653 0 : write(fstderr,*) "C14 = ", params(iC14)
4654 0 : write(fstderr,*) "Warning in setup_clubb_core"
4655 : !write(fstderr,*) "Fatal error in setup_clubb_core"
4656 : !err_code = clubb_fatal_error
4657 : !err_code_out = clubb_fatal_error
4658 : endif ! C14 check
4659 :
4660 : endif ! l_diag_Lscale_from_tau
4661 :
4662 : ! Setup flags
4663 : #ifdef GFDL
4664 : call setup_model_flags &
4665 : ( l_host_applies_sfc_fluxes, & ! intent(in)
4666 : saturation_formula, & ! intent(in)
4667 : I_sat_sphum ) ! intent(in) h1g, 2010-06-16
4668 :
4669 : #else
4670 : call setup_model_flags &
4671 : ( l_host_applies_sfc_fluxes, & ! intent(in)
4672 1536 : saturation_formula ) ! intent(in)
4673 : #endif
4674 :
4675 :
4676 : ! Define model constant parameters
4677 : #ifdef GFDL
4678 : call setup_parameters_model( T0_in, ts_nudge_in, params(iSkw_max_mag), & ! intent(in)
4679 : hydromet_dim_in, & ! intent(in)
4680 : sclr_dim_in, sclr_tol_in, edsclr_dim_in, & ! intent(in)
4681 : cloud_frac_min ) ! intent(in) h1g, 2010-06-16
4682 : #else
4683 : call setup_parameters_model( T0_in, ts_nudge_in, params(iSkw_max_mag), & ! intent(in)
4684 : hydromet_dim_in, & ! intent(in)
4685 1536 : sclr_dim_in, sclr_tol_in, edsclr_dim_in ) ! intent(in)
4686 : #endif
4687 :
4688 1536 : return
4689 : end subroutine setup_clubb_core
4690 :
4691 : !----------------------------------------------------------------------------
4692 0 : subroutine cleanup_clubb_core( gr )
4693 :
4694 : ! Description:
4695 : ! Frees memory used by the model itself.
4696 : !
4697 : ! References:
4698 : ! None
4699 : !---------------------------------------------------------------------------
4700 : use parameters_model, only: sclr_tol ! Variable
4701 :
4702 : use grid_class, only: &
4703 : cleanup_grid, & ! Procedure
4704 : grid ! Type
4705 :
4706 : implicit none
4707 :
4708 : type(grid), target, intent(inout) :: gr
4709 :
4710 : !----- Begin Code -----
4711 :
4712 : ! De-allocate the array for the passive scalar tolerances
4713 0 : deallocate( sclr_tol )
4714 :
4715 : ! De-allocate the arrays for the grid
4716 0 : call cleanup_grid( gr ) ! intent(in)
4717 :
4718 0 : return
4719 : end subroutine cleanup_clubb_core
4720 :
4721 : !-----------------------------------------------------------------------
4722 352944 : subroutine trapezoidal_rule_zt( nz, ngrdcol, gr, l_call_pdf_closure_twice, & ! intent(in)
4723 : stats_metadata, & ! intent(in)
4724 352944 : wprtp2, wpthlp2, & ! intent(inout)
4725 352944 : wprtpthlp, cloud_frac, ice_supersat_frac, & ! intent(inout)
4726 352944 : rcm, wp2thvp, wpsclrprtp, wpsclrp2, & ! intent(inout)
4727 352944 : wpsclrpthlp, & ! intent(inout)
4728 352944 : wprtp2_zm, wpthlp2_zm, & ! intent(inout)
4729 352944 : wprtpthlp_zm, cloud_frac_zm, & ! intent(inout)
4730 352944 : ice_supersat_frac_zm, rcm_zm, wp2thvp_zm, & ! intent(inout)
4731 352944 : wpsclrprtp_zm, wpsclrp2_zm, wpsclrpthlp_zm ) ! intent(inout)
4732 :
4733 : !
4734 : ! Description:
4735 : ! This subroutine takes the output variables on the thermo.
4736 : ! grid and either: interpolates them to the momentum grid, or uses the
4737 : ! values output from the second call to pdf_closure on momentum levels if
4738 : ! l_call_pdf_closure_twice is true. It then calls the function
4739 : ! trapezoid_zt to recompute the variables on the thermo. grid.
4740 : !
4741 : ! ldgrant June 2009
4742 : !
4743 : ! Note:
4744 : ! The argument variables in the last 5 lines of the subroutine
4745 : ! (wprtp2_zm through pdf_params_zm) are declared intent(inout) because
4746 : ! if l_call_pdf_closure_twice is true, these variables will already have
4747 : ! values from pdf_closure on momentum levels and will not be altered in
4748 : ! this subroutine. However, if l_call_pdf_closure_twice is false, these
4749 : ! variables will not have values yet and will be interpolated to
4750 : ! momentum levels in this subroutine.
4751 : ! References:
4752 : ! None
4753 : !-----------------------------------------------------------------------
4754 :
4755 : use grid_class, only: &
4756 : grid, & ! Type
4757 : zt2zm ! Procedure
4758 :
4759 : use parameters_model, only: &
4760 : sclr_dim ! Number of passive scalar variables
4761 :
4762 : use pdf_parameter_module, only: &
4763 : pdf_parameter ! Derived data type
4764 :
4765 : use clubb_precision, only: &
4766 : core_rknd ! Variable(s)
4767 :
4768 : use stats_variables, only: &
4769 : stats_metadata_type
4770 :
4771 : implicit none
4772 :
4773 : !------------------------ Input variables ------------------------
4774 : integer, intent(in) :: &
4775 : nz, &
4776 : ngrdcol
4777 :
4778 : type (grid), target, intent(in) :: &
4779 : gr
4780 :
4781 : logical, intent(in) :: &
4782 : l_call_pdf_closure_twice
4783 :
4784 : type (stats_metadata_type), intent(in) :: &
4785 : stats_metadata
4786 :
4787 : !------------------------ Input/Output variables ------------------------
4788 : ! Thermodynamic level variables output from the first call to pdf_closure
4789 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
4790 : wprtp2, & ! w'rt'^2 [m kg^2/kg^2]
4791 : wpthlp2, & ! w'thl'^2 [m K^2/s]
4792 : wprtpthlp, & ! w'rt'thl' [m kg K/kg s]
4793 : cloud_frac, & ! Cloud Fraction [-]
4794 : ice_supersat_frac, & ! Ice Cloud Fraction [-]
4795 : rcm, & ! Liquid water mixing ratio [kg/kg]
4796 : wp2thvp ! w'^2 th_v' [m^2 K/s^2]
4797 :
4798 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(inout) :: &
4799 : wpsclrprtp, & ! w'sclr'rt'
4800 : wpsclrp2, & ! w'sclr'^2
4801 : wpsclrpthlp ! w'sclr'thl'
4802 :
4803 : ! Thermo. level variables brought to momentum levels either by
4804 : ! interpolation (in subroutine trapezoidal_rule_zt) or by
4805 : ! the second call to pdf_closure (in subroutine advance_clubb_core)
4806 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
4807 : wprtp2_zm, & ! w'rt'^2 on momentum grid [m kg^2/kg^2]
4808 : wpthlp2_zm, & ! w'thl'^2 on momentum grid [m K^2/s]
4809 : wprtpthlp_zm, & ! w'rt'thl' on momentum grid [m kg K/kg s]
4810 : cloud_frac_zm, & ! Cloud Fraction on momentum grid [-]
4811 : ice_supersat_frac_zm, & ! Ice Cloud Fraction on momentum grid [-]
4812 : rcm_zm, & ! Liquid water mixing ratio on momentum grid [kg/kg]
4813 : wp2thvp_zm ! w'^2 th_v' on momentum grid [m^2 K/s^2]
4814 :
4815 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(inout) :: &
4816 : wpsclrprtp_zm, & ! w'sclr'rt' on momentum grid
4817 : wpsclrp2_zm, & ! w'sclr'^2 on momentum grid
4818 : wpsclrpthlp_zm ! w'sclr'thl' on momentum grid
4819 :
4820 : !------------------------ Local variables ------------------------
4821 :
4822 : integer :: i, k, sclr
4823 :
4824 : !----------------------- Begin Code -----------------------------
4825 :
4826 : ! Store components of pdf_params in the locally declared variables
4827 : ! We only apply the trapezoidal rule to these when
4828 : ! l_apply_rule_to_pdf_params is true. This is because when we apply the
4829 : ! rule to the final result of pdf_closure rather than the intermediate
4830 : ! results it can lead to an inconsistency in how we determine which
4831 : ! PDF component a point is in and whether the point is in or out of cloud,
4832 : ! which is turn will break the latin hypercube code that samples
4833 : ! preferentially in cloud. -dschanen 13 Feb 2012
4834 :
4835 :
4836 : ! If l_call_pdf_closure_twice is true, the _zm variables already have
4837 : ! values from the second call to pdf_closure in advance_clubb_core.
4838 : ! If it is false, the variables are interpolated to the _zm levels.
4839 352944 : if ( .not. l_call_pdf_closure_twice ) then
4840 :
4841 : ! Interpolate thermodynamic variables to the momentum grid.
4842 0 : wprtp2_zm = zt2zm( nz, ngrdcol, gr, wprtp2 )
4843 0 : wpthlp2_zm = zt2zm( nz, ngrdcol, gr, wpthlp2 )
4844 0 : wprtpthlp_zm = zt2zm( nz, ngrdcol, gr, wprtpthlp )
4845 0 : cloud_frac_zm = zt2zm( nz, ngrdcol, gr, cloud_frac )
4846 0 : ice_supersat_frac_zm = zt2zm( nz, ngrdcol, gr, ice_supersat_frac )
4847 0 : rcm_zm = zt2zm( nz, ngrdcol, gr, rcm )
4848 0 : wp2thvp_zm = zt2zm( nz, ngrdcol, gr, wp2thvp )
4849 :
4850 : ! Since top momentum level is higher than top thermo. level,
4851 : ! set variables at top momentum level to 0.
4852 : !$acc parallel loop gang vector default(present)
4853 0 : do i = 1, ngrdcol
4854 0 : wprtp2_zm(i,nz) = 0.0_core_rknd
4855 0 : wpthlp2_zm(i,nz) = 0.0_core_rknd
4856 0 : wprtpthlp_zm(i,nz) = 0.0_core_rknd
4857 0 : cloud_frac_zm(i,nz) = 0.0_core_rknd
4858 0 : ice_supersat_frac_zm(i,nz) = 0.0_core_rknd
4859 0 : rcm_zm(i,nz) = 0.0_core_rknd
4860 0 : wp2thvp_zm(i,nz) = 0.0_core_rknd
4861 : end do
4862 : !$acc end parallel loop
4863 :
4864 0 : do sclr = 1, sclr_dim
4865 0 : wpsclrprtp_zm(:,:,sclr) = zt2zm( nz, ngrdcol, gr, wpsclrprtp(:,:,sclr) )
4866 0 : wpsclrp2_zm(:,:,sclr) = zt2zm( nz, ngrdcol, gr, wpsclrp2(:,:,sclr) )
4867 0 : wpsclrpthlp_zm(:,:,sclr) = zt2zm( nz, ngrdcol, gr, wpsclrpthlp(:,:,sclr) )
4868 :
4869 : !$acc parallel loop gang vector default(present)
4870 0 : do i = 1, ngrdcol
4871 0 : wpsclrprtp_zm(i,nz,sclr) = 0.0_core_rknd
4872 0 : wpsclrp2_zm(i,nz,sclr) = 0.0_core_rknd
4873 0 : wpsclrpthlp_zm(i,nz,sclr) = 0.0_core_rknd
4874 : end do
4875 : !$acc end parallel loop
4876 : end do ! i = 1, sclr_dim
4877 :
4878 : end if ! .not. l_call_pdf_closure_twice
4879 :
4880 352944 : if ( stats_metadata%l_stats ) then
4881 : ! Use the trapezoidal rule to recompute the variables on the stats_zt level
4882 0 : if ( stats_metadata%iwprtp2 > 0 ) then
4883 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4884 : wprtp2, wprtp2_zm, &
4885 0 : wprtp2 )
4886 : end if
4887 0 : if ( stats_metadata%iwpthlp2 > 0 ) then
4888 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4889 : wpthlp2, wpthlp2_zm, &
4890 0 : wpthlp2 )
4891 : end if
4892 0 : if ( stats_metadata%iwprtpthlp > 0 ) then
4893 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4894 : wprtpthlp, wprtpthlp_zm, &
4895 0 : wprtpthlp )
4896 : end if
4897 :
4898 0 : do sclr = 1, sclr_dim
4899 0 : if ( stats_metadata%iwpsclrprtp(sclr) > 0 ) then
4900 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4901 : wpsclrprtp(:,:,sclr), wpsclrprtp_zm(:,:,sclr), &
4902 0 : wpsclrprtp(:,:,sclr) )
4903 : end if
4904 0 : if ( stats_metadata%iwpsclrpthlp(sclr) > 0 ) then
4905 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4906 : wpsclrpthlp(:,:,sclr), wpsclrpthlp_zm(:,:,sclr), &
4907 0 : wpsclrpthlp(:,:,sclr) )
4908 : end if
4909 0 : if ( stats_metadata%iwpsclrp2(sclr) > 0 ) then
4910 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4911 : wpsclrp2(:,:,sclr), wpsclrp2_zm(:,:,sclr), &
4912 0 : wpsclrp2(:,:,sclr) )
4913 : end if
4914 :
4915 : end do ! i = 1, sclr_dim
4916 : end if ! l_stats
4917 :
4918 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4919 : cloud_frac, cloud_frac_zm, &
4920 352944 : cloud_frac )
4921 :
4922 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4923 : ice_supersat_frac, ice_supersat_frac_zm, &
4924 352944 : ice_supersat_frac )
4925 :
4926 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4927 : rcm, rcm_zm, &
4928 352944 : rcm )
4929 :
4930 : call calc_trapezoid_zt( nz, ngrdcol, gr, &
4931 : wp2thvp, wp2thvp_zm, &
4932 352944 : wp2thvp )
4933 :
4934 : ! End of trapezoidal rule
4935 :
4936 352944 : return
4937 : end subroutine trapezoidal_rule_zt
4938 :
4939 : !-----------------------------------------------------------------------
4940 352944 : subroutine trapezoidal_rule_zm( nz, ngrdcol, gr, & ! intent(in)
4941 352944 : wpthvp_zt, thlpthvp_zt, rtpthvp_zt, & ! intent(in)
4942 352944 : wpthvp, thlpthvp, rtpthvp ) ! intent(inout)
4943 : !
4944 : ! Description:
4945 : ! This subroutine recomputes three variables on the
4946 : ! momentum grid from pdf_closure -- wpthvp, thlpthvp, and
4947 : ! rtpthvp -- by calling the function trapezoid_zm. Only these three
4948 : ! variables are used in this subroutine because they are the only
4949 : ! pdf_closure momentum variables used elsewhere in CLUBB.
4950 : !
4951 : ! The _zt variables are output from the first call to pdf_closure.
4952 : ! The _zm variables are output from the second call to pdf_closure
4953 : ! on the momentum levels.
4954 : ! This is done before the call to this subroutine.
4955 : !
4956 : ! ldgrant Feb. 2010
4957 : !
4958 : ! References:
4959 : ! None
4960 : !-----------------------------------------------------------------------
4961 :
4962 : use grid_class, only: grid
4963 :
4964 : use clubb_precision, only: &
4965 : core_rknd ! variable(s)
4966 :
4967 : implicit none
4968 :
4969 : ! ----------------------- Input variables -----------------------
4970 : integer, intent(in) :: &
4971 : nz, &
4972 : ngrdcol
4973 :
4974 : type (grid), target, intent(in) :: gr
4975 :
4976 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
4977 : wpthvp_zt, & ! Buoyancy flux (on thermo. grid) [(K m)/s]
4978 : thlpthvp_zt, & ! th_l' th_v' (on thermo. grid) [K^2]
4979 : rtpthvp_zt ! r_t' th_v' (on thermo. grid) [(kg K)/kg]
4980 :
4981 : ! ----------------------- Input/Output variables -----------------------
4982 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
4983 : wpthvp, & ! Buoyancy flux [(K m)/s]
4984 : thlpthvp, & ! th_l' th_v' [K^2]
4985 : rtpthvp ! r_t' th_v' [(kg K)/kg]
4986 :
4987 : ! ----------------------- Begin Code -----------------------
4988 :
4989 : ! Use the trapezoidal rule to recompute the variables on the zm level
4990 : call calc_trapezoid_zm( nz, ngrdcol, gr, wpthvp, wpthvp_zt, & ! Intent(in)
4991 352944 : wpthvp ) ! Intent(out)
4992 :
4993 : call calc_trapezoid_zm( nz, ngrdcol, gr, thlpthvp, thlpthvp_zt, & ! Intent(in)
4994 352944 : thlpthvp ) ! Intent(out)
4995 :
4996 : call calc_trapezoid_zm( nz, ngrdcol, gr, rtpthvp, rtpthvp_zt, & ! Intent(in)
4997 352944 : rtpthvp ) ! Intent(out)
4998 :
4999 352944 : return
5000 : end subroutine trapezoidal_rule_zm
5001 :
5002 : !-----------------------------------------------------------------------
5003 1411776 : subroutine calc_trapezoid_zt( nz, ngrdcol, gr, &
5004 1411776 : variable_zt, variable_zm, &
5005 1411776 : trapezoid_zt )
5006 : !
5007 : ! Description:
5008 : ! Function which uses the trapezoidal rule from calculus
5009 : ! to recompute the values for the variables on the thermo. grid which
5010 : ! are output from the first call to pdf_closure in module clubb_core.
5011 : !
5012 : ! ldgrant June 2009
5013 : !--------------------------------------------------------------------
5014 :
5015 : use grid_class, only: grid
5016 :
5017 : use clubb_precision, only: &
5018 : core_rknd ! Variable(s)
5019 :
5020 : implicit none
5021 :
5022 : ! ---------------- Input Variables ----------------
5023 : integer, intent(in) :: &
5024 : nz, &
5025 : ngrdcol
5026 :
5027 : type (grid), target, intent(in) :: gr
5028 :
5029 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
5030 : variable_zt, & ! Variable on the zt grid
5031 : variable_zm ! Variable on the zm grid
5032 :
5033 : ! ---------------- Output Variable ----------------
5034 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
5035 : trapezoid_zt
5036 :
5037 : ! ---------------- Local Variables ----------------
5038 : integer :: i, k ! Loop index
5039 :
5040 : ! ---------------- Begin Code ----------------
5041 :
5042 : ! Boundary condition: trapezoidal rule not valid at zt level 1
5043 : !$acc parallel loop gang vector default(present)
5044 23573376 : do i = 1, ngrdcol
5045 23573376 : trapezoid_zt(i,1) = variable_zt(i,1)
5046 : end do
5047 : !$acc end parallel loop
5048 :
5049 : !$acc parallel loop gang vector collapse(2) default(present)
5050 120000960 : do k = 2, nz
5051 1981575360 : do i = 1, ngrdcol
5052 : ! Trapezoidal rule from calculus
5053 3723148800 : trapezoid_zt(i,k) = 0.5_core_rknd * ( variable_zm(i,k) + variable_zt(i,k) ) &
5054 0 : * ( gr%zm(i,k) - gr%zt(i,k) ) * gr%invrs_dzt(i,k) &
5055 1861574400 : + 0.5_core_rknd * ( variable_zt(i,k) + variable_zm(i,k-1) ) &
5056 7564886784 : * ( gr%zt(i,k) - gr%zm(i,k-1) ) * gr%invrs_dzt(i,k)
5057 : end do
5058 : end do ! k = 2, gr%nz
5059 : !$acc end parallel loop
5060 :
5061 1411776 : return
5062 : end subroutine calc_trapezoid_zt
5063 :
5064 : !-----------------------------------------------------------------------
5065 1058832 : subroutine calc_trapezoid_zm( nz, ngrdcol, gr, variable_zm, variable_zt, &
5066 1058832 : trapezoid_zm )
5067 : !
5068 : ! Description:
5069 : ! Function which uses the trapezoidal rule from calculus
5070 : ! to recompute the values for the important variables on the momentum
5071 : ! grid which are output from pdf_closure in module clubb_core.
5072 : ! These momentum variables only include wpthvp, thlpthvp, and rtpthvp.
5073 : !
5074 : ! ldgrant Feb. 2010
5075 : !--------------------------------------------------------------------
5076 :
5077 : use grid_class, only: grid
5078 :
5079 : use clubb_precision, only: &
5080 : core_rknd ! Variable(s)
5081 :
5082 : implicit none
5083 :
5084 : ! -------------------- Input Variables --------------------
5085 : integer, intent(in) :: &
5086 : nz, &
5087 : ngrdcol
5088 :
5089 : type (grid), target, intent(in) :: gr
5090 :
5091 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
5092 : variable_zm, & ! Variable on the zm grid
5093 : variable_zt ! Variable on the zt grid
5094 :
5095 : ! -------------------- Output Variable --------------------
5096 : real( kind = core_rknd ), intent(out), dimension(ngrdcol,nz) :: &
5097 : trapezoid_zm
5098 :
5099 : ! -------------------- Local Variables --------------------
5100 : integer :: i, k ! Loop index
5101 :
5102 : ! -------------------- Begin Code --------------------
5103 :
5104 : ! Boundary conditions: trapezoidal rule not valid at top zm level, nzmax.
5105 : ! Trapezoidal rule also not used at zm level 1.
5106 : !$acc parallel loop gang vector default(present)
5107 17680032 : do i = 1, ngrdcol
5108 16621200 : trapezoid_zm(i,1) = variable_zm(i,1)
5109 17680032 : trapezoid_zm(i,nz) = variable_zm(i,nz)
5110 : end do
5111 : !$acc end parallel loop
5112 :
5113 : !$acc parallel loop gang vector collapse(2) default(present)
5114 88941888 : do k = 2, nz-1
5115 1468501488 : do i = 1, ngrdcol
5116 : ! Trapezoidal rule from calculus
5117 4138678800 : trapezoid_zm(i,k) = 0.5_core_rknd * ( variable_zt(i,k+1) + variable_zm(i,k) ) &
5118 0 : * ( gr%zt(i,k+1) - gr%zm(i,k) ) * gr%invrs_dzm(i,k) &
5119 : + 0.5_core_rknd * ( variable_zm(i,k) + variable_zt(i,k) ) &
5120 5606121456 : * ( gr%zm(i,k) - gr%zt(i,k) ) * gr%invrs_dzm(i,k)
5121 : end do
5122 : end do
5123 : !$acc end parallel loop
5124 :
5125 1058832 : return
5126 : end subroutine calc_trapezoid_zm
5127 :
5128 : !-----------------------------------------------------------------------
5129 352944 : subroutine compute_cloud_cover( gr, nz, ngrdcol, &
5130 352944 : pdf_params, cloud_frac, rcm, & ! intent(in)
5131 352944 : cloud_cover, rcm_in_layer ) ! intent(out)
5132 : !
5133 : ! Description:
5134 : ! Subroutine to compute cloud cover (the amount of sky
5135 : ! covered by cloud) and rcm in layer (liquid water mixing ratio in
5136 : ! the portion of the grid box filled by cloud).
5137 : !
5138 : ! References:
5139 : ! Definition of 's' comes from:
5140 : ! ``The Gaussian Cloud Model Relations'' G. L. Mellor (1977)
5141 : ! JAS, Vol. 34, pp. 356--358.
5142 : !
5143 : ! Notes:
5144 : ! Added July 2009
5145 : !---------------------------------------------------------------------
5146 :
5147 : use constants_clubb, only: &
5148 : rc_tol, & ! Variable(s)
5149 : fstderr, &
5150 : unused_var
5151 :
5152 : use grid_class, only: grid
5153 :
5154 : use pdf_parameter_module, only: &
5155 : pdf_parameter ! Derived data type
5156 :
5157 : use clubb_precision, only: &
5158 : core_rknd ! Variable(s)
5159 :
5160 : use error_code, only: &
5161 : clubb_at_least_debug_level, & ! Procedure
5162 : err_code, & ! Error Indicator
5163 : clubb_fatal_error ! Constant
5164 :
5165 : implicit none
5166 :
5167 : !------------------------ Input variables ------------------------
5168 : integer, intent(in) :: &
5169 : ngrdcol, & ! Number of grid columns
5170 : nz ! Number of vertical level
5171 :
5172 : type (grid), target, intent(in) :: gr
5173 :
5174 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
5175 : cloud_frac, & ! Cloud fraction [-]
5176 : rcm ! Liquid water mixing ratio [kg/kg]
5177 :
5178 : type (pdf_parameter), intent(in) :: &
5179 : pdf_params ! PDF Parameters [units vary]
5180 :
5181 : !------------------------ Output variables ------------------------
5182 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
5183 : cloud_cover, & ! Cloud cover [-]
5184 : rcm_in_layer ! Liquid water mixing ratio in cloud layer [kg/kg]
5185 :
5186 : !------------------------ Local variables ------------------------
5187 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
5188 705888 : chi_mean, & ! Mean extended cloud water mixing ratio of the
5189 : ! two Gaussian distributions
5190 705888 : vert_cloud_frac_upper, & ! Fraction of cloud in top half of grid box
5191 705888 : vert_cloud_frac_lower, & ! Fraction of cloud in bottom half of grid box
5192 705888 : vert_cloud_frac ! Fraction of cloud filling the grid box in the vertical
5193 :
5194 : integer :: i, k
5195 :
5196 : !------------------------ Begin code ------------------------
5197 :
5198 : !$acc enter data create( chi_mean, vert_cloud_frac_upper, &
5199 : !$acc vert_cloud_frac_lower, vert_cloud_frac )
5200 :
5201 : !$acc parallel loop gang vector collapse(2) default(present)
5202 30353184 : do k = 1, nz
5203 501287184 : do i = 1, ngrdcol
5204 :
5205 941868000 : chi_mean(i,k) = pdf_params%mixt_frac(i,k) * pdf_params%chi_1(i,k) + &
5206 1442802240 : (1.0_core_rknd-pdf_params%mixt_frac(i,k)) * pdf_params%chi_2(i,k)
5207 : end do
5208 : end do
5209 : !$acc end parallel loop
5210 :
5211 : !$acc parallel loop gang vector collapse(2) default(present)
5212 29647296 : do k = 2, nz-1
5213 489500496 : do i = 1, ngrdcol
5214 :
5215 489147552 : if ( rcm(i,k) < rc_tol ) then ! No cloud at this level
5216 :
5217 436708639 : cloud_cover(i,k) = cloud_frac(i,k)
5218 436708639 : rcm_in_layer(i,k) = rcm(i,k)
5219 :
5220 23144561 : else if ( ( rcm(i,k+1) >= rc_tol ) .and. ( rcm(i,k-1) >= rc_tol ) ) then
5221 : ! There is cloud above and below,
5222 : ! so assume cloud fills grid box from top to bottom
5223 :
5224 15663790 : cloud_cover(i,k) = cloud_frac(i,k)
5225 15663790 : rcm_in_layer(i,k) = rcm(i,k)
5226 :
5227 7480771 : else if ( ( rcm(i,k+1) < rc_tol ) .or. ( rcm(i,k-1) < rc_tol) ) then
5228 : ! Cloud may fail to reach gridbox top or base or both
5229 :
5230 : ! First let the cloud fill the entire grid box, then overwrite
5231 : ! vert_cloud_frac_upper(k) and/or vert_cloud_frac_lower(k)
5232 : ! for a cloud top, cloud base, or one-point cloud.
5233 7480771 : vert_cloud_frac_upper(i,k) = 0.5_core_rknd
5234 7480771 : vert_cloud_frac_lower(i,k) = 0.5_core_rknd
5235 :
5236 7480771 : if ( rcm(i,k+1) < rc_tol ) then ! Cloud top
5237 :
5238 : vert_cloud_frac_upper(i,k) = &
5239 0 : ( ( 0.5_core_rknd / gr%invrs_dzm(i,k) ) / ( gr%zm(i,k) - gr%zt(i,k) ) ) &
5240 3986471 : * ( rcm(i,k) / ( rcm(i,k) + abs( chi_mean(i,k+1) ) ) )
5241 :
5242 3986471 : vert_cloud_frac_upper(i,k) = min( 0.5_core_rknd, vert_cloud_frac_upper(i,k) )
5243 :
5244 : ! Make the transition in cloudiness more gradual than using
5245 : ! the above min statement alone.
5246 : vert_cloud_frac_upper(i,k) = vert_cloud_frac_upper(i,k) + &
5247 3986471 : ( ( rcm(i,k+1)/rc_tol )*( 0.5_core_rknd -vert_cloud_frac_upper(i,k) ) )
5248 :
5249 : else
5250 :
5251 : vert_cloud_frac_upper(i,k) = 0.5_core_rknd
5252 :
5253 : end if
5254 :
5255 7480771 : if ( rcm(i,k-1) < rc_tol ) then ! Cloud base
5256 :
5257 : vert_cloud_frac_lower(i,k) = &
5258 0 : ( ( 0.5_core_rknd / gr%invrs_dzm(i,k-1) ) / ( gr%zt(i,k) - gr%zm(i,k-1) ) ) &
5259 3821307 : * ( rcm(i,k) / ( rcm(i,k) + abs( chi_mean(i,k-1) ) ) )
5260 :
5261 3821307 : vert_cloud_frac_lower(i,k) = min( 0.5_core_rknd, vert_cloud_frac_lower(i,k) )
5262 :
5263 : ! Make the transition in cloudiness more gradual than using
5264 : ! the above min statement alone.
5265 : vert_cloud_frac_lower(i,k) = vert_cloud_frac_lower(i,k) + &
5266 3821307 : ( ( rcm(i,k-1)/rc_tol )*( 0.5_core_rknd -vert_cloud_frac_lower(i,k) ) )
5267 :
5268 : else
5269 :
5270 3659464 : vert_cloud_frac_lower(i,k) = 0.5_core_rknd
5271 :
5272 : end if
5273 :
5274 : vert_cloud_frac(i,k) = &
5275 7480771 : vert_cloud_frac_upper(i,k) + vert_cloud_frac_lower(i,k)
5276 :
5277 : vert_cloud_frac(i,k) = &
5278 7480771 : max( cloud_frac(i,k), min( 1.0_core_rknd, vert_cloud_frac(i,k) ) )
5279 :
5280 7480771 : cloud_cover(i,k) = cloud_frac(i,k) / vert_cloud_frac(i,k)
5281 7480771 : rcm_in_layer(i,k) = rcm(i,k) / vert_cloud_frac(i,k)
5282 :
5283 : else
5284 :
5285 : ! This case should not be entered
5286 0 : cloud_cover(i,k) = unused_var
5287 0 : rcm_in_layer(i,k) = unused_var
5288 0 : err_code = clubb_fatal_error
5289 :
5290 : end if ! rcm(k) < rc_tol
5291 :
5292 : end do
5293 : end do ! k = 2, gr%nz-1, 1
5294 : !$acc end parallel loop
5295 :
5296 : !$acc parallel loop gang vector default(present)
5297 5893344 : do i = 1, ngrdcol
5298 5540400 : cloud_cover(i,1) = cloud_frac(i,1)
5299 5540400 : cloud_cover(i,nz) = cloud_frac(i,nz)
5300 :
5301 5540400 : rcm_in_layer(i,1) = rcm(i,1)
5302 5893344 : rcm_in_layer(i,nz) = rcm(i,nz)
5303 : end do
5304 : !$acc end parallel loop
5305 :
5306 352944 : if ( clubb_at_least_debug_level( 0 ) ) then
5307 352944 : if ( err_code == clubb_fatal_error ) then
5308 :
5309 : !$acc update host( pdf_params%mixt_frac, pdf_params%chi_1, pdf_params%chi_2, &
5310 : !$acc cloud_frac, rcm )
5311 :
5312 : write(fstderr,*) &
5313 0 : "ERROR: compute_cloud_cover entered a conditional case it should not have "
5314 :
5315 0 : write(fstderr,*) "pdf_params%mixt_frac = ", pdf_params%mixt_frac
5316 0 : write(fstderr,*) "pdf_params%chi_1 = ", pdf_params%chi_1
5317 0 : write(fstderr,*) "pdf_params%chi_2 = ", pdf_params%chi_2
5318 0 : write(fstderr,*) "cloud_frac = ", cloud_frac
5319 0 : write(fstderr,*) "rcm = ", rcm
5320 : end if
5321 : end if
5322 :
5323 : !$acc exit data delete( chi_mean, vert_cloud_frac_upper, &
5324 : !$acc vert_cloud_frac_lower, vert_cloud_frac )
5325 :
5326 352944 : return
5327 :
5328 : end subroutine compute_cloud_cover
5329 :
5330 : !-----------------------------------------------------------------------
5331 705888 : subroutine clip_rcm ( nz, ngrdcol, rtm, & ! intent(in)
5332 : message, & ! intent(in)
5333 705888 : rcm ) ! intent(inout)
5334 : !
5335 : ! Description:
5336 : ! Subroutine that reduces cloud water (rcm) whenever
5337 : ! it exceeds total water (rtm = vapor + liquid).
5338 : ! This avoids negative values of rvm = water vapor mixing ratio.
5339 : ! However, it will not ensure that rcm <= rtm if rtm <= 0.
5340 : !
5341 : ! References:
5342 : ! None
5343 : !---------------------------------------------------------------------
5344 :
5345 : use error_code, only: &
5346 : clubb_at_least_debug_level ! Procedure
5347 :
5348 : use constants_clubb, only: &
5349 : fstderr, & ! Variable(s)
5350 : zero_threshold
5351 :
5352 : use clubb_precision, only: &
5353 : core_rknd ! Variable(s)
5354 :
5355 : implicit none
5356 :
5357 : ! Input variables
5358 : integer, intent(in) :: &
5359 : nz, &
5360 : ngrdcol
5361 :
5362 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
5363 : rtm ! Total water mixing ratio [kg/kg]
5364 :
5365 : character(len= * ), intent(in) :: message
5366 :
5367 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
5368 : rcm ! Cloud water mixing ratio [kg/kg]
5369 :
5370 : integer :: i, k
5371 :
5372 : ! ------------ Begin code ---------------
5373 :
5374 : !$acc data copyin( rtm ) &
5375 : !$acc copy( rcm )
5376 :
5377 705888 : if ( clubb_at_least_debug_level( 3 ) ) then
5378 :
5379 : !$acc update host( rcm, rtm )
5380 :
5381 0 : do k = 1, nz
5382 0 : do i = 1, ngrdcol
5383 :
5384 0 : if ( rtm(i,k) < rcm(i,k) ) then
5385 :
5386 0 : write(fstderr,*) message, ' at k=', k, ' at i=', i, 'rcm(k) = ', rcm(i,k), &
5387 0 : 'rtm(k) = ', rtm(i,k), '.', ' Clipping rcm.'
5388 :
5389 : end if ! rtm(k) < rcm(k)
5390 :
5391 : end do
5392 : end do
5393 : end if ! clubb_at_least_debug_level( 3 )
5394 :
5395 : ! Vince Larson clipped rcm in order to prevent rvm < 0. 5 Apr 2008.
5396 : ! This code won't work unless rtm >= 0 !!!
5397 : ! We do not clip rcm_in_layer because rcm_in_layer only influences
5398 : ! radiation, and we do not want to bother recomputing it. 6 Aug 2009
5399 : !$acc parallel loop gang vector collapse(2) default(present)
5400 60706368 : do k = 1, nz
5401 1002574368 : do i = 1, ngrdcol
5402 1001868480 : if ( rtm(i,k) < rcm(i,k) ) then
5403 35 : rcm(i,k) = max( zero_threshold, rtm(i,k) - epsilon( rtm(i,k) ) )
5404 : end if ! rtm(k) < rcm(k)
5405 : end do
5406 : end do
5407 : !$acc end parallel loop
5408 :
5409 : !$acc end data
5410 :
5411 705888 : return
5412 : end subroutine clip_rcm
5413 :
5414 : !-----------------------------------------------------------------------------
5415 352944 : subroutine set_Lscale_max( ngrdcol, l_implemented, host_dx, host_dy, &
5416 352944 : Lscale_max )
5417 :
5418 : ! Description:
5419 : ! This subroutine sets the value of Lscale_max, which is the maximum
5420 : ! allowable value of Lscale. For standard CLUBB, it is set to a very large
5421 : ! value so that Lscale will not be limited. However, when CLUBB is running
5422 : ! as part of a host model, the value of Lscale_max is dependent on the size
5423 : ! of the host model's horizontal grid spacing. The smaller the host model's
5424 : ! horizontal grid spacing, the smaller the value of Lscale_max. When Lscale
5425 : ! is limited to a small value, the value of time-scale Tau is reduced, which
5426 : ! in turn produces greater damping on CLUBB's turbulent parameters. This
5427 : ! is the desired effect on turbulent parameters for a host model with small
5428 : ! horizontal grid spacing, for small areas usually contain much less
5429 : ! variation in meteorological quantities than large areas.
5430 :
5431 : ! References:
5432 : ! None
5433 : !-----------------------------------------------------------------------
5434 :
5435 : use clubb_precision, only: &
5436 : core_rknd ! Variable(s)
5437 :
5438 : implicit none
5439 :
5440 : !----------------------- Input Variables -----------------------
5441 : integer, intent(in) :: &
5442 : ngrdcol
5443 :
5444 : logical, intent(in) :: &
5445 : l_implemented ! Flag to see if CLUBB is running on it's own,
5446 : ! or if it's implemented as part of a host model.
5447 :
5448 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
5449 : host_dx, & ! Host model's east-west horizontal grid spacing [m]
5450 : host_dy ! Host model's north-south horizontal grid spacing [m]
5451 :
5452 : !----------------------- Output Variable -----------------------
5453 : real( kind = core_rknd ), dimension(ngrdcol), intent(out) :: &
5454 : Lscale_max ! Maximum allowable value for Lscale [m]
5455 :
5456 : !----------------------- Local Variable -----------------------
5457 : integer :: i
5458 :
5459 : !----------------------- Begin Code-----------------------
5460 :
5461 : ! Determine the maximum allowable value for Lscale (in meters).
5462 352944 : if ( l_implemented ) then
5463 : !$acc parallel loop gang vector default(present)
5464 5893344 : do i = 1, ngrdcol
5465 5893344 : Lscale_max(i) = 0.25_core_rknd * min( host_dx(i), host_dy(i) )
5466 : end do
5467 : !$acc end parallel loop
5468 : else
5469 : !$acc parallel loop gang vector default(present)
5470 0 : do i = 1, ngrdcol
5471 0 : Lscale_max(i) = 1.0e5_core_rknd
5472 : end do
5473 : !$acc end parallel loop
5474 : end if
5475 :
5476 352944 : return
5477 : end subroutine set_Lscale_max
5478 :
5479 : !===============================================================================
5480 0 : subroutine calculate_thlp2_rad &
5481 0 : ( nz, rcm_zm, thlprcp, radht_zm, & ! Intent(in)
5482 : clubb_params, & ! Intent(in)
5483 0 : thlp2_forcing ) ! Intent(inout)
5484 :
5485 : ! Description:
5486 : ! Computes the contribution of radiative cooling to thlp2
5487 :
5488 : ! References:
5489 : ! See clubb:ticket:632
5490 : !----------------------------------------------------------------------
5491 :
5492 : use clubb_precision, only: &
5493 : core_rknd ! Constant(s)
5494 :
5495 : use grid_class, only: &
5496 : zt2zm ! Procedure
5497 :
5498 : use constants_clubb, only: &
5499 : two, &
5500 : rc_tol
5501 :
5502 : use parameter_indices, only: &
5503 : nparams, & ! Variable(s)
5504 : ithlp2_rad_coef
5505 :
5506 : implicit none
5507 :
5508 : ! Input Variables
5509 : integer, intent(in) :: &
5510 : nz ! Number of vertical levels [-]
5511 :
5512 : real( kind = core_rknd ), dimension(nz), intent(in) :: &
5513 : rcm_zm, & ! Cloud water mixing ratio on momentum grid [kg/kg]
5514 : thlprcp, & ! thl'rc' [K kg/kg]
5515 : radht_zm ! SW + LW heating rate (on momentum grid) [K/s]
5516 :
5517 : real( kind = core_rknd ), dimension(nparams), intent(in) :: &
5518 : clubb_params ! Array of CLUBB's tunable parameters [units vary]
5519 :
5520 : ! Input/Output Variables
5521 : real( kind = core_rknd ), dimension(nz), intent(inout) :: &
5522 : thlp2_forcing ! <th_l'^2> forcing (momentum levels) [K^2/s]
5523 :
5524 : ! Local Variables
5525 : integer :: &
5526 : k ! Loop iterator [-]
5527 :
5528 : !----------------------------------------------------------------------
5529 :
5530 :
5531 0 : do k = 1, nz
5532 :
5533 0 : if ( rcm_zm(k) > rc_tol ) then
5534 :
5535 : thlp2_forcing(k) &
5536 : = thlp2_forcing(k) + &
5537 0 : clubb_params(ithlp2_rad_coef) * ( two ) * radht_zm(k) / rcm_zm(k) * thlprcp(k)
5538 :
5539 : end if
5540 :
5541 : end do
5542 :
5543 :
5544 0 : return
5545 : end subroutine calculate_thlp2_rad
5546 :
5547 :
5548 : !-----------------------------------------------------------------------
5549 : end module advance_clubb_core_module
|