Line data Source code
1 : !---------------------------------------------------------------------------
2 : ! $Id$
3 : !===============================================================================
4 : module pdf_closure_module
5 :
6 : ! Options for the two component normal (double Gaussian) PDF type to use for
7 : ! the w, rt, and theta-l (or w, chi, and eta) portion of CLUBB's multivariate,
8 : ! two-component PDF.
9 : use model_flags, only: &
10 : iiPDF_ADG1, & ! ADG1 PDF
11 : iiPDF_ADG2, & ! ADG2 PDF
12 : iiPDF_3D_Luhar, & ! 3D Luhar PDF
13 : iiPDF_new, & ! new PDF
14 : iiPDF_TSDADG, & ! new TSDADG PDF
15 : iiPDF_LY93, & ! Lewellen and Yoh (1993)
16 : iiPDF_new_hybrid ! new hybrid PDF
17 :
18 : implicit none
19 :
20 : public :: pdf_closure, &
21 : calc_wp4_pdf, &
22 : calc_wp2xp_pdf, &
23 : calc_wpxp2_pdf, &
24 : calc_wpxpyp_pdf, &
25 : calc_w_up_in_cloud
26 :
27 : private ! Set Default Scope
28 :
29 : contains
30 : !------------------------------------------------------------------------
31 :
32 : !#######################################################################
33 : !#######################################################################
34 : ! If you change the argument list of pdf_closure you also have to
35 : ! change the calls to this function in the host models CAM, WRF, SAM
36 : ! and GFDL.
37 : !#######################################################################
38 : !#######################################################################
39 705888 : subroutine pdf_closure( nz, ngrdcol, &
40 705888 : hydromet_dim, p_in_Pa, exner, thv_ds, &
41 705888 : wm, wp2, wp3, &
42 705888 : Skw, Skthl_in, Skrt_in, Sku_in, Skv_in, &
43 705888 : rtm, rtp2, wprtp, &
44 705888 : thlm, thlp2, wpthlp, &
45 705888 : um, up2, upwp, &
46 705888 : vm, vp2, vpwp, &
47 705888 : rtpthlp, &
48 705888 : sclrm, wpsclrp, sclrp2, &
49 705888 : sclrprtp, sclrpthlp, Sksclr_in, &
50 705888 : gamma_Skw_fnc, &
51 : #ifdef GFDL
52 : RH_crit, do_liquid_only_in_clubb, & ! h1g, 2010-06-15
53 : #endif
54 705888 : wphydrometp, wp2hmp, &
55 705888 : rtphmp, thlphmp, &
56 : clubb_params, &
57 : stats_metadata, &
58 : iiPDF_type, &
59 705888 : sigma_sqd_w, &
60 : pdf_params, pdf_implicit_coefs_terms, &
61 705888 : wpup2, wpvp2, &
62 705888 : wp2up2, wp2vp2, wp4, &
63 705888 : wprtp2, wp2rtp, &
64 705888 : wpthlp2, wp2thlp, wprtpthlp, &
65 705888 : cloud_frac, ice_supersat_frac, &
66 705888 : rcm, wpthvp, wp2thvp, rtpthvp, &
67 705888 : thlpthvp, wprcp, wp2rcp, rtprcp, &
68 705888 : thlprcp, rcp2, &
69 705888 : uprcp, vprcp, &
70 705888 : w_up_in_cloud, w_down_in_cloud, &
71 705888 : cloudy_updraft_frac, cloudy_downdraft_frac, &
72 705888 : F_w, F_rt, F_thl, &
73 705888 : min_F_w, max_F_w, &
74 705888 : min_F_rt, max_F_rt, &
75 705888 : min_F_thl, max_F_thl, &
76 705888 : wpsclrprtp, wpsclrp2, sclrpthvp, &
77 705888 : wpsclrpthlp, sclrprcp, wp2sclrp, &
78 705888 : rc_coef )
79 :
80 :
81 : ! Description:
82 : ! Subroutine that computes pdf parameters analytically.
83 : !
84 : ! Based of the original formulation, but with some tweaks
85 : ! to remove some of the less realistic assumptions and
86 : ! improve transport terms.
87 :
88 : ! Corrected version that should remove inconsistency
89 :
90 : ! References:
91 : ! The shape of CLUBB's PDF is given by the expression in
92 : ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:clubb_pdf
93 :
94 : ! Eqn. 29, 30, 31, 32 & 33 on p. 3547 of
95 : ! ``A PDF-Based Model for Boundary Layer Clouds. Part I:
96 : ! Method and Model Description'' Golaz, et al. (2002)
97 : ! JAS, Vol. 59, pp. 3540--3551.
98 : !----------------------------------------------------------------------
99 :
100 : use grid_class, only: &
101 : grid ! Type
102 :
103 : use constants_clubb, only: & ! Constants
104 : three, & ! 3
105 : one, & ! 1
106 : one_half, & ! 1/2
107 : zero, & ! 0
108 : Cp, & ! Dry air specific heat at constant p [J/kg/K]
109 : Lv, & ! Latent heat of vaporization [J/kg]
110 : ep1, & ! (1.0-ep)/ep; ep1 = 0.61 [-]
111 : ep2, & ! 1.0/ep; ep2 = 1.61 [-]
112 : rt_tol, & ! Tolerance for r_t [kg/kg]
113 : thl_tol, & ! Tolerance for th_l [K]
114 : fstderr, &
115 : zero_threshold, &
116 : eps, &
117 : w_tol
118 :
119 : use parameters_model, only: &
120 : mixt_frac_max_mag, & ! Variable(s)
121 : sclr_dim ! Number of passive scalar variables
122 :
123 : use parameter_indices, only: &
124 : nparams, & ! Variable(s)
125 : ibeta, &
126 : iSkw_denom_coef, &
127 : islope_coef_spread_DG_means_w, &
128 : ipdf_component_stdev_factor_w, &
129 : icoef_spread_DG_means_rt, &
130 : icoef_spread_DG_means_thl
131 :
132 : use pdf_parameter_module, only: &
133 : pdf_parameter, & ! Variable Type
134 : implicit_coefs_terms
135 :
136 : use new_pdf_main, only: &
137 : new_pdf_driver ! Procedure(s)
138 :
139 : use new_hybrid_pdf_main, only: &
140 : new_hybrid_pdf_driver ! Procedure(s)
141 :
142 : use adg1_adg2_3d_luhar_pdf, only: &
143 : ADG1_pdf_driver, & ! Procedure(s)
144 : ADG2_pdf_driver, &
145 : Luhar_3D_pdf_driver
146 :
147 : use new_tsdadg_pdf, only: &
148 : tsdadg_pdf_driver ! Procedure(s)
149 :
150 : use LY93_pdf, only: &
151 : LY93_driver ! Procedure(s)
152 :
153 : use pdf_utilities, only: &
154 : calc_comp_corrs_binormal, & ! Procedure(s)
155 : calc_corr_chi_x, &
156 : calc_corr_eta_x
157 :
158 : use array_index, only: &
159 : l_mix_rat_hm ! Variable(s)
160 :
161 : use model_flags, only: &
162 : l_explicit_turbulent_adv_xpyp ! Variable(s)
163 :
164 : use numerical_check, only: &
165 : pdf_closure_check ! Procedure(s)
166 :
167 : use saturation, only: &
168 : sat_mixrat_liq, & ! Procedure(s)
169 : sat_mixrat_ice
170 :
171 : use clubb_precision, only: &
172 : core_rknd ! Variable(s)
173 :
174 : use error_code, only: &
175 : clubb_at_least_debug_level, & ! Procedure
176 : err_code, & ! Error Indicator
177 : clubb_fatal_error ! Constant
178 :
179 : use stats_variables, only: &
180 : stats_metadata_type
181 :
182 : implicit none
183 :
184 : !----------------------------- Input Variables -----------------------------
185 : integer, intent(in) :: &
186 : hydromet_dim, & ! Number of hydrometeor species [#]
187 : nz, &
188 : ngrdcol
189 :
190 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
191 : p_in_Pa, & ! Pressure [Pa]
192 : exner, & ! Exner function [-]
193 : thv_ds, & ! Dry, base-state theta_v (ref. th_l here) [K]
194 : wm, & ! mean w-wind component (vertical velocity) [m/s]
195 : wp2, & ! w'^2 [m^2/s^2]
196 : wp3, & ! w'^3 [m^3/s^3]
197 : Skw, & ! Skewness of w [-]
198 : Skthl_in, & ! Skewness of thl [-]
199 : Skrt_in, & ! Skewness of rt [-]
200 : Sku_in, & ! Skewness of u [-]
201 : Skv_in, & ! Skewness of v [-]
202 : rtm, & ! Mean total water mixing ratio [kg/kg]
203 : rtp2, & ! r_t'^2 [(kg/kg)^2]
204 : wprtp, & ! w'r_t' [(kg/kg)(m/s)]
205 : thlm, & ! Mean liquid water potential temperature [K]
206 : thlp2, & ! th_l'^2 [K^2]
207 : wpthlp, & ! w'th_l' [K(m/s)]
208 : rtpthlp ! r_t'th_l' [K(kg/kg)]
209 :
210 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
211 : um, & ! Grid-mean eastward wind [m/s]
212 : up2, & ! u'^2 [(m/s)^2]
213 : upwp, & ! u'w' [(m/s)^2]
214 : vm, & ! Grid-mean northward wind [m/s]
215 : vp2, & ! v'^2 [(m/s)^2]
216 : vpwp ! v'w' [(m/s)^2]
217 :
218 : real( kind = core_rknd ), dimension(ngrdcol,nz, sclr_dim), intent(in) :: &
219 : sclrm, & ! Mean passive scalar [units vary]
220 : wpsclrp, & ! w' sclr' [units vary]
221 : sclrp2, & ! sclr'^2 [units vary]
222 : sclrprtp, & ! sclr' r_t' [units vary]
223 : sclrpthlp, & ! sclr' th_l' [units vary]
224 : Sksclr_in ! Skewness of sclr [-]
225 :
226 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
227 : gamma_Skw_fnc ! Gamma as a function of skewness [-]
228 :
229 : #ifdef GFDL
230 : ! critial relative humidity for nucleation
231 : real( kind = core_rknd ), dimension(ngrdcol, nz, min(1,sclr_dim), 2 ), intent(in) :: & ! h1g, 2010-06-15
232 : RH_crit ! critical relative humidity for droplet and ice nucleation
233 : ! ---> h1g, 2012-06-14
234 : logical, intent(in) :: do_liquid_only_in_clubb
235 : ! <--- h1g, 2012-06-14
236 : #endif
237 :
238 : real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim), intent(in) :: &
239 : wphydrometp, & ! Covariance of w and a hydrometeor [(m/s) <hm units>]
240 : wp2hmp, & ! Third-order moment: < w'^2 hm' > [(m/s)^2 <hm units>]
241 : rtphmp, & ! Covariance of rt and a hydrometeor [(kg/kg) <hm units>]
242 : thlphmp ! Covariance of thl and a hydrometeor [K <hm units>]
243 :
244 : real( kind = core_rknd ), dimension(nparams), intent(in) :: &
245 : clubb_params ! Array of CLUBB's tunable parameters [units vary]
246 :
247 : integer, intent(in) :: &
248 : iiPDF_type ! Selected option for the two-component normal (double
249 : ! Gaussian) PDF type to use for the w, rt, and theta-l (or
250 : ! w, chi, and eta) portion of CLUBB's multivariate,
251 : ! two-component PDF.
252 :
253 : type (stats_metadata_type), intent(in) :: &
254 : stats_metadata
255 :
256 : !----------------------------- InOut Variables -----------------------------
257 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
258 : ! If iiPDF_type == iiPDF_ADG2, this gets overwritten. Therefore,
259 : ! intent(inout). Otherwise it should be intent(in)
260 : sigma_sqd_w ! Width of individual w plumes [-]
261 :
262 : type(pdf_parameter), intent(inout) :: &
263 : pdf_params ! pdf paramters [units vary]
264 :
265 : type(implicit_coefs_terms), intent(inout) :: &
266 : pdf_implicit_coefs_terms ! Implicit coefs / explicit terms [units vary]
267 :
268 : !----------------------------- Output Variables -----------------------------
269 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
270 : wpup2, & ! w'u'^2 [m^3/s^3]
271 : wpvp2, & ! w'v'^2 [m^3/s^3]
272 : wp2up2, & ! w'^2u'^2 [m^2/s^4]
273 : wp2vp2, & ! w'^2v'^2 [m^2/s^4]
274 : wp4, & ! w'^4 [m^4/s^4]
275 : wprtp2, & ! w' r_t' [(m kg)/(s kg)]
276 : wp2rtp, & ! w'^2 r_t' [(m^2 kg)/(s^2 kg)]
277 : wpthlp2, & ! w' th_l'^2 [(m K^2)/s]
278 : wp2thlp, & ! w'^2 th_l' [(m^2 K)/s^2]
279 : cloud_frac, & ! Cloud fraction [-]
280 : ice_supersat_frac, & ! Ice cloud fracion [-]
281 : rcm, & ! Mean liquid water [kg/kg]
282 : wpthvp, & ! Buoyancy flux [(K m)/s]
283 : wp2thvp, & ! w'^2 th_v' [(m^2 K)/s^2]
284 : rtpthvp, & ! r_t' th_v' [(kg K)/kg]
285 : thlpthvp, & ! th_l' th_v' [K^2]
286 : wprcp, & ! w' r_c' [(m kg)/(s kg)]
287 : wp2rcp, & ! w'^2 r_c' [(m^2 kg)/(s^2 kg)]
288 : rtprcp, & ! r_t' r_c' [(kg^2)/(kg^2)]
289 : thlprcp, & ! th_l' r_c' [(K kg)/kg]
290 : rcp2, & ! r_c'^2 [(kg^2)/(kg^2)]
291 : wprtpthlp, & ! w' r_t' th_l' [(m kg K)/(s kg)]
292 : w_up_in_cloud, & ! cloudy updraft vel [m/s]
293 : w_down_in_cloud, & ! cloudy downdraft vel [m/s]
294 : cloudy_updraft_frac, & ! cloudy updraft fraction [-]
295 : cloudy_downdraft_frac ! cloudy downdraft fraction [-]
296 :
297 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
298 : uprcp, & ! u' r_c' [(m kg)/(s kg)]
299 : vprcp ! v' r_c' [(m kg)/(s kg)]
300 :
301 : ! Parameters output only for recording statistics (new PDF).
302 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
303 : F_w, & ! Parameter for the spread of the PDF component means of w [-]
304 : F_rt, & ! Parameter for the spread of the PDF component means of rt [-]
305 : F_thl ! Parameter for the spread of the PDF component means of thl [-]
306 :
307 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
308 : min_F_w, & ! Minimum allowable value of parameter F_w [-]
309 : max_F_w, & ! Maximum allowable value of parameter F_w [-]
310 : min_F_rt, & ! Minimum allowable value of parameter F_rt [-]
311 : max_F_rt, & ! Maximum allowable value of parameter F_rt [-]
312 : min_F_thl, & ! Minimum allowable value of parameter F_thl [-]
313 : max_F_thl ! Maximum allowable value of parameter F_thl [-]
314 :
315 : ! Output (passive scalar variables)
316 : real( kind = core_rknd ), intent(out), dimension(ngrdcol,nz,sclr_dim) :: &
317 : sclrpthvp, &
318 : sclrprcp, &
319 : wpsclrp2, &
320 : wpsclrprtp, &
321 : wpsclrpthlp, &
322 : wp2sclrp
323 :
324 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
325 : rc_coef ! Coefficient on X'r_c' in X'th_v' equation [K/(kg/kg)]
326 :
327 : !----------------------------- Local Variables -----------------------------
328 :
329 : ! Variables that are stored in derived data type pdf_params.
330 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
331 1411776 : u_1, & ! Mean of eastward wind (1st PDF component) [m/s]
332 1411776 : u_2, & ! Mean of eastward wind (2nd PDF component) [m/s]
333 1411776 : varnce_u_1, & ! Variance of u (1st PDF component) [m^2/s^2]
334 1411776 : varnce_u_2, & ! Variance of u (2nd PDF component) [m^2/s^2]
335 1411776 : v_1, & ! Mean of northward wind (1st PDF component) [m/s]
336 1411776 : v_2, & ! Mean of northward wind (2nd PDF component) [m/s]
337 1411776 : varnce_v_1, & ! Variance of v (1st PDF component) [m^2/s^2]
338 1411776 : varnce_v_2, & ! Variance of v (2nd PDF component) [m^2/s^2]
339 1411776 : alpha_u, & ! Factor relating to normalized variance for u [-]
340 1411776 : alpha_v ! Factor relating to normalized variance for v [-]
341 :
342 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
343 1411776 : corr_u_w_1, & ! Correlation of u and w (1st PDF component) [-]
344 1411776 : corr_u_w_2, & ! Correlation of u and w (2nd PDF component) [-]
345 1411776 : corr_v_w_1, & ! Correlation of v and w (1st PDF component) [-]
346 1411776 : corr_v_w_2 ! Correlation of v and w (2nd PDF component) [-]
347 :
348 : ! Note: alpha coefficients = 0.5 * ( 1 - correlations^2 ).
349 : ! These are used to calculate the scalar widths
350 : ! varnce_thl_1, varnce_thl_2, varnce_rt_1, and varnce_rt_2 as in
351 : ! Eq. (34) of Larson and Golaz (2005)
352 :
353 : ! Passive scalar local variables
354 :
355 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
356 1411776 : sclr1, sclr2, &
357 1411776 : varnce_sclr1, varnce_sclr2, &
358 1411776 : alpha_sclr, &
359 1411776 : corr_sclr_thl_1, corr_sclr_thl_2, &
360 1411776 : corr_sclr_rt_1, corr_sclr_rt_2, &
361 1411776 : corr_w_sclr_1, corr_w_sclr_2
362 :
363 : logical :: &
364 : l_scalar_calc, & ! True if sclr_dim > 0
365 : l_calc_ice_supersat_frac ! True if we should calculate ice_supersat_frac
366 :
367 : ! Quantities needed to predict higher order moments
368 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
369 1411776 : tl1, tl2
370 :
371 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
372 1411776 : sqrt_wp2, & ! Square root of wp2 [m/s]
373 1411776 : Skthl, & ! Skewness of thl [-]
374 1411776 : Skrt, & ! Skewness of rt [-]
375 1411776 : Sku, & ! Skewness of u [-]
376 1411776 : Skv ! Skewness of v [-]
377 :
378 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
379 1411776 : Sksclr ! Skewness of rt [-]
380 :
381 : ! Thermodynamic quantity
382 :
383 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
384 1411776 : wprcp_contrib_comp_1, & ! <w'rc'> contrib. (1st PDF comp.) [m/s(kg/kg)]
385 1411776 : wprcp_contrib_comp_2, & ! <w'rc'> contrib. (2nd PDF comp.) [m/s(kg/kg)]
386 1411776 : wp2rcp_contrib_comp_1, & ! <w'^2rc'> contrib. (1st comp) [m^2/s^2(kg/kg)]
387 1411776 : wp2rcp_contrib_comp_2, & ! <w'^2rc'> contrib. (2nd comp) [m^2/s^2(kg/kg)]
388 1411776 : rtprcp_contrib_comp_1, & ! <rt'rc'> contrib. (1st PDF comp.) [kg^2/kg^2]
389 1411776 : rtprcp_contrib_comp_2, & ! <rt'rc'> contrib. (2nd PDF comp.) [kg^2/kg^2]
390 1411776 : thlprcp_contrib_comp_1, & ! <thl'rc'> contrib. (1st PDF comp.) [K(kg/kg)]
391 1411776 : thlprcp_contrib_comp_2, & ! <thl'rc'> contrib. (2nd PDF comp.) [K(kg/kg)]
392 1411776 : uprcp_contrib_comp_1, & ! <u'rc'> contrib. (1st PDF comp.) [m/s(kg/kg)]
393 1411776 : uprcp_contrib_comp_2, & ! <u'rc'> contrib. (2nd PDF comp.) [m/s(kg/kg)]
394 1411776 : vprcp_contrib_comp_1, & ! <v'rc'> contrib. (1st PDF comp.) [m/s(kg/kg)]
395 1411776 : vprcp_contrib_comp_2 ! <v'rc'> contrib. (2nd PDF comp.) [m/s(kg/kg)]
396 :
397 : ! variables for computing ice cloud fraction
398 : real( kind = core_rknd), dimension(ngrdcol,nz) :: &
399 1411776 : rc_1_ice, rc_2_ice
400 :
401 : ! To test pdf parameters
402 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
403 1411776 : wm_clubb_pdf, &
404 1411776 : rtm_clubb_pdf, &
405 1411776 : thlm_clubb_pdf, &
406 1411776 : wp2_clubb_pdf, &
407 1411776 : rtp2_clubb_pdf, &
408 1411776 : thlp2_clubb_pdf, &
409 1411776 : wp3_clubb_pdf, &
410 1411776 : rtp3_clubb_pdf, &
411 1411776 : thlp3_clubb_pdf, &
412 1411776 : Skw_clubb_pdf, &
413 1411776 : Skrt_clubb_pdf, &
414 1411776 : Skthl_clubb_pdf, &
415 1411776 : rsatl_1, &
416 1411776 : rsatl_2
417 :
418 : real( kind = core_rknd ) :: &
419 : beta, & ! CLUBB tunable parameter beta
420 : Skw_denom_coef, & ! CLUBB tunable parameter Skw_denom_coef
421 : slope_coef_spread_DG_means_w, & ! CLUBB tunable parameter
422 : pdf_component_stdev_factor_w, & ! CLUBB tunable parameter
423 : coef_spread_DG_means_rt, & ! CLUBB tunable parameter
424 : coef_spread_DG_means_thl ! CLUBB tunable parameter
425 :
426 : logical, parameter :: &
427 : l_liq_ice_loading_test = .false. ! Temp. flag liq./ice water loading test
428 :
429 : integer :: k, i, j, hm_idx ! Indices
430 :
431 : #ifdef GFDL
432 : real ( kind = core_rknd ), parameter :: t1_combined = 273.16, &
433 : t2_combined = 268.16, &
434 : t3_combined = 238.16
435 : #endif
436 :
437 : !----------------------------- Begin Code -----------------------------
438 :
439 : !$acc enter data create( u_1, u_2, varnce_u_1, varnce_u_2, v_1, v_2, &
440 : !$acc varnce_v_1, varnce_v_2, alpha_u, alpha_v, &
441 : !$acc corr_u_w_1, corr_u_w_2, corr_v_w_1, corr_v_w_2, &
442 : !$acc tl1, tl2, sqrt_wp2, Skthl, &
443 : !$acc Skrt, Sku, Skv, wprcp_contrib_comp_1, wprcp_contrib_comp_2, &
444 : !$acc wp2rcp_contrib_comp_1, wp2rcp_contrib_comp_2, &
445 : !$acc rtprcp_contrib_comp_1, rtprcp_contrib_comp_2, &
446 : !$acc thlprcp_contrib_comp_1, thlprcp_contrib_comp_2, &
447 : !$acc uprcp_contrib_comp_1, uprcp_contrib_comp_2, &
448 : !$acc vprcp_contrib_comp_1, vprcp_contrib_comp_2, &
449 : !$acc rc_1_ice, rc_2_ice, rsatl_1, rsatl_2 )
450 :
451 : !$acc enter data if( sclr_dim > 0 ) &
452 : !$acc create( sclr1, sclr2, varnce_sclr1, varnce_sclr2, &
453 : !$acc alpha_sclr, corr_sclr_thl_1, corr_sclr_thl_2, &
454 : !$acc corr_sclr_rt_1, corr_sclr_rt_2, corr_w_sclr_1, &
455 : !$acc corr_w_sclr_2, Sksclr )
456 :
457 : ! Check whether the passive scalars are present.
458 705888 : if ( sclr_dim > 0 ) then
459 0 : l_scalar_calc = .true.
460 : else
461 705888 : l_scalar_calc = .false.
462 : end if
463 :
464 : ! Initialize to default values to prevent a runtime error
465 705888 : if ( ( iiPDF_type /= iiPDF_ADG1 ) .and. ( iiPDF_type /= iiPDF_ADG2 ) ) then
466 :
467 0 : do k = 1, nz
468 0 : do i = 1, ngrdcol
469 0 : pdf_params%alpha_thl(i,k) = one_half
470 0 : pdf_params%alpha_rt(i,k) = one_half
471 : end do
472 : end do
473 :
474 : ! This allows for skewness to be clipped locally without passing the updated
475 : ! value back out.
476 0 : do k = 1, nz
477 0 : do i = 1, ngrdcol
478 0 : Skrt(i,k) = Skrt_in(i,k)
479 0 : Skthl(i,k) = Skthl_in(i,k)
480 0 : Sku(i,k) = Sku_in(i,k)
481 0 : Skv(i,k) = Skv_in(i,k)
482 : end do
483 : end do
484 :
485 0 : do j = 1, sclr_dim
486 0 : do k = 1, nz
487 0 : do i = 1, ngrdcol
488 :
489 0 : Sksclr(i,k,j) = Sksclr_in(i,k,j)
490 :
491 0 : if ( l_scalar_calc ) then
492 0 : alpha_sclr(i,k,j) = one_half
493 : end if
494 :
495 : end do
496 : end do
497 : end do
498 :
499 : end if
500 :
501 : ! Initialize to 0 to prevent a runtime error
502 705888 : if ( iiPDF_type /= iiPDF_new .and. iiPDF_type /= iiPDF_new_hybrid ) then
503 : ! Stats only variables, setting to zero
504 60706368 : do k = 1, nz
505 1002574368 : do i = 1, ngrdcol
506 941868000 : F_w(i,k) = zero
507 941868000 : F_rt(i,k) = zero
508 941868000 : F_thl(i,k) = zero
509 941868000 : min_F_w(i,k) = zero
510 941868000 : max_F_w(i,k) = zero
511 941868000 : min_F_rt(i,k) = zero
512 941868000 : max_F_rt(i,k) = zero
513 941868000 : min_F_thl(i,k) = zero
514 1001868480 : max_F_thl(i,k) = zero
515 : end do
516 : end do
517 : end if
518 :
519 : ! Unpack CLUBB's tunable parameters
520 705888 : if ( ( iiPDF_type == iiPDF_ADG1 ) .or. ( iiPDF_type == iiPDF_ADG2 ) ) then
521 705888 : beta = clubb_params(ibeta)
522 0 : elseif ( iiPDF_type == iiPDF_new ) then
523 0 : slope_coef_spread_DG_means_w = clubb_params(islope_coef_spread_DG_means_w)
524 0 : pdf_component_stdev_factor_w = clubb_params(ipdf_component_stdev_factor_w)
525 0 : coef_spread_DG_means_rt = clubb_params(icoef_spread_DG_means_rt)
526 0 : coef_spread_DG_means_thl = clubb_params(icoef_spread_DG_means_thl)
527 0 : elseif ( iiPDF_type == iiPDF_new_hybrid ) then
528 0 : slope_coef_spread_DG_means_w = clubb_params(islope_coef_spread_DG_means_w)
529 0 : pdf_component_stdev_factor_w = clubb_params(ipdf_component_stdev_factor_w)
530 : end if
531 :
532 :
533 : ! To avoid recomputing
534 : !$acc parallel loop gang vector collapse(2) default(present)
535 60706368 : do k = 1, nz
536 1002574368 : do i = 1, ngrdcol
537 1001868480 : sqrt_wp2(i,k) = sqrt( wp2(i,k) )
538 : end do
539 : end do
540 : !$acc end parallel loop
541 :
542 : ! Select the PDF closure method for the two-component PDF used by CLUBB for
543 : ! w, rt, theta-l, and passive scalar variables.
544 : ! Calculate the mixture fraction for the multivariate PDF, as well as both
545 : ! PDF component means and both PDF component variances for each of w, rt,
546 : ! theta-l, and passive scalar variables.
547 : if ( iiPDF_type == iiPDF_ADG1 ) then ! use ADG1
548 :
549 : call ADG1_pdf_driver( nz, ngrdcol, & ! In
550 : wm, rtm, thlm, um, vm, & ! In
551 : wp2, rtp2, thlp2, up2, vp2, & ! In
552 : Skw, wprtp, wpthlp, upwp, vpwp, sqrt_wp2, & ! In
553 : sigma_sqd_w, beta, mixt_frac_max_mag, & ! In
554 : sclrm, sclrp2, wpsclrp, l_scalar_calc, & ! In
555 : pdf_params%w_1, pdf_params%w_2, & ! Out
556 : pdf_params%rt_1, pdf_params%rt_2, & ! Out
557 : pdf_params%thl_1, pdf_params%thl_2, & ! Out
558 : u_1, u_2, v_1, v_2, & ! Out
559 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, & ! Out
560 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, & ! Out
561 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, & ! Out
562 : varnce_u_1, varnce_u_2, & ! Out
563 : varnce_v_1, varnce_v_2, & ! Out
564 : pdf_params%mixt_frac, & ! Out
565 : pdf_params%alpha_rt, pdf_params%alpha_thl, & ! Out
566 : alpha_u, alpha_v, & ! Out
567 : sclr1, sclr2, varnce_sclr1, & ! Out
568 705888 : varnce_sclr2, alpha_sclr ) ! Out
569 :
570 : elseif ( iiPDF_type == iiPDF_ADG2 ) then ! use ADG2
571 :
572 : call ADG2_pdf_driver( nz, ngrdcol, & ! In
573 : wm, rtm, thlm, wp2, rtp2, thlp2, & ! In
574 : Skw, wprtp, wpthlp, sqrt_wp2, beta, & ! In
575 : sclrm, sclrp2, wpsclrp, l_scalar_calc, & ! In
576 : pdf_params%w_1, pdf_params%w_2, & ! Out
577 : pdf_params%rt_1, pdf_params%rt_2, & ! Out
578 : pdf_params%thl_1, pdf_params%thl_2, & ! Out
579 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, & ! Out
580 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, & ! Out
581 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, & ! Out
582 : pdf_params%mixt_frac, & ! Out
583 : pdf_params%alpha_rt, pdf_params%alpha_thl, & ! Out
584 : sigma_sqd_w, sclr1, sclr2, & ! Out
585 0 : varnce_sclr1, varnce_sclr2, alpha_sclr ) ! Out
586 :
587 : elseif ( iiPDF_type == iiPDF_3D_Luhar ) then ! use 3D Luhar
588 0 : do i = 1, ngrdcol
589 : call Luhar_3D_pdf_driver( nz, &
590 0 : wm(i,:), rtm(i,:), thlm(i,:), wp2(i,:), rtp2(i,:), thlp2(i,:), & ! In
591 0 : Skw(i,:), Skrt(i,:), Skthl(i,:), wprtp(i,:), wpthlp(i,:), & ! In
592 0 : pdf_params%w_1(i,:), pdf_params%w_2(i,:), & ! Out
593 0 : pdf_params%rt_1(i,:), pdf_params%rt_2(i,:), & ! Out
594 0 : pdf_params%thl_1(i,:), pdf_params%thl_2(i,:), & ! Out
595 0 : pdf_params%varnce_w_1(i,:), pdf_params%varnce_w_2(i,:), & ! Out
596 0 : pdf_params%varnce_rt_1(i,:), pdf_params%varnce_rt_2(i,:), & ! Out
597 0 : pdf_params%varnce_thl_1(i,:), pdf_params%varnce_thl_2(i,:), & ! Out
598 0 : pdf_params%mixt_frac(i,:) ) ! Out
599 : end do
600 : elseif ( iiPDF_type == iiPDF_new ) then ! use new PDF
601 : call new_pdf_driver( nz, ngrdcol, wm, rtm, thlm, wp2, rtp2, thlp2, Skw, & ! In
602 : wprtp, wpthlp, rtpthlp, & ! In
603 : slope_coef_spread_DG_means_w, & ! In
604 : pdf_component_stdev_factor_w, & ! In
605 : coef_spread_DG_means_rt, & ! In
606 : coef_spread_DG_means_thl, & ! In
607 : Skrt, Skthl, & ! In/Out
608 : pdf_params%w_1, pdf_params%w_2, & ! Out
609 : pdf_params%rt_1, pdf_params%rt_2, & ! Out
610 : pdf_params%thl_1, pdf_params%thl_2, & ! Out
611 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, & ! Out
612 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, & ! Out
613 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, & ! Out
614 : pdf_params%mixt_frac, & ! Out
615 : pdf_implicit_coefs_terms, & ! Out
616 : F_w, F_rt, F_thl, min_F_w, max_F_w, & ! Out
617 0 : min_F_rt, max_F_rt, min_F_thl, max_F_thl ) ! Out
618 : elseif ( iiPDF_type == iiPDF_TSDADG ) then
619 0 : do i = 1, ngrdcol
620 : call tsdadg_pdf_driver( nz, &
621 0 : wm(i,:), rtm(i,:), thlm(i,:), wp2(i,:), rtp2(i,:), thlp2(i,:), & ! In
622 0 : Skw(i,:), Skrt(i,:), Skthl(i,:), wprtp(i,:), wpthlp(i,:), & ! In
623 0 : pdf_params%w_1(i,:), pdf_params%w_2(i,:), & ! Out
624 0 : pdf_params%rt_1(i,:), pdf_params%rt_2(i,:), & ! Out
625 0 : pdf_params%thl_1(i,:), pdf_params%thl_2(i,:), & ! Out
626 0 : pdf_params%varnce_w_1(i,:), pdf_params%varnce_w_2(i,:), & ! Out
627 0 : pdf_params%varnce_rt_1(i,:), pdf_params%varnce_rt_2(i,:), & ! Out
628 0 : pdf_params%varnce_thl_1(i,:), pdf_params%varnce_thl_2(i,:), & ! Out
629 0 : pdf_params%mixt_frac(i,:) ) ! Out
630 : end do
631 : elseif ( iiPDF_type == iiPDF_LY93 ) then ! use LY93
632 0 : do i = 1, ngrdcol
633 0 : call LY93_driver( nz, wm(i,:), rtm(i,:), thlm(i,:), wp2(i,:), rtp2(i,:), & ! In
634 0 : thlp2(i,:), Skw(i,:), Skrt(i,:), Skthl(i,:), & ! In
635 0 : pdf_params%w_1(i,:), pdf_params%w_2(i,:), & ! Out
636 0 : pdf_params%rt_1(i,:), pdf_params%rt_2(i,:), & ! Out
637 0 : pdf_params%thl_1(i,:), pdf_params%thl_2(i,:), & ! Out
638 0 : pdf_params%varnce_w_1(i,:), pdf_params%varnce_w_2(i,:), & ! Out
639 0 : pdf_params%varnce_rt_1(i,:), pdf_params%varnce_rt_2(i,:), & ! Out
640 0 : pdf_params%varnce_thl_1(i,:), pdf_params%varnce_thl_2(i,:), & ! Out
641 0 : pdf_params%mixt_frac(i,:) ) ! Out
642 : end do
643 : elseif ( iiPDF_type == iiPDF_new_hybrid ) then ! use new hybrid PDF
644 : call new_hybrid_pdf_driver( nz, ngrdcol, wm, rtm, thlm, um, vm, & ! In
645 : wp2, rtp2, thlp2, up2, vp2, & ! In
646 : Skw, wprtp, wpthlp, upwp, vpwp, & ! In
647 : sclrm, sclrp2, wpsclrp, & ! In
648 : gamma_Skw_fnc, & ! In
649 : slope_coef_spread_DG_means_w, & ! In
650 : pdf_component_stdev_factor_w, & ! In
651 : Skrt, Skthl, Sku, Skv, Sksclr, & ! I/O
652 : pdf_params%w_1, pdf_params%w_2, & ! Out
653 : pdf_params%rt_1, pdf_params%rt_2, & ! Out
654 : pdf_params%thl_1, pdf_params%thl_2, & ! Out
655 : u_1, u_2, v_1, v_2, & ! Out
656 : pdf_params%varnce_w_1, & ! Out
657 : pdf_params%varnce_w_2, & ! Out
658 : pdf_params%varnce_rt_1, & ! Out
659 : pdf_params%varnce_rt_2, & ! Out
660 : pdf_params%varnce_thl_1, & ! Out
661 : pdf_params%varnce_thl_2, & ! Out
662 : varnce_u_1, varnce_u_2, & ! Out
663 : varnce_v_1, varnce_v_2, & ! Out
664 : sclr1, sclr2, & ! Out
665 : varnce_sclr1, varnce_sclr2, & ! Out
666 : pdf_params%mixt_frac, & ! Out
667 : pdf_implicit_coefs_terms, & ! Out
668 0 : F_w, min_F_w, max_F_w ) ! Out
669 :
670 : ! The calculation of skewness of rt, thl, u, v, and scalars is hard-wired
671 : ! for use with the ADG1 code, which contains the variable sigma_sqd_w.
672 : ! In order to use an equivalent expression for these skewnesses using the
673 : ! new hybrid PDF (without doing more recoding), set the value of
674 : ! sigma_sqd_w to 1 - F_w.
675 0 : do k = 1, nz
676 0 : do i = 1, ngrdcol
677 0 : sigma_sqd_w(i,k) = one - F_w(i,k)
678 : end do
679 : end do
680 :
681 : end if ! iiPDF_type
682 :
683 : ! Calculate the PDF component correlations of rt and thl.
684 : call calc_comp_corrs_binormal( nz, ngrdcol, & ! In
685 : rtpthlp, rtm, thlm, & ! In
686 : pdf_params%rt_1, pdf_params%rt_2, & ! In
687 : pdf_params%thl_1, pdf_params%thl_2, & ! In
688 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, & ! In
689 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, & ! In
690 : pdf_params%mixt_frac, & ! In
691 705888 : pdf_params%corr_rt_thl_1, pdf_params%corr_rt_thl_2 ) ! Out
692 :
693 : if ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
694 705888 : .or. iiPDF_type == iiPDF_new_hybrid ) then
695 :
696 : ! These PDF types define corr_w_rt_1, corr_w_rt_2, corr_w_thl_1, and
697 : ! corr_w_thl_2 to all have a value of 0, so skip the calculation.
698 : ! The values of corr_u_w_1, corr_u_w_2, corr_v_w_1, and corr_v_w_2 are
699 : ! all defined to be 0, as well.
700 : !$acc parallel loop gang vector collapse(2) default(present)
701 60706368 : do k = 1, nz
702 1002574368 : do i = 1, ngrdcol
703 941868000 : pdf_params%corr_w_rt_1(i,k) = zero
704 941868000 : pdf_params%corr_w_rt_2(i,k) = zero
705 941868000 : pdf_params%corr_w_thl_1(i,k) = zero
706 941868000 : pdf_params%corr_w_thl_2(i,k) = zero
707 941868000 : corr_u_w_1(i,k) = zero
708 941868000 : corr_u_w_2(i,k) = zero
709 941868000 : corr_v_w_1(i,k) = zero
710 1001868480 : corr_v_w_2(i,k) = zero
711 : end do
712 : end do
713 : !$acc end parallel loop
714 :
715 : else
716 :
717 : ! Calculate the PDF component correlations of w and rt.
718 : call calc_comp_corrs_binormal( nz, ngrdcol, & ! In
719 : wprtp, wm, rtm, & ! In
720 : pdf_params%w_1, pdf_params%w_2, & ! In
721 : pdf_params%rt_1, pdf_params%rt_2, & ! In
722 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, & ! In
723 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, & ! In
724 : pdf_params%mixt_frac, & ! In
725 0 : pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2 ) ! Out
726 :
727 : ! Calculate the PDF component correlations of w and thl.
728 : call calc_comp_corrs_binormal( nz, ngrdcol, & ! In
729 : wpthlp, wm, thlm, & ! In
730 : pdf_params%w_1, pdf_params%w_2, & ! In
731 : pdf_params%thl_1, pdf_params%thl_2, & ! In
732 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, & ! In
733 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, & ! In
734 : pdf_params%mixt_frac, & ! In
735 0 : pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2 ) ! Out
736 : end if
737 :
738 705888 : if ( l_scalar_calc ) then
739 :
740 : ! Calculate the PDF component correlations of a passive scalar and thl.
741 0 : do j = 1, sclr_dim
742 : call calc_comp_corrs_binormal( nz, ngrdcol, & ! In
743 : sclrpthlp(:,:,j), sclrm(:,:,j), thlm, & ! In
744 : sclr1(:,:,j), sclr2(:,:,j), & ! In
745 : pdf_params%thl_1, pdf_params%thl_2, & ! In
746 : varnce_sclr1(:,:,j), varnce_sclr2(:,:,j), & ! In
747 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, & ! In
748 : pdf_params%mixt_frac, & ! In
749 0 : corr_sclr_thl_1(:,:,j), corr_sclr_thl_2(:,:,j) ) ! Out
750 : end do
751 :
752 : ! Calculate the PDF component correlations of a passive scalar and rt.
753 0 : do j = 1, sclr_dim
754 : call calc_comp_corrs_binormal( nz, ngrdcol, & ! In
755 : sclrprtp(:,:,j), sclrm(:,:,j), rtm, & ! In
756 : sclr1(:,:,j), sclr2(:,:,j), & ! In
757 : pdf_params%rt_1, pdf_params%rt_2, & ! In
758 : varnce_sclr1(:,:,j), varnce_sclr2(:,:,j), & ! In
759 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, & ! In
760 : pdf_params%mixt_frac, & ! In
761 0 : corr_sclr_rt_1(:,:,j), corr_sclr_rt_2(:,:,j) ) ! Out
762 : end do
763 :
764 : if ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
765 0 : .or. iiPDF_type == iiPDF_new_hybrid ) then
766 :
767 : ! These PDF types define all PDF component correlations involving w
768 : ! to have a value of 0, so skip the calculation.
769 : !$acc parallel loop gang vector collapse(2) default(present)
770 0 : do j = 1, sclr_dim
771 0 : do k = 1, nz
772 0 : do i = 1, ngrdcol
773 0 : corr_w_sclr_1(i,k,j) = zero
774 0 : corr_w_sclr_2(i,k,j) = zero
775 : end do
776 : end do
777 : end do
778 : !$acc end parallel loop
779 :
780 : else
781 :
782 : ! Calculate the PDF component correlations of w and a passive scalar.
783 0 : do j = 1, sclr_dim
784 : call calc_comp_corrs_binormal( nz, ngrdcol, & ! In
785 : wpsclrp(:,:,j), wm, sclrm(:,:,j), & ! In
786 : pdf_params%w_1, pdf_params%w_2, & ! In
787 : sclr1(:,:,j), sclr2(:,:,j), & ! In
788 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, & ! In
789 : varnce_sclr1(:,:,j), varnce_sclr2(:,:,j), & ! In
790 : pdf_params%mixt_frac, & ! In
791 0 : corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j) ) ! Out
792 :
793 : end do
794 :
795 : end if
796 :
797 : end if
798 :
799 :
800 : ! Compute higher order moments (these are interactive)
801 : call calc_wp2xp_pdf( nz, ngrdcol, &
802 : wm, rtm, pdf_params%w_1, pdf_params%w_2, &
803 : pdf_params%rt_1, pdf_params%rt_2, &
804 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
805 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, &
806 : pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2, &
807 : pdf_params%mixt_frac, &
808 705888 : wp2rtp )
809 :
810 : call calc_wp2xp_pdf( nz, ngrdcol, &
811 : wm, thlm, pdf_params%w_1, pdf_params%w_2, &
812 : pdf_params%thl_1, pdf_params%thl_2, &
813 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
814 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, &
815 : pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2, &
816 : pdf_params%mixt_frac, &
817 705888 : wp2thlp )
818 :
819 : ! Compute higher order moments (these may be interactive)
820 : call calc_wpxp2_pdf( nz, ngrdcol, &
821 : wm, um, pdf_params%w_1, pdf_params%w_2, &
822 : u_1, u_2, &
823 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
824 : varnce_u_1, varnce_u_2, &
825 : corr_u_w_1, corr_u_w_2, &
826 : pdf_params%mixt_frac, &
827 705888 : wpup2 )
828 :
829 : call calc_wpxp2_pdf( nz, ngrdcol, &
830 : wm, vm, pdf_params%w_1, pdf_params%w_2, &
831 : v_1, v_2, &
832 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
833 : varnce_v_1, varnce_v_2, &
834 : corr_v_w_1, corr_v_w_2, &
835 : pdf_params%mixt_frac, &
836 705888 : wpvp2 )
837 :
838 : call calc_wp2xp2_pdf( nz, ngrdcol, &
839 : wm, um, pdf_params%w_1, pdf_params%w_2, &
840 : u_1, u_2, &
841 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
842 : varnce_u_1, varnce_u_2, &
843 : corr_u_w_1, corr_u_w_2, &
844 : pdf_params%mixt_frac, &
845 705888 : wp2up2 )
846 :
847 : call calc_wp2xp2_pdf( nz, ngrdcol, &
848 : wm, vm, pdf_params%w_1, pdf_params%w_2, &
849 : v_1, v_2, &
850 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
851 : varnce_v_1, varnce_v_2, &
852 : corr_v_w_1, corr_v_w_2, &
853 : pdf_params%mixt_frac, &
854 705888 : wp2vp2 )
855 :
856 : call calc_wp4_pdf( nz, ngrdcol, &
857 : wm, pdf_params%w_1, pdf_params%w_2, &
858 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
859 : pdf_params%mixt_frac, &
860 705888 : wp4 )
861 :
862 705888 : if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwprtp2 > 0 ) then
863 : call calc_wpxp2_pdf( nz, ngrdcol, &
864 : wm, rtm, pdf_params%w_1, pdf_params%w_2, &
865 : pdf_params%rt_1, pdf_params%rt_2, &
866 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
867 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, &
868 : pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2, &
869 : pdf_params%mixt_frac, &
870 0 : wprtp2 )
871 : end if
872 :
873 705888 : if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwpthlp2 > 0 ) then
874 : call calc_wpxp2_pdf( nz, ngrdcol, &
875 : wm, thlm, pdf_params%w_1, pdf_params%w_2, &
876 : pdf_params%thl_1, pdf_params%thl_2, &
877 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
878 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, &
879 : pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2, &
880 : pdf_params%mixt_frac, &
881 0 : wpthlp2 )
882 : end if
883 :
884 705888 : if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwprtpthlp > 0 ) then
885 :
886 : call calc_wpxpyp_pdf( nz, ngrdcol, &
887 : wm, rtm, thlm, pdf_params%w_1, pdf_params%w_2, &
888 : pdf_params%rt_1, pdf_params%rt_2, &
889 : pdf_params%thl_1, pdf_params%thl_2, &
890 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
891 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, &
892 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, &
893 : pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2, &
894 : pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2, &
895 : pdf_params%corr_rt_thl_1, pdf_params%corr_rt_thl_2, &
896 : pdf_params%mixt_frac, &
897 0 : wprtpthlp )
898 : end if
899 :
900 :
901 : ! Scalar Addition to higher order moments
902 705888 : if ( l_scalar_calc ) then
903 :
904 0 : do j = 1, sclr_dim
905 : call calc_wp2xp_pdf( nz, ngrdcol, &
906 : wm, sclrm(:,:,j), pdf_params%w_1, pdf_params%w_2, &
907 : sclr1(:,:,j), sclr2(:,:,j), &
908 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
909 : varnce_sclr1(:,:,j), varnce_sclr2(:,:,j), &
910 : corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j), &
911 : pdf_params%mixt_frac, &
912 0 : wp2sclrp(:,:,j) )
913 : end do
914 :
915 0 : do j = 1, sclr_dim
916 : call calc_wpxp2_pdf( nz, ngrdcol, &
917 : wm, sclrm(:,:,j), pdf_params%w_1, pdf_params%w_2, &
918 : sclr1(:,:,j), sclr2(:,:,j), &
919 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
920 : varnce_sclr1(:,:,j), varnce_sclr2(:,:,j), &
921 : corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j), &
922 : pdf_params%mixt_frac, &
923 0 : wpsclrp2(:,:,j) )
924 : end do
925 :
926 0 : do j = 1, sclr_dim
927 : call calc_wpxpyp_pdf( nz, ngrdcol, &
928 : wm, sclrm(:,:,j), rtm, pdf_params%w_1, pdf_params%w_2, &
929 : sclr1(:,:,j), sclr2(:,:,j), &
930 : pdf_params%rt_1, pdf_params%rt_2, &
931 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
932 : varnce_sclr1(:,:,j), varnce_sclr2(:,:,j), &
933 : pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, &
934 : corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j), &
935 : pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2, &
936 : corr_sclr_rt_1(:,:,j), corr_sclr_rt_2(:,:,j), &
937 : pdf_params%mixt_frac, &
938 0 : wpsclrprtp(:,:,j) )
939 : end do
940 :
941 0 : do j = 1, sclr_dim
942 : call calc_wpxpyp_pdf( nz, ngrdcol, &
943 : wm, sclrm(:,:,j), thlm, pdf_params%w_1, pdf_params%w_2, &
944 : sclr1(:,:,j), sclr2(:,:,j), &
945 : pdf_params%thl_1, pdf_params%thl_2, &
946 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
947 : varnce_sclr1(:,:,j), varnce_sclr2(:,:,j), &
948 : pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, &
949 : corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j), &
950 : pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2, &
951 : corr_sclr_thl_1(:,:,j), corr_sclr_thl_2(:,:,j), &
952 : pdf_params%mixt_frac, &
953 0 : wpsclrpthlp(:,:,j) )
954 : end do
955 :
956 : end if
957 :
958 : ! Compute higher order moments that include theta_v.
959 :
960 : ! First compute some preliminary quantities.
961 : ! "1" denotes first Gaussian; "2" denotes 2nd Gaussian
962 : ! liq water temp (Sommeria & Deardorff 1977 (SD), eqn. 3)
963 : !$acc parallel loop gang vector collapse(2) default(present)
964 60706368 : do k = 1, nz
965 1002574368 : do i = 1, ngrdcol
966 941868000 : tl1(i,k) = pdf_params%thl_1(i,k)*exner(i,k)
967 1001868480 : tl2(i,k) = pdf_params%thl_2(i,k)*exner(i,k)
968 : end do
969 : end do
970 : !$acc end parallel loop
971 :
972 : #ifdef GFDL
973 : if ( sclr_dim > 0 .and. (.not. do_liquid_only_in_clubb) ) then ! h1g, 2010-06-16 begin mod
974 :
975 : do i = 1, ngrdcol
976 : where ( tl1(i,:) > t1_combined )
977 : pdf_params%rsatl_1(i,:) = sat_mixrat_liq( nz, p_in_Pa(i,:), tl1(i,:) )
978 : elsewhere ( tl1(i,:) > t2_combined )
979 : pdf_params%rsatl_1(i,:) = sat_mixrat_liq( nz, p_in_Pa(i,:), tl1(i,:) ) &
980 : * (tl1(i,:) - t2_combined)/(t1_combined - t2_combined) &
981 : + sat_mixrat_ice( nz, p_in_Pa(i,:), tl1(i,:) ) &
982 : * (t1_combined - tl1(i,:))/(t1_combined - t2_combined)
983 : elsewhere ( tl1(i,:) > t3_combined )
984 : pdf_params%rsatl_1(i,:) = sat_mixrat_ice( nz, p_in_Pa(i,:), tl1(i,:) ) &
985 : + sat_mixrat_ice( nz, p_in_Pa(i,:), tl1(i,:) ) * (RH_crit(i, :, 1, 1) -one ) &
986 : * ( t2_combined -tl1(i,:))/(t2_combined - t3_combined)
987 : elsewhere
988 : pdf_params%rsatl_1(i,:) = sat_mixrat_ice( nz, p_in_Pa(i,:), tl1(i,:) ) * RH_crit(i, :, 1, 1)
989 : endwhere
990 :
991 : where ( tl2(i,:) > t1_combined )
992 : pdf_params%rsatl_2(i,:) = sat_mixrat_liq( nz, p_in_Pa(i,:), tl2(i,:) )
993 : elsewhere ( tl2(i,:) > t2_combined )
994 : pdf_params%rsatl_2(i,:) = sat_mixrat_liq( nz, p_in_Pa(i,:), tl2(i,:) ) &
995 : * (tl2(i,:) - t2_combined)/(t1_combined - t2_combined) &
996 : + sat_mixrat_ice( nz, p_in_Pa(i,:), tl2(i,:) ) &
997 : * (t1_combined - tl2(i,:))/(t1_combined - t2_combined)
998 : elsewhere ( tl2(i,:) > t3_combined )
999 : pdf_params%rsatl_2(i,:) = sat_mixrat_ice( nz, p_in_Pa(i,:), tl2(i,:) ) &
1000 : + sat_mixrat_ice( nz, p_in_Pa(i,:), tl2(i,:) )* (RH_crit(i, :, 1, 2) -one) &
1001 : * ( t2_combined -tl2(i,:))/(t2_combined - t3_combined)
1002 : elsewhere
1003 : pdf_params%rsatl_2(i,:) = sat_mixrat_ice( nz, p_in_Pa(i,:), tl2(i,:) ) * RH_crit(i, :, 1, 2)
1004 : endwhere
1005 :
1006 : end do
1007 :
1008 : else ! sclr_dim <= 0 or do_liquid_only_in_clubb = .T.
1009 :
1010 : pdf_params%rsatl_1 = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, tl1 )
1011 : pdf_params%rsatl_2 = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, tl2 )
1012 :
1013 : end if !sclr_dim > 0
1014 :
1015 : ! Determine whether to compute ice_supersat_frac. We do not compute
1016 : ! ice_supersat_frac for GFDL (unless do_liquid_only_in_clubb is true),
1017 : ! because liquid and ice are both fed into rtm, ruining the calculation.
1018 : if (do_liquid_only_in_clubb) then
1019 : l_calc_ice_supersat_frac = .true.
1020 : else
1021 : l_calc_ice_supersat_frac = .false.
1022 : end if
1023 :
1024 : #else
1025 705888 : rsatl_1 = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, tl1 )
1026 705888 : rsatl_2 = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, tl2 ) ! h1g, 2010-06-16 end mod
1027 :
1028 : !$acc parallel loop gang vector collapse(2) default(present)
1029 60706368 : do k = 1, nz
1030 1002574368 : do i = 1, ngrdcol
1031 941868000 : pdf_params%rsatl_1(i,k) = rsatl_1(i,k)
1032 1001868480 : pdf_params%rsatl_2(i,k) = rsatl_2(i,k)
1033 : end do
1034 : end do
1035 : !$acc end parallel loop
1036 :
1037 705888 : l_calc_ice_supersat_frac = .true.
1038 : #endif
1039 :
1040 : call transform_pdf_chi_eta_component( nz, ngrdcol, &
1041 : tl1, pdf_params%rsatl_1, pdf_params%rt_1, exner, & ! In
1042 : pdf_params%varnce_thl_1, pdf_params%varnce_rt_1, & ! In
1043 : pdf_params%corr_rt_thl_1, pdf_params%chi_1, & ! In
1044 : pdf_params%crt_1, pdf_params%cthl_1, & ! Out
1045 : pdf_params%stdev_chi_1, pdf_params%stdev_eta_1, & ! Out
1046 : pdf_params%covar_chi_eta_1, & ! Out
1047 705888 : pdf_params%corr_chi_eta_1 ) ! Out
1048 :
1049 :
1050 : ! Calculate cloud fraction component for pdf 1
1051 : call calc_liquid_cloud_frac_component( nz, ngrdcol, &
1052 : pdf_params%chi_1, pdf_params%stdev_chi_1, & ! In
1053 705888 : pdf_params%cloud_frac_1, pdf_params%rc_1 ) ! Out
1054 :
1055 : ! Calc ice_supersat_frac
1056 : if ( l_calc_ice_supersat_frac ) then
1057 :
1058 : call calc_ice_cloud_frac_component( nz, ngrdcol, &
1059 : pdf_params%chi_1, pdf_params%stdev_chi_1, &
1060 : pdf_params%rc_1, pdf_params%cloud_frac_1, &
1061 : p_in_Pa, tl1, &
1062 : pdf_params%rsatl_1, pdf_params%crt_1, &
1063 705888 : pdf_params%ice_supersat_frac_1, rc_1_ice )
1064 : end if
1065 :
1066 : call transform_pdf_chi_eta_component( nz, ngrdcol, &
1067 : tl2, pdf_params%rsatl_2, pdf_params%rt_2, exner, & ! In
1068 : pdf_params%varnce_thl_2, pdf_params%varnce_rt_2, & ! In
1069 : pdf_params%corr_rt_thl_2, pdf_params%chi_2, & ! In
1070 : pdf_params%crt_2, pdf_params%cthl_2, & ! Out
1071 : pdf_params%stdev_chi_2, pdf_params%stdev_eta_2, & ! Out
1072 : pdf_params%covar_chi_eta_2, & ! Out
1073 705888 : pdf_params%corr_chi_eta_2 ) ! Out
1074 :
1075 :
1076 : ! Calculate cloud fraction component for pdf 2
1077 : call calc_liquid_cloud_frac_component( nz, ngrdcol, &
1078 : pdf_params%chi_2, pdf_params%stdev_chi_2, & ! In
1079 705888 : pdf_params%cloud_frac_2, pdf_params%rc_2 ) ! Out
1080 :
1081 : ! Calc ice_supersat_frac
1082 : if ( l_calc_ice_supersat_frac ) then
1083 :
1084 : call calc_ice_cloud_frac_component( nz, ngrdcol, &
1085 : pdf_params%chi_2, pdf_params%stdev_chi_2, &
1086 : pdf_params%rc_2, pdf_params%cloud_frac_2, &
1087 : p_in_Pa, tl2, &
1088 : pdf_params%rsatl_2, pdf_params%crt_2, &
1089 705888 : pdf_params%ice_supersat_frac_2, rc_2_ice )
1090 :
1091 : ! Compute ice cloud fraction, ice_supersat_frac
1092 : !$acc parallel loop gang vector collapse(2) default(present)
1093 60706368 : do k = 1, nz
1094 1002574368 : do i = 1, ngrdcol
1095 1883736000 : ice_supersat_frac(i,k) = pdf_params%mixt_frac(i,k) &
1096 0 : * pdf_params%ice_supersat_frac_1(i,k) &
1097 : + ( one - pdf_params%mixt_frac(i,k) ) &
1098 2885604480 : * pdf_params%ice_supersat_frac_2(i,k)
1099 : end do
1100 : end do
1101 : !$acc end parallel loop
1102 :
1103 : else
1104 :
1105 : ! ice_supersat_frac will be garbage if computed as above
1106 : !$acc parallel loop gang vector collapse(2) default(present)
1107 : do k = 1, nz
1108 : do i = 1, ngrdcol
1109 : ice_supersat_frac(i,k) = 0.0_core_rknd
1110 : end do
1111 : end do
1112 : !$acc end parallel loop
1113 :
1114 : if (clubb_at_least_debug_level( 1 )) then
1115 : write(fstderr,*) "Warning: ice_supersat_frac has garbage values if &
1116 : & do_liquid_only_in_clubb = .false."
1117 : end if
1118 :
1119 : end if ! l_calc_ice_supersat_frac
1120 :
1121 :
1122 : ! Compute cloud fraction and mean cloud water mixing ratio.
1123 : ! Reference:
1124 : ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:anl_int_cloud_terms
1125 : !$acc parallel loop gang vector collapse(2) default(present)
1126 60706368 : do k = 1, nz
1127 1002574368 : do i = 1, ngrdcol
1128 1883736000 : cloud_frac(i,k) = pdf_params%mixt_frac(i,k) * pdf_params%cloud_frac_1(i,k) &
1129 2825604000 : + ( one - pdf_params%mixt_frac(i,k) ) * pdf_params%cloud_frac_2(i,k)
1130 0 : rcm(i,k) = pdf_params%mixt_frac(i,k) * pdf_params%rc_1(i,k) + ( one - pdf_params%mixt_frac(i,k) ) &
1131 941868000 : * pdf_params%rc_2(i,k)
1132 1001868480 : rcm(i,k) = max( zero_threshold, rcm(i,k) )
1133 : end do
1134 : end do
1135 : !$acc end parallel loop
1136 :
1137 : if ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
1138 705888 : .or. iiPDF_type == iiPDF_new_hybrid ) then
1139 :
1140 : ! corr_w_rt and corr_w_thl are zero for these pdf types so
1141 : ! corr_w_chi and corr_w_eta are zero as well
1142 : !$acc parallel loop gang vector collapse(2) default(present)
1143 60706368 : do k = 1, nz
1144 1002574368 : do i = 1, ngrdcol
1145 941868000 : pdf_params%corr_w_chi_1(i,k) = zero
1146 941868000 : pdf_params%corr_w_chi_2(i,k) = zero
1147 941868000 : pdf_params%corr_w_eta_1(i,k) = zero
1148 1001868480 : pdf_params%corr_w_eta_2(i,k) = zero
1149 : end do
1150 : end do
1151 : !$acc end parallel loop
1152 :
1153 : else
1154 :
1155 : ! Correlation of w and chi for each component.
1156 : pdf_params%corr_w_chi_1 &
1157 0 : = calc_corr_chi_x( pdf_params%crt_1, pdf_params%cthl_1, &
1158 0 : sqrt(pdf_params%varnce_rt_1), sqrt(pdf_params%varnce_thl_1), &
1159 0 : pdf_params%stdev_chi_1, &
1160 0 : pdf_params%corr_w_rt_1, pdf_params%corr_w_thl_1 )
1161 :
1162 : pdf_params%corr_w_chi_2 &
1163 0 : = calc_corr_chi_x( pdf_params%crt_2, pdf_params%cthl_2, &
1164 0 : sqrt(pdf_params%varnce_rt_2), sqrt(pdf_params%varnce_thl_2), &
1165 0 : pdf_params%stdev_chi_2, pdf_params%corr_w_rt_2, &
1166 0 : pdf_params%corr_w_thl_2 )
1167 :
1168 : ! Correlation of w and eta for each component.
1169 : pdf_params%corr_w_eta_1 &
1170 0 : = calc_corr_eta_x( pdf_params%crt_1, pdf_params%cthl_1, &
1171 0 : sqrt(pdf_params%varnce_rt_1), sqrt(pdf_params%varnce_thl_1), &
1172 0 : pdf_params%stdev_eta_1, pdf_params%corr_w_rt_1, &
1173 0 : pdf_params%corr_w_thl_1 )
1174 :
1175 : pdf_params%corr_w_eta_2 &
1176 0 : = calc_corr_eta_x( pdf_params%crt_2, pdf_params%cthl_2, &
1177 0 : sqrt(pdf_params%varnce_rt_2), sqrt(pdf_params%varnce_thl_2), &
1178 0 : pdf_params%stdev_eta_2, pdf_params%corr_w_rt_2, &
1179 0 : pdf_params%corr_w_thl_2 )
1180 :
1181 : end if
1182 :
1183 :
1184 : ! Compute moments that depend on theta_v
1185 : !
1186 : ! The moments that depend on th_v' are calculated based on an approximated
1187 : ! and linearized form of the theta_v equation:
1188 : !
1189 : ! theta_v = theta_l + { (R_v/R_d) - 1 } * thv_ds * r_t
1190 : ! + [ {L_v/(C_p*exner)} - (R_v/R_d) * thv_ds ] * r_c;
1191 : !
1192 : ! and therefore:
1193 : !
1194 : ! th_v' = th_l' + { (R_v/R_d) - 1 } * thv_ds * r_t'
1195 : ! + [ {L_v/(C_p*exner)} - (R_v/R_d) * thv_ds ] * r_c';
1196 : !
1197 : ! where thv_ds is used as a reference value to approximate theta_l.
1198 : !
1199 : ! Reference:
1200 : ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:anl_int_buoy_terms
1201 :
1202 : ! Calculate the contributions to <w'rc'>, <w'^2 rc'>, <rt'rc'>, and
1203 : ! <thl'rc'> from the 1st PDF component.
1204 : call calc_xprcp_component( nz, ngrdcol, & ! In
1205 : wm, rtm, thlm, um, vm, rcm, & ! In
1206 : pdf_params%w_1, pdf_params%rt_1, & ! In
1207 : pdf_params%thl_1, u_1, v_1, & ! In
1208 : pdf_params%varnce_w_1, pdf_params%chi_1, & ! In
1209 : pdf_params%stdev_chi_1, pdf_params%stdev_eta_1, & ! In
1210 : pdf_params%corr_w_chi_1, pdf_params%corr_chi_eta_1, & ! In
1211 : pdf_params%crt_1, pdf_params%cthl_1, & ! In
1212 : pdf_params%rc_1, pdf_params%cloud_frac_1, iiPDF_type, & ! In
1213 : wprcp_contrib_comp_1, wp2rcp_contrib_comp_1, & ! Out
1214 : rtprcp_contrib_comp_1, thlprcp_contrib_comp_1, & ! Out
1215 705888 : uprcp_contrib_comp_1, vprcp_contrib_comp_1 ) ! Out
1216 :
1217 : call calc_xprcp_component( nz, ngrdcol, & ! In
1218 : wm, rtm, thlm, um, vm, rcm, & ! In
1219 : pdf_params%w_2, pdf_params%rt_2, & ! In
1220 : pdf_params%thl_2, u_2, v_2, & ! In
1221 : pdf_params%varnce_w_2, pdf_params%chi_2, & ! In
1222 : pdf_params%stdev_chi_2, pdf_params%stdev_eta_2, & ! In
1223 : pdf_params%corr_w_chi_2, pdf_params%corr_chi_eta_2, & ! In
1224 : pdf_params%crt_2, pdf_params%cthl_2, & ! In
1225 : pdf_params%rc_2, pdf_params%cloud_frac_2, iiPDF_type, & ! In
1226 : wprcp_contrib_comp_2, wp2rcp_contrib_comp_2, & ! Out
1227 : rtprcp_contrib_comp_2, thlprcp_contrib_comp_2, & ! Out
1228 705888 : uprcp_contrib_comp_2, vprcp_contrib_comp_2 ) ! Out
1229 :
1230 :
1231 : ! Calculate rc_coef, which is the coefficient on <x'rc'> in the <x'thv'> equation.
1232 : !$acc parallel loop gang vector collapse(2) default(present)
1233 60706368 : do k = 1, nz
1234 1002574368 : do i = 1, ngrdcol
1235 :
1236 941868000 : rc_coef(i,k) = Lv / ( exner(i,k) * Cp ) - ep2 * thv_ds(i,k)
1237 :
1238 : ! Calculate <w'rc'>, <w'^2 rc'>, <rt'rc'>, and <thl'rc'>.
1239 0 : wprcp(i,k) = pdf_params%mixt_frac(i,k) * wprcp_contrib_comp_1(i,k) &
1240 941868000 : + ( one - pdf_params%mixt_frac(i,k) ) * wprcp_contrib_comp_2(i,k)
1241 :
1242 0 : wp2rcp(i,k) = pdf_params%mixt_frac(i,k) * wp2rcp_contrib_comp_1(i,k) &
1243 941868000 : + ( one - pdf_params%mixt_frac(i,k) ) * wp2rcp_contrib_comp_2(i,k)
1244 :
1245 0 : rtprcp(i,k) = pdf_params%mixt_frac(i,k) * rtprcp_contrib_comp_1(i,k) &
1246 941868000 : + ( one - pdf_params%mixt_frac(i,k) ) * rtprcp_contrib_comp_2(i,k)
1247 :
1248 0 : thlprcp(i,k) = pdf_params%mixt_frac(i,k) * thlprcp_contrib_comp_1(i,k) &
1249 941868000 : + ( one - pdf_params%mixt_frac(i,k) ) * thlprcp_contrib_comp_2(i,k)
1250 :
1251 0 : uprcp(i,k) = pdf_params%mixt_frac(i,k) * uprcp_contrib_comp_1(i,k) &
1252 941868000 : + ( one - pdf_params%mixt_frac(i,k) ) * uprcp_contrib_comp_2(i,k)
1253 :
1254 0 : vprcp(i,k) = pdf_params%mixt_frac(i,k) * vprcp_contrib_comp_1(i,k) &
1255 1001868480 : + ( one - pdf_params%mixt_frac(i,k) ) * vprcp_contrib_comp_2(i,k)
1256 : end do
1257 : end do
1258 : !$acc end parallel loop
1259 :
1260 : ! Calculate <w'thv'>, <w'^2 thv'>, <rt'thv'>, and <thl'thv'>.
1261 : !$acc parallel loop gang vector collapse(2) default(present)
1262 60706368 : do k = 1, nz
1263 1002574368 : do i = 1, ngrdcol
1264 941868000 : wpthvp(i,k) = wpthlp(i,k) + ep1 * thv_ds(i,k) * wprtp(i,k) + rc_coef(i,k) * wprcp(i,k)
1265 941868000 : wp2thvp(i,k) = wp2thlp(i,k) + ep1 * thv_ds(i,k) * wp2rtp(i,k) + rc_coef(i,k) * wp2rcp(i,k)
1266 941868000 : rtpthvp(i,k) = rtpthlp(i,k) + ep1 * thv_ds(i,k) * rtp2(i,k) + rc_coef(i,k) * rtprcp(i,k)
1267 1001868480 : thlpthvp(i,k)= thlp2(i,k) + ep1 * thv_ds(i,k) * rtpthlp(i,k) + rc_coef(i,k) * thlprcp(i,k)
1268 : end do
1269 : end do
1270 : !$acc end parallel loop
1271 :
1272 : ! Add the precipitation loading term in the <x'thv'> equation.
1273 : if ( l_liq_ice_loading_test ) then
1274 :
1275 : do hm_idx = 1, hydromet_dim, 1
1276 :
1277 : if ( l_mix_rat_hm(hm_idx) ) then
1278 : !$acc parallel loop gang vector collapse(2) default(present)
1279 : do k = 1, nz
1280 : do i = 1, ngrdcol
1281 : wp2thvp(i,k) = wp2thvp(i,k) - thv_ds(i,k) * wp2hmp(i,k,hm_idx)
1282 : wpthvp(i,k) = wpthvp(i,k) - thv_ds(i,k) * wphydrometp(i,k,hm_idx)
1283 : thlpthvp(i,k) = thlpthvp(i,k) - thv_ds(i,k) * thlphmp(i,k,hm_idx)
1284 : rtpthvp(i,k) = rtpthvp(i,k) - thv_ds(i,k) * rtphmp(i,k,hm_idx)
1285 : end do
1286 : end do
1287 : !$acc end parallel loop
1288 : end if
1289 :
1290 : end do
1291 :
1292 : end if
1293 :
1294 : ! Account for subplume correlation of scalar, theta_v.
1295 : ! See Eqs. A13, A8 from Larson et al. (2002) ``Small-scale...''
1296 : ! where the ``scalar'' in this paper is w.
1297 705888 : if ( l_scalar_calc ) then
1298 :
1299 : !$acc parallel loop gang vector collapse(3) default(present)
1300 0 : do j = 1, sclr_dim
1301 0 : do k = 1, nz
1302 0 : do i = 1, ngrdcol
1303 :
1304 0 : sclrprcp(i,k,j) &
1305 0 : = pdf_params%mixt_frac(i,k) * ( ( sclr1(i,k,j) - sclrm(i,k,j) ) * pdf_params%rc_1(i,k) ) &
1306 : + ( one - pdf_params%mixt_frac(i,k) ) * ( ( sclr2(i,k,j) - sclrm(i,k,j) ) &
1307 0 : * pdf_params%rc_2(i,k) ) &
1308 0 : + pdf_params%mixt_frac(i,k) * corr_sclr_rt_1(i,k,j) * pdf_params%crt_1(i,k) &
1309 0 : * sqrt( varnce_sclr1(i,k,j) * pdf_params%varnce_rt_1(i,k) ) &
1310 0 : * pdf_params%cloud_frac_1(i,k) &
1311 0 : + ( one - pdf_params%mixt_frac(i,k) ) * corr_sclr_rt_2(i,k,j) * pdf_params%crt_2(i,k) &
1312 0 : * sqrt( varnce_sclr2(i,k,j) * pdf_params%varnce_rt_2(i,k) ) &
1313 0 : * pdf_params%cloud_frac_2(i,k) &
1314 0 : - pdf_params%mixt_frac(i,k) * corr_sclr_thl_1(i,k,j) * pdf_params%cthl_1(i,k) &
1315 0 : * sqrt( varnce_sclr1(i,k,j) * pdf_params%varnce_thl_1(i,k) ) &
1316 : * pdf_params%cloud_frac_1(i,k) &
1317 0 : - ( one - pdf_params%mixt_frac(i,k) ) * corr_sclr_thl_2(i,k,j) * pdf_params%cthl_2(i,k) &
1318 0 : * sqrt( varnce_sclr2(i,k,j) * pdf_params%varnce_thl_2(i,k) ) &
1319 0 : * pdf_params%cloud_frac_2(i,k)
1320 :
1321 : sclrpthvp(i,k,j) = sclrpthlp(i,k,j) + ep1*thv_ds(i,k)*sclrprtp(i,k,j) &
1322 0 : + rc_coef(i,k)*sclrprcp(i,k,j)
1323 :
1324 : end do
1325 : end do
1326 : end do ! i=1, sclr_dim
1327 : !$acc end parallel loop
1328 :
1329 : end if ! l_scalar_calc
1330 :
1331 :
1332 : ! Compute variance of liquid water mixing ratio.
1333 : ! This is not needed for closure. Statistical Analysis only.
1334 :
1335 : #ifndef CLUBB_CAM
1336 : ! if CLUBB is used in CAM we want this variable computed no matter what
1337 : if ( stats_metadata%ircp2 > 0 ) then
1338 : #endif
1339 : !$acc parallel loop gang vector collapse(2) default(present)
1340 60706368 : do k = 1,nz
1341 1002574368 : do i = 1, ngrdcol
1342 1883736000 : rcp2(i,k) = pdf_params%mixt_frac(i,k) &
1343 0 : * ( pdf_params%chi_1(i,k)*pdf_params%rc_1(i,k) &
1344 0 : + pdf_params%cloud_frac_1(i,k)*pdf_params%stdev_chi_1(i,k)**2 ) &
1345 : + ( one-pdf_params%mixt_frac(i,k) ) &
1346 0 : * ( pdf_params%chi_2(i,k)*pdf_params%rc_2(i,k) &
1347 0 : + pdf_params%cloud_frac_2(i,k)*pdf_params%stdev_chi_2(i,k)**2 ) &
1348 2825604000 : - rcm(i,k)**2
1349 1001868480 : rcp2(i,k) = max( zero_threshold, rcp2(i,k) )
1350 :
1351 : end do
1352 : end do
1353 : !$acc end parallel loop
1354 : #ifndef CLUBB_CAM
1355 : ! if CLUBB is used in CAM we want this variable computed no matter what
1356 : end if
1357 : #endif
1358 :
1359 : if ( ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
1360 : .or. iiPDF_type == iiPDF_new_hybrid ) &
1361 705888 : .and. ( stats_metadata%iw_up_in_cloud > 0 .or. stats_metadata%iw_down_in_cloud > 0 ) ) then
1362 :
1363 : call calc_w_up_in_cloud( nz, ngrdcol, & ! In
1364 : pdf_params%mixt_frac, & ! In
1365 : pdf_params%cloud_frac_1, pdf_params%cloud_frac_2, & ! In
1366 : pdf_params%w_1, pdf_params%w_2, & ! In
1367 : pdf_params%varnce_w_1, pdf_params%varnce_w_2, & ! In
1368 : w_up_in_cloud, w_down_in_cloud, & ! Out
1369 0 : cloudy_updraft_frac, cloudy_downdraft_frac ) ! Out
1370 :
1371 : else
1372 : !$acc parallel loop gang vector collapse(2) default(present)
1373 60706368 : do k = 1,nz
1374 1002574368 : do i = 1, ngrdcol
1375 941868000 : w_up_in_cloud(i,k) = zero
1376 1001868480 : w_down_in_cloud(i,k) = zero
1377 : end do
1378 : end do
1379 : end if
1380 :
1381 : #ifdef TUNER
1382 :
1383 : !$acc update host( pdf_params, pdf_params%thl_1, pdf_params%thl_2 )
1384 :
1385 : ! Check the first levels (and first gridcolumn) for reasonable temperatures
1386 : ! greater than 190K and less than 1000K
1387 : ! This is necessary because for certain parameter sets we can get floating point errors
1388 : do i=1, min( 10, size(pdf_params%thl_1(1,:)) )
1389 : if ( pdf_params%thl_1(1,i) < 190. ) then
1390 : write(fstderr,*) "Fatal error: pdf_params%thl_1 =", pdf_params%thl_1(1,i), &
1391 : " < 190K at first grid column and grid level i = ", i
1392 : err_code = clubb_fatal_error
1393 : return
1394 : end if
1395 : if ( pdf_params%thl_2(1,i) < 190. ) then
1396 : write(fstderr,*) "Fatal error: pdf_params%thl_2 =", pdf_params%thl_2(1,i), &
1397 : " < 190K at first grid column and grid level i = ", i
1398 : err_code = clubb_fatal_error
1399 : return
1400 : end if
1401 : if ( pdf_params%thl_1(1,i) > 1000. ) then
1402 : write(fstderr,*) "Fatal error: pdf_params%thl_1 =", pdf_params%thl_1(1,i), &
1403 : " > 1000K at first grid column and grid level i = ", i
1404 : err_code = clubb_fatal_error
1405 : return
1406 : end if
1407 : if ( pdf_params%thl_2(1,i) > 1000. ) then
1408 : write(fstderr,*) "Fatal error: pdf_params%thl_2 =", pdf_params%thl_2(1,i), &
1409 : " > 1000K at first grid column and grid level i = ", i
1410 : err_code = clubb_fatal_error
1411 : return
1412 : end if
1413 : end do
1414 : #endif /*TUNER*/
1415 :
1416 705888 : if ( clubb_at_least_debug_level( 2 ) ) then
1417 :
1418 : !$acc update host( wp4, wprtp2, wp2rtp, wpthlp2, wp2thlp, cloud_frac, &
1419 : !$acc rcm, wpthvp, wp2thvp, rtpthvp, thlpthvp, wprcp, wp2rcp, &
1420 : !$acc rtprcp, thlprcp, rcp2, wprtpthlp, sclrpthvp, sclrprcp, &
1421 : !$acc wpsclrp2, wpsclrprtp, wpsclrpthlp, wp2sclrp, &
1422 : !$acc pdf_params%w_1, pdf_params%w_2, &
1423 : !$acc pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
1424 : !$acc pdf_params%rt_1, pdf_params%rt_2, &
1425 : !$acc pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, &
1426 : !$acc pdf_params%thl_1, pdf_params%thl_2, &
1427 : !$acc pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, &
1428 : !$acc pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2, &
1429 : !$acc pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2, &
1430 : !$acc pdf_params%corr_rt_thl_1, pdf_params%corr_rt_thl_2,&
1431 : !$acc pdf_params%alpha_thl, pdf_params%alpha_rt, &
1432 : !$acc pdf_params%crt_1, pdf_params%crt_2, pdf_params%cthl_1, &
1433 : !$acc pdf_params%cthl_2, pdf_params%chi_1, &
1434 : !$acc pdf_params%chi_2, pdf_params%stdev_chi_1, &
1435 : !$acc pdf_params%stdev_chi_2, pdf_params%stdev_eta_1, &
1436 : !$acc pdf_params%stdev_eta_2, pdf_params%covar_chi_eta_1, &
1437 : !$acc pdf_params%covar_chi_eta_2, pdf_params%corr_w_chi_1, &
1438 : !$acc pdf_params%corr_w_chi_2, pdf_params%corr_w_eta_1, &
1439 : !$acc pdf_params%corr_w_eta_2, pdf_params%corr_chi_eta_1, &
1440 : !$acc pdf_params%corr_chi_eta_2, pdf_params%rsatl_1, &
1441 : !$acc pdf_params%rsatl_2, pdf_params%rc_1, pdf_params%rc_2, &
1442 : !$acc pdf_params%cloud_frac_1, pdf_params%cloud_frac_2, &
1443 : !$acc pdf_params%mixt_frac, pdf_params%ice_supersat_frac_1, &
1444 : !$acc pdf_params%ice_supersat_frac_2 )
1445 :
1446 0 : do i = 1, ngrdcol
1447 :
1448 : call pdf_closure_check( &
1449 0 : nz, wp4(i,:), wprtp2(i,:), wp2rtp(i,:), wpthlp2(i,:), & ! intent(in)
1450 0 : wp2thlp(i,:), cloud_frac(i,:), rcm(i,:), wpthvp(i,:), wp2thvp(i,:), & ! intent(in)
1451 0 : rtpthvp(i,:), thlpthvp(i,:), wprcp(i,:), wp2rcp(i,:), & ! intent(in)
1452 0 : rtprcp(i,:), thlprcp(i,:), rcp2(i,:), wprtpthlp(i,:), & ! intent(in)
1453 0 : pdf_params%crt_1(i,:), pdf_params%crt_2(i,:), & ! intent(in)
1454 0 : pdf_params%cthl_1(i,:), pdf_params%cthl_2(i,:), & ! intent(in)
1455 : pdf_params, & ! intent(in)
1456 0 : sclrpthvp(i,:,:), sclrprcp(i,:,:), wpsclrp2(i,:,:), & ! intent(in)
1457 0 : wpsclrprtp(i,:,:), wpsclrpthlp(i,:,:), wp2sclrp(i,:,:), & ! intent(in)
1458 0 : stats_metadata ) ! intent(in)
1459 : end do
1460 : end if
1461 :
1462 : ! Error Reporting
1463 : ! Joshua Fasching February 2008
1464 705888 : if ( clubb_at_least_debug_level( 2 ) ) then
1465 0 : if ( err_code == clubb_fatal_error ) then
1466 :
1467 : !$acc update host( p_in_Pa, exner, thv_ds, wm, wp2, wp3, sigma_sqd_w, &
1468 : !$acc rtm, rtp2, wprtp, thlm, thlp2, wpthlp, rtpthlp, sclrm, &
1469 : !$acc wpsclrp, sclrp2, sclrprtp, sclrpthlp, ice_supersat_frac )
1470 :
1471 0 : write(fstderr,*) "Error in pdf_closure_new"
1472 :
1473 0 : write(fstderr,*) "Intent(in)"
1474 :
1475 0 : write(fstderr,*) "p_in_Pa = ", p_in_Pa
1476 0 : write(fstderr,*) "exner = ", exner
1477 0 : write(fstderr,*) "thv_ds = ", thv_ds
1478 0 : write(fstderr,*) "wm = ", wm
1479 0 : write(fstderr,*) "wp2 = ", wp2
1480 0 : write(fstderr,*) "wp3 = ", wp3
1481 0 : write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w
1482 0 : write(fstderr,*) "rtm = ", rtm
1483 0 : write(fstderr,*) "rtp2 = ", rtp2
1484 0 : write(fstderr,*) "wprtp = ", wprtp
1485 0 : write(fstderr,*) "thlm = ", thlm
1486 0 : write(fstderr,*) "thlp2 = ", thlp2
1487 0 : write(fstderr,*) "wpthlp = ", wpthlp
1488 0 : write(fstderr,*) "rtpthlp = ", rtpthlp
1489 :
1490 0 : if ( sclr_dim > 0 ) then
1491 0 : write(fstderr,*) "sclrm = ", sclrm
1492 0 : write(fstderr,*) "wpsclrp = ", wpsclrp
1493 0 : write(fstderr,*) "sclrp2 = ", sclrp2
1494 0 : write(fstderr,*) "sclrprtp = ", sclrprtp
1495 0 : write(fstderr,*) "sclrpthlp = ", sclrpthlp
1496 : end if
1497 :
1498 0 : write(fstderr,*) "Intent(out)"
1499 :
1500 0 : write(fstderr,*) "wp4 = ", wp4
1501 0 : if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwprtp2 > 0 ) then
1502 0 : write(fstderr,*) "wprtp2 = ", wprtp2
1503 : end if
1504 0 : write(fstderr,*) "wp2rtp = ", wp2rtp
1505 0 : if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwpthlp2 > 0 ) then
1506 0 : write(fstderr,*) "wpthlp2 = ", wpthlp2
1507 : end if
1508 0 : write(fstderr,*) "cloud_frac = ", cloud_frac
1509 0 : write(fstderr,*) "ice_supersat_frac = ", ice_supersat_frac
1510 0 : write(fstderr,*) "rcm = ", rcm
1511 0 : write(fstderr,*) "wpthvp = ", wpthvp
1512 0 : write(fstderr,*) "wp2thvp = ", wp2thvp
1513 0 : write(fstderr,*) "rtpthvp = ", rtpthvp
1514 0 : write(fstderr,*) "thlpthvp = ", thlpthvp
1515 0 : write(fstderr,*) "wprcp = ", wprcp
1516 0 : write(fstderr,*) "wp2rcp = ", wp2rcp
1517 0 : write(fstderr,*) "rtprcp = ", rtprcp
1518 0 : write(fstderr,*) "thlprcp = ", thlprcp
1519 : #ifndef CLUBB_CAM
1520 : ! if CLUBB is used in CAM we want this variable computed no matter what
1521 : if ( stats_metadata%ircp2 > 0 ) then
1522 : #endif
1523 0 : write(fstderr,*) "rcp2 = ", rcp2
1524 : #ifndef CLUBB_CAM
1525 : end if
1526 : #endif
1527 0 : if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwprtpthlp > 0 ) then
1528 0 : write(fstderr,*) "wprtpthlp = ", wprtpthlp
1529 : end if
1530 0 : write(fstderr,*) "rcp2 = ", rcp2
1531 0 : write(fstderr,*) "wprtpthlp = ", wprtpthlp
1532 0 : write(fstderr,*) "pdf_params%w_1 = ", pdf_params%w_1
1533 0 : write(fstderr,*) "pdf_params%w_2 = ", pdf_params%w_2
1534 0 : write(fstderr,*) "pdf_params%varnce_w_1 = ", pdf_params%varnce_w_1
1535 0 : write(fstderr,*) "pdf_params%varnce_w_2 = ", pdf_params%varnce_w_2
1536 0 : write(fstderr,*) "pdf_params%rt_1 = ", pdf_params%rt_1
1537 0 : write(fstderr,*) "pdf_params%rt_2 = ", pdf_params%rt_2
1538 0 : write(fstderr,*) "pdf_params%varnce_rt_1 = ", pdf_params%varnce_rt_1
1539 0 : write(fstderr,*) "pdf_params%varnce_rt_2 = ", pdf_params%varnce_rt_2
1540 0 : write(fstderr,*) "pdf_params%thl_1 = ", pdf_params%thl_1
1541 0 : write(fstderr,*) "pdf_params%thl_2 = ", pdf_params%thl_2
1542 0 : write(fstderr,*) "pdf_params%varnce_thl_1 = ", pdf_params%varnce_thl_1
1543 0 : write(fstderr,*) "pdf_params%varnce_thl_2 = ", pdf_params%varnce_thl_2
1544 0 : write(fstderr,*) "pdf_params%corr_w_rt_1 = ", pdf_params%corr_w_rt_1
1545 0 : write(fstderr,*) "pdf_params%corr_w_rt_2 = ", pdf_params%corr_w_rt_2
1546 0 : write(fstderr,*) "pdf_params%corr_w_thl_1 = ", pdf_params%corr_w_thl_1
1547 0 : write(fstderr,*) "pdf_params%corr_w_thl_2 = ", pdf_params%corr_w_thl_2
1548 0 : write(fstderr,*) "pdf_params%corr_rt_thl_1 = ", pdf_params%corr_rt_thl_1
1549 0 : write(fstderr,*) "pdf_params%corr_rt_thl_2 = ", pdf_params%corr_rt_thl_2
1550 0 : write(fstderr,*) "pdf_params%alpha_thl = ", pdf_params%alpha_thl
1551 0 : write(fstderr,*) "pdf_params%alpha_rt = ", pdf_params%alpha_rt
1552 0 : write(fstderr,*) "pdf_params%crt_1 = ", pdf_params%crt_1
1553 0 : write(fstderr,*) "pdf_params%crt_2 = ", pdf_params%crt_2
1554 0 : write(fstderr,*) "pdf_params%cthl_1 = ", pdf_params%cthl_1
1555 0 : write(fstderr,*) "pdf_params%cthl_2 = ", pdf_params%cthl_2
1556 0 : write(fstderr,*) "pdf_params%chi_1 = ", pdf_params%chi_1
1557 0 : write(fstderr,*) "pdf_params%chi_2 = ", pdf_params%chi_2
1558 0 : write(fstderr,*) "pdf_params%stdev_chi_1 = ", pdf_params%stdev_chi_1
1559 0 : write(fstderr,*) "pdf_params%stdev_chi_2 = ", pdf_params%stdev_chi_2
1560 0 : write(fstderr,*) "pdf_params%stdev_eta_1 = ", pdf_params%stdev_eta_1
1561 0 : write(fstderr,*) "pdf_params%stdev_eta_2 = ", pdf_params%stdev_eta_2
1562 0 : write(fstderr,*) "pdf_params%covar_chi_eta_1 = ", &
1563 0 : pdf_params%covar_chi_eta_1
1564 0 : write(fstderr,*) "pdf_params%covar_chi_eta_2 = ", &
1565 0 : pdf_params%covar_chi_eta_2
1566 0 : write(fstderr,*) "pdf_params%corr_w_chi_1 = ", pdf_params%corr_w_chi_1
1567 0 : write(fstderr,*) "pdf_params%corr_w_chi_2 = ", pdf_params%corr_w_chi_2
1568 0 : write(fstderr,*) "pdf_params%corr_w_eta_1 = ", pdf_params%corr_w_eta_1
1569 0 : write(fstderr,*) "pdf_params%corr_w_eta_2 = ", pdf_params%corr_w_eta_2
1570 0 : write(fstderr,*) "pdf_params%corr_chi_eta_1 = ", &
1571 0 : pdf_params%corr_chi_eta_1
1572 0 : write(fstderr,*) "pdf_params%corr_chi_eta_2 = ", &
1573 0 : pdf_params%corr_chi_eta_2
1574 0 : write(fstderr,*) "pdf_params%rsatl_1 = ", pdf_params%rsatl_1
1575 0 : write(fstderr,*) "pdf_params%rsatl_2 = ", pdf_params%rsatl_2
1576 0 : write(fstderr,*) "pdf_params%rc_1 = ", pdf_params%rc_1
1577 0 : write(fstderr,*) "pdf_params%rc_2 = ", pdf_params%rc_2
1578 0 : write(fstderr,*) "pdf_params%cloud_frac_1 = ", pdf_params%cloud_frac_1
1579 0 : write(fstderr,*) "pdf_params%cloud_frac_2 = ", pdf_params%cloud_frac_2
1580 0 : write(fstderr,*) "pdf_params%mixt_frac = ", pdf_params%mixt_frac
1581 0 : write(fstderr,*) "pdf_params%ice_supersat_frac_1 = ", &
1582 0 : pdf_params%ice_supersat_frac_1
1583 0 : write(fstderr,*) "pdf_params%ice_supersat_frac_2 = ", &
1584 0 : pdf_params%ice_supersat_frac_2
1585 :
1586 0 : if ( sclr_dim > 0 )then
1587 0 : write(fstderr,*) "sclrpthvp = ", sclrpthvp
1588 0 : write(fstderr,*) "sclrprcp = ", sclrprcp
1589 0 : write(fstderr,*) "wpsclrp2 = ", wpsclrp2
1590 0 : write(fstderr,*) "wpsclrprtp = ", wpsclrprtp
1591 0 : write(fstderr,*) "wpsclrpthlp = ", wpsclrpthlp
1592 0 : write(fstderr,*) "wp2sclrp = ", wp2sclrp
1593 : end if
1594 :
1595 0 : return
1596 :
1597 : end if ! Fatal error
1598 :
1599 0 : do i = 1, ngrdcol
1600 :
1601 : ! Error check pdf parameters and moments to ensure consistency
1602 0 : if ( iiPDF_type == iiPDF_3D_Luhar ) then
1603 :
1604 : ! Means
1605 0 : wm_clubb_pdf(i,:) = pdf_params%mixt_frac(i,:) * pdf_params%w_1(i,:) &
1606 0 : + ( one - pdf_params%mixt_frac(i,:) ) * pdf_params%w_2(i,:)
1607 :
1608 0 : do k = 1, nz, 1
1609 0 : if ( abs( ( wm_clubb_pdf(i,k) - wm(i,k) ) &
1610 0 : / max( wm(i,k), eps ) ) > .05_core_rknd ) then
1611 0 : write(fstderr,*) "wm error at thlm = ", thlm(i,k), &
1612 : ( ( wm_clubb_pdf(i,k) - wm(i,k) ) &
1613 0 : / max( wm(i,k), eps ) )
1614 : end if
1615 : end do ! k = 1, nz, 1
1616 :
1617 0 : rtm_clubb_pdf(i,:) = pdf_params%mixt_frac(i,:) * pdf_params%rt_1(i,:) &
1618 0 : + ( one - pdf_params%mixt_frac(i,:) ) * pdf_params%rt_2(i,:)
1619 :
1620 0 : do k = 1, nz, 1
1621 0 : if ( abs( ( rtm_clubb_pdf(i,k) - rtm(i,k) ) &
1622 0 : / max( rtm(i,k), eps ) ) > .05_core_rknd ) then
1623 0 : write(fstderr,*) "rtm error at thlm = ", thlm(i,k), &
1624 : ( ( rtm_clubb_pdf(i,k) - rtm(i,k) ) &
1625 0 : / max( rtm(i,k), eps ) )
1626 : end if
1627 : end do ! k = 1, nz, 1
1628 :
1629 0 : thlm_clubb_pdf(i,:) = pdf_params%mixt_frac(i,:) * pdf_params%thl_1(i,:) &
1630 0 : + ( one - pdf_params%mixt_frac(i,:) ) * pdf_params%thl_2(i,:)
1631 :
1632 0 : do k = 1, nz, 1
1633 0 : if ( abs( ( thlm_clubb_pdf(i,k) - thlm(i,k) ) / thlm(i,k) ) &
1634 0 : > .05_core_rknd ) then
1635 0 : write(fstderr,*) "thlm error at thlm = ", thlm(i,k), &
1636 0 : ( ( thlm_clubb_pdf(i,k) - thlm(i,k) ) / thlm(i,k) )
1637 : end if
1638 : end do ! k = 1, nz, 1
1639 :
1640 : ! Variances
1641 0 : wp2_clubb_pdf(i,:) = pdf_params%mixt_frac(i,:) &
1642 0 : * ( ( pdf_params%w_1(i,:) - wm(i,:) )**2 + pdf_params%varnce_w_1(i,:) ) &
1643 : + ( one - pdf_params%mixt_frac(i,:) ) &
1644 0 : * ( ( pdf_params%w_2(i,:) - wm(i,:) )**2 + pdf_params%varnce_w_2(i,:) )
1645 :
1646 0 : do k = 1, nz, 1
1647 0 : if ( wp2(i,k) > w_tol**2 ) then
1648 0 : if ( abs( ( wp2_clubb_pdf(i,k) - wp2(i,k) ) / wp2(i,k) ) &
1649 : > .05_core_rknd ) then
1650 0 : write(fstderr,*) "wp2 error at thlm = ", thlm(i,k), &
1651 0 : ( ( wp2_clubb_pdf(i,k) - wp2(i,k) ) / wp2(i,k) )
1652 : end if
1653 : end if
1654 : end do ! k = 1, nz, 1
1655 :
1656 : rtp2_clubb_pdf(i,:) &
1657 0 : = pdf_params%mixt_frac(i,:) &
1658 0 : * ( ( pdf_params%rt_1(i,:) - rtm(i,:) )**2 + pdf_params%varnce_rt_1(i,:) ) &
1659 : + ( one - pdf_params%mixt_frac(i,:) ) &
1660 0 : * ( ( pdf_params%rt_2(i,:) - rtm(i,:) )**2 + pdf_params%varnce_rt_2(i,:) )
1661 :
1662 0 : do k = 1, nz, 1
1663 0 : if ( rtp2(i,k) > rt_tol**2 ) then
1664 0 : if ( abs( ( rtp2_clubb_pdf(i,k) - rtp2(i,k) ) / rtp2(i,k) ) &
1665 : > .05_core_rknd ) then
1666 0 : write(fstderr,*) "rtp2 error at thlm = ", thlm(i,k), &
1667 0 : "Error = ", ( ( rtp2_clubb_pdf(i,k) - rtp2(i,k) ) / rtp2(i,k) )
1668 : end if
1669 : end if
1670 : end do ! k = 1, nz, 1
1671 :
1672 : thlp2_clubb_pdf(i,:) &
1673 0 : = pdf_params%mixt_frac(i,:) &
1674 0 : * ( ( pdf_params%thl_1(i,:) - thlm(i,:) )**2 + pdf_params%varnce_thl_1(i,:) ) &
1675 : + ( one - pdf_params%mixt_frac(i,:) ) &
1676 0 : * ( ( pdf_params%thl_2(i,:) - thlm(i,:) )**2 + pdf_params%varnce_thl_2(i,:) )
1677 :
1678 0 : do k = 1, nz, 1
1679 0 : if( thlp2(i,k) > thl_tol**2 ) then
1680 0 : if ( abs( ( thlp2_clubb_pdf(i,k) - thlp2(i,k) ) / thlp2(i,k) ) &
1681 : > .05_core_rknd ) then
1682 0 : write(fstderr,*) "thlp2 error at thlm = ", thlm(i,k), &
1683 0 : "Error = ", ( ( thlp2_clubb_pdf(i,k) - thlp2(i,k) ) / thlp2(i,k) )
1684 : end if
1685 : end if
1686 : end do ! k = 1, nz, 1
1687 :
1688 : ! Third order moments
1689 : wp3_clubb_pdf(i,:) &
1690 0 : = pdf_params%mixt_frac(i,:) * ( pdf_params%w_1(i,:) - wm(i,:) ) &
1691 0 : * ( ( pdf_params%w_1(i,:) - wm(i,:) )**2 + three * pdf_params%varnce_w_1(i,:) ) &
1692 0 : + ( one - pdf_params%mixt_frac(i,:) ) * ( pdf_params%w_2(i,:) - wm(i,:) ) &
1693 0 : * ( ( pdf_params%w_2(i,:) - wm(i,:) )**2 + three * pdf_params%varnce_w_2(i,:) )
1694 :
1695 : rtp3_clubb_pdf(i,:) &
1696 0 : = pdf_params%mixt_frac(i,:) * ( pdf_params%rt_1(i,:) - rtm(i,:) ) &
1697 0 : * ( ( pdf_params%rt_1(i,:) - rtm(i,:) )**2 + three * pdf_params%varnce_rt_1(i,:) ) &
1698 0 : + ( one - pdf_params%mixt_frac(i,:) ) * ( pdf_params%rt_2(i,:) - rtm(i,:) ) &
1699 0 : * ( ( pdf_params%rt_2(i,:) - rtm(i,:) )**2 + three * pdf_params%varnce_rt_2(i,:) )
1700 :
1701 : thlp3_clubb_pdf(i,:) &
1702 0 : = pdf_params%mixt_frac(i,:) * ( pdf_params%thl_1(i,:) - thlm(i,:) ) &
1703 0 : * ( ( pdf_params%thl_1(i,:) - thlm(i,:) )**2 + three * pdf_params%varnce_thl_1(i,:) ) &
1704 0 : + ( one - pdf_params%mixt_frac(i,:) ) * ( pdf_params%thl_2(i,:) - thlm(i,:) ) &
1705 0 : * ( ( pdf_params%thl_2(i,:) - thlm(i,:) )**2 + three * pdf_params%varnce_thl_2(i,:) )
1706 :
1707 : ! Skewness
1708 0 : Skw_denom_coef = clubb_params(iSkw_denom_coef)
1709 :
1710 : Skw_clubb_pdf(i,:) &
1711 : = wp3_clubb_pdf(i,:) &
1712 0 : / ( wp2_clubb_pdf(i,:) + Skw_denom_coef * w_tol**2 )**1.5_core_rknd
1713 :
1714 0 : do k = 1, nz, 1
1715 0 : if ( Skw(i,k) > .05_core_rknd ) then
1716 0 : if( abs( ( Skw_clubb_pdf(i,k) - Skw(i,k) ) / Skw(i,k) ) &
1717 : > .25_core_rknd ) then
1718 0 : write(fstderr,*) "Skw error at thlm = ", thlm(i,k), &
1719 0 : "Error = ", ( ( Skw_clubb_pdf(i,k) - Skw(i,k) ) / Skw(i,k) ), &
1720 0 : Skw_clubb_pdf(i,k), Skw(i,k)
1721 : end if
1722 : end if
1723 : end do ! k = 1, nz, 1
1724 :
1725 : Skrt_clubb_pdf(i,:) &
1726 : = rtp3_clubb_pdf(i,:) &
1727 0 : / ( rtp2_clubb_pdf(i,:) + Skw_denom_coef * rt_tol**2 )**1.5_core_rknd
1728 :
1729 0 : do k = 1, nz, 1
1730 0 : if ( Skrt(i,k) > .05_core_rknd ) then
1731 0 : if( abs( ( Skrt_clubb_pdf(i,k) - Skrt(i,k) ) / Skrt(i,k) ) &
1732 : > .25_core_rknd ) then
1733 0 : write(fstderr,*) "Skrt error at thlm = ", thlm(i,k), &
1734 0 : "Error = ", ( ( Skrt_clubb_pdf(i,k) - Skrt(i,k) ) / Skrt(i,k) ), &
1735 0 : Skrt_clubb_pdf(i,k), Skrt(i,k)
1736 : end if
1737 : end if
1738 : end do ! k = 1, nz, 1
1739 :
1740 : Skthl_clubb_pdf(i,:) &
1741 : = thlp3_clubb_pdf(i,:) &
1742 0 : / ( thlp2_clubb_pdf(i,:) + Skw_denom_coef * thl_tol**2 )**1.5_core_rknd
1743 :
1744 0 : do k = 1, nz, 1
1745 0 : if ( Skthl(i,k) > .05_core_rknd ) then
1746 0 : if ( abs( ( Skthl_clubb_pdf(i,k) - Skthl(i,k) ) / Skthl(i,k) ) &
1747 : > .25_core_rknd ) then
1748 0 : write(fstderr,*) "Skthl error at thlm = ", thlm(i,k), &
1749 0 : "Error = ", ( ( Skthl_clubb_pdf(i,k) - Skthl(i,k) ) / Skthl(i,k) ), &
1750 0 : Skthl_clubb_pdf(i,k), Skthl(i,k)
1751 : end if
1752 : end if
1753 : end do ! k = 1, nz, 1
1754 :
1755 : end if ! iiPDF_type == iiPDF_3D_Luhar
1756 :
1757 : end do
1758 :
1759 : end if ! clubb_at_least_debug_level
1760 :
1761 : !$acc exit data delete( u_1, u_2, varnce_u_1, varnce_u_2, v_1, v_2, &
1762 : !$acc varnce_v_1, varnce_v_2, alpha_u, alpha_v, &
1763 : !$acc corr_u_w_1, corr_u_w_2, corr_v_w_1, corr_v_w_2, &
1764 : !$acc tl1, tl2, sqrt_wp2, Skthl, &
1765 : !$acc Skrt, Sku, Skv, wprcp_contrib_comp_1, wprcp_contrib_comp_2, &
1766 : !$acc wp2rcp_contrib_comp_1, wp2rcp_contrib_comp_2, &
1767 : !$acc rtprcp_contrib_comp_1, rtprcp_contrib_comp_2, &
1768 : !$acc thlprcp_contrib_comp_1, thlprcp_contrib_comp_2, &
1769 : !$acc uprcp_contrib_comp_1, uprcp_contrib_comp_2, &
1770 : !$acc vprcp_contrib_comp_1, vprcp_contrib_comp_2, &
1771 : !$acc rc_1_ice, rc_2_ice, rsatl_1, rsatl_2 )
1772 :
1773 : !$acc exit data if( sclr_dim > 0 ) &
1774 : !$acc delete( sclr1, sclr2, varnce_sclr1, varnce_sclr2, &
1775 : !$acc alpha_sclr, corr_sclr_thl_1, corr_sclr_thl_2, &
1776 : !$acc corr_sclr_rt_1, corr_sclr_rt_2, corr_w_sclr_1, &
1777 : !$acc corr_w_sclr_2, Sksclr )
1778 :
1779 : return
1780 :
1781 : end subroutine pdf_closure
1782 :
1783 : !===============================================================================================
1784 1411776 : subroutine transform_pdf_chi_eta_component( nz, ngrdcol, &
1785 1411776 : tl, rsatl, rt, exner, & ! In
1786 1411776 : varnce_thl, varnce_rt, & ! In
1787 1411776 : corr_rt_thl, chi, & ! In
1788 1411776 : crt, cthl, & ! Out
1789 1411776 : stdev_chi, stdev_eta, & ! Out
1790 1411776 : covar_chi_eta, & ! Out
1791 1411776 : corr_chi_eta ) ! Out
1792 :
1793 : use clubb_precision, only: &
1794 : core_rknd ! Variable(s)
1795 :
1796 : use constants_clubb, only: &
1797 : zero, one, two, &
1798 : ep, Lv, Rd, Cp, &
1799 : chi_tol, &
1800 : eta_tol, &
1801 : max_mag_correlation
1802 :
1803 : implicit none
1804 :
1805 : integer, intent(in) :: &
1806 : ngrdcol, & ! Number of grid columns
1807 : nz ! Number of vertical level
1808 :
1809 : ! ----------- Input Variables -----------
1810 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
1811 : tl, &
1812 : rsatl, &
1813 : rt, &
1814 : varnce_thl, &
1815 : varnce_rt, &
1816 : corr_rt_thl, &
1817 : exner
1818 :
1819 : ! ----------- Output Variables -----------
1820 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
1821 : chi, & ! s from Lewellen and Yoh 1993 (LY) eqn. 1
1822 : crt, & ! Coefficients for s'
1823 : cthl, & ! Coefficients for s'
1824 : stdev_chi, & ! Standard deviation of chi for each component.
1825 : stdev_eta, & ! Standard deviation of eta for each component.
1826 : covar_chi_eta, & ! Covariance of chi and eta for each component.
1827 : corr_chi_eta ! Correlation of chi and eta for each component.
1828 :
1829 : ! ----------- Local Variables -----------
1830 : real( kind = core_rknd ) :: &
1831 : varnce_rt_term, &
1832 : corr_rt_thl_term, &
1833 : varnce_thl_term, &
1834 : varnce_chi, &
1835 : varnce_eta, &
1836 : beta, &
1837 : invrs_beta_rsatl_p1
1838 :
1839 : real( kind = core_rknd ), parameter :: &
1840 : chi_tol_sqd = chi_tol**2, &
1841 : eta_tol_sqd = eta_tol**2, &
1842 : Cp_on_Lv = Cp / Lv
1843 :
1844 : ! Loop variable
1845 : integer :: k, i
1846 :
1847 : ! ----------- Begin Code -----------
1848 :
1849 : !$acc parallel loop gang vector collapse(2) default(present)
1850 121412736 : do k = 1, nz
1851 2005148736 : do i = 1, ngrdcol
1852 :
1853 : ! SD's beta (eqn. 8)
1854 1883736000 : beta = ep * Lv**2 / ( Rd * Cp * tl(i,k)**2 )
1855 :
1856 1883736000 : invrs_beta_rsatl_p1 = one / ( one + beta * rsatl(i,k) )
1857 :
1858 : ! s from Lewellen and Yoh 1993 (LY) eqn. 1
1859 1883736000 : chi(i,k) = ( rt(i,k) - rsatl(i,k) ) * invrs_beta_rsatl_p1
1860 :
1861 : ! For each normal distribution in the sum of two normal distributions,
1862 : ! s' = crt * rt' + cthl * thl';
1863 : ! therefore, x's' = crt * x'rt' + cthl * x'thl'.
1864 : ! Larson et al. May, 2001.
1865 1883736000 : crt(i,k) = invrs_beta_rsatl_p1
1866 : cthl(i,k) = ( one + beta * rt(i,k) ) * invrs_beta_rsatl_p1**2 &
1867 2003736960 : * Cp_on_Lv * beta * rsatl(i,k) * exner(i,k)
1868 :
1869 : end do
1870 : end do
1871 : !$acc end parallel loop
1872 :
1873 : ! Calculate covariance, correlation, and standard deviation of
1874 : ! chi and eta for each component
1875 : ! Include subplume correlation of qt, thl
1876 : !$acc parallel loop gang vector collapse(2) default(present)
1877 121412736 : do k = 1, nz
1878 2005148736 : do i = 1, ngrdcol
1879 :
1880 1883736000 : varnce_rt_term = crt(i,k)**2 * varnce_rt(i,k)
1881 1883736000 : varnce_thl_term = cthl(i,k)**2 * varnce_thl(i,k)
1882 :
1883 1883736000 : covar_chi_eta(i,k) = varnce_rt_term - varnce_thl_term
1884 :
1885 : corr_rt_thl_term = two * corr_rt_thl(i,k) * crt(i,k) * cthl(i,k) &
1886 1883736000 : * sqrt( varnce_rt(i,k) * varnce_thl(i,k) )
1887 :
1888 1883736000 : varnce_chi = varnce_rt_term - corr_rt_thl_term + varnce_thl_term
1889 1883736000 : varnce_eta = varnce_rt_term + corr_rt_thl_term + varnce_thl_term
1890 :
1891 : ! We need to introduce a threshold value for the variance of chi and eta
1892 2003736960 : if ( varnce_chi < chi_tol_sqd .or. varnce_eta < eta_tol_sqd ) then
1893 :
1894 47455623 : if ( varnce_chi < chi_tol_sqd ) then
1895 47447583 : stdev_chi(i,k) = zero ! Treat chi as a delta function
1896 : else
1897 8040 : stdev_chi(i,k) = sqrt( varnce_chi )
1898 : end if
1899 :
1900 47455623 : if ( varnce_eta < eta_tol_sqd ) then
1901 47448366 : stdev_eta(i,k) = zero ! Treat eta as a delta function
1902 : else
1903 7257 : stdev_eta(i,k) = sqrt( varnce_eta )
1904 : end if
1905 :
1906 47455623 : corr_chi_eta(i,k) = zero
1907 :
1908 : else
1909 :
1910 1836280377 : stdev_chi(i,k) = sqrt( varnce_chi )
1911 1836280377 : stdev_eta(i,k) = sqrt( varnce_eta )
1912 :
1913 1836280377 : corr_chi_eta(i,k) = covar_chi_eta(i,k) / ( stdev_chi(i,k) * stdev_eta(i,k) )
1914 : corr_chi_eta(i,k) = min( max_mag_correlation, &
1915 1836280377 : max( -max_mag_correlation, corr_chi_eta(i,k) ) )
1916 :
1917 : end if
1918 :
1919 : end do
1920 : end do
1921 : !$acc end parallel loop
1922 :
1923 1411776 : end subroutine transform_pdf_chi_eta_component
1924 :
1925 : !=============================================================================
1926 705888 : subroutine calc_wp4_pdf( nz, ngrdcol, &
1927 705888 : wm, w_1, w_2, &
1928 705888 : varnce_w_1, varnce_w_2, &
1929 705888 : mixt_frac, &
1930 705888 : wp4 )
1931 :
1932 : ! Description:
1933 : ! Calculates <w'^4> by integrating over the PDF of w. The integral is:
1934 : !
1935 : ! <w'^4> = INT(-inf:inf) ( w - <w> )^4 P(w) dw;
1936 : !
1937 : ! where <w> is the overall mean of w and P(w) is a two-component normal
1938 : ! distribution of w. The integrated equation is:
1939 : !
1940 : ! <w'^4> = mixt_frac * ( 3 * sigma_w_1^4
1941 : ! + 6 * ( mu_w_1 - <w> )^2 * sigma_w_1^2
1942 : ! + ( mu_w_1 - <w> )^4 )
1943 : ! + ( 1 - mixt_frac ) * ( 3 * sigma_w_2^4
1944 : ! + 6 * ( mu_w_2 - <w> )^2 * sigma_w_2^2
1945 : ! + ( mu_w_2 - <w> )^4 );
1946 : !
1947 : ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
1948 : ! of w in the 2nd PDF component, sigma_w_1 is the standard deviation of w in
1949 : ! the 1st PDF component, sigma_w_2 is the standard deviation of w in the 2nd
1950 : ! PDF component, and mixt_frac is the mixture fraction, which is the weight
1951 : ! of the 1st PDF component.
1952 :
1953 : ! References:
1954 : !-----------------------------------------------------------------------
1955 :
1956 : use constants_clubb, only: &
1957 : six, & ! Variable(s)
1958 : three, &
1959 : one
1960 :
1961 : use clubb_precision, only: &
1962 : core_rknd ! Variable(s)
1963 :
1964 : implicit none
1965 :
1966 : integer, intent(in) :: &
1967 : ngrdcol, & ! Number of grid columns
1968 : nz ! Number of vertical level
1969 :
1970 : ! Input Variables
1971 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
1972 : wm, & ! Mean of w (overall) [m/s]
1973 : w_1, & ! Mean of w (1st PDF component) [m/s]
1974 : w_2, & ! Mean of w (2nd PDF component) [m/s]
1975 : varnce_w_1, & ! Variance of w (1st PDF component) [m^2/s^2]
1976 : varnce_w_2, & ! Variance of w (2nd PDF component) [m^2/s^2]
1977 : mixt_frac ! Mixture fraction [-]
1978 :
1979 : ! Output Variable
1980 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
1981 : wp4 ! <w'^4> [m^4/s^4]
1982 :
1983 : ! Local Variables
1984 : integer :: i, k
1985 :
1986 : !$acc parallel loop gang vector collapse(2) default(present)
1987 60706368 : do k = 1, nz
1988 1002574368 : do i = 1, ngrdcol
1989 :
1990 : ! Calculate <w'^4> by integrating over the PDF.
1991 1883736000 : wp4(i,k) = mixt_frac(i,k) * ( three * varnce_w_1(i,k)**2 &
1992 : + six * ( ( w_1(i,k) - wm(i,k) )**2 ) * varnce_w_1(i,k) &
1993 : + ( w_1(i,k) - wm(i,k) )**4 ) &
1994 : + ( one - mixt_frac(i,k) ) * ( three * varnce_w_2(i,k)**2 &
1995 : + six * ( (w_2(i,k) - wm(i,k) )**2 )*varnce_w_2(i,k) &
1996 2885604480 : + ( w_2(i,k) - wm(i,k) )**4 )
1997 : end do
1998 : end do
1999 : !$acc end parallel loop
2000 :
2001 705888 : return
2002 :
2003 : end subroutine calc_wp4_pdf
2004 :
2005 : !=============================================================================
2006 1411776 : subroutine calc_wp2xp2_pdf( nz, ngrdcol, &
2007 1411776 : wm, xm, w_1, &
2008 1411776 : w_2, x_1, x_2, &
2009 1411776 : varnce_w_1, varnce_w_2, &
2010 1411776 : varnce_x_1, varnce_x_2, &
2011 1411776 : corr_w_x_1, corr_w_x_2, &
2012 1411776 : mixt_frac, &
2013 1411776 : wp2xp2 )
2014 :
2015 : ! Description:
2016 : ! Calculates <w'^2x'^2> by integrating over the PDF of w and x. The
2017 : ! integral
2018 : ! is:
2019 : !
2020 : ! <w'^2x'^2>
2021 : ! = INT(-inf:inf) INT(-inf:inf) ( w - <w> )^2 ( x - <x> )^2 P(w,x) dx dw;
2022 : !
2023 : ! where <w> is the overall mean of w, <x> is the overall mean of x, and
2024 : ! P(w,x) is a two-component bivariate normal distribution of w and x. The
2025 : ! integrated equation is:
2026 : !
2027 : ! <w'^2x'^2>
2028 : ! = mixt_frac
2029 : ! * ( ( mu_w_1 - <w> )**2 * ( ( mu_x_1 - <x> )**2 + sigma_x_1^2 )
2030 : ! + four * corr_w_x_1 * sigma_w_1 * sigma_x_1 * ( mu_x_1 - <x> ) * (
2031 : ! mu_w_1 - <w> )
2032 : ! + ( ( mu_x_1 - <x> )**2 + ( 1 + 2*corr_w_x_1**2 ) * sigma_x_1^2 ) *
2033 : ! sigma_w_1^2 )
2034 : ! + ( one - mixt_frac )
2035 : ! * ( ( mu_w_2 - <w> )**2 * ( ( mu_x_2 - <x> )**2 + sigma_x_2^2 )
2036 : ! + four * corr_w_x_2 * sigma_w_2 * sigma_x_2 * ( mu_x_2 - <x> ) * (
2037 : ! mu_w_2 - <w> )
2038 : ! + ( ( mu_x_2 - <x> )**2 + ( 1 + 2*corr_w_x_2**2 ) * sigma_x_2^2 ) *
2039 : ! sigma_w_2^2 )
2040 : !
2041 : ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
2042 : ! of w in the 2nd PDF component, mu_x_1 is the mean of x in the 1st PDF
2043 : ! component, mu_x_2 is the mean of x in the 2nd PDF component, sigma_w_1 is
2044 : ! the standard deviation of w in the 1st PDF component, sigma_w_2 is the
2045 : ! standard deviation of w in the 2nd PDF component, sigma_x_1 is the
2046 : ! standard deviation of x in the 1st PDF component, sigma_x_2 is the
2047 : ! standard deviation of x in the 2nd PDF component, corr_w_x_1 is the
2048 : ! correlation of w and x in the 1st PDF component, corr_w_x_2 is the
2049 : ! correlation of w and x in the 2nd PDF component, and mixt_frac is the
2050 : ! mixture fraction, which is the weight of the 1st PDF component.
2051 :
2052 : ! References:
2053 : !-----------------------------------------------------------------------
2054 :
2055 : use constants_clubb, only: &
2056 : one, & ! Variable(s)
2057 : four
2058 :
2059 : use clubb_precision, only: &
2060 : core_rknd ! Variable(s)
2061 :
2062 : implicit none
2063 :
2064 : integer, intent(in) :: &
2065 : ngrdcol, & ! Number of grid columns
2066 : nz ! Number of vertical level
2067 :
2068 : ! Input Variables
2069 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
2070 : wm, & ! Mean of w (overall) [m/s]
2071 : xm, & ! Mean of x (overall) [units vary]
2072 : w_1, & ! Mean of w (1st PDF component) [m/s]
2073 : w_2, & ! Mean of w (2nd PDF component) [m/s]
2074 : x_1, & ! Mean of x (1st PDF component) [units vary]
2075 : x_2, & ! Mean of x (2nd PDF component) [units vary]
2076 : varnce_w_1, & ! Variance of w (1st PDF component) [m^2/s^2]
2077 : varnce_w_2, & ! Variance of w (2nd PDF component) [m^2/s^2]
2078 : varnce_x_1, & ! Variance of x (1st PDF component) [(units vary)^2]
2079 : varnce_x_2, & ! Variance of x (2nd PDF component) [(units vary)^2]
2080 : corr_w_x_1, & ! Correlation of w and x (1st PDF comp.) [-]
2081 : corr_w_x_2, & ! Correlation of w and x (2nd PDF comp.) [-]
2082 : mixt_frac ! Mixture fraction [-]
2083 :
2084 : ! Output Variable
2085 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
2086 : wp2xp2 ! <w'^2x'^2> [m^2/s^2 (units vary)^2]
2087 :
2088 : ! Local Variable
2089 : integer :: i, k
2090 :
2091 : !$acc parallel loop gang vector collapse(2) default(present)
2092 121412736 : do k = 1, nz
2093 2005148736 : do i = 1, ngrdcol
2094 :
2095 : ! Calculate <w'x'^2> by integrating over the PDF.
2096 3767472000 : wp2xp2(i,k) = mixt_frac(i,k) &
2097 : * ( ( w_1(i,k) - wm(i,k) )**2 * ( ( x_1(i,k) - xm(i,k) )**2 + varnce_x_1(i,k) ) &
2098 : + four * corr_w_x_1(i,k) * sqrt( varnce_w_1(i,k) * varnce_x_1(i,k) ) &
2099 : * ( x_1(i,k) - xm(i,k) ) * ( w_1(i,k) - wm(i,k) ) &
2100 : + ( ( x_1(i,k) - xm(i,k) )**2 &
2101 : + ( 1 + 2*corr_w_x_1(i,k)**2 ) * varnce_x_1(i,k) ) * varnce_w_1(i,k) ) &
2102 : + ( one - mixt_frac(i,k) ) &
2103 : * ( ( w_2(i,k) - wm(i,k) )**2 * ( ( x_2(i,k) - xm(i,k) )**2 + varnce_x_2(i,k) ) &
2104 : + four * corr_w_x_2(i,k) * sqrt( varnce_w_2(i,k) * varnce_x_2(i,k) ) &
2105 : * ( x_2(i,k) - xm(i,k) ) * ( w_2(i,k) - wm(i,k) ) &
2106 : + ( ( x_2(i,k) - xm(i,k) )**2 &
2107 5771208960 : + ( 1 + 2*corr_w_x_2(i,k)**2 ) * varnce_x_2(i,k) ) * varnce_w_2(i,k) )
2108 : end do
2109 : end do
2110 : !$acc end parallel loop
2111 :
2112 1411776 : return
2113 :
2114 : end subroutine calc_wp2xp2_pdf
2115 :
2116 : !=============================================================================
2117 1411776 : subroutine calc_wp2xp_pdf( nz, ngrdcol, &
2118 1411776 : wm, xm, w_1, w_2, &
2119 1411776 : x_1, x_2, &
2120 1411776 : varnce_w_1, varnce_w_2, &
2121 1411776 : varnce_x_1, varnce_x_2, &
2122 1411776 : corr_w_x_1, corr_w_x_2, &
2123 1411776 : mixt_frac, &
2124 1411776 : wp2xp )
2125 :
2126 : ! Description:
2127 : ! Calculates <w'^2 x'> by integrating over the PDF of w and x. The integral
2128 : ! is:
2129 : !
2130 : ! <w'^2 x'>
2131 : ! = INT(-inf:inf) INT(-inf:inf) ( w - <w> )^2 ( x - <x> ) P(w,x) dx dw;
2132 : !
2133 : ! where <w> is the overall mean of w, <x> is the overall mean of x, and
2134 : ! P(w,x) is a two-component bivariate normal distribution of w and x. The
2135 : ! integrated equation is:
2136 : !
2137 : ! <w'^2 x'>
2138 : ! = mixt_frac * ( ( mu_x_1 - <x> ) * ( ( mu_w_1 - <w> )^2 + sigma_w_1^2 )
2139 : ! + 2 * corr_w_x_1 * sigma_w_1 * sigma_x_1
2140 : ! * ( mu_w_1 - <w> ) )
2141 : ! + ( 1 - mixt_frac ) * ( ( mu_x_2 - <x> )
2142 : ! * ( ( mu_w_2 - <w> )^2 + sigma_w_2^2 )
2143 : ! + 2 * corr_w_x_2 * sigma_w_2 * sigma_x_2
2144 : ! * ( mu_w_2 - <w> ) );
2145 : !
2146 : ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
2147 : ! of w in the 2nd PDF component, mu_x_1 is the mean of x in the 1st PDF
2148 : ! component, mu_x_2 is the mean of x in the 2nd PDF component, sigma_w_1 is
2149 : ! the standard deviation of w in the 1st PDF component, sigma_w_2 is the
2150 : ! standard deviation of w in the 2nd PDF component, sigma_x_1 is the
2151 : ! standard deviation of x in the 1st PDF component, sigma_x_2 is the
2152 : ! standard deviation of x in the 2nd PDF component, corr_w_x_1 is the
2153 : ! correlation of w and x in the 1st PDF component, corr_w_x_2 is the
2154 : ! correlation of w and x in the 2nd PDF component, and mixt_frac is the
2155 : ! mixture fraction, which is the weight of the 1st PDF component.
2156 :
2157 : ! References:
2158 : !-----------------------------------------------------------------------
2159 :
2160 : use constants_clubb, only: &
2161 : two, & ! Variable(s)
2162 : one
2163 :
2164 : use clubb_precision, only: &
2165 : core_rknd ! Variable(s)
2166 :
2167 : implicit none
2168 :
2169 : integer, intent(in) :: &
2170 : ngrdcol, & ! Number of grid columns
2171 : nz ! Number of vertical level
2172 :
2173 : ! Input Variables
2174 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
2175 : wm, & ! Mean of w (overall) [m/s]
2176 : xm, & ! Mean of x (overall) [units vary]
2177 : w_1, & ! Mean of w (1st PDF component) [m/s]
2178 : w_2, & ! Mean of w (2nd PDF component) [m/s]
2179 : x_1, & ! Mean of x (1st PDF component) [units vary]
2180 : x_2, & ! Mean of x (2nd PDF component) [units vary]
2181 : varnce_w_1, & ! Variance of w (1st PDF component) [m^2/s^2]
2182 : varnce_w_2, & ! Variance of w (2nd PDF component) [m^2/s^2]
2183 : varnce_x_1, & ! Variance of x (1st PDF component) [(units vary)^2]
2184 : varnce_x_2, & ! Variance of x (2nd PDF component) [(units vary)^2]
2185 : corr_w_x_1, & ! Correlation of w and x (1st PDF comp.) [-]
2186 : corr_w_x_2, & ! Correlation of w and x (2nd PDF comp.) [-]
2187 : mixt_frac ! Mixture fraction [-]
2188 :
2189 : ! Output Variable
2190 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
2191 : wp2xp ! <w'^2 x'> [m^2/s^2 (units vary)]
2192 :
2193 : ! Local Variables
2194 : integer :: i, k
2195 :
2196 :
2197 : ! Calculate <w'^2 x'> by integrating over the PDF.
2198 : !$acc parallel loop gang vector collapse(2) default(present)
2199 121412736 : do k = 1, nz
2200 2005148736 : do i = 1, ngrdcol
2201 :
2202 3767472000 : wp2xp(i,k) = mixt_frac(i,k) &
2203 : * ( ( ( w_1(i,k) - wm(i,k) )**2 + varnce_w_1(i,k) ) * ( x_1(i,k) - xm(i,k) ) &
2204 : + two * corr_w_x_1(i,k) * sqrt( varnce_w_1(i,k) * varnce_x_1(i,k) ) &
2205 : * ( w_1(i,k) - wm(i,k) ) ) &
2206 : + ( one - mixt_frac(i,k) ) &
2207 : * ( ( ( w_2(i,k) - wm(i,k) )**2 + varnce_w_2(i,k) ) * ( x_2(i,k) - xm(i,k) ) &
2208 : + two * corr_w_x_2(i,k) * sqrt( varnce_w_2(i,k) * varnce_x_2(i,k) ) &
2209 5771208960 : * ( w_2(i,k) - wm(i,k) ) )
2210 : end do
2211 : end do
2212 : !$acc end parallel loop
2213 :
2214 1411776 : return
2215 :
2216 : end subroutine calc_wp2xp_pdf
2217 :
2218 : !=============================================================================
2219 1411776 : subroutine calc_wpxp2_pdf( nz, ngrdcol, &
2220 1411776 : wm, xm, w_1, &
2221 1411776 : w_2, x_1, x_2, &
2222 1411776 : varnce_w_1, varnce_w_2, &
2223 1411776 : varnce_x_1, varnce_x_2, &
2224 1411776 : corr_w_x_1, corr_w_x_2, &
2225 1411776 : mixt_frac, &
2226 1411776 : wpxp2 )
2227 :
2228 : ! Description:
2229 : ! Calculates <w'x'^2> by integrating over the PDF of w and x. The integral
2230 : ! is:
2231 : !
2232 : ! <w'x'^2>
2233 : ! = INT(-inf:inf) INT(-inf:inf) ( w - <w> ) ( x - <x> )^2 P(w,x) dx dw;
2234 : !
2235 : ! where <w> is the overall mean of w, <x> is the overall mean of x, and
2236 : ! P(w,x) is a two-component bivariate normal distribution of w and x. The
2237 : ! integrated equation is:
2238 : !
2239 : ! <w'x'^2>
2240 : ! = mixt_frac * ( ( mu_w_1 - <w> ) * ( ( mu_x_1 - <x> )^2 + sigma_x_1^2 )
2241 : ! + 2 * corr_w_x_1 * sigma_w_1 * sigma_x_1
2242 : ! * ( mu_x_1 - <x> ) )
2243 : ! + ( 1 - mixt_frac ) * ( ( mu_w_2 - <w> )
2244 : ! * ( ( mu_x_2 - <x> )^2 + sigma_x_2^2 )
2245 : ! + 2 * corr_w_x_2 * sigma_w_2 * sigma_x_2
2246 : ! * ( mu_x_2 - <x> ) );
2247 : !
2248 : ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
2249 : ! of w in the 2nd PDF component, mu_x_1 is the mean of x in the 1st PDF
2250 : ! component, mu_x_2 is the mean of x in the 2nd PDF component, sigma_w_1 is
2251 : ! the standard deviation of w in the 1st PDF component, sigma_w_2 is the
2252 : ! standard deviation of w in the 2nd PDF component, sigma_x_1 is the
2253 : ! standard deviation of x in the 1st PDF component, sigma_x_2 is the
2254 : ! standard deviation of x in the 2nd PDF component, corr_w_x_1 is the
2255 : ! correlation of w and x in the 1st PDF component, corr_w_x_2 is the
2256 : ! correlation of w and x in the 2nd PDF component, and mixt_frac is the
2257 : ! mixture fraction, which is the weight of the 1st PDF component.
2258 :
2259 : ! References:
2260 : !-----------------------------------------------------------------------
2261 :
2262 : use constants_clubb, only: &
2263 : two, & ! Variable(s)
2264 : one
2265 :
2266 : use clubb_precision, only: &
2267 : core_rknd ! Variable(s)
2268 :
2269 : implicit none
2270 :
2271 : integer, intent(in) :: &
2272 : ngrdcol, & ! Number of grid columns
2273 : nz ! Number of vertical level
2274 :
2275 : ! Input Variables
2276 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
2277 : wm, & ! Mean of w (overall) [m/s]
2278 : xm, & ! Mean of x (overall) [units vary]
2279 : w_1, & ! Mean of w (1st PDF component) [m/s]
2280 : w_2, & ! Mean of w (2nd PDF component) [m/s]
2281 : x_1, & ! Mean of x (1st PDF component) [units vary]
2282 : x_2, & ! Mean of x (2nd PDF component) [units vary]
2283 : varnce_w_1, & ! Variance of w (1st PDF component) [m^2/s^2]
2284 : varnce_w_2, & ! Variance of w (2nd PDF component) [m^2/s^2]
2285 : varnce_x_1, & ! Variance of x (1st PDF component) [(units vary)^2]
2286 : varnce_x_2, & ! Variance of x (2nd PDF component) [(units vary)^2]
2287 : corr_w_x_1, & ! Correlation of w and x (1st PDF comp.) [-]
2288 : corr_w_x_2, & ! Correlation of w and x (2nd PDF comp.) [-]
2289 : mixt_frac ! Mixture fraction [-]
2290 :
2291 : ! Return Variable
2292 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
2293 : wpxp2 ! <w'x'^2> [m/s (units vary)^2]
2294 :
2295 : ! Local Variables
2296 : integer :: i, k
2297 :
2298 : !$acc parallel loop gang vector collapse(2) default(present)
2299 121412736 : do k = 1, nz
2300 2005148736 : do i = 1, ngrdcol
2301 :
2302 : ! Calculate <w'x'^2> by integrating over the PDF.
2303 3767472000 : wpxp2(i,k) = mixt_frac(i,k) &
2304 : * ( ( w_1(i,k) - wm(i,k) ) * ( ( x_1(i,k) - xm(i,k) )**2 + varnce_x_1(i,k) ) &
2305 : + two * corr_w_x_1(i,k) * sqrt( varnce_w_1(i,k) * varnce_x_1(i,k) ) &
2306 : * ( x_1(i,k) - xm(i,k) ) ) &
2307 : + ( one - mixt_frac(i,k) ) &
2308 : * ( ( w_2(i,k) - wm(i,k) ) * ( ( x_2(i,k) - xm(i,k) )**2 + varnce_x_2(i,k) ) &
2309 : + two * corr_w_x_2(i,k) * sqrt( varnce_w_2(i,k) * varnce_x_2(i,k) ) &
2310 5771208960 : * ( x_2(i,k) - xm(i,k) ) )
2311 : end do
2312 : end do
2313 : !$acc end parallel loop
2314 :
2315 1411776 : return
2316 :
2317 : end subroutine calc_wpxp2_pdf
2318 :
2319 : !=============================================================================
2320 0 : subroutine calc_wpxpyp_pdf( nz, ngrdcol, &
2321 0 : wm, xm, ym, w_1, w_2, &
2322 0 : x_1, x_2, &
2323 0 : y_1, y_2, &
2324 0 : varnce_w_1, varnce_w_2, &
2325 0 : varnce_x_1, varnce_x_2, &
2326 0 : varnce_y_1, varnce_y_2, &
2327 0 : corr_w_x_1, corr_w_x_2, &
2328 0 : corr_w_y_1, corr_w_y_2, &
2329 0 : corr_x_y_1, corr_x_y_2, &
2330 0 : mixt_frac, &
2331 0 : wpxpyp )
2332 :
2333 : ! Description:
2334 : ! Calculates <w'x'y'> by integrating over the PDF of w, x, and y. The
2335 : ! integral is:
2336 : !
2337 : ! <w'x'y'>
2338 : ! = INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
2339 : ! ( w - <w> ) ( x - <x> ) ( y - <y> ) P(w,x,y) dy dx dw;
2340 : !
2341 : ! where <w> is the overall mean of w, <x> is the overall mean of x, <y> is
2342 : ! the overall mean of y, and P(w,x,y) is a two-component trivariate normal
2343 : ! distribution of w, x, and y. The integrated equation is:
2344 : !
2345 : ! <w'x'y'>
2346 : ! = mixt_frac
2347 : ! * ( ( mu_w_1 - <w> ) * ( mu_x_1 - <x> ) * ( mu_y_1 - <y> )
2348 : ! + corr_x_y_1 * sigma_x_1 * sigma_y_1 * ( mu_w_1 - <w> )
2349 : ! + corr_w_y_1 * sigma_w_1 * sigma_y_1 * ( mu_x_1 - <x> )
2350 : ! + corr_w_x_1 * sigma_w_1 * sigma_x_1 * ( mu_y_1 - <y> ) )
2351 : ! + ( 1 - mixt_frac )
2352 : ! * ( ( mu_w_2 - <w> ) * ( mu_x_2 - <x> ) * ( mu_y_2 - <y> )
2353 : ! + corr_x_y_2 * sigma_x_2 * sigma_y_2 * ( mu_w_2 - <w> )
2354 : ! + corr_w_y_2 * sigma_w_2 * sigma_y_2 * ( mu_x_2 - <x> )
2355 : ! + corr_w_x_2 * sigma_w_2 * sigma_x_2 * ( mu_y_2 - <y> ) );
2356 : !
2357 : ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
2358 : ! of w in the 2nd PDF component, mu_x_1 is the mean of x in the 1st PDF
2359 : ! component, mu_x_2 is the mean of x in the 2nd PDF component, mu_y_1 is the
2360 : ! mean of y in the 1st PDF component, mu_y_2 is the mean of y in the 2nd PDF
2361 : ! component, sigma_w_1 is the standard deviation of w in the 1st PDF
2362 : ! component, sigma_w_2 is the standard deviation of w in the 2nd PDF
2363 : ! component, sigma_x_1 is the standard deviation of x in the 1st PDF
2364 : ! component, sigma_x_2 is the standard deviation of x in the 2nd PDF
2365 : ! component, sigma_y_1 is the standard deviation of y in the 1st PDF
2366 : ! component, sigma_y_2 is the standard deviation of y in the 2nd PDF
2367 : ! component, corr_w_x_1 is the correlation of w and x in the 1st PDF
2368 : ! component, corr_w_x_2 is the correlation of w and x in the 2nd PDF
2369 : ! component, corr_w_y_1 is the correlation of w and y in the 1st PDF
2370 : ! component, corr_w_y_2 is the correlation of w and y in the 2nd PDF
2371 : ! component, corr_x_y_1 is the correlation of x and y in the 1st PDF
2372 : ! component, corr_x_y_2 is the correlation of x and y in the 2nd PDF
2373 : ! component, and mixt_frac is the mixture fraction, which is the weight of
2374 : ! the 1st PDF component.
2375 :
2376 : ! References:
2377 : !-----------------------------------------------------------------------
2378 :
2379 : use grid_class, only: &
2380 : grid ! Type
2381 :
2382 : use constants_clubb, only: &
2383 : one ! Variable(s)
2384 :
2385 : use clubb_precision, only: &
2386 : core_rknd ! Variable(s)
2387 :
2388 : implicit none
2389 :
2390 : integer, intent(in) :: &
2391 : ngrdcol, & ! Number of grid columns
2392 : nz ! Number of vertical level
2393 :
2394 : ! Input Variables
2395 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
2396 : wm, & ! Mean of w (overall) [m/s]
2397 : xm, & ! Mean of x (overall) [x units]
2398 : ym, & ! Mean of y (overall) [y units]
2399 : w_1, & ! Mean of w (1st PDF component) [m/s]
2400 : w_2, & ! Mean of w (2nd PDF component) [m/s]
2401 : x_1, & ! Mean of x (1st PDF component) [x units]
2402 : x_2, & ! Mean of x (2nd PDF component) [x units]
2403 : y_1, & ! Mean of y (1st PDF component) [y units]
2404 : y_2, & ! Mean of y (2nd PDF component) [y units]
2405 : varnce_w_1, & ! Variance of w (1st PDF component) [m^2/s^2]
2406 : varnce_w_2, & ! Variance of w (2nd PDF component) [m^2/s^2]
2407 : varnce_x_1, & ! Variance of x (1st PDF component) [(x units)^2]
2408 : varnce_x_2, & ! Variance of x (2nd PDF component) [(x units)^2]
2409 : varnce_y_1, & ! Variance of y (1st PDF component) [(y units)^2]
2410 : varnce_y_2, & ! Variance of y (2nd PDF component) [(y units)^2]
2411 : corr_w_x_1, & ! Correlation of w and x (1st PDF component) [-]
2412 : corr_w_x_2, & ! Correlation of w and x (2nd PDF component) [-]
2413 : corr_w_y_1, & ! Correlation of w and y (1st PDF component) [-]
2414 : corr_w_y_2, & ! Correlation of w and y (2nd PDF component) [-]
2415 : corr_x_y_1, & ! Correlation of x and y (1st PDF component) [-]
2416 : corr_x_y_2, & ! Correlation of x and y (2nd PDF component) [-]
2417 : mixt_frac ! Mixture fraction [-]
2418 :
2419 : ! Output Variable
2420 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
2421 : wpxpyp ! <w'x'y'> [m/s (units vary)]
2422 :
2423 : ! Local Variables
2424 : integer :: i, k
2425 :
2426 :
2427 : ! Calculate <w'x'y'> by integrating over the PDF.
2428 : !$acc parallel loop gang vector collapse(2) default(present)
2429 0 : do k = 1, nz
2430 0 : do i = 1, ngrdcol
2431 0 : wpxpyp(i,k) &
2432 : = mixt_frac(i,k) &
2433 : * ( ( w_1(i,k) - wm(i,k) ) * ( x_1(i,k) - xm(i,k) ) * ( y_1(i,k) - ym(i,k) ) &
2434 : + corr_x_y_1(i,k)*sqrt( varnce_x_1(i,k)*varnce_y_1(i,k) )*( w_1(i,k)-wm(i,k) ) &
2435 : + corr_w_y_1(i,k)*sqrt( varnce_w_1(i,k)*varnce_y_1(i,k) )*( x_1(i,k)-xm(i,k) ) &
2436 : + corr_w_x_1(i,k)*sqrt( varnce_w_1(i,k)*varnce_x_1(i,k) )*( y_1(i,k)-ym(i,k) ) ) &
2437 : + ( one - mixt_frac(i,k) ) &
2438 : * ( ( w_2(i,k) - wm(i,k) )*( x_2(i,k) - xm(i,k) ) * ( y_2(i,k) - ym(i,k) ) &
2439 : + corr_x_y_2(i,k)*sqrt( varnce_x_2(i,k)*varnce_y_2(i,k) )*( w_2(i,k)-wm(i,k) ) &
2440 : + corr_w_y_2(i,k)*sqrt( varnce_w_2(i,k)*varnce_y_2(i,k) )*( x_2(i,k)-xm(i,k) ) &
2441 0 : + corr_w_x_2(i,k)*sqrt( varnce_w_2(i,k)*varnce_x_2(i,k) )*( y_2(i,k)-ym(i,k) ) )
2442 : end do
2443 : end do
2444 : !$acc end parallel loop
2445 :
2446 0 : return
2447 :
2448 : end subroutine calc_wpxpyp_pdf
2449 :
2450 : !=============================================================================
2451 1411776 : subroutine calc_liquid_cloud_frac_component( nz, ngrdcol, &
2452 1411776 : mean_chi, stdev_chi, &
2453 1411776 : cloud_frac, rc )
2454 : ! Description:
2455 : ! Calculates the PDF component cloud water mixing ratio, rc_i, and cloud
2456 : ! fraction, cloud_frac_i, for the ith PDF component.
2457 : !
2458 : ! The equation for cloud water mixing ratio, rc, at any point is:
2459 : !
2460 : ! rc = chi * H(chi);
2461 : !
2462 : ! and the equation for cloud fraction at a point, fc, is:
2463 : !
2464 : ! fc = H(chi);
2465 : !
2466 : ! where where extended liquid water mixing ratio, chi, is equal to cloud
2467 : ! water mixing ratio, rc, when positive. When the atmosphere is saturated
2468 : ! at this point, cloud water is found, and rc = chi, while fc = 1.
2469 : ! Otherwise, clear air is found at this point, and rc = fc = 0.
2470 : !
2471 : ! The mean of rc and fc is calculated by integrating over the PDF, such
2472 : ! that:
2473 : !
2474 : ! <rc> = INT(-inf:inf) chi * H(chi) * P(chi) dchi; and
2475 : !
2476 : ! cloud_frac = <fc> = INT(-inf:inf) H(chi) * P(chi) dchi.
2477 : !
2478 : ! This can be rewritten as:
2479 : !
2480 : ! <rc> = INT(0:inf) chi * P(chi) dchi; and
2481 : !
2482 : ! cloud_frac = <fc> = INT(0:inf) P(chi) dchi;
2483 : !
2484 : ! and further rewritten as:
2485 : !
2486 : ! <rc> = SUM(i=1,N) mixt_frac_i INT(0:inf) chi * P_i(chi) dchi; and
2487 : !
2488 : ! cloud_frac = SUM(i=1,N) mixt_frac_i INT(0:inf) P_i(chi) dchi;
2489 : !
2490 : ! where N is the number of PDF components. The equation for mean rc in the
2491 : ! ith PDF component is:
2492 : !
2493 : ! rc_i = INT(0:inf) chi * P_i(chi) dchi;
2494 : !
2495 : ! and the equation for cloud fraction in the ith PDF component is:
2496 : !
2497 : ! cloud_frac_i = INT(0:inf) P_i(chi) dchi.
2498 : !
2499 : ! The component values are related to the overall values by:
2500 : !
2501 : ! <rc> = SUM(i=1,N) mixt_frac_i * rc_i; and
2502 : !
2503 : ! cloud_frac = SUM(i=1,N) mixt_frac_i * cloud_frac_i.
2504 :
2505 : ! References:
2506 : !----------------------------------------------------------------------
2507 :
2508 : use constants_clubb, only: &
2509 : chi_tol, & ! Tolerance for pdf parameter chi [kg/kg]
2510 : sqrt_2pi, & ! sqrt(2*pi)
2511 : sqrt_2, & ! sqrt(2)
2512 : one, & ! 1
2513 : one_half, & ! 1/2
2514 : zero, & ! 0
2515 : max_num_stdevs, &
2516 : eps
2517 :
2518 : use clubb_precision, only: &
2519 : core_rknd ! Precision
2520 :
2521 : implicit none
2522 :
2523 : integer, intent(in) :: &
2524 : ngrdcol, & ! Number of grid columns
2525 : nz ! Number of vertical level
2526 :
2527 : !----------- Input Variables -----------
2528 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
2529 : mean_chi, & ! Mean of chi (old s) (ith PDF component) [kg/kg]
2530 : stdev_chi ! Standard deviation of chi (ith PDF component) [kg/kg]
2531 :
2532 : !----------- Output Variables -----------
2533 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
2534 : cloud_frac, & ! Cloud fraction (ith PDF component) [-]
2535 : rc ! Mean cloud water mixing ratio (ith PDF comp.) [kg/kg]
2536 :
2537 : !----------- Local Variables -----------
2538 : real( kind = core_rknd), parameter :: &
2539 : invrs_sqrt_2 = one / sqrt_2, &
2540 : invrs_sqrt_2pi = one / sqrt_2pi
2541 :
2542 : real( kind = core_rknd ) :: &
2543 : zeta
2544 :
2545 : integer :: k, i ! Vertical loop index
2546 :
2547 : !----------- Begin Code -----------
2548 : !$acc parallel loop gang vector collapse(2) default(present)
2549 121412736 : do k = 1, nz
2550 2005148736 : do i = 1, ngrdcol
2551 :
2552 3767472000 : if ( ( abs( mean_chi(i,k) ) <= eps .and. stdev_chi(i,k) <= chi_tol ) &
2553 5771208960 : .or. ( mean_chi(i,k) < - max_num_stdevs * stdev_chi(i,k) ) ) then
2554 :
2555 : ! The mean of chi is at saturation and does not vary in the ith PDF component
2556 1774142983 : cloud_frac(i,k) = zero
2557 1774142983 : rc(i,k) = zero
2558 :
2559 109593017 : elseif ( mean_chi(i,k) > max_num_stdevs * stdev_chi(i,k) ) then
2560 :
2561 : ! The mean of chi is multiple standard deviations above the saturation point.
2562 : ! Thus, all cloud in the ith PDF component.
2563 18458032 : cloud_frac(i,k) = one
2564 18458032 : rc(i,k) = mean_chi(i,k)
2565 :
2566 : else
2567 :
2568 : ! The mean of chi is within max_num_stdevs of the saturation point.
2569 : ! Thus, layer is partly cloudy, requires calculation.
2570 :
2571 91134985 : zeta = mean_chi(i,k) / stdev_chi(i,k)
2572 :
2573 91134985 : cloud_frac(i,k) = one_half * ( one + erf( zeta * invrs_sqrt_2 ) )
2574 :
2575 : rc(i,k) = mean_chi(i,k) * cloud_frac(i,k) &
2576 91134985 : + stdev_chi(i,k) * exp( - one_half * zeta**2 ) * invrs_sqrt_2pi
2577 :
2578 : end if
2579 :
2580 : end do
2581 : end do
2582 : !$acc end parallel loop
2583 :
2584 1411776 : return
2585 :
2586 : end subroutine calc_liquid_cloud_frac_component
2587 :
2588 : !=============================================================================
2589 1411776 : subroutine calc_ice_cloud_frac_component( nz, ngrdcol, &
2590 1411776 : mean_chi, stdev_chi, &
2591 1411776 : rc_in, cloud_frac, &
2592 1411776 : p_in_Pa, tl, &
2593 1411776 : rsatl, crt, &
2594 1411776 : ice_supersat_frac, rc )
2595 : ! Description:
2596 : ! A version of the cloud fraction calculation modified to work
2597 : ! for layers that are potentially below freezing. If there are
2598 : ! no below freezing levels, the ice_supersat_frac calculation is
2599 : ! the same as cloud_frac.
2600 : !
2601 : ! For the below freezing levels, the saturation point will be
2602 : ! non-zero, thus we need to calculate chi_at_ice_sat.
2603 : !
2604 : ! The description of the equations are located in the description
2605 : ! of calc_liquid_cloud_frac_component.
2606 : !----------------------------------------------------------------------
2607 :
2608 : use constants_clubb, only: &
2609 : chi_tol, & ! Tolerance for pdf parameter chi [kg/kg]
2610 : T_freeze_K, & ! Freezing point of water [K]
2611 : sqrt_2pi, & ! sqrt(2*pi)
2612 : sqrt_2, & ! sqrt(2)
2613 : one, & ! 1
2614 : one_half, & ! 1/2
2615 : zero, & ! 0
2616 : max_num_stdevs, &
2617 : eps
2618 :
2619 : use clubb_precision, only: &
2620 : core_rknd ! Precision
2621 :
2622 : use saturation, only: &
2623 : sat_mixrat_ice
2624 :
2625 : implicit none
2626 :
2627 : ! ---------------------- Input Variables ----------------------
2628 : integer, intent(in) :: &
2629 : ngrdcol, & ! Number of grid columns
2630 : nz ! Number of vertical level
2631 :
2632 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
2633 : mean_chi, & ! Mean of chi (old s) (ith PDF component) [kg/kg]
2634 : stdev_chi, & ! Standard deviation of chi (ith PDF component) [kg/kg]
2635 : rc_in, & ! Mean cloud water mixing ratio (ith PDF comp.) [kg/kg]
2636 : cloud_frac, & ! Cloud fraction [-]
2637 : p_in_Pa, & ! Pressure [Pa]
2638 : rsatl, & ! Saturation mixing ratio of liquid [kg/kg]
2639 : crt, & ! r_t coef. in chi/eta eqns. [-]
2640 : tl ! Quantities needed to predict higher order moments
2641 : ! tl = thl*exner
2642 :
2643 : ! ---------------------- Output Variables ----------------------
2644 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
2645 : ice_supersat_frac, & ! Ice supersaturation fraction [-]
2646 : rc ! Mean cloud ice mixing ratio (ith PDF comp.) [kg/kg]
2647 :
2648 : ! ---------------------- Local Variables----------------------
2649 : real( kind = core_rknd), parameter :: &
2650 : invrs_sqrt_2 = one / sqrt_2, &
2651 : invrs_sqrt_2pi = one / sqrt_2pi
2652 :
2653 : real( kind = core_rknd ) :: &
2654 : zeta, &
2655 : chi_at_ice_sat
2656 :
2657 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
2658 2823552 : rsat_ice
2659 :
2660 : integer :: k, i ! Loop indices
2661 :
2662 : logical :: &
2663 : l_any_below_freezing
2664 :
2665 : ! ---------------------- Begin Code ----------------------
2666 :
2667 1411776 : l_any_below_freezing = .false.
2668 :
2669 : ! If a grid boxes is above freezing, then the calculation is the
2670 : ! same as the cloud_frac calculation
2671 : !$acc parallel loop gang vector collapse(2) default(present) &
2672 : !$acc reduction(.or.:l_any_below_freezing)
2673 121412736 : do k = 1, nz
2674 2005148736 : do i = 1, ngrdcol
2675 2003736960 : if ( tl(i,k) > T_freeze_K ) then
2676 370783364 : ice_supersat_frac(i,k) = cloud_frac(i,k)
2677 370783364 : rc(i,k) = rc_in(i,k)
2678 : else
2679 : l_any_below_freezing = .true.
2680 : end if
2681 : end do
2682 : end do
2683 : !$acc end parallel loop
2684 :
2685 : ! If all grid boxes are above freezing, then the calculation is the
2686 : ! same as the cloud_frac calculation
2687 1411776 : if ( .not. l_any_below_freezing ) then
2688 : return
2689 : end if
2690 :
2691 : !$acc data create( rsat_ice )
2692 :
2693 : ! Calculate the saturation mixing ratio of ice
2694 1411776 : rsat_ice = sat_mixrat_ice( nz, ngrdcol, p_in_Pa, tl )
2695 :
2696 : !$acc parallel loop gang vector collapse(2) default(present)
2697 121412736 : do k = 1, nz
2698 2005148736 : do i = 1, ngrdcol
2699 :
2700 2003736960 : if ( tl(i,k) <= T_freeze_K ) then
2701 :
2702 : ! Temperature is freezing, we must compute chi_at_ice_sat and
2703 : ! calculate the new cloud_frac_component
2704 1512952636 : chi_at_ice_sat = crt(i,k) * ( rsat_ice(i,k) - rsatl(i,k) )
2705 :
2706 : if ( ( abs( mean_chi(i,k)-chi_at_ice_sat ) <= eps .and. stdev_chi(i,k) <= chi_tol ) &
2707 1512952636 : .or. ( mean_chi(i,k)-chi_at_ice_sat < - max_num_stdevs * stdev_chi(i,k) ) ) then
2708 :
2709 : ! The mean of chi is at saturation and does not vary in the ith PDF component
2710 1382228998 : ice_supersat_frac(i,k) = zero
2711 1382228998 : rc(i,k) = zero
2712 :
2713 130723638 : elseif ( mean_chi(i,k)-chi_at_ice_sat > max_num_stdevs * stdev_chi(i,k) ) then
2714 :
2715 : ! The mean of chi is multiple standard deviations above the saturation point.
2716 : ! Thus, all cloud in the ith PDF component.
2717 84429422 : ice_supersat_frac(i,k) = one
2718 84429422 : rc(i,k) = mean_chi(i,k)-chi_at_ice_sat
2719 :
2720 : else
2721 :
2722 : ! The mean of chi is within max_num_stdevs of the saturation point.
2723 : ! Thus, layer is partly cloudy, requires calculation.
2724 :
2725 46294216 : zeta = (mean_chi(i,k)-chi_at_ice_sat) / stdev_chi(i,k)
2726 :
2727 46294216 : ice_supersat_frac(i,k) = one_half * ( one + erf( zeta * invrs_sqrt_2 ) )
2728 :
2729 : rc(i,k) = (mean_chi(i,k)-chi_at_ice_sat) * ice_supersat_frac(i,k) &
2730 46294216 : + stdev_chi(i,k) * exp( - one_half * zeta**2 ) * invrs_sqrt_2pi
2731 :
2732 : end if
2733 :
2734 : end if
2735 :
2736 : end do
2737 : end do
2738 : !$acc end parallel loop
2739 :
2740 : !$acc end data
2741 :
2742 : return
2743 :
2744 : end subroutine calc_ice_cloud_frac_component
2745 :
2746 : !=============================================================================
2747 1411776 : subroutine calc_xprcp_component( nz, ngrdcol, & ! In
2748 1411776 : wm, rtm, thlm, um, vm, rcm, & ! In
2749 1411776 : w_i, rt_i, & ! In
2750 1411776 : thl_i, u_i, v_i, & ! In
2751 1411776 : varnce_w_i, chi_i, & ! In
2752 1411776 : stdev_chi_i, stdev_eta_i, & ! In
2753 1411776 : corr_w_chi_i, corr_chi_eta_i, & ! In
2754 : ! corr_u_w_i, corr_v_w_i, & ! In
2755 1411776 : crt_i, cthl_i, & ! In
2756 1411776 : rc_i, cloud_frac_i, iiPDF_type, & ! In
2757 1411776 : wprcp_contrib_comp_i, wp2rcp_contrib_comp_i, & ! Out
2758 1411776 : rtprcp_contrib_comp_i, thlprcp_contrib_comp_i, & ! Out
2759 1411776 : uprcp_contrib_comp_i, vprcp_contrib_comp_i ) ! Out
2760 :
2761 : ! Description:
2762 : ! Calculates the contribution to <w'rc'>, <w'^2 rc'>, <rt'rc'>, and
2763 : ! <thl'rc'> from the ith PDF component.
2764 : !
2765 : !
2766 : ! <w'rc'>
2767 : ! -------
2768 : !
2769 : ! The value of <w'rc'> is calculated by integrating over the PDF:
2770 : !
2771 : ! <w'rc'>
2772 : ! = INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
2773 : ! ( w - <w> ) ( rc - <rc> ) P(w,rt,thl) dthl drt dw;
2774 : !
2775 : ! where <w> is the overall mean of w, <rc> is the overall mean of rc, and
2776 : ! P(w,rt,thl) is a two-component trivariate normal distribution of w, rt,
2777 : ! and thl. This equation is rewritten as:
2778 : !
2779 : ! <w'rc'>
2780 : ! = mixt_frac
2781 : ! * INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
2782 : ! ( w - <w> ) ( rc - <rc> ) P_1(w,rt,thl) dthl drt dw
2783 : ! + ( 1 - mixt_frac )
2784 : ! * INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
2785 : ! ( w - <w> ) ( rc - <rc> ) P_2(w,rt,thl) dthl drt dw;
2786 : !
2787 : ! where mixt_frac is the mixture fraction, which is the weight of the 1st
2788 : ! PDF component, and where P_1(w,rt,thl) and P_2(w,rt,thl) are the equations
2789 : ! for the trivariate normal PDF of w, rt, and thl in the 1st and 2nd PDF
2790 : ! components, respectively. The contribution from the ith PDF component is:
2791 : !
2792 : ! INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
2793 : ! ( w - <w> ) ( rc - <rc> ) P_i(w,rt,thl) dthl drt dw;
2794 : !
2795 : ! where P_i(w,rt,thl) is the trivariate normal PDF of w, rt, and thl in the
2796 : ! ith PDF component. The PDF undergoes a PDF transformation in each PDF
2797 : ! component, which is a change of variables and a translation, stretching,
2798 : ! and rotation of the axes. The PDF becomes a trivariate normal PDF that is
2799 : ! written in terms of w, chi, and eta coordinates. Cloud water mixing
2800 : ! ratio, rc, is written in terms of extended liquid water mixing ratio, chi,
2801 : ! such that:
2802 : !
2803 : ! rc = chi H(chi);
2804 : !
2805 : ! where H(chi) is the Heaviside step function. The contribution from the
2806 : ! ith PDF component to <w'rc'> can be written as:
2807 : !
2808 : ! INT(-inf:inf) INT(-inf:inf)
2809 : ! ( w - <w> ) ( chi H(chi) - <rc> ) P_i(w,chi) dchi dw;
2810 : !
2811 : ! where P_i(w,chi) is the bivariate normal PDF of w and chi in the ith PDF
2812 : ! component. The solved equation for the <w'rc'> contribution from the ith
2813 : ! PDF component (wprcp_contrib_comp_i) is:
2814 : !
2815 : ! wprcp_contrib_comp_i
2816 : ! = INT(-inf:inf) INT(-inf:inf)
2817 : ! ( w - <w> ) ( chi H(chi) - <rc> ) P_i(w,chi) dchi dw
2818 : ! = ( mu_w_i - <w> )
2819 : ! * ( mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
2820 : ! + 1/sqrt(2*pi) * sigma_chi_i
2821 : ! * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) } - <rc> )
2822 : ! + corr_w_chi_i * sigma_w_i * sigma_chi_i
2823 : ! * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) );
2824 : !
2825 : ! where mu_w_i is the mean of w in the ith PDF component, mu_chi_i is the
2826 : ! mean of chi in the ith PDF component, sigma_w_i is the standard deviation
2827 : ! of w in the ith PDF component, sigma_chi_i is the standard deviation of
2828 : ! chi in the ith PDF component, and corr_w_chi_i is the correlation of w and
2829 : ! chi in the ith PDF component.
2830 : !
2831 : ! Special case: sigma_chi_i = 0.
2832 : !
2833 : ! In the special case that sigma_chi_i = 0, chi, as well as rc, are constant
2834 : ! in the ith PDF component. The equation becomes:
2835 : !
2836 : ! wprcp_contrib_comp_i
2837 : ! = | ( mu_w_i - <w> ) * ( mu_chi_i - <rc> ); when mu_chi_i > 0;
2838 : ! | ( mu_w_i - <w> ) * ( -<rc> ); when mu_chi_i <= 0.
2839 : !
2840 : !
2841 : ! <w'^2 rc'>
2842 : ! ----------
2843 : !
2844 : ! The value of <w'^2 rc'> is calculated by integrating over the PDF:
2845 : !
2846 : ! <w'^2 rc'>
2847 : ! = INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
2848 : ! ( w - <w> )^2 ( rc - <rc> ) P(w,rt,thl) dthl drt dw.
2849 : !
2850 : ! This equation is rewritten as:
2851 : !
2852 : ! <w'^2 rc'>
2853 : ! = mixt_frac
2854 : ! * INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
2855 : ! ( w - <w> )^2 ( rc - <rc> ) P_1(w,rt,thl) dthl drt dw
2856 : ! + ( 1 - mixt_frac )
2857 : ! * INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
2858 : ! ( w - <w> )^2 ( rc - <rc> ) P_2(w,rt,thl) dthl drt dw.
2859 : !
2860 : ! The contribution from the ith PDF component is:
2861 : !
2862 : ! INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
2863 : ! ( w - <w> )^2 ( rc - <rc> ) P_i(w,rt,thl) dthl drt dw.
2864 : !
2865 : ! The PDF undergoes a PDF transformation in each PDF component, and becomes
2866 : ! a trivariate normal PDF that is written in terms of w, chi, and eta
2867 : ! coordinates. The contribution from the ith PDF component to <w'^2 rc'>
2868 : ! can be written as:
2869 : !
2870 : ! INT(-inf:inf) INT(-inf:inf)
2871 : ! ( w - <w> )^2 ( chi H(chi) - <rc> ) P_i(w,chi) dchi dw.
2872 : !
2873 : ! The solved equation for the <w'^2 rc'> contribution from the ith PDF
2874 : ! component (wp2rcp_contrib_comp_i) is:
2875 : !
2876 : ! wp2rcp_contrib_comp_i
2877 : ! = INT(-inf:inf) INT(-inf:inf)
2878 : ! ( w - <w> )^2 ( chi H(chi) - <rc> ) P_i(w,chi) dchi dw
2879 : ! = ( ( mu_w_i - <w> )^2 + sigma_w_i^2 )
2880 : ! * ( mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
2881 : ! + 1/sqrt(2*pi) * sigma_chi_i
2882 : ! * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) } - <rc> )
2883 : ! + ( mu_w_i - <w> ) * corr_w_chi_i * sigma_w_i * sigma_chi_i
2884 : ! * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
2885 : ! + 1/sqrt(2*pi) * corr_w_chi_i^2 * sigma_w_i^2 * sigma_chi_i
2886 : ! * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) }.
2887 : !
2888 : ! Special case: sigma_chi_i = 0.
2889 : !
2890 : ! In the special case that sigma_chi_i = 0, chi, as well as rc, are constant
2891 : ! in the ith PDF component. The equation becomes:
2892 : !
2893 : ! wp2rcp_contrib_comp_i
2894 : ! = | ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * ( mu_chi_i - <rc> );
2895 : ! | when mu_chi_i > 0;
2896 : ! | ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * ( -<rc> );
2897 : ! | when mu_chi_i <= 0.
2898 : !
2899 : !
2900 : ! <rt'rc'>
2901 : ! --------
2902 : !
2903 : ! The value of <rt'rc'> is calculated by integrating over the PDF:
2904 : !
2905 : ! <rt'rc'>
2906 : ! = INT(-inf:inf) INT(-inf:inf)
2907 : ! ( rt - <rt> ) ( rc - <rc> ) P(rt,thl) dthl drt;
2908 : !
2909 : ! where <rt> is the overall mean of rt, and where P(rt,thl) is a
2910 : ! two-component bivariate normal distribution of rt and thl. This equation
2911 : ! is rewritten as:
2912 : !
2913 : ! <rt'rc'>
2914 : ! = mixt_frac
2915 : ! * INT(-inf:inf) INT(-inf:inf)
2916 : ! ( rt - <rt> ) ( rc - <rc> ) P_1(rt,thl) dthl drt
2917 : ! + ( 1 - mixt_frac )
2918 : ! * INT(-inf:inf) INT(-inf:inf)
2919 : ! ( rt - <rt> ) ( rc - <rc> ) P_2(rt,thl) dthl drt;
2920 : !
2921 : ! where P_1(rt,thl) and P_2(rt,thl) are the equations for the bivariate
2922 : ! normal PDF of rt and thl in the 1st and 2nd PDF components, respectively.
2923 : ! The contribution from the ith PDF component is:
2924 : !
2925 : ! INT(-inf:inf) INT(-inf:inf)
2926 : ! ( rt - <rt> ) ( rc - <rc> ) P_i(rt,thl) dthl drt;
2927 : !
2928 : ! where P_i(rt,thl) is the bivariate normal PDF of rt and thl in the ith PDF
2929 : ! component. The PDF undergoes a PDF transformation in each PDF component,
2930 : ! and becomes a bivariate normal PDF that is written in terms of chi and
2931 : ! eta coordinates. Total water mixing ratio, rt, is rewritten in terms of
2932 : ! chi and eta by:
2933 : !
2934 : ! rt = mu_rt_i
2935 : ! + ( ( eta - mu_eta_i ) + ( chi - mu_chi_i ) ) / ( 2 * crt_i );
2936 : !
2937 : ! where mu_rt_i is the mean of rt in the ith PDF component, mu_eta_i is the
2938 : ! mean of eta in the ith PDF component, and crt_i is a coefficient on rt in
2939 : ! the chi/eta transformation equations. The contribution from the ith PDF
2940 : ! component to <rt'rc'> can be written as:
2941 : !
2942 : ! INT(-inf:inf) INT(-inf:inf)
2943 : ! ( mu_rt_i - <rt> + ( eta - mu_eta_i ) / ( 2 * crt_i )
2944 : ! + ( chi - mu_chi_i ) / ( 2 * crt_i ) )
2945 : ! * ( chi H(chi) - <rc> ) P_i(chi,eta) deta dchi;
2946 : !
2947 : ! where P_i(chi,eta) is the bivariate normal PDF of chi and eta in the ith
2948 : ! PDF component. The solved equation for the <rt'rc'> contribution from the
2949 : ! ith PDF component (rtprcp_contrib_comp_i) is:
2950 : !
2951 : ! rtprcp_contrib_comp_i
2952 : ! = INT(-inf:inf) INT(-inf:inf)
2953 : ! ( mu_rt_i - <rt> + ( eta - mu_eta_i ) / ( 2 * crt_i )
2954 : ! + ( chi - mu_chi_i ) / ( 2 * crt_i ) )
2955 : ! * ( chi H(chi) - <rc> ) P_i(chi,eta) deta dchi
2956 : ! = ( mu_rt_i - <rt> )
2957 : ! * ( mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
2958 : ! + 1/sqrt(2*pi) * sigma_chi_i
2959 : ! * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) } - <rc> )
2960 : ! + ( corr_chi_eta_i * sigma_eta_i + sigma_chi_i ) / ( 2 * crt_i )
2961 : ! * sigma_chi_i
2962 : ! * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) );
2963 : !
2964 : ! where sigma_eta_i is the standard deviation of eta in the ith PDF
2965 : ! component and corr_chi_eta_i is the correlation of chi and eta in the ith
2966 : ! PDF component.
2967 : !
2968 : ! Special case: sigma_chi_i = 0.
2969 : !
2970 : ! In the special case that sigma_chi_i = 0, chi, as well as rc, are constant
2971 : ! in the ith PDF component. The equation becomes:
2972 : !
2973 : ! rtprcp_contrib_comp_i
2974 : ! = | ( mu_rt_i - <rt> ) * ( mu_chi_i - <rc> ); when mu_chi_i > 0;
2975 : ! | ( mu_rt_i - <rt> ) * ( -<rc> ); when mu_chi_i <= 0.
2976 : !
2977 : !
2978 : ! <thl'rc'>
2979 : ! ---------
2980 : !
2981 : ! The value of <thl'rc'> is calculated by integrating over the PDF:
2982 : !
2983 : ! <thl'rc'>
2984 : ! = INT(-inf:inf) INT(-inf:inf)
2985 : ! ( thl - <thl> ) ( rc - <rc> ) P(rt,thl) dthl drt;
2986 : !
2987 : ! where <thl> is the overall mean of thl. This equation is rewritten as:
2988 : !
2989 : ! <thl'rc'>
2990 : ! = mixt_frac
2991 : ! * INT(-inf:inf) INT(-inf:inf)
2992 : ! ( thl - <thl> ) ( rc - <rc> ) P_1(rt,thl) dthl drt
2993 : ! + ( 1 - mixt_frac )
2994 : ! * INT(-inf:inf) INT(-inf:inf)
2995 : ! ( thl - <thl> ) ( rc - <rc> ) P_2(rt,thl) dthl drt.
2996 : !
2997 : ! The contribution from the ith PDF component is:
2998 : !
2999 : ! INT(-inf:inf) INT(-inf:inf)
3000 : ! ( thl - <thl> ) ( rc - <rc> ) P_i(rt,thl) dthl drt.
3001 : !
3002 : ! The PDF undergoes a PDF transformation in each PDF component, and becomes
3003 : ! a bivariate normal PDF that is written in terms of chi and eta
3004 : ! coordinates. Liquid water potential temperature, thl, is rewritten in
3005 : ! terms of chi and eta by:
3006 : !
3007 : ! thl = mu_thl_i
3008 : ! + ( ( eta - mu_eta_i ) - ( chi - mu_chi_i ) ) / ( 2 * cthl_i );
3009 : !
3010 : ! where mu_thl_i is the mean of thl in the ith PDF component and cthl_i is a
3011 : ! coefficient on thl in the chi/eta transformation equations. The
3012 : ! contribution from the ith PDF component to <thl'rc'> can be written as:
3013 : !
3014 : ! INT(-inf:inf) INT(-inf:inf)
3015 : ! ( mu_thl_i - <thl> + ( eta - mu_eta_i ) / ( 2 * cthl_i )
3016 : ! - ( chi - mu_chi_i ) / ( 2 * cthl_i ) )
3017 : ! * ( chi H(chi) - <rc> ) P_i(chi,eta) deta dchi.
3018 : !
3019 : ! The solved equation for the <thl'rc'> contribution from the ith PDF
3020 : ! component (thlprcp_contrib_comp_i) is:
3021 : !
3022 : ! thlprcp_contrib_comp_i
3023 : ! = INT(-inf:inf) INT(-inf:inf)
3024 : ! ( mu_thl_i - <thl> + ( eta - mu_eta_i ) / ( 2 * cthl_i )
3025 : ! - ( chi - mu_chi_i ) / ( 2 * cthl_i ) )
3026 : ! * ( chi H(chi) - <rc> ) P_i(chi,eta) deta dchi
3027 : ! = ( mu_thl_i - <thl> )
3028 : ! * ( mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
3029 : ! + 1/sqrt(2*pi) * sigma_chi_i
3030 : ! * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) } - <rc> )
3031 : ! + ( corr_chi_eta_i * sigma_eta_i - sigma_chi_i ) / ( 2 * cthl_i )
3032 : ! * sigma_chi_i
3033 : ! * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) ).
3034 : !
3035 : ! Special case: sigma_chi_i = 0.
3036 : !
3037 : ! In the special case that sigma_chi_i = 0, chi, as well as rc, are constant
3038 : ! in the ith PDF component. The equation becomes:
3039 : !
3040 : ! thlprcp_contrib_comp_i
3041 : ! = | ( mu_thl_i - <thl> ) * ( mu_chi_i - <rc> ); when mu_chi_i > 0;
3042 : ! | ( mu_thl_i - <thl> ) * ( -<rc> ); when mu_chi_i <= 0.
3043 : !
3044 : !
3045 : ! Use equations for PDF component cloud fraction cloud water mixing ratio
3046 : ! -----------------------------------------------------------------------
3047 : !
3048 : ! The equation for cloud fraction in the ith PDF component, fc_i, is:
3049 : !
3050 : ! fc_i = 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) ).
3051 : !
3052 : ! In the special case that sigma_chi_i = 0, the equation becomes:
3053 : !
3054 : ! fc_i = | 1; when mu_chi_i > 0;
3055 : ! | 0; when mu_chi_i <= 0.
3056 : !
3057 : ! The equation for mean cloud water mixing ratio in the ith PDF component,
3058 : ! rc_i, is:
3059 : !
3060 : ! rc_i
3061 : ! = mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
3062 : ! + 1/sqrt(2*pi) * sigma_chi_i
3063 : ! * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) }
3064 : ! = mu_chi_i * fc_i
3065 : ! + 1/sqrt(2*pi) * sigma_chi_i
3066 : ! * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) }.
3067 : !
3068 : ! In the special case that sigma_chi_i = 0, the equation becomes:
3069 : !
3070 : ! rc_i = | mu_chi_i; when mu_chi_i > 0;
3071 : ! | 0; when mu_chi_i <= 0.
3072 : !
3073 : ! The above equations can be substituted into the equations for
3074 : ! wprcp_contrib_comp_i, wp2rcp_contrib_comp_i, rtprcp_contrib_comp_i, and
3075 : ! thlprcp_contrib_comp_i. The new equations are:
3076 : !
3077 : ! wprcp_contrib_comp_i
3078 : ! = ( mu_w_i - <w> ) * ( rc_i - <rc> )
3079 : ! + corr_w_chi_i * sigma_w_i * sigma_chi_i * fc_i;
3080 : !
3081 : ! wp2rcp_contrib_comp_i
3082 : ! = ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * ( rc_i - <rc> )
3083 : ! + 2 * ( mu_w_i - <w> ) * corr_w_chi_i * sigma_w_i * sigma_chi_i * fc_i
3084 : ! + 1/sqrt(2*pi) * corr_w_chi_i^2 * sigma_w_i^2 * sigma_chi_i
3085 : ! * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) };
3086 : !
3087 : ! rtprcp_contrib_comp_i
3088 : ! = ( mu_rt_i - <rt> ) * ( rc_i - <rc> )
3089 : ! + ( corr_chi_eta_i * sigma_eta_i + sigma_chi_i ) / ( 2 * crt_i )
3090 : ! * sigma_chi_i * fc_i; and
3091 : !
3092 : ! thlprcp_contrib_comp_i
3093 : ! = ( mu_thl_i - <thl> ) * ( rc_i - <rc> )
3094 : ! + ( corr_chi_eta_i * sigma_eta_i - sigma_chi_i ) / ( 2 * cthl_i )
3095 : ! * sigma_chi_i * fc_i.
3096 : !
3097 : ! While the above equations reduce to their listed versions in the special
3098 : ! case that sigma_chi_i = 0, those versions are faster to calculate. When
3099 : ! mu_chi_i > 0, they are:
3100 : !
3101 : ! wprcp_contrib_comp_i = ( mu_w_i - <w> ) * ( mu_chi_i - <rc> );
3102 : ! wp2rcp_contrib_comp_i
3103 : ! = ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * ( mu_chi_i - <rc> );
3104 : ! rtprcp_contrib_comp_i = ( mu_rt_i - <rt> ) * ( mu_chi_i - <rc> ); and
3105 : ! thlprcp_contrib_comp_i = ( mu_thl_i - <thl> ) * ( mu_chi_i - <rc> );
3106 : !
3107 : ! and when mu_chi_i <= 0, they are:
3108 : !
3109 : ! wprcp_contrib_comp_i = - ( mu_w_i - <w> ) * <rc>;
3110 : ! wp2rcp_contrib_comp_i = - ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * <rc>;
3111 : ! rtprcp_contrib_comp_i = - ( mu_rt_i - <rt> ) * <rc>; and
3112 : ! thlprcp_contrib_comp_i = - ( mu_thl_i - <thl> ) * <rc>.
3113 :
3114 : ! References:
3115 : !-----------------------------------------------------------------------
3116 :
3117 : use grid_class, only: &
3118 : grid ! Type
3119 :
3120 : use constants_clubb, only: &
3121 : sqrt_2pi, & ! Variable(s)
3122 : two, &
3123 : zero, &
3124 : chi_tol
3125 :
3126 : use clubb_precision, only: &
3127 : core_rknd ! Variable(s)
3128 :
3129 : implicit none
3130 :
3131 : integer, intent(in) :: &
3132 : ngrdcol, & ! Number of grid columns
3133 : nz ! Number of vertical level
3134 :
3135 : ! Input Variables
3136 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3137 : wm, & ! Mean of w (overall) [m/s]
3138 : rtm, & ! Mean of rt (overall) [kg/kg]
3139 : thlm, & ! Mean of thl (overall) [K]
3140 : um, & ! Mean of eastward wind (overall) [m/s]
3141 : vm, & ! Mean of northward wind (overall) [m/s]
3142 : rcm, & ! Mean of rc (overall) [kg/kg]
3143 : w_i, & ! Mean of w (ith PDF component) [m/s]
3144 : rt_i, & ! Mean of rt (ith PDF component) [kg/kg]
3145 : thl_i, & ! Mean of thl (ith PDF component) [K]
3146 : u_i, & ! Mean of eastward wind (ith PDF component) [m/s]
3147 : v_i, & ! Mean of northward wind (ith PDF component) [m/s]
3148 : varnce_w_i, & ! Variance of w (ith PDF component) [m^2/s^2]
3149 : chi_i, & ! Mean of chi (ith PDF component) [kg/kg]
3150 : stdev_chi_i, & ! Standard deviation of chi (ith PDF comp.) [kg/kg]
3151 : stdev_eta_i, & ! Standard deviation of eta (ith PDF comp.) [kg/kg]
3152 : corr_w_chi_i, & ! Correlation of w and chi (ith PDF component) [-]
3153 : corr_chi_eta_i, & ! Correlation of chi and eta (ith PDF comp.) [-]
3154 : ! corr_u_w_i, & ! Correlation of u and w (ith PDF component) [-]
3155 : ! corr_v_w_i, & ! Correlation of v and w (ith PDF component) [-]
3156 : crt_i, & ! Coef. on rt in chi/eta eqns. (ith PDF comp.) [-]
3157 : cthl_i, & ! Coef. on thl: chi/eta eqns. (ith PDF comp.) [kg/kg/K]
3158 : rc_i, & ! Mean of rc (ith PDF component) [kg/kg]
3159 : cloud_frac_i ! Cloud fraction (ith PDF component) [-]
3160 :
3161 : integer, intent(in) :: &
3162 : iiPDF_type ! Selected option for the two-component normal (double
3163 : ! Gaussian) PDF type to use for the w, rt, and theta-l (or
3164 : ! w, chi, and eta) portion of CLUBB's multivariate,
3165 : ! two-component PDF.
3166 :
3167 : ! Output Variables
3168 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3169 : wprcp_contrib_comp_i, & ! <w'rc'> contrib. (ith PDF comp.) [m/s(kg/kg)]
3170 : wp2rcp_contrib_comp_i, & ! <w'^2rc'> contrib. (ith comp) [m^2/s^2(kg/kg)]
3171 : rtprcp_contrib_comp_i, & ! <rt'rc'> contrib. (ith PDF comp.) [kg^2/kg^2]
3172 : thlprcp_contrib_comp_i, & ! <thl'rc'> contrib. (ith PDF comp.) [K(kg/kg)]
3173 : uprcp_contrib_comp_i, & ! <u'rc'> contrib. (ith PDF comp.) [m/s(kg/kg)]
3174 : vprcp_contrib_comp_i ! <v'rc'> contrib. (ith PDF comp.) [m/s(kg/kg)]
3175 :
3176 : ! Local Variables
3177 : integer :: i, k
3178 :
3179 : ! ---------------------- Begin Code ------------------
3180 :
3181 : ! Changing these conditionals may result in inconsistencies with the conditional
3182 : ! statements located in calc_cloud_frac_component
3183 : !$acc parallel loop gang vector collapse(2) default(present)
3184 121412736 : do k = 1, nz
3185 2005148736 : do i = 1, ngrdcol
3186 :
3187 1883736000 : wprcp_contrib_comp_i(i,k) = ( w_i(i,k) - wm(i,k) ) * ( rc_i(i,k) - rcm(i,k) )
3188 :
3189 : wp2rcp_contrib_comp_i(i,k) = ( ( w_i(i,k) - wm(i,k) )**2 + varnce_w_i(i,k) ) &
3190 1883736000 : * ( rc_i(i,k) - rcm(i,k) )
3191 :
3192 : rtprcp_contrib_comp_i(i,k) = ( rt_i(i,k) - rtm(i,k) ) * ( rc_i(i,k) - rcm(i,k) ) &
3193 : + ( corr_chi_eta_i(i,k) * stdev_eta_i(i,k) + stdev_chi_i(i,k) ) &
3194 1883736000 : / ( two * crt_i(i,k) ) * stdev_chi_i(i,k) * cloud_frac_i(i,k)
3195 :
3196 : thlprcp_contrib_comp_i(i,k) = ( thl_i(i,k) - thlm(i,k) ) * ( rc_i(i,k) - rcm(i,k) ) &
3197 : + ( corr_chi_eta_i(i,k) * stdev_eta_i(i,k) - stdev_chi_i(i,k) ) &
3198 1883736000 : / ( two * cthl_i(i,k) ) * stdev_chi_i(i,k) * cloud_frac_i(i,k)
3199 :
3200 1883736000 : uprcp_contrib_comp_i(i,k) = ( u_i(i,k) - um(i,k) ) * ( rc_i(i,k) - rcm(i,k) )
3201 :
3202 2003736960 : vprcp_contrib_comp_i(i,k) = ( v_i(i,k) - vm(i,k) ) * ( rc_i(i,k) - rcm(i,k) )
3203 :
3204 : end do
3205 : end do
3206 : !$acc end parallel loop
3207 :
3208 : ! If iiPDF_type isn't iiPDF_ADG1, iiPDF_ADG2, or iiPDF_new_hybrid, so
3209 : ! corr_w_chi_i /= 0 (and perhaps corr_u_w_i /= 0).
3210 1411776 : if ( .not. ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
3211 : .or. iiPDF_type == iiPDF_new_hybrid ) ) then
3212 :
3213 : ! Chi varies significantly in the ith PDF component (stdev_chi > chi_tol)
3214 : ! and there is some cloud (0 < cloud_frac <= 1)
3215 0 : do k = 1, nz
3216 0 : do i = 1, ngrdcol
3217 0 : if ( stdev_chi_i(i,k) > chi_tol .and. cloud_frac_i(i,k) > zero ) then
3218 :
3219 : wprcp_contrib_comp_i(i,k) = wprcp_contrib_comp_i(i,k) &
3220 : + corr_w_chi_i(i,k) * sqrt( varnce_w_i(i,k) ) &
3221 0 : * stdev_chi_i(i,k) * cloud_frac_i(i,k)
3222 :
3223 : wp2rcp_contrib_comp_i(i,k) = wp2rcp_contrib_comp_i(i,k) &
3224 : + two * ( w_i(i,k) - wm(i,k) ) * corr_w_chi_i(i,k) &
3225 : * sqrt( varnce_w_i(i,k) ) * stdev_chi_i(i,k) &
3226 : * cloud_frac_i(i,k) &
3227 : + corr_w_chi_i(i,k)**2 * varnce_w_i(i,k) &
3228 : * stdev_chi_i(i,k) &
3229 : * exp( -chi_i(i,k)**2 / ( two*stdev_chi_i(i,k)**2 ) ) &
3230 0 : / sqrt_2pi
3231 :
3232 : ! In principle, uprcp_contrib_comp_i might depend on corr_u_w_i here.
3233 : end if
3234 : end do
3235 : end do
3236 : end if
3237 :
3238 1411776 : return
3239 :
3240 : end subroutine calc_xprcp_component
3241 :
3242 : !=============================================================================
3243 0 : subroutine calc_w_up_in_cloud( nz, ngrdcol, &
3244 0 : mixt_frac, cloud_frac_1, cloud_frac_2, &
3245 0 : w_1, w_2, varnce_w_1, varnce_w_2, &
3246 0 : w_up_in_cloud, w_down_in_cloud, &
3247 0 : cloudy_updraft_frac, cloudy_downdraft_frac )
3248 :
3249 : ! Description:
3250 : ! Subroutine that computes the mean cloudy updraft (and also calculates
3251 : ! the mean cloudy downdraft).
3252 : !
3253 : ! In order to activate aerosol, we'd like to feed the activation scheme
3254 : ! a vertical velocity that's representative of cloudy updrafts. For skewed
3255 : ! layers, like cumulus layers, this might be an improvement over the square
3256 : ! root of wp2 that's currently used. At the same time, it would be simpler
3257 : ! and less expensive than feeding SILHS samples into the aerosol code
3258 : ! (see larson-group/e3sm#19 and larson-group/e3sm#26).
3259 : !
3260 : ! The formulas are only valid for certain PDFs in CLUBB (ADG1, ADG2,
3261 : ! new hybrid), hence we omit calculation if another PDF type is used.
3262 : !
3263 : ! References: https://www.overleaf.com/project/614a136d47846639af22ae34
3264 : !----------------------------------------------------------------------
3265 :
3266 : use constants_clubb, only: &
3267 : sqrt_2pi, & ! sqrt(2*pi)
3268 : sqrt_2, & ! sqrt(2)
3269 : one, & ! 1
3270 : one_half, & ! 1/2
3271 : zero, & ! 0
3272 : max_num_stdevs, &
3273 : eps
3274 :
3275 : use clubb_precision, only: &
3276 : core_rknd ! Precision
3277 :
3278 : implicit none
3279 :
3280 : integer, intent(in) :: &
3281 : ngrdcol, & ! Number of grid columns
3282 : nz ! Number of vertical level
3283 :
3284 : !----------- Input Variables -----------
3285 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3286 : mixt_frac, & ! mixture fraction [-]
3287 : cloud_frac_1, & ! cloud fraction (1st PDF component) [-]
3288 : cloud_frac_2, & ! cloud fraction (2nd PDF component) [-]
3289 : w_1, & ! upward velocity (1st PDF component) [m/s]
3290 : w_2, & ! upward velocity (2nd PDF component) [m/s]
3291 : varnce_w_1, & ! standard deviation of w (1st PDF component) [m^2/s^2]
3292 : varnce_w_2 ! standard deviation of w (2nd PDF component) [m^2/s^2]
3293 :
3294 : !----------- Output Variables -----------
3295 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3296 : w_up_in_cloud, & ! mean cloudy updraft speed [m/s]
3297 : w_down_in_cloud, & ! mean cloudy downdraft speed [m/s]
3298 : cloudy_updraft_frac, & ! cloudy updraft fraction [-]
3299 : cloudy_downdraft_frac ! cloudy downdraft fraction [-]
3300 :
3301 : !----------- Local Variables -----------
3302 : real( kind = core_rknd ) :: &
3303 : w_up_1, w_up_2, & ! integral of w and Heaviside fnc, where w > 0
3304 : w_down_1, w_down_2, & ! integral of w and Heaviside fnc, where w < 0
3305 : stdev_w_1, stdev_w_2, & ! Standard deviation of w
3306 : ratio_w_1, & ! mu_w_1 / ( sqrt(2) * sigma_w_1 )
3307 : ratio_w_2, & ! mu_w_2 / ( sqrt(2) * sigma_w_2 )
3308 : erf_ratio_w_1, & ! erf( ratio_w_1 )
3309 : erf_ratio_w_2, & ! erf( ratio_w_2 )
3310 : exp_neg_ratio_w_1_sqd, & ! exp( -ratio_w_1^2 )
3311 : exp_neg_ratio_w_2_sqd, & ! exp( -ratio_w_2^2 )
3312 : updraft_frac_1, & ! Fraction of 1st PDF comp. where w > 0
3313 : updraft_frac_2, & ! Fraction of 2nd PDF comp. where w > 0
3314 : downdraft_frac_1, & ! Fraction of 1st PDF comp. where w < 0
3315 : downdraft_frac_2 ! Fraction of 2nd PDF comp. where w < 0
3316 :
3317 : integer :: i, k
3318 :
3319 : !$acc parallel loop gang vector collapse(2) default(present)
3320 0 : do k = 1, nz
3321 0 : do i = 1, ngrdcol
3322 :
3323 0 : stdev_w_1 = sqrt(varnce_w_1(i,k))
3324 0 : stdev_w_2 = sqrt(varnce_w_2(i,k))
3325 :
3326 : ! Calculate quantities in the 1st PDF component.
3327 0 : if ( w_1(i,k) > max_num_stdevs * stdev_w_1 ) then
3328 :
3329 : ! The mean of w in the 1st PDF component is more than
3330 : ! max_num_stdevs standard deviations above 0.
3331 : ! The entire 1st PDF component is found in an updraft (w > 0).
3332 : w_up_1 = w_1(i,k)
3333 : updraft_frac_1 = one
3334 : w_down_1 = zero
3335 : downdraft_frac_1 = zero
3336 :
3337 0 : elseif ( w_1(i,k) < - max_num_stdevs * stdev_w_1 ) then
3338 :
3339 : ! The mean of w in the 1st PDF component is more than
3340 : ! max_num_stdevs standard deviations below 0.
3341 : ! The entire 1st PDF component is found in a downdraft (w < 0).
3342 : w_up_1 = zero
3343 : updraft_frac_1 = zero
3344 : w_down_1 = w_1(i,k)
3345 : downdraft_frac_1 = one
3346 :
3347 : else
3348 :
3349 : ! The 1st PDF component contains both updraft and downdraft.
3350 0 : ratio_w_1 = w_1(i,k) / ( sqrt_2 * max(eps, stdev_w_1) )
3351 0 : erf_ratio_w_1 = erf( ratio_w_1 )
3352 0 : exp_neg_ratio_w_1_sqd = exp( -ratio_w_1**2 )
3353 :
3354 : w_up_1 &
3355 : = one_half * w_1(i,k) * ( one + erf_ratio_w_1 ) &
3356 0 : + ( stdev_w_1 / sqrt_2pi ) * exp_neg_ratio_w_1_sqd
3357 :
3358 0 : updraft_frac_1 = one_half * ( one + erf_ratio_w_1 )
3359 :
3360 : w_down_1 &
3361 : = one_half * w_1(i,k) * ( one - erf_ratio_w_1 ) &
3362 0 : - ( stdev_w_1 / sqrt_2pi ) * exp_neg_ratio_w_1_sqd
3363 :
3364 : !downdraft_frac_1 = one_half * ( one - erf_ratio_w_1 )
3365 0 : downdraft_frac_1 = one - updraft_frac_1
3366 :
3367 : endif
3368 :
3369 : ! Calculate quantities in the 2nd PDF component.
3370 0 : if ( w_2(i,k) > max_num_stdevs * stdev_w_2 ) then
3371 :
3372 : ! The mean of w in the 2nd PDF component is more than
3373 : ! max_num_stdevs standard deviations above 0.
3374 : ! The entire 2nd PDF component is found in an updraft (w > 0).
3375 : w_up_2 = w_2(i,k)
3376 : updraft_frac_2 = one
3377 : w_down_2 = zero
3378 : downdraft_frac_2 = zero
3379 :
3380 0 : elseif ( w_2(i,k) < - max_num_stdevs * stdev_w_2 ) then
3381 :
3382 : ! The mean of w in the 2nd PDF component is more than
3383 : ! max_num_stdevs standard deviations below 0.
3384 : ! The entire 2nd PDF component is found in a downdraft (w < 0).
3385 : w_up_2 = zero
3386 : updraft_frac_2 = zero
3387 : w_down_2 = w_2(i,k)
3388 : downdraft_frac_2 = one
3389 :
3390 : else
3391 :
3392 : ! The 2nd PDF component contains both updraft and downdraft.
3393 0 : ratio_w_2 = w_2(i,k) / ( sqrt_2 * max(eps, stdev_w_2) )
3394 0 : erf_ratio_w_2 = erf( ratio_w_2 )
3395 0 : exp_neg_ratio_w_2_sqd = exp( -ratio_w_2**2 )
3396 :
3397 : w_up_2 &
3398 : = one_half * w_2(i,k) * ( one + erf_ratio_w_2 ) &
3399 0 : + ( stdev_w_2 / sqrt_2pi ) * exp_neg_ratio_w_2_sqd
3400 :
3401 0 : updraft_frac_2 = one_half * ( one + erf_ratio_w_2 )
3402 :
3403 : w_down_2 &
3404 : = one_half * w_2(i,k) * ( one - erf_ratio_w_2 ) &
3405 0 : - ( stdev_w_2 / sqrt_2pi ) * exp_neg_ratio_w_2_sqd
3406 :
3407 : !downdraft_frac_2 = one_half * ( one - erf_ratio_w_2 )
3408 0 : downdraft_frac_2 = one - updraft_frac_2
3409 :
3410 : endif
3411 :
3412 : ! Calculate the total cloudy updraft fraction.
3413 : cloudy_updraft_frac(i,k) &
3414 : = mixt_frac(i,k) * cloud_frac_1(i,k) * updraft_frac_1 &
3415 0 : + ( one - mixt_frac(i,k) ) * cloud_frac_2(i,k) * updraft_frac_2
3416 :
3417 : ! Calculate the total cloudy downdraft fraction.
3418 : cloudy_downdraft_frac(i,k) &
3419 : = mixt_frac(i,k) * cloud_frac_1(i,k) * downdraft_frac_1 &
3420 0 : + ( one - mixt_frac(i,k) ) * cloud_frac_2(i,k) * downdraft_frac_2
3421 :
3422 : ! Calculate the mean vertical velocity found in a cloudy updraft.
3423 : w_up_in_cloud(i,k) &
3424 : = ( mixt_frac(i,k) * cloud_frac_1(i,k) * w_up_1 &
3425 : + ( one - mixt_frac(i,k) ) * cloud_frac_2(i,k) * w_up_2 ) &
3426 0 : / max( eps, cloudy_updraft_frac(i,k) )
3427 :
3428 : ! Calculate the mean vertical velocity found in a cloudy downdraft.
3429 : w_down_in_cloud(i,k) &
3430 : = ( mixt_frac(i,k) * cloud_frac_1(i,k) * w_down_1 &
3431 : + ( one - mixt_frac(i,k) ) * cloud_frac_2(i,k) * w_down_2 ) &
3432 0 : / max( eps, cloudy_downdraft_frac(i,k) )
3433 :
3434 : end do
3435 : end do
3436 : !$acc end parallel loop
3437 :
3438 0 : return
3439 :
3440 : end subroutine calc_w_up_in_cloud
3441 :
3442 : !=============================================================================
3443 : function interp_var_array( n_points, nz, k, z_vals, var )
3444 :
3445 : ! Description:
3446 : ! Interpolates a variable to an array of values about a given level
3447 :
3448 : ! References
3449 : !-----------------------------------------------------------------------
3450 :
3451 : use clubb_precision, only: &
3452 : core_rknd ! Constant
3453 :
3454 : implicit none
3455 :
3456 : ! Input Variables
3457 : integer, intent(in) :: &
3458 : n_points, & ! Number of points to interpolate to (must be odd and >= 3)
3459 : nz, & ! Total number of vertical levels
3460 : k ! Center of interpolation array
3461 :
3462 : real( kind = core_rknd ), dimension(nz), intent(in) :: &
3463 : z_vals, & ! Height at each vertical level [m]
3464 : var ! Variable values on grid [units vary]
3465 :
3466 : ! Output Variables
3467 : real( kind = core_rknd ), dimension(n_points) :: &
3468 : interp_var_array ! Interpolated values of variable [units vary]
3469 :
3470 : ! Local Variables
3471 : real( kind = core_rknd ) :: &
3472 : dz ! Distance between vertical levels
3473 :
3474 : real( kind = core_rknd ) :: &
3475 : z_val ! Height at some sub-grid level
3476 :
3477 : integer :: &
3478 : i, & ! Loop iterator
3479 :
3480 : subgrid_lev_count ! Number of refined grid points located between
3481 : ! two defined grid levels
3482 :
3483 : !-----------------------------------------------------------------------
3484 :
3485 : !----- Begin Code -----
3486 :
3487 : ! Place a point at each of k-1, k, and k+1.
3488 : interp_var_array(1) = var_value_integer_height( nz, k-1, z_vals, var )
3489 : interp_var_array((n_points+1)/2) = var_value_integer_height( nz, k, z_vals, var )
3490 : interp_var_array(n_points) = var_value_integer_height( nz, k+1, z_vals, var )
3491 :
3492 : subgrid_lev_count = (n_points - 3) / 2
3493 :
3494 : ! Lower half
3495 : if ( k == 1 ) then
3496 : dz = (z_vals(2) - z_vals(1)) / real( subgrid_lev_count+1, kind=core_rknd )
3497 : else
3498 : dz = (z_vals(k) - z_vals(k-1)) / real( subgrid_lev_count+1, kind=core_rknd )
3499 : end if
3500 : do i=1, subgrid_lev_count
3501 : z_val = z_vals(k) - real( i, kind=core_rknd ) * dz
3502 : interp_var_array(1+i) &
3503 : = var_subgrid_interp( nz, k, z_vals, var, z_val, l_below=.true. )
3504 : end do
3505 :
3506 : ! Upper half
3507 : if ( k == nz ) then
3508 : dz = ( z_vals(nz) - z_vals(nz-1) ) / real( subgrid_lev_count+1, kind=core_rknd )
3509 : else
3510 : dz = ( z_vals(k+1) - z_vals(k) ) / real( subgrid_lev_count+1, kind=core_rknd )
3511 : end if
3512 : do i=1, (n_points-3)/2
3513 : z_val = z_vals(k) + real( i, kind=core_rknd ) * dz
3514 : interp_var_array((n_points+1)/2+i) &
3515 : = var_subgrid_interp( nz, k, z_vals, var, z_val, l_below=.false. )
3516 : end do
3517 :
3518 : return
3519 : end function interp_var_array
3520 :
3521 : !=============================================================================
3522 : function var_value_integer_height( nz, k, z_vals, var_grid_value ) result( var_value )
3523 :
3524 : ! Description
3525 : ! Returns the value of a variable at an integer height between 0 and
3526 : ! nz+1 inclusive, using extrapolation when k==0 or k==nz+1
3527 :
3528 : ! References
3529 : !-----------------------------------------------------------------------
3530 :
3531 : use clubb_precision, only: &
3532 : core_rknd ! Constant
3533 :
3534 : use interpolation, only: &
3535 : mono_cubic_interp ! Procedure
3536 :
3537 : implicit none
3538 :
3539 : ! Input Variables
3540 : integer, intent(in) :: &
3541 : nz, & ! Total number of vertical levels
3542 : k ! Level to resolve variable value
3543 :
3544 : real( kind = core_rknd ), dimension(nz), intent(in) :: &
3545 : z_vals, & ! Height at each vertical level [m]
3546 : var_grid_value ! Value of variable at each grid level [units vary]
3547 :
3548 : ! Output Variables
3549 : real( kind = core_rknd ) :: &
3550 : var_value ! Value of variable at height level [units vary]
3551 :
3552 : ! Local Variables
3553 : integer :: km1, k00, kp1, kp2
3554 : !-----------------------------------------------------------------------
3555 :
3556 : !----- Begin Code -----
3557 :
3558 : if ( k >= 1 .and. k <= nz ) then
3559 : ! This is the simple case. No extrapolation necessary.
3560 : var_value = var_grid_value(k)
3561 : else if ( k == 0 ) then
3562 : ! Extrapolate below the lower boundary
3563 : km1 = nz
3564 : k00 = 1
3565 : kp1 = 2
3566 : kp2 = 3
3567 : var_value = mono_cubic_interp( z_vals(1)-(z_vals(2)-z_vals(1)), &
3568 : km1, k00, kp1, kp2, &
3569 : z_vals(km1), z_vals(k00), z_vals(kp1), z_vals(kp2), &
3570 : var_grid_value(km1), var_grid_value(k00), &
3571 : var_grid_value(kp1), var_grid_value(kp2) )
3572 : else if ( k == nz+1 ) then
3573 : ! Extrapolate above the upper boundary
3574 : km1 = nz
3575 : k00 = nz-1
3576 : kp1 = nz
3577 : kp2 = nz
3578 : var_value = mono_cubic_interp( z_vals(nz)+(z_vals(nz)-z_vals(nz-1)), &
3579 : km1, k00, kp1, kp2, &
3580 : z_vals(km1), z_vals(k00), z_vals(kp1), z_vals(kp2), &
3581 : var_grid_value(km1), var_grid_value(k00), &
3582 : var_grid_value(kp1), var_grid_value(kp2) )
3583 : else
3584 : ! Invalid height requested
3585 : var_value = -999._core_rknd
3586 : end if ! k > 1 .and. k < nz
3587 : return
3588 : end function var_value_integer_height
3589 :
3590 : !=============================================================================
3591 : function var_subgrid_interp( nz, k, z_vals, var, z_interp, l_below ) result( var_value )
3592 :
3593 : ! Description
3594 : ! Interpolates (or extrapolates) a variable to a value between grid
3595 : ! levels
3596 :
3597 : ! References
3598 : !-----------------------------------------------------------------------
3599 :
3600 : use clubb_precision, only: &
3601 : core_rknd ! Constant
3602 :
3603 : use interpolation, only: &
3604 : mono_cubic_interp ! Procedure
3605 :
3606 : implicit none
3607 :
3608 : ! Input Variables
3609 : integer, intent(in) :: &
3610 : nz, & ! Number of vertical levels
3611 : k ! Grid level near interpolation target
3612 :
3613 : real( kind = core_rknd ), dimension(nz), intent(in) :: &
3614 : z_vals, & ! Height at each grid level [m]
3615 : var ! Variable values at grid levels [units vary]
3616 :
3617 : real( kind = core_rknd ), intent(in) :: &
3618 : z_interp ! Interpolation target height [m]
3619 :
3620 : logical, intent(in) :: &
3621 : l_below ! True if z_interp < z_vals(k), false otherwise
3622 :
3623 : ! Output Variable
3624 : real( kind = core_rknd ) :: &
3625 : var_value ! Interpolated value of variable [units vary]
3626 :
3627 : ! Local Variables
3628 : integer :: km1, k00, kp1, kp2 ! Parameters for call to mono_cubic_interp
3629 : !----------------------------------------------------------------------
3630 :
3631 : !----- Begin Code -----
3632 : if ( l_below ) then
3633 :
3634 : if ( k == 1 ) then ! Extrapolation
3635 : km1 = nz
3636 : k00 = 1
3637 : kp1 = 2
3638 : kp2 = 3
3639 : else if ( k == 2 ) then
3640 : km1 = 1
3641 : k00 = 1
3642 : kp1 = 2
3643 : kp2 = 3
3644 : else if ( k == nz ) then
3645 : km1 = nz-2
3646 : k00 = nz-1
3647 : kp1 = nz
3648 : kp2 = nz
3649 : else
3650 : km1 = k-2
3651 : k00 = k-1
3652 : kp1 = k
3653 : kp2 = k+1
3654 : end if ! k == 1
3655 :
3656 : else ! .not. l_below
3657 :
3658 : if ( k == 1 ) then
3659 : km1 = 1
3660 : k00 = 1
3661 : kp1 = 2
3662 : kp2 = 3
3663 : else if ( k == nz-1 ) then
3664 : km1 = nz-2
3665 : k00 = nz-1
3666 : kp1 = nz
3667 : kp2 = nz
3668 : else if ( k == nz ) then ! Extrapolation
3669 : km1 = nz
3670 : k00 = nz-1
3671 : kp1 = nz
3672 : kp2 = nz
3673 : else
3674 : km1 = k-1
3675 : k00 = k
3676 : kp1 = k+1
3677 : kp2 = k+2
3678 : end if ! k == 1
3679 :
3680 : end if ! l_below
3681 :
3682 : ! Now perform the interpolation
3683 : var_value = mono_cubic_interp( z_interp, km1, k00, kp1, kp2, &
3684 : z_vals(km1), z_vals(k00), z_vals(kp1), z_vals(kp2), &
3685 : var(km1), var(k00), var(kp1), var(kp2) )
3686 :
3687 : return
3688 :
3689 : end function var_subgrid_interp
3690 :
3691 : !=============================================================================
3692 :
3693 : end module pdf_closure_module
|