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