Line data Source code
1 : !------------------------------------------------------------------------
2 : ! $Id$
3 : !===============================================================================
4 : module advance_wp2_wp3_module
5 :
6 : implicit none
7 :
8 : private ! Default Scope
9 :
10 : public :: advance_wp2_wp3
11 :
12 : private :: wp23_solve, &
13 : wp23_lhs, &
14 : wp23_rhs, &
15 : wp2_term_ta_lhs, &
16 : wp2_terms_ac_pr2_lhs, &
17 : wp2_term_dp1_lhs, &
18 : wp2_term_pr1_lhs, &
19 : wp2_terms_bp_pr2_rhs, &
20 : wp2_term_dp1_rhs, &
21 : wp2_term_pr3_rhs, &
22 : wp2_term_pr1_rhs, &
23 : wp3_term_ta_new_pdf_lhs, &
24 : wp3_term_ta_ADG1_lhs, &
25 : wp3_term_tp_lhs, &
26 : wp3_terms_ac_pr2_lhs, &
27 : wp3_term_pr1_lhs, &
28 : wp3_term_ta_explicit_rhs, &
29 : wp3_terms_bp1_pr2_rhs, &
30 : wp3_term_pr1_rhs, &
31 : wp3_term_pr_turb_rhs, &
32 : wp3_term_pr_dfsn_rhs
33 :
34 :
35 : ! Private named constants to avoid string comparisons
36 : integer, parameter, private :: &
37 : clip_wp2 = 12 ! Named constant for wp2 clipping.
38 : ! NOTE: This must be the same as the clip_wp2 declared in
39 : ! clip_explicit!
40 :
41 : ! Set logical to true for Crank-Nicholson diffusion scheme
42 : ! or to false for completely implicit diffusion scheme.
43 : ! Note: Although Crank-Nicholson diffusion has usually been used for wp2
44 : ! and wp3 in the past, we found that using completely implicit
45 : ! diffusion stabilized the deep convective cases more while having
46 : ! almost no effect on the boundary layer cases. Brian; 1/4/2008.
47 : logical, parameter :: l_crank_nich_diff = .false.
48 :
49 : integer, parameter :: &
50 : ndiags2 = 2, &
51 : ndiags3 = 3, &
52 : ndiags5 = 5
53 :
54 : contains
55 :
56 : !=============================================================================
57 8935056 : subroutine advance_wp2_wp3( nz, ngrdcol, gr, dt, & ! intent(in)
58 8935056 : sfc_elevation, sigma_sqd_w, wm_zm, & ! intent(in)
59 8935056 : wm_zt, a3, a3_zt, wp3_on_wp2, & ! intent(in)
60 8935056 : wpup2, wpvp2, wp2up2, wp2vp2, wp4, & ! intent(in)
61 8935056 : wpthvp, wp2thvp, um, vm, upwp, vpwp, & ! intent(in)
62 8935056 : up2, vp2, em, Kh_zm, Kh_zt, invrs_tau_C4_zm, & ! intent(in)
63 8935056 : invrs_tau_wp3_zt, invrs_tau_C1_zm, Skw_zm, & ! intent(in)
64 8935056 : Skw_zt, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in)
65 8935056 : invrs_rho_ds_zt, radf, thv_ds_zm, & ! intent(in)
66 8935056 : thv_ds_zt, mixt_frac, Cx_fnc_Richardson, & ! intent(in)
67 8935056 : lhs_splat_wp2, lhs_splat_wp3, & ! intent(in)
68 : pdf_implicit_coefs_terms, & ! intent(in)
69 8935056 : wprtp, wpthlp, rtp2, thlp2, & ! intent(in)
70 8935056 : clubb_params, nu_vert_res_dep, & ! intent(in)
71 : iiPDF_type, & ! intent(in)
72 : penta_solve_method, & ! intent(in)
73 : l_min_wp2_from_corr_wx, & ! intent(in)
74 : l_upwind_xm_ma, & ! intent(in)
75 : l_tke_aniso, & ! intent(in)
76 : l_standard_term_ta, & ! intent(in)
77 : l_partial_upwind_wp3, & ! intent(in)
78 : l_damp_wp2_using_em, & ! intent(in)
79 : l_use_C11_Richardson, & ! intent(in)
80 : l_damp_wp3_Skw_squared, & ! intent(in)
81 : l_lmm_stepping, & ! intent(in)
82 : l_use_tke_in_wp3_pr_turb_term, & ! intent(in)
83 : l_use_tke_in_wp2_wp3_K_dfsn, & ! intent(in)
84 : l_use_wp3_lim_with_smth_Heaviside, & ! intent(in)
85 : stats_metadata, & ! intent(in)
86 8935056 : stats_zt, stats_zm, stats_sfc, & ! intent(inout)
87 8935056 : wp2, wp3, wp3_zm, wp2_zt ) ! intent(inout)
88 :
89 : ! Description:
90 : ! Advance w'^2 and w'^3 one timestep.
91 :
92 : ! References:
93 : ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:wp2_wp3_eqns
94 : !
95 : ! Eqn. 12 & 18 on p. 3545--3546 of
96 : ! ``A PDF-Based Model for Boundary Layer Clouds. Part I:
97 : ! Method and Model Description'' Golaz, et al. (2002)
98 : ! JAS, Vol. 59, pp. 3540--3551.
99 :
100 : ! See also
101 : ! ``Equations for CLUBB'', Section 6:
102 : ! /Implict solution for the vertical velocity moments/
103 : !------------------------------------------------------------------------
104 :
105 : use grid_class, only: &
106 : grid, & ! Type
107 : ddzt, & ! Procedure
108 : zt2zm, & ! Procedure(s)
109 : zm2zt
110 :
111 : use parameter_indices, only: &
112 : nparams, & ! Variable(s)
113 : iC11c, &
114 : iC11b, &
115 : iC11, &
116 : iC1c, &
117 : iC1b, &
118 : iC1, &
119 : ic_K1, &
120 : ic_K8, &
121 : iC4, &
122 : iC_uu_shr, &
123 : iC_uu_buoy, &
124 : iC8, &
125 : iC8b, &
126 : iC12, &
127 : iC_wp2_pr_dfsn, &
128 : iC_wp3_pr_tp, &
129 : iC_wp3_pr_turb, &
130 : iC_wp3_pr_dfsn
131 :
132 : use model_flags, only: &
133 : iiPDF_ADG1, & ! Variable(s)
134 : iiPDF_new, &
135 : iiPDF_new_hybrid, &
136 : l_explicit_turbulent_adv_wp3
137 :
138 : use parameters_tunable, only: &
139 : nu_vertical_res_dep ! Type(s)
140 :
141 : use sponge_layer_damping, only: &
142 : wp2_sponge_damp_settings, & ! Variable(s)
143 : wp3_sponge_damp_settings, &
144 : wp2_sponge_damp_profile, &
145 : wp3_sponge_damp_profile, &
146 : sponge_damp_xp2, & ! Procedure(s)
147 : sponge_damp_xp3
148 :
149 : use stats_type_utilities, only: &
150 : stat_begin_update, & ! Procedure(s)
151 : stat_end_update, &
152 : stat_update_var, &
153 : stat_update_var_pt, &
154 : stat_end_update_pt
155 :
156 : use diffusion, only: &
157 : diffusion_zm_lhs, & ! Procedures
158 : diffusion_zt_lhs
159 :
160 : use mean_adv, only: &
161 : term_ma_zm_lhs, & ! Procedures
162 : term_ma_zt_lhs
163 :
164 : use stats_variables, only: &
165 : stats_metadata_type
166 :
167 : use constants_clubb, only: &
168 : fstderr, & ! Variables
169 : one, &
170 : one_half, &
171 : one_third, &
172 : w_tol_sqd, &
173 : eps, &
174 : zero, &
175 : zero_threshold
176 :
177 : use pdf_parameter_module, only: &
178 : implicit_coefs_terms ! Variable Type
179 :
180 : use clubb_precision, only: &
181 : core_rknd ! Variable(s)
182 :
183 : use error_code, only: &
184 : clubb_at_least_debug_level, & ! Procedure
185 : err_code, & ! Error Indicator
186 : clubb_fatal_error ! Constant
187 :
188 : use stats_type, only: stats ! Type
189 :
190 : implicit none
191 :
192 : ! --------------------------- Input Variables ---------------------------
193 : integer, intent(in) :: &
194 : nz, &
195 : ngrdcol
196 :
197 : type (grid), target, intent(in) :: &
198 : gr
199 :
200 : real( kind = core_rknd ), intent(in) :: &
201 : dt ! Model timestep [s]
202 :
203 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
204 : sfc_elevation ! Elevation of ground level [m AMSL]
205 :
206 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
207 : sigma_sqd_w, & ! sigma_sqd_w (momentum levels) [-]
208 : wm_zm, & ! w wind component on momentum levels [m/s]
209 : wm_zt, & ! w wind component on thermodynamic levels [m/s]
210 : a3, & ! a_3 (momentum levels); See eqn. 25 in `Equations for CLUBB' [-]
211 : a3_zt, & ! a_3 interpolated to thermodynamic levels [-]
212 : wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s]
213 : wpup2, & ! w'u'^2 (thermodynamic levels) [m^3/s^3]
214 : wpvp2, & ! w'v'^2 (thermodynamic levels) [m^3/s^3]
215 : wp2up2, & ! w'^2u'^2 (momentum levels) [m^4/s^4]
216 : wp2vp2, & ! w'^2v'^2 (momentum levels) [m^4/s^4]
217 : wp4, & ! w'^4 (momentum levels) [m^4/s^4]
218 : wpthvp, & ! w'th_v' (momentum levels) [K m/s]
219 : wp2thvp, & ! w'^2th_v' (thermodynamic levels) [K m^2/s^2]
220 : um, & ! u wind component (thermodynamic levels) [m/s]
221 : vm, & ! v wind component (thermodynamic levels) [m/s]
222 : upwp, & ! u'w' (momentum levels) [m^2/s^2]
223 : vpwp, & ! v'w' (momentum levels) [m^2/s^2]
224 : up2, & ! u'^2 (momentum levels) [m^2/s^2]
225 : vp2, & ! v'^2 (momentum levels) [m^2/s^2]
226 : em, & ! Turbulence kinetic energy [m^2/s^2]
227 : Kh_zm, & ! Eddy diffusivity on momentum levels [m^2/s]
228 : Kh_zt, & ! Eddy diffusivity on thermodynamic levels [m^2/s]
229 : invrs_tau_C4_zm, & ! Inverse time-scale tau on momentum levels [1/s]
230 : invrs_tau_wp3_zt, & ! Inverse time-scale tau on thermodynamic levels [1/s]
231 : invrs_tau_C1_zm, & ! Inverse tau values used for the C1 (dp1) term in wp2 [1/s]
232 : Skw_zm, & ! Skewness of w on momentum levels [-]
233 : Skw_zt, & ! Skewness of w on thermodynamic levels [-]
234 : rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3]
235 : rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3]
236 : invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg]
237 : invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg]
238 : radf, & ! Buoyancy production at the CL top [m^2/s^3]
239 : thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K]
240 : thv_ds_zt, & ! Dry, base-state theta_v on thermo. levs. [K]
241 : mixt_frac, & ! Weight of 1st normal distribution [-]
242 : wprtp, & ! Flux of total water mixing ratio [m/s kg/kg]
243 : wpthlp, & ! Flux of liquid water potential temp. [m/s K]
244 : rtp2, & ! Variance of rt (overall) [kg^2/kg^2]
245 : thlp2, & ! Variance of thl (overall) [K^2]
246 : Cx_fnc_Richardson, & ! Cx_fnc from Richardson_num [-]
247 : lhs_splat_wp2, & ! LHS coefficient of wp2 splatting term [1/s]
248 : lhs_splat_wp3 ! LHS coefficient of wp3 splatting term [1/s]
249 :
250 : type(implicit_coefs_terms), intent(in) :: &
251 : pdf_implicit_coefs_terms ! Implicit coefs / explicit terms [units vary]
252 :
253 : real( kind = core_rknd ), dimension(ngrdcol,nparams), intent(in) :: &
254 : clubb_params ! Array of CLUBB's tunable parameters [units vary]
255 :
256 : type(nu_vertical_res_dep), intent(in) :: &
257 : nu_vert_res_dep ! Vertical resolution dependent nu values
258 :
259 : integer, intent(in) :: &
260 : iiPDF_type, & ! Selected option for the two-component normal (double
261 : ! Gaussian) PDF type to use for the w, rt, and theta-l (or
262 : ! w, chi, and eta) portion of CLUBB's multivariate,
263 : ! two-component PDF.
264 : penta_solve_method ! Method to solve then penta-diagonal system
265 :
266 : logical, intent(in) :: &
267 : l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping the
268 : ! overall correlation of w and x (w and rt, as well as w and
269 : ! theta-l) within the limits of -max_mag_correlation_flux to
270 : ! max_mag_correlation_flux.
271 : l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind
272 : ! differencing approximation rather than a centered differencing
273 : ! for turbulent or mean advection terms. It affects rtm, thlm,
274 : ! sclrm, um and vm.
275 : l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. TKE = 1/2
276 : ! (u'^2 + v'^2 + w'^2)
277 : l_standard_term_ta, & ! Use the standard discretization for the turbulent advection
278 : ! terms. Setting to .false. means that a_1 and a_3 are pulled
279 : ! outside of the derivative in advance_wp2_wp3_module.F90 and in
280 : ! advance_xp2_xpyp_module.F90.
281 : l_partial_upwind_wp3, & ! Flag to use an "upwind" discretization rather
282 : ! than a centered discretization for the portion
283 : ! of the wp3 turbulent advection term for ADG1
284 : ! that is linearized in terms of wp3<t+1>.
285 : ! (Requires ADG1 PDF and l_standard_term_ta).
286 : l_damp_wp2_using_em, & ! intent(in) wp2 equation, use a dissipation formula of
287 : ! -(2/3)*em/tau_zm,
288 : ! as in Bougeault (1981)
289 : l_use_C11_Richardson, & ! Parameterize C16 based on Richardson number
290 : l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4
291 : l_lmm_stepping, & ! Apply Linear Multistep Method (LMM) Stepping
292 : l_use_tke_in_wp3_pr_turb_term, & ! Use TKE formulation for wp3 pr_turb term
293 : l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3
294 : l_use_wp3_lim_with_smth_Heaviside ! Flag to activate mods on wp3 limiters for conv test
295 :
296 : type (stats_metadata_type), intent(in) :: &
297 : stats_metadata
298 :
299 : ! --------------------------- Input/Output ---------------------------
300 : type (stats), target, dimension(ngrdcol), intent(inout) :: &
301 : stats_zt, &
302 : stats_zm, &
303 : stats_sfc
304 :
305 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
306 : wp2, & ! w'^2 (momentum levels) [m^2/s^2]
307 : wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3]
308 : wp3_zm ! w'^3 interpolated to momentum levels [m^3/s^3]
309 :
310 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
311 : wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2]
312 :
313 : ! --------------------------- Local Variables ---------------------------
314 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
315 17870112 : wp2_old, & ! w'^2 (momentum levels) [m^2/s^2]
316 17870112 : wp3_old ! w'^3 (thermodynamic levels) [m^3/s^3]
317 :
318 : ! Eddy Diffusion for w'^2 and w'^3.
319 17870112 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: Kw1 ! w'^2 coef. eddy diff. [m^2/s]
320 17870112 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: Kw8 ! w'^3 coef. eddy diff. [m^2/s]
321 :
322 : ! Internal variables for C11 function, Vince Larson 13 Mar 2005
323 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
324 17870112 : C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-]
325 17870112 : C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-]
326 : ! End Vince Larson's addition.
327 17870112 : C16_fnc ! C_16 parameter [-]
328 :
329 : real( kind = core_rknd ), dimension(ndiags5,ngrdcol,nz) :: &
330 17870112 : wp3_term_ta_lhs_result
331 :
332 : real( kind = core_rknd ), dimension(ndiags5,ngrdcol,nz) :: &
333 17870112 : wp3_pr3_lhs
334 :
335 : real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz) :: &
336 17870112 : lhs_ta_wp2, & ! Turbulent advection terms for wp2
337 17870112 : lhs_tp_wp3, & ! Turbulent production terms of w'^3
338 17870112 : lhs_adv_tp_wp3, & ! Turbulent production terms of w'^3 (for stats)
339 17870112 : lhs_pr_tp_wp3, & ! Pressure scrambling terms for turbulent production of w'^3 (for stats)
340 17870112 : lhs_ta_wp3 ! Turbulent advection terms for wp3
341 :
342 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
343 17870112 : lhs_dp1_wp2, & ! wp2 "over-implicit" dissipation term
344 17870112 : rhs_dp1_wp2, & ! wp2 rhs dissipation term
345 17870112 : lhs_pr1_wp2, & ! wp2 "over-implicit" pressure term 1
346 17870112 : rhs_pr1_wp2, & ! wp2 rhs pressure term 1
347 17870112 : lhs_pr1_wp3, & ! wp3 "over-implicit" pressure term 1
348 17870112 : rhs_pr1_wp3, & ! wp3 rhs pressure term 1
349 17870112 : rhs_bp_pr2_wp2, & ! wp2 bouyancy production and pressure term 2
350 17870112 : rhs_pr_dfsn_wp2, & ! wp2 pressure diffusion term
351 17870112 : rhs_bp1_pr2_wp3, & ! wp3 bouyancy production 1 and pressure term 2
352 17870112 : rhs_pr3_wp2, & ! wp2 pressure term 3
353 17870112 : rhs_pr3_wp3, & ! wp3 pressure term 3
354 17870112 : rhs_ta_wp3, & ! wp3 turbulent advection term
355 17870112 : rhs_pr_turb_wp3, & ! wp3 pressure-turbulence correlation term !--EXPERIMENTAL--!
356 17870112 : rhs_pr_dfsn_wp3 ! wp3 pressure diffusion term
357 :
358 : real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz) :: &
359 17870112 : lhs_diff_zm, & ! Completely implicit diffusion term for w'2
360 17870112 : lhs_diff_zt, & ! Completely implicit diffusion term for w'3
361 17870112 : lhs_diff_zm_crank, &
362 17870112 : lhs_diff_zt_crank, &
363 17870112 : lhs_ma_zm, & ! Mean advection term for w'2
364 17870112 : lhs_ma_zt ! Mean advection term for w'3
365 :
366 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
367 17870112 : lhs_ac_pr2_wp2, & ! Accumulation terms of w'^2 and w'^2 pressure term 2
368 17870112 : lhs_ac_pr2_wp3 ! Accumulation terms of w'^3 and w'^3 pressure term 2
369 :
370 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
371 17870112 : coef_wp4_implicit_zt, & ! <w'^4>|_zt=coef_wp4_implicit_zt*<w'^2>|_zt^2 [-]
372 17870112 : coef_wp4_implicit ! <w'^4> = coef_wp4_implicit * <w'^2>^2 [-]
373 :
374 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
375 17870112 : a1, & ! a_1 (momentum levels); See eqn. 23 in `Equations for CLUBB' [-]
376 17870112 : a1_zt ! a_1 interpolated to thermodynamic levels [-]
377 :
378 : real( kind = core_rknd ) :: &
379 : C1, & ! CLUBB tunable parameter C1
380 : C1b, & ! CLUBB tunable parameter C1b
381 : C1c, & ! CLUBB tunable parameter C1c
382 : C11, & ! CLUBB tunable parameter C11
383 : C11b, & ! CLUBB tunable parameter C11b
384 : C11c, & ! CLUBB tunable parameter C11c
385 : c_K1, & ! CLUBB tunable parameter c_K1
386 : c_K8 ! CLUBB tunable parameter c_K8
387 :
388 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
389 17870112 : dum_dz, dvm_dz ! Vertical derivatives of um and vm
390 :
391 : real( kind = core_rknd ), dimension(ndiags5,ngrdcol,2*nz) :: &
392 17870112 : lhs ! Implicit contributions to wp2/wp3 (band diag. matrix)
393 :
394 : real( kind = core_rknd ), dimension(ngrdcol,2*nz) :: &
395 17870112 : rhs ! RHS of band matrix
396 :
397 : real( kind = core_rknd ), dimension(ngrdcol) :: &
398 17870112 : C_wp3_pr_tp ! CLUBB tunable parameter C_wp3_pr_tp
399 :
400 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
401 17870112 : Kw1_zm, & ! Eddy diffusivity coefficient, momentum levels [m2/s]
402 17870112 : Kw8_zt ! Eddy diffusivity coefficient, thermo. levels [m2/s]
403 :
404 : integer :: k, i, b
405 :
406 : !$acc enter data create( wp2_old, wp3_old, C1_Skw_fnc, C11_Skw_fnc, C16_fnc, C_wp3_pr_tp, &
407 : !$acc wp3_term_ta_lhs_result, wp3_pr3_lhs, lhs_ta_wp2, &
408 : !$acc lhs_tp_wp3, lhs_adv_tp_wp3, lhs_pr_tp_wp3, &
409 : !$acc lhs_ta_wp3, lhs_dp1_wp2, rhs_dp1_wp2, lhs_pr1_wp2, &
410 : !$acc rhs_pr1_wp2, lhs_pr1_wp3, rhs_pr1_wp3, rhs_bp_pr2_wp2, &
411 : !$acc rhs_pr_dfsn_wp2, rhs_bp1_pr2_wp3, rhs_pr3_wp2, &
412 : !$acc rhs_pr3_wp3, rhs_ta_wp3, rhs_pr_turb_wp3, rhs_pr_dfsn_wp3, &
413 : !$acc lhs_diff_zm, lhs_diff_zt, lhs_diff_zm_crank, lhs_diff_zt_crank, &
414 : !$acc lhs_ma_zm, lhs_ma_zt, lhs_ac_pr2_wp2, lhs_ac_pr2_wp3, &
415 : !$acc coef_wp4_implicit_zt, coef_wp4_implicit, a1, a1_zt, &
416 : !$acc dum_dz, dvm_dz, lhs, rhs, Kw1, Kw8, Kw1_zm, Kw8_zt )
417 :
418 : !-----------------------------------------------------------------------
419 :
420 : ! Define tauw
421 :
422 : ! tauw3t = tau_zt
423 : ! / ( 1.
424 : ! + 3.0_core_rknd * max(
425 : ! min(1.-(mixt_frac-0.01_core_rknd)/(0.05_core_rknd-0.01_core_rknd)
426 : ! ,1.)
427 : ! ,0.)
428 : ! + 3.0_core_rknd * max(
429 : ! min(1.-(mixt_frac-0.99_core_rknd)/(0.95_core_rknd-0.99_core_rknd)
430 : ! ,1.)
431 : ! ,0.)
432 : ! )
433 :
434 : ! do k=1,gr%nz
435 : ! Skw = abs( wp3(k)/max(wp2(k),1.e-8)**1.5_core_rknd )
436 : ! Skw = min( 5.0_core_rknd, Skw )
437 : ! tauw3t(k) = tau_zt(k) / ( 0.005_core_rknd*Skw**4 + one )
438 : ! end do
439 :
440 : if ( l_crank_nich_diff .and. l_use_tke_in_wp2_wp3_K_dfsn ) then
441 : write(fstderr,*) "The l_crank_nich_diff flag and l_use_tke_in_wp2_wp3_K_dfsn ", &
442 : "flags cannot currently be used together."
443 : err_code = clubb_fatal_error
444 : return
445 : end if
446 :
447 : ! Vince Larson added code to make C11 function of Skw. 13 Mar 2005
448 : ! If this code is used, C11 is no longer relevant, i.e. constants
449 : ! are hardwired.
450 :
451 8935056 : if ( l_use_C11_Richardson ) then
452 : !$acc parallel loop gang vector collapse(2) default(present)
453 0 : do k = 1, nz
454 0 : do i = 1, ngrdcol
455 0 : C11_Skw_fnc(i,k) = Cx_fnc_Richardson(i,k)
456 : end do
457 : end do
458 : !$acc end parallel loop
459 : else
460 :
461 : !$acc parallel loop gang vector collapse(2) default(present)
462 768414816 : do k = 1, nz
463 12690480816 : do i = 1, ngrdcol
464 :
465 11922066000 : C11 = clubb_params(i,iC11)
466 11922066000 : C11b = clubb_params(i,iC11b)
467 11922066000 : C11c = clubb_params(i,iC11c)
468 :
469 : ! Calculate C_{1} and C_{11} as functions of skewness of w.
470 : ! The if..then here is only for computational efficiency -dschanen 2 Sept 08
471 12681545760 : if ( abs(C11-C11b) > abs(C11+C11b)*eps/2 ) then
472 11922066000 : C11_Skw_fnc(i,k) = C11b + (C11-C11b)*exp( -one_half * (Skw_zt(i,k)/C11c)**2 )
473 : else
474 0 : C11_Skw_fnc(i,k) = C11b
475 : end if
476 :
477 : end do
478 : end do
479 : !$acc end parallel loop
480 :
481 : end if ! l_use_C11_Richardson
482 :
483 : !$acc parallel loop gang vector collapse(2) default(present)
484 768414816 : do k = 1, nz
485 12690480816 : do i = 1, ngrdcol
486 :
487 11922066000 : C1 = clubb_params(i,iC1)
488 11922066000 : C1b = clubb_params(i,iC1b)
489 11922066000 : C1c = clubb_params(i,iC1c)
490 :
491 : ! The if..then here is only for computational efficiency -dschanen 2 Sept 08
492 12681545760 : if ( abs(C1-C1b) > abs(C1+C1b)*eps/2 ) then
493 0 : C1_Skw_fnc(i,k) = C1b + (C1-C1b)*exp( -one_half * (Skw_zm(i,k)/C1c)**2 )
494 : else
495 11922066000 : C1_Skw_fnc(i,k) = C1b
496 : end if
497 :
498 : end do
499 : end do
500 : !$acc end parallel loop
501 :
502 8935056 : if ( l_damp_wp2_using_em ) then
503 : ! Insert 1/3 here to account for the fact that in the dissipation term,
504 : ! (2/3)*em = (2/3)*(1/2)*(wp2+up2+vp2). Then we can insert wp2, up2,
505 : ! and vp2 directly into the dissipation subroutines without prefixing them by (1/3).
506 : !$acc parallel loop gang vector collapse(2) default(present)
507 0 : do k = 1, nz
508 0 : do i = 1, ngrdcol
509 0 : C1_Skw_fnc(i,k) = one_third * C1_Skw_fnc(i,k)
510 : end do
511 : end do
512 : !$acc end parallel loop
513 : end if
514 :
515 : ! Set C16_fnc based on Richardson_num
516 : !$acc parallel loop gang vector collapse(2) default(present)
517 768414816 : do k = 1, nz
518 12690480816 : do i = 1, ngrdcol
519 12681545760 : C16_fnc(i,k) = Cx_fnc_Richardson(i,k)
520 : end do
521 : end do
522 : !$acc end parallel loop
523 :
524 8935056 : if ( clubb_at_least_debug_level( 0 ) ) then
525 :
526 : !$acc parallel loop gang vector collapse(2) default(present) reduction(.or.:err_code)
527 768414816 : do k = 1, nz
528 12690480816 : do i = 1, ngrdcol
529 : ! Assertion check for C11_Skw_fnc
530 12681545760 : if ( C11_Skw_fnc(i,k) > one .or. C11_Skw_fnc(i,k) < 0._core_rknd ) then
531 0 : write(fstderr,*) "The C11_Skw_fnc is outside the valid range for this variable"
532 0 : err_code = clubb_fatal_error
533 : end if
534 : end do
535 : end do
536 : !$acc end parallel loop
537 :
538 : !$acc parallel loop gang vector collapse(2) default(present) reduction(.or.:err_code)
539 768414816 : do k = 1, nz
540 12690480816 : do i = 1, ngrdcol
541 : ! Assertion check for C11_Skw_fnc
542 12681545760 : if ( C16_fnc(i,k) > one .or. C16_fnc(i,k) < 0._core_rknd ) then
543 0 : write(fstderr,*) "The C16_fnc is outside the valid range for this variable"
544 0 : err_code = clubb_fatal_error
545 : end if
546 : end do
547 : end do
548 : !$acc end parallel loop
549 :
550 8935056 : if ( err_code == clubb_fatal_error ) then
551 : return
552 : end if
553 :
554 : end if
555 :
556 8935056 : if ( stats_metadata%l_stats_samp ) then
557 :
558 : !$acc update host( C11_Skw_fnc, C1_Skw_fnc )
559 :
560 0 : do i = 1, ngrdcol
561 0 : call stat_update_var( stats_metadata%iC11_Skw_fnc, C11_Skw_fnc(i,:), & ! intent(in)
562 0 : stats_zt(i) ) ! intent(inout)
563 : call stat_update_var( stats_metadata%iC1_Skw_fnc, C1_Skw_fnc(i,:), & ! intent(in)
564 0 : stats_zm(i) ) ! intent(inout)
565 : end do
566 : endif
567 :
568 : ! Define the Coefficent of Eddy Diffusivity for the wp2 and wp3.
569 : !$acc parallel loop gang vector collapse(2) default(present)
570 768414816 : do k = 1, nz
571 12690480816 : do i = 1, ngrdcol
572 :
573 : ! Kw1 is used for wp2, which is located on momentum levels.
574 : ! Kw1 is located on thermodynamic levels.
575 : ! Kw1 = c_K1 * Kh_zt
576 11922066000 : Kw1(i,k) = clubb_params(i,ic_K1) * Kh_zt(i,k)
577 :
578 : ! Kw8 is used for wp3, which is located on thermodynamic levels.
579 : ! Kw8 is located on momentum levels.
580 : ! Note: Kw8 is usually defined to be 1/2 of Kh_zm.
581 : ! Kw8 = c_K8 * Kh_zm
582 12681545760 : Kw8(i,k) = clubb_params(i,ic_K8) * Kh_zm(i,k)
583 : end do
584 : enddo
585 : !$acc end parallel loop
586 :
587 : if ( .not. l_explicit_turbulent_adv_wp3 ) then
588 :
589 8935056 : if ( iiPDF_type == iiPDF_new .or. iiPDF_type == iiPDF_new_hybrid ) then
590 :
591 : ! Unpack coef_wp4_implicit from pdf_implicit_coefs_terms.
592 : ! Since PDF parameters and the resulting implicit coefficients and
593 : ! explicit terms are calculated on thermodynamic levels, the <w'^4>
594 : ! implicit coefficient needs to be unpacked as coef_wp4_implicit_zt.
595 0 : do k = 1, nz
596 0 : do i = 1, ngrdcol
597 0 : coef_wp4_implicit_zt(i,k) = pdf_implicit_coefs_terms%coef_wp4_implicit(i,k)
598 : end do
599 : end do
600 :
601 : ! The values of <w'^4> are located on momentum levels. Interpolate
602 : ! coef_wp4_implicit_zt to momentum levels as coef_wp4_implicit. The
603 : ! discretization diagram is found in the description section of
604 : ! function wp3_term_ta_new_pdf_lhs below. These values are always
605 : ! positive.
606 : coef_wp4_implicit(:,:) = zt2zm( nz, ngrdcol, gr, coef_wp4_implicit_zt(:,:), &
607 0 : zero_threshold )
608 :
609 : ! Set the value of coef_wp4_implicit to 0 at the lower boundary and at
610 : ! the upper boundary. This sets the value of <w'^4> to 0 at the lower
611 : ! and upper boundaries.
612 0 : coef_wp4_implicit(:,1) = zero
613 0 : coef_wp4_implicit(:,nz) = zero
614 :
615 0 : if ( stats_metadata%l_stats_samp ) then
616 0 : do i = 1, ngrdcol
617 0 : call stat_update_var( stats_metadata%icoef_wp4_implicit, coef_wp4_implicit(i,:), & ! intent(in)
618 0 : stats_zm(i) ) ! intent(inout)
619 : end do
620 : endif ! stats_metadata%l_stats_samp
621 :
622 8935056 : elseif ( iiPDF_type == iiPDF_ADG1 ) then
623 :
624 : ! Define a_1 and a_3 (both are located on momentum levels).
625 : ! They are variables that are both functions of sigma_sqd_w (where
626 : ! sigma_sqd_w is located on momentum levels).
627 : !$acc parallel loop gang vector collapse(2) default(present)
628 768414816 : do k = 1, nz
629 12690480816 : do i = 1, ngrdcol
630 12681545760 : a1(i,k) = one / ( one - sigma_sqd_w(i,k) )
631 : end do
632 : end do
633 : !$acc end parallel loop
634 :
635 : ! Interpolate a_1 from momentum levels to thermodynamic levels. This
636 : ! will be used for the w'^3 turbulent advection (ta) term.
637 8935056 : a1_zt(:,:) = zm2zt( nz, ngrdcol, gr, a1(:,:), zero_threshold ) ! Positive def. quantity
638 :
639 : endif ! iiPDF_type
640 :
641 : endif ! .not. l_explicit_turbulent_adv_wp3
642 :
643 : ! Not using pressure term, set to 0
644 : !$acc parallel loop gang vector collapse(2) default(present)
645 768414816 : do k = 1, nz
646 12690480816 : do i = 1, ngrdcol
647 12681545760 : rhs_pr3_wp3(i,k) = zero
648 : end do
649 : end do
650 : !$acc end parallel loop
651 :
652 : ! Initiaize some terms to zero
653 : !$acc parallel loop gang vector default(present) collapse(3)
654 768414816 : do k = 1, nz
655 12690480816 : do i = 1, ngrdcol
656 72291875760 : do b = 1, ndiags5
657 59610330000 : wp3_term_ta_lhs_result(b,i,k) = zero
658 71532396000 : wp3_pr3_lhs(b,i,k) = zero
659 : end do
660 : end do
661 : end do
662 : !$acc end parallel loop
663 :
664 8935056 : Kw1_zm(:,:) = zt2zm( nz, ngrdcol, gr, Kw1(:,:), zero )
665 8935056 : Kw8_zt(:,:) = zm2zt( nz, ngrdcol, gr, Kw8(:,:), zero )
666 :
667 : ! Experimental term from CLUBB TRAC ticket #411
668 :
669 : ! Compute the vertical derivative of the u and v winds
670 8935056 : if ( .not. l_use_tke_in_wp3_pr_turb_term ) then
671 8935056 : dum_dz(:,:) = ddzt( nz, ngrdcol, gr, um(:,:) )
672 8935056 : dvm_dz(:,:) = ddzt( nz, ngrdcol, gr, vm(:,:) )
673 : end if
674 :
675 : ! Calculate term
676 : call wp3_term_pr_turb_rhs( nz, ngrdcol, gr, clubb_params(:,iC_wp3_pr_turb), & ! intent(in)
677 : Kh_zt, wpthvp, & ! intent(in)
678 : dum_dz, dvm_dz, & ! intent(in)
679 : upwp, vpwp, & ! intent(in)
680 : thv_ds_zt, & ! intent(in)
681 : rho_ds_zm, invrs_rho_ds_zt, & ! intent(in)
682 : em, wp2, & ! intent(in)
683 : rhs_pr_turb_wp3, & ! intent(out)
684 8935056 : l_use_tke_in_wp3_pr_turb_term ) ! intent(in)
685 :
686 : call wp3_term_pr_dfsn_rhs( nz, ngrdcol, gr, clubb_params(:,iC_wp3_pr_dfsn), & ! intent(in)
687 : rho_ds_zm, invrs_rho_ds_zt, & ! intent(in)
688 : wp2up2, wp2vp2, wp4, & ! intent(in)
689 : up2, vp2, wp2, & ! intent(in)
690 8935056 : rhs_pr_dfsn_wp3 ) ! intent(out)
691 :
692 : call wp2_term_pr_dfsn_rhs( nz, ngrdcol, gr, clubb_params(:,iC_wp2_pr_dfsn), & ! intent(in)
693 : rho_ds_zt, invrs_rho_ds_zm, & ! intent(in)
694 : wpup2, wpvp2, wp3, & ! intent(in)
695 8935056 : rhs_pr_dfsn_wp2 ) ! intent(out)
696 :
697 : ! This part handles the wp2 equation terms.
698 : call diffusion_zm_lhs( nz, ngrdcol, gr, Kw1, Kw1_zm, nu_vert_res_dep%nu1, & ! intent(in)
699 : invrs_rho_ds_zm, rho_ds_zt, & ! intent(in)
700 8935056 : lhs_diff_zm ) ! intent(out)
701 :
702 : ! This part handles the wp3 equation terms.
703 : call diffusion_zt_lhs( nz, ngrdcol, gr, Kw8, Kw8_zt, nu_vert_res_dep%nu8, & ! intent(in)
704 : invrs_rho_ds_zt, rho_ds_zm, & ! intent(in)
705 8935056 : lhs_diff_zt ) ! intent(out)
706 :
707 : ! Calculate RHS eddy diffusion terms for w'2 and w'3
708 : if ( l_crank_nich_diff ) then
709 : !$acc parallel loop gang vector collapse(2) default(present)
710 : do k = 2, nz-1
711 : do i = 1, ngrdcol
712 : lhs_diff_zm_crank(1,i,k) = lhs_diff_zm(1,i,k) * one_half
713 : lhs_diff_zm_crank(2,i,k) = lhs_diff_zm(2,i,k) * one_half
714 : lhs_diff_zm_crank(3,i,k) = lhs_diff_zm(3,i,k) * one_half
715 :
716 : lhs_diff_zt_crank(1,i,k) = lhs_diff_zt(1,i,k) * clubb_params(i,iC12) * one_half
717 : lhs_diff_zt_crank(2,i,k) = lhs_diff_zt(2,i,k) * clubb_params(i,iC12) * one_half
718 : lhs_diff_zt_crank(3,i,k) = lhs_diff_zt(3,i,k) * clubb_params(i,iC12) * one_half
719 : end do
720 : end do
721 : !$acc end parallel loop
722 : end if
723 :
724 : ! Calculate "over-implicit" pressure terms for w'2 and w'3
725 8935056 : if ( l_tke_aniso ) then
726 : call wp2_term_pr1_rhs( nz, ngrdcol, clubb_params(:,iC4), & ! intent(in)
727 : up2, vp2, invrs_tau_C4_zm, & ! intent(in)
728 8935056 : rhs_pr1_wp2 ) ! intent(out)
729 :
730 : ! Note: An "over-implicit" weighted time step is applied to the term.
731 : ! A weighting factor of greater than 1 may be used to make the
732 : ! term more numerically stable (see note below for w'^3 RHS
733 : ! turbulent advection (ta) term).
734 : call wp2_term_pr1_lhs( nz, ngrdcol, & ! intent(in)
735 : clubb_params(:,iC4), invrs_tau_C4_zm, & ! intent(in)
736 8935056 : lhs_pr1_wp2 ) ! intent(out)
737 : end if
738 :
739 : !$acc parallel loop gang vector default(present)
740 149194656 : do i = 1, ngrdcol
741 149194656 : C_wp3_pr_tp(i) = one
742 : end do
743 : !$acc end parallel loop
744 :
745 : ! Calculate turbulent production terms of w'^3
746 : call wp3_term_tp_lhs( nz, ngrdcol, gr, C_wp3_pr_tp, & ! intent(in)
747 : wp2, rho_ds_zm, invrs_rho_ds_zt, & ! intent(in)
748 8935056 : lhs_adv_tp_wp3 ) ! intent(out)
749 :
750 : !$acc parallel loop gang vector default(present)
751 149194656 : do i = 1, ngrdcol
752 149194656 : C_wp3_pr_tp(i) = -clubb_params(i,iC_wp3_pr_tp)
753 : end do
754 : !$acc end parallel loop
755 :
756 : ! Calculate pressure damping of turbulent production of w'^3
757 : call wp3_term_tp_lhs( nz, ngrdcol, gr, C_wp3_pr_tp, & ! intent(in)
758 : wp2, rho_ds_zm, invrs_rho_ds_zt, & ! intent(in)
759 8935056 : lhs_pr_tp_wp3 ) ! intent(out)
760 :
761 : ! Sum contributions to turbulent production from standard term & damping
762 : !$acc parallel loop gang vector default(present) collapse(3)
763 768414816 : do k = 1, nz
764 12690480816 : do i = 1, ngrdcol
765 36525677760 : do b = 1, ndiags2
766 35766198000 : lhs_tp_wp3(b,i,k) = lhs_adv_tp_wp3(b,i,k) + lhs_pr_tp_wp3(b,i,k)
767 : end do
768 : end do
769 : end do
770 : !$acc end parallel loop
771 :
772 : ! Calculate pressure terms 1 for w'^3
773 : call wp3_term_pr1_lhs( nz, ngrdcol, & ! intent(in)
774 : clubb_params(:,iC8), clubb_params(:,iC8b), & ! intent(in)
775 : invrs_tau_wp3_zt, Skw_zt, & ! intent(in)
776 : l_damp_wp3_Skw_squared, & ! intent(in)
777 8935056 : lhs_pr1_wp3 ) ! intent(out)
778 :
779 : ! Calculate dissipation terms 1 for w'^2
780 : call wp2_term_dp1_lhs( nz, ngrdcol, & ! intent(in)
781 : C1_Skw_fnc, invrs_tau_C1_zm, & ! intent(in)
782 8935056 : lhs_dp1_wp2 ) ! intent(out)
783 :
784 : ! Calculate buoyancy production of w'^2 and w'^2 pressure term 2
785 : call wp2_terms_bp_pr2_rhs( nz, ngrdcol, & ! intent(in)
786 : clubb_params(:,iC_uu_buoy), & ! intent(in)
787 : thv_ds_zm, wpthvp, & ! intent(in)
788 8935056 : rhs_bp_pr2_wp2 ) ! intent(out)
789 :
790 : ! Calculate pressure terms 3 for w'^2
791 : call wp2_term_pr3_rhs( nz, ngrdcol, gr, & ! intent(in)
792 : clubb_params(:,iC_uu_shr), & ! intent(in)
793 : clubb_params(:,iC_uu_buoy), & ! intent(in)
794 : thv_ds_zm, wpthvp, upwp, & ! intent(in)
795 : um, vpwp, vm, & ! intent(in)
796 8935056 : rhs_pr3_wp2 ) ! intent(out)
797 :
798 : ! Calculate dissipation terms 1 for w'^2
799 : call wp2_term_dp1_rhs( nz, ngrdcol, C1_Skw_fnc, & ! intent(in)
800 : invrs_tau_C1_zm, w_tol_sqd, up2, vp2, & ! intent(in)
801 : l_damp_wp2_using_em, & ! intent(in)
802 8935056 : rhs_dp1_wp2 ) ! intent(out)
803 :
804 : ! Calculate buoyancy production of w'^3 and w'^3 pressure term 2
805 : call wp3_terms_bp1_pr2_rhs( nz, ngrdcol, C11_Skw_fnc, & ! intent(in)
806 : thv_ds_zt, wp2thvp, & ! intent(in)
807 8935056 : rhs_bp1_pr2_wp3 ) ! intent(out)
808 :
809 : ! Calculate pressure terms 1 for w'^3
810 : call wp3_term_pr1_rhs( nz, ngrdcol, gr, & ! intent(in)
811 : clubb_params(:,iC8), clubb_params(:,iC8b), & ! intent(in)
812 : invrs_tau_wp3_zt, Skw_zt, wp3, & ! intent(in)
813 : l_damp_wp3_Skw_squared, & ! intent(in)
814 8935056 : rhs_pr1_wp3 ) ! intent(out)
815 :
816 : if ( l_explicit_turbulent_adv_wp3 ) then
817 :
818 : ! The turbulent advection term is being solved explicitly.
819 :
820 : ! The w'^3 turbulent advection term is being solved explicitly.
821 : !
822 : ! The turbulent advection stats code is still set up in two parts,
823 : ! so call stat_begin_update_pt. The implicit portion of the stat,
824 : ! which has a value of 0, will still be called later. Since
825 : ! stat_begin_update_pt automatically subtracts the value sent in,
826 : ! reverse the sign on the input value.
827 : call wp3_term_ta_explicit_rhs( nz, ngrdcol, gr, & ! intent(in)
828 : wp4, rho_ds_zm, invrs_rho_ds_zt, & ! intent(in)
829 : rhs_ta_wp3 ) ! intent(out)
830 :
831 : else
832 :
833 : ! The turbulent advection term is being solved implicitly. See note above
834 :
835 8935056 : if ( iiPDF_type == iiPDF_ADG1 ) then
836 :
837 : ! The ADG1 PDF is used.
838 : call wp3_term_ta_ADG1_lhs( nz, ngrdcol, gr, & ! intent(in)
839 : wp2, a1, a1_zt, a3, a3_zt, & ! intent(in)
840 : wp3_on_wp2, rho_ds_zm, & ! intent(in)
841 : rho_ds_zt, invrs_rho_ds_zt, & ! intent(in)
842 : l_standard_term_ta, & ! intent(in)
843 : l_partial_upwind_wp3, & ! intent(in)
844 8935056 : wp3_term_ta_lhs_result ) ! intent(out)
845 :
846 0 : elseif ( iiPDF_type == iiPDF_new .or. iiPDF_type == iiPDF_new_hybrid ) then
847 :
848 : ! The new PDF or the new hybrid PDF is used.
849 :
850 : ! Calculate terms
851 : call wp3_term_ta_new_pdf_lhs( nz, ngrdcol, gr, coef_wp4_implicit, & ! intent(in)
852 : wp2, rho_ds_zm, invrs_rho_ds_zt, & ! intent(in)
853 0 : lhs_ta_wp3 ) ! intent(out)
854 :
855 : ! Add terms
856 0 : do k = 2, nz-1
857 0 : do i = 1, ngrdcol
858 0 : wp3_term_ta_lhs_result(2,i,k) = lhs_ta_wp3(1,i,k)
859 0 : wp3_term_ta_lhs_result(4,i,k) = lhs_ta_wp3(2,i,k)
860 : end do
861 : end do
862 :
863 : endif ! iiPDF_type
864 :
865 : endif ! l_explicit_turbulent_adv_wp3
866 :
867 : ! Compute the explicit portion of the w'^2 and w'^3 equations.
868 : ! Build the right-hand side vector.
869 : call wp23_rhs( nz, ngrdcol, gr, dt, & ! intent(in)
870 : wp3_term_ta_lhs_result, & ! intent(in)
871 : lhs_diff_zm, lhs_diff_zt, lhs_diff_zm_crank, lhs_diff_zt_crank, & ! intent(in)
872 : lhs_tp_wp3, lhs_adv_tp_wp3, lhs_pr_tp_wp3, & ! intent(in)
873 : lhs_ta_wp3, lhs_dp1_wp2, rhs_dp1_wp2, lhs_pr1_wp2, & ! intent(in)
874 : rhs_pr1_wp2, lhs_pr1_wp3, rhs_pr1_wp3, rhs_bp_pr2_wp2, & ! intent(in)
875 : rhs_pr_dfsn_wp2, rhs_bp1_pr2_wp3, rhs_pr3_wp2, rhs_pr3_wp3, & ! intent(in)
876 : rhs_ta_wp3, rhs_pr_turb_wp3, rhs_pr_dfsn_wp3, & ! intent(in)
877 : wp2, wp3, wpup2, wpvp2, & ! intent(in)
878 : wpthvp, wp2thvp, up2, vp2, & ! intent(in)
879 : C11_Skw_fnc, radf, thv_ds_zm, thv_ds_zt, & ! intent(in)
880 : lhs_splat_wp2, lhs_splat_wp3, & ! intent(in)
881 : clubb_params, & ! intent(in)
882 : iiPDF_type, & ! intent(in)
883 : l_tke_aniso, & ! intent(in)
884 : l_use_tke_in_wp2_wp3_K_dfsn, & ! intent(in)
885 : stats_metadata, & ! intent(in)
886 : stats_zt, stats_zm, & ! intent(in)
887 8935056 : rhs ) ! intent(out)
888 :
889 : ! Calculated mean advection term for w'2
890 : call term_ma_zm_lhs( nz, ngrdcol, wm_zm, & ! intent(in)
891 : gr%invrs_dzm, gr%weights_zm2zt, & ! In
892 8935056 : lhs_ma_zm ) ! intent(out)
893 :
894 : ! Calculated mean advection term for w'3
895 : call term_ma_zt_lhs( nz, ngrdcol, wm_zt, gr%weights_zt2zm, & ! intent(in)
896 : gr%invrs_dzt, gr%invrs_dzm, & ! intent(in)
897 : l_upwind_xm_ma, & ! intent(in)
898 8935056 : lhs_ma_zt ) ! intent(out)
899 :
900 : !$acc parallel loop gang vector default(present) collapse(3)
901 768414816 : do k = 1, nz
902 12690480816 : do i = 1, ngrdcol
903 48447743760 : do b = 1, ndiags3
904 47688264000 : lhs_diff_zt(b,i,k) = lhs_diff_zt(b,i,k) * clubb_params(i,iC12)
905 : end do
906 : end do
907 : end do
908 : !$acc end parallel loop
909 :
910 : if ( l_crank_nich_diff ) then
911 :
912 : ! Using a Crank-Nicholson time step for diffusion terms
913 : ! Modify diffusion terms
914 : !$acc parallel loop gang vector collapse(2) default(present)
915 : do k = 2, nz - 1
916 : do i = 1, ngrdcol
917 : lhs_diff_zm(1,i,k) = lhs_diff_zm(1,i,k) * 0.5_core_rknd
918 : lhs_diff_zm(2,i,k) = lhs_diff_zm(2,i,k) * 0.5_core_rknd
919 : lhs_diff_zm(3,i,k) = lhs_diff_zm(3,i,k) * 0.5_core_rknd
920 :
921 : lhs_diff_zt(1,i,k) = lhs_diff_zt(1,i,k) * 0.5_core_rknd
922 : lhs_diff_zt(2,i,k) = lhs_diff_zt(2,i,k) * 0.5_core_rknd
923 : lhs_diff_zt(3,i,k) = lhs_diff_zt(3,i,k) * 0.5_core_rknd
924 : end do
925 : end do
926 : !$acc end parallel loop
927 :
928 : end if
929 :
930 : ! Calculate turbulent advection terms for wp2
931 : call wp2_term_ta_lhs( nz, ngrdcol, gr, & ! intent(in)
932 : rho_ds_zt, invrs_rho_ds_zm, & ! intent(in)
933 8935056 : lhs_ta_wp2 ) ! intent(out)
934 :
935 : ! Calculate accumulation terms of w'^2 and w'^2 pressure term 2
936 : call wp2_terms_ac_pr2_lhs( nz, ngrdcol, gr, & ! intent(in)
937 : clubb_params(:,iC_uu_shr), wm_zt, & ! intent(in)
938 8935056 : lhs_ac_pr2_wp2 ) ! intent(out)
939 :
940 : ! Calculate accumulation terms of w'^3 and w'^3 pressure terms 2
941 : call wp3_terms_ac_pr2_lhs( nz, ngrdcol, gr, C11_Skw_fnc, wm_zm, & ! intent(in)
942 8935056 : lhs_ac_pr2_wp3 ) ! intent(out)
943 :
944 : ! Compute the implicit portion of the w'^2 and w'^3 equations.
945 : ! Build the left-hand side matrix.
946 : call wp23_lhs( nz, ngrdcol, gr, dt, & ! intent(in)
947 : wp3_term_ta_lhs_result, & ! intent(in)
948 : lhs_diff_zm, lhs_diff_zt, lhs_ma_zm, & ! intent(in)
949 : lhs_ma_zt, lhs_ta_wp2, & ! intent(in)
950 : lhs_tp_wp3, & ! intent(in)
951 : lhs_ac_pr2_wp2, lhs_ac_pr2_wp3, lhs_dp1_wp2, & ! intent(in)
952 : lhs_pr1_wp3, lhs_pr1_wp2, lhs_splat_wp2, lhs_splat_wp3, & ! intent(in)
953 : l_tke_aniso, & ! intent(in)
954 8935056 : lhs ) ! intent(out)
955 :
956 8935056 : if ( l_lmm_stepping ) then
957 : !$acc parallel loop gang vector collapse(2) default(present)
958 0 : do k = 1, nz
959 0 : do i = 1, ngrdcol
960 0 : wp2_old(i,k) = wp2(i,k)
961 0 : wp3_old(i,k) = wp3(i,k)
962 : end do
963 : end do
964 : !$acc end parallel loop
965 : endif ! l_lmm_stepping
966 :
967 : ! Solve semi-implicitly
968 : call wp23_solve( nz, ngrdcol, gr, dt, lhs, rhs, & ! intent(in)
969 : lhs_ma_zm, lhs_dp1_wp2, lhs_diff_zm, & ! intent(in)
970 : lhs_ta_wp2, lhs_pr1_wp2, lhs_pr1_wp3, & ! intent(in)
971 : lhs_diff_zt, lhs_adv_tp_wp3, lhs_pr_tp_wp3, & ! intent(in)
972 : wp3_pr3_lhs, lhs_ma_zt, & ! intent(in)
973 : wp3_term_ta_lhs_result, & ! intent(in)
974 : wm_zm, wm_zt, & ! intent(in)
975 : sfc_elevation, C11_Skw_fnc, & ! intent(in)
976 : rho_ds_zm, rho_ds_zt, & ! intent(in)
977 : wprtp, wpthlp, rtp2, thlp2, & ! intent(in)
978 : clubb_params, & ! intent(in)
979 : penta_solve_method, & ! intent(in)
980 : l_min_wp2_from_corr_wx, & ! intent(in)
981 : l_tke_aniso, & ! intent(in)
982 : l_use_tke_in_wp2_wp3_K_dfsn, & ! intent(in)
983 : l_use_wp3_lim_with_smth_Heaviside, & ! intent(in)
984 : stats_metadata, & ! intent(in)
985 : stats_zt, stats_zm, stats_sfc, & ! intent(inout)
986 8935056 : wp2, wp3, wp3_zm, wp2_zt ) ! intent(inout)
987 :
988 8935056 : if ( l_lmm_stepping ) then
989 : !$acc parallel loop gang vector collapse(2) default(present)
990 0 : do k = 1, nz
991 0 : do i = 1, ngrdcol
992 0 : wp2(i,k) = one_half * ( wp2_old(i,k) + wp2(i,k) )
993 0 : wp3(i,k) = one_half * ( wp3_old(i,k) + wp3(i,k) )
994 : end do
995 : end do
996 : !$acc end parallel loop
997 : endif ! l_lmm_stepping
998 :
999 : ! When selected, apply sponge damping after wp2 and wp3 have been advanced.
1000 8935056 : if ( wp2_sponge_damp_settings%l_sponge_damping ) then
1001 :
1002 : !$acc update host( wp2 )
1003 :
1004 0 : if ( stats_metadata%l_stats_samp ) then
1005 0 : do i = 1, ngrdcol
1006 0 : call stat_begin_update( nz, stats_metadata%iwp2_sdmp, wp2(i,:) / dt, & ! intent(in)
1007 0 : stats_zm(i) ) ! intent(inout)
1008 : end do
1009 : end if
1010 :
1011 0 : do i = 1, ngrdcol
1012 0 : wp2(i,:) = sponge_damp_xp2( nz, dt, gr%zm(i,:), wp2(i,:), w_tol_sqd, &
1013 0 : wp2_sponge_damp_profile )
1014 : end do
1015 :
1016 0 : if ( stats_metadata%l_stats_samp ) then
1017 0 : do i = 1, ngrdcol
1018 0 : call stat_end_update( nz, stats_metadata%iwp2_sdmp, wp2(i,:) / dt, & ! intent(in)
1019 0 : stats_zm(i) ) ! intent(inout)
1020 : end do
1021 : end if
1022 :
1023 : !$acc update device( wp2 )
1024 :
1025 : end if ! wp2_sponge_damp_settings%l_sponge_damping
1026 :
1027 8935056 : if ( wp3_sponge_damp_settings%l_sponge_damping ) then
1028 :
1029 : !$acc update host( wp3 )
1030 :
1031 0 : if ( stats_metadata%l_stats_samp ) then
1032 0 : do i = 1, ngrdcol
1033 0 : call stat_begin_update( nz, stats_metadata%iwp3_sdmp, wp3(i,:) / dt, & ! intent(in)
1034 0 : stats_zt(i) ) ! intent(inout)
1035 : end do
1036 : end if
1037 :
1038 0 : do i = 1, ngrdcol
1039 0 : wp3(i,:) = sponge_damp_xp3( nz, dt, gr%zt(i,:), gr%zm(i,:), wp3(i,:), &
1040 0 : wp3_sponge_damp_profile )
1041 : end do
1042 :
1043 0 : if ( stats_metadata%l_stats_samp ) then
1044 0 : do i = 1, ngrdcol
1045 0 : call stat_end_update( nz, stats_metadata%iwp3_sdmp, wp3(i,:) / dt, & ! intent(in)
1046 0 : stats_zt(i) ) ! intent(inout)
1047 : end do
1048 : end if
1049 :
1050 : !$acc update device( wp3 )
1051 :
1052 : end if ! wp3_sponge_damp_settings%l_sponge_damping
1053 :
1054 8935056 : if ( clubb_at_least_debug_level( 0 ) ) then
1055 8935056 : if ( err_code == clubb_fatal_error ) then
1056 :
1057 : !$acc update host( sfc_elevation, sigma_sqd_w, wm_zm, sfc_elevation, &
1058 : !$acc sigma_sqd_w, wm_zm, wm_zt, wpup2, wpvp2, wp2up2, &
1059 : !$acc wp2vp2, wp4, wpthvp, wp2thvp, um, vm, upwp, vpwp, &
1060 : !$acc up2, vp2, em, Kh_zm, Kh_zt, invrs_tau_C4_zm, &
1061 : !$acc invrs_tau_wp3_zt, Skw_zm, Skw_zt, mixt_frac, a3, &
1062 : !$acc a3_zt, wp3_on_wp2, invrs_tau_C1_zm, rho_ds_zm, rho_ds_zt, &
1063 : !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, radf, thv_ds_zm, thv_ds_zt, &
1064 : !$acc Cx_fnc_Richardson, lhs_splat_wp2, lhs_splat_wp3, wprtp, &
1065 : !$acc wpthlp, rtp2, thlp2, wp2_zt, wp3_zm, wp2_old, wp2, &
1066 : !$acc wp3_old, wp3 )
1067 :
1068 0 : write(fstderr,*) "Error in advance_wp2_wp3"
1069 :
1070 0 : write(fstderr,*) "intent(in)"
1071 :
1072 0 : write(fstderr,*) "gr%zt(1,:) = ", gr%zt, new_line('c')
1073 0 : write(fstderr,*) "dt = ", dt, new_line('c')
1074 0 : write(fstderr,*) "sfc_elevation = ", sfc_elevation, new_line('c')
1075 0 : write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w, new_line('c')
1076 0 : write(fstderr,*) "wm_zm = ", wm_zm, new_line('c')
1077 0 : write(fstderr,*) "wm_zt = ", wm_zt, new_line('c')
1078 0 : write(fstderr,*) "wpup2 = ", wpup2, new_line('c')
1079 0 : write(fstderr,*) "wpvp2 = ", wpvp2, new_line('c')
1080 0 : write(fstderr,*) "wp2up2 = ", wp2up2, new_line('c')
1081 0 : write(fstderr,*) "wp2vp2 = ", wp2vp2, new_line('c')
1082 0 : write(fstderr,*) "wp4 = ", wp4, new_line('c')
1083 0 : write(fstderr,*) "wpthvp = ", wpthvp, new_line('c')
1084 0 : write(fstderr,*) "wp2thvp = ", wp2thvp, new_line('c')
1085 0 : write(fstderr,*) "um = ", um, new_line('c')
1086 0 : write(fstderr,*) "vm = ", vm, new_line('c')
1087 0 : write(fstderr,*) "upwp = ", upwp, new_line('c')
1088 0 : write(fstderr,*) "vpwp = ", vpwp, new_line('c')
1089 0 : write(fstderr,*) "up2 = ", up2, new_line('c')
1090 0 : write(fstderr,*) "vp2 = ", vp2, new_line('c')
1091 0 : write(fstderr,*) "em = ", em, new_line('c')
1092 0 : write(fstderr,*) "Kh_zm = ", Kh_zm, new_line('c')
1093 0 : write(fstderr,*) "Kh_zt = ", Kh_zt, new_line('c')
1094 0 : write(fstderr,*) "invrs_tau_C4 zm = ", invrs_tau_C4_zm, new_line('c')
1095 0 : write(fstderr,*) "invrs_tau_wp3_zt = ", invrs_tau_wp3_zt, new_line('c')
1096 0 : write(fstderr,*) "Skw_zm = ", Skw_zm, new_line('c')
1097 0 : write(fstderr,*) "Skw_zt = ", Skw_zt, new_line('c')
1098 0 : write(fstderr,*) "mixt_frac = ", mixt_frac, new_line('c')
1099 0 : write(fstderr,*) "a3 = ", a3, new_line('c')
1100 0 : write(fstderr,*) "a3_zt = ", a3_zt, new_line('c')
1101 0 : write(fstderr,*) "wp3_on_wp2 = ", wp3_on_wp2, new_line('c')
1102 0 : write(fstderr,*) "invrs_tau_C1_zm = ", invrs_tau_C1_zm, new_line('c')
1103 0 : write(fstderr,*) "rho_ds_zm = ", rho_ds_zm, new_line('c')
1104 0 : write(fstderr,*) "rho_ds_zt = ", rho_ds_zt, new_line('c')
1105 0 : write(fstderr,*) "invrs_rho_ds_zm = ", invrs_rho_ds_zm, new_line('c')
1106 0 : write(fstderr,*) "invrs_rho_ds_zt = ", invrs_rho_ds_zt, new_line('c')
1107 0 : write(fstderr,*) "radf = ", radf, new_line('c')
1108 0 : write(fstderr,*) "thv_ds_zm = ", thv_ds_zm, new_line('c')
1109 0 : write(fstderr,*) "thv_ds_zt = ", thv_ds_zt, new_line('c')
1110 0 : write(fstderr,*) "Cx_fnc_Richardson = ", Cx_fnc_Richardson, new_line('c')
1111 0 : write(fstderr,*) "lhs_splat_wp2 = ", lhs_splat_wp2, new_line('c')
1112 0 : write(fstderr,*) "lhs_splat_wp3 = ", lhs_splat_wp3, new_line('c')
1113 0 : write(fstderr,*) "wprtp = ", wprtp, new_line('c')
1114 0 : write(fstderr,*) "wpthlp = ", wpthlp, new_line('c')
1115 0 : write(fstderr,*) "rtp2 = ", rtp2, new_line('c')
1116 0 : write(fstderr,*) "thlp2 = ", thlp2, new_line('c')
1117 0 : write(fstderr,*) "pdf_implicit_coefs_terms%coef_wp4_implicit = ", &
1118 0 : pdf_implicit_coefs_terms%coef_wp4_implicit
1119 0 : write(fstderr,*) new_line('c')
1120 :
1121 0 : write(fstderr,*) "intent(in/out)"
1122 :
1123 0 : write(fstderr,*) "wp2_zt = ", wp2_zt, new_line('c')
1124 0 : write(fstderr,*) "wp3_zm = ", wp3_zm, new_line('c')
1125 0 : if ( l_lmm_stepping ) &
1126 0 : write(fstderr,*) "wp2 (pre-solve) = ", wp2_old, new_line('c')
1127 0 : write(fstderr,*) "wp2 = ", wp2, new_line('c')
1128 0 : if ( l_lmm_stepping ) &
1129 0 : write(fstderr,*) "wp3 (pre-solve) = ", wp3_old, new_line('c')
1130 0 : write(fstderr,*) "wp3 = ", wp3, new_line('c')
1131 :
1132 : end if ! fatal error
1133 : end if
1134 :
1135 : !$acc exit data delete( wp2_old, wp3_old, C1_Skw_fnc, C11_Skw_fnc, C16_fnc, C_wp3_pr_tp, &
1136 : !$acc wp3_term_ta_lhs_result, wp3_pr3_lhs, lhs_ta_wp2, &
1137 : !$acc lhs_tp_wp3, lhs_adv_tp_wp3, lhs_pr_tp_wp3, &
1138 : !$acc lhs_ta_wp3, lhs_dp1_wp2, rhs_dp1_wp2, lhs_pr1_wp2, &
1139 : !$acc rhs_pr1_wp2, lhs_pr1_wp3, rhs_pr1_wp3, rhs_bp_pr2_wp2, &
1140 : !$acc rhs_pr_dfsn_wp2, rhs_bp1_pr2_wp3, rhs_pr3_wp2, &
1141 : !$acc rhs_pr3_wp3, rhs_ta_wp3, rhs_pr_turb_wp3, rhs_pr_dfsn_wp3, &
1142 : !$acc lhs_diff_zm, lhs_diff_zt, lhs_diff_zm_crank, lhs_diff_zt_crank, &
1143 : !$acc lhs_ma_zm, lhs_ma_zt, lhs_ac_pr2_wp2, lhs_ac_pr2_wp3, &
1144 : !$acc coef_wp4_implicit_zt, coef_wp4_implicit, a1, a1_zt, &
1145 : !$acc dum_dz, dvm_dz, lhs, rhs, Kw1, Kw8, Kw1_zm, Kw8_zt )
1146 :
1147 : return
1148 :
1149 : end subroutine advance_wp2_wp3
1150 :
1151 : !=============================================================================
1152 8935056 : subroutine wp23_solve( nz, ngrdcol, gr, dt, lhs, rhs, &
1153 8935056 : lhs_ma_zm, lhs_dp1_wp2, lhs_diff_zm, &
1154 8935056 : lhs_ta_wp2, lhs_pr1_wp2, lhs_pr1_wp3, &
1155 8935056 : lhs_diff_zt, lhs_adv_tp_wp3, lhs_pr_tp_wp3, &
1156 8935056 : wp3_pr3_lhs, lhs_ma_zt, &
1157 8935056 : wp3_term_ta_lhs_result, &
1158 8935056 : wm_zm, wm_zt, &
1159 8935056 : sfc_elevation, C11_Skw_fnc, &
1160 8935056 : rho_ds_zm, rho_ds_zt, &
1161 8935056 : wprtp, wpthlp, rtp2, thlp2, &
1162 8935056 : clubb_params, &
1163 : penta_solve_method, &
1164 : l_min_wp2_from_corr_wx, &
1165 : l_tke_aniso, &
1166 : l_use_tke_in_wp2_wp3_K_dfsn, &
1167 : l_use_wp3_lim_with_smth_Heaviside, &
1168 : stats_metadata, &
1169 8935056 : stats_zt, stats_zm, stats_sfc, &
1170 8935056 : wp2, wp3, wp3_zm, wp2_zt )
1171 :
1172 : ! Description:
1173 : ! Decompose, and back substitute the matrix for wp2/wp3
1174 :
1175 : ! References:
1176 : ! _Equations for CLUBB_ section 6.3
1177 : !------------------------------------------------------------------------
1178 :
1179 : use grid_class, only: &
1180 : grid ! Type
1181 :
1182 : use grid_class, only: &
1183 : zm2zt, & ! Function(s)
1184 : zt2zm
1185 :
1186 : use constants_clubb, only: &
1187 : w_tol_sqd, & ! Variables(s)
1188 : max_mag_correlation_flux, &
1189 : one, &
1190 : zero, &
1191 : fstderr, &
1192 : gamma_over_implicit_ts, &
1193 : num_hf_draw_points, &
1194 : wp2_max
1195 :
1196 : use error_code, only: &
1197 : clubb_at_least_debug_level, & ! Procedure
1198 : err_code, & ! Error Indicator
1199 : clubb_fatal_error ! Constants
1200 :
1201 : use model_flags, only: &
1202 : l_hole_fill ! Variable(s)
1203 :
1204 : use clubb_precision, only: &
1205 : core_rknd ! Variable(s)
1206 :
1207 : use matrix_solver_wrapper, only: &
1208 : band_solve ! Procedure(s)
1209 :
1210 : use parameter_indices, only: &
1211 : nparams, & ! Variable(s)
1212 : iSkw_max_mag, &
1213 : iC_uu_shr
1214 :
1215 : use parameters_tunable, only: &
1216 : nu_vertical_res_dep ! Type(s)
1217 :
1218 : use fill_holes, only: &
1219 : fill_holes_vertical
1220 :
1221 : use clip_explicit, only: &
1222 : clip_variance, & ! Procedure(s)
1223 : clip_skewness
1224 :
1225 : use pdf_parameter_module, only: &
1226 : implicit_coefs_terms ! Variable Type
1227 :
1228 : use stats_type_utilities, only: &
1229 : stat_begin_update, & ! Procedure(s)
1230 : stat_update_var, &
1231 : stat_update_var_pt, &
1232 : stat_end_update, &
1233 : stat_end_update_pt
1234 :
1235 : use stats_variables, only: &
1236 : stats_metadata_type
1237 :
1238 : use stats_type, only: stats ! Type
1239 :
1240 : use model_flags, only: &
1241 : penta_bicgstab
1242 :
1243 : implicit none
1244 :
1245 : ! Parameter Constants
1246 : integer, parameter :: &
1247 : nrhs = 1 ! Number of RHS vectors
1248 :
1249 : ! ----------------------- Input Variables -----------------------
1250 : integer, intent(in) :: &
1251 : nz, &
1252 : ngrdcol
1253 :
1254 : type (grid), target, intent(in) :: &
1255 : gr
1256 :
1257 : real( kind = core_rknd ), intent(in) :: &
1258 : dt ! Timestep [s]
1259 :
1260 : real( kind = core_rknd ), intent(inout), dimension(ndiags5,ngrdcol,2*nz) :: &
1261 : lhs ! Implicit contributions to wp2/wp3 (band diag. matrix)
1262 :
1263 : real( kind = core_rknd ), intent(inout), dimension(ngrdcol,2*nz) :: &
1264 : rhs ! RHS of band matrix
1265 :
1266 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
1267 : lhs_dp1_wp2, & ! wp2 "over-implicit" dissipation term
1268 : lhs_pr1_wp2, & ! wp2 "over-implicit" pressure term 1
1269 : lhs_pr1_wp3 ! wp3 "over-implicit" pressure term 1
1270 :
1271 : real( kind = core_rknd ), intent(in), dimension(ndiags2,ngrdcol,nz) :: &
1272 : lhs_ta_wp2, & ! Turbulent advection terms for wp2
1273 : lhs_adv_tp_wp3, & ! Turbulent production terms of w'^3 (for stats)
1274 : lhs_pr_tp_wp3 ! Pressure scrambling terms for turbulent production of w'^3 (for stats)
1275 :
1276 : real( kind = core_rknd ), intent(in), dimension(ndiags3,ngrdcol,nz) :: &
1277 : lhs_diff_zm, & ! Completely implicit diffusion term for w'2
1278 : lhs_diff_zt, & ! Completely implicit diffusion term for w'3
1279 : lhs_ma_zm, & ! Mean advection term for w'2
1280 : lhs_ma_zt ! Mean advection term for w'3
1281 :
1282 : real( kind = core_rknd ), dimension(ndiags5,ngrdcol,nz) :: &
1283 : wp3_pr3_lhs
1284 :
1285 : real( kind = core_rknd ), intent(in), dimension(ndiags5,ngrdcol,nz) :: &
1286 : wp3_term_ta_lhs_result
1287 :
1288 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
1289 : sfc_elevation ! Elevation of ground level [m AMSL]
1290 :
1291 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
1292 : wm_zm, & ! w wind component on momentum levels [m/s]
1293 : wm_zt, & ! w wind component on thermodynamic levels [m/s]
1294 : C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-]
1295 : rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3]
1296 : rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3]
1297 : wprtp, & ! Flux of total water mixing ratio [m/s kg/kg]
1298 : wpthlp, & ! Flux of liquid water potential temp. [m/s K]
1299 : rtp2, & ! Variance of rt (overall) [kg^2/kg^2]
1300 : thlp2 ! Variance of thl (overall) [K^2]
1301 :
1302 : real( kind = core_rknd ), dimension(ngrdcol,nparams), intent(in) :: &
1303 : clubb_params ! Array of CLUBB's tunable parameters [units vary]
1304 :
1305 : integer, intent(in) :: &
1306 : penta_solve_method ! Method to solve then penta-diagonal system
1307 :
1308 : logical, intent(in) :: &
1309 : l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping the
1310 : ! overall correlation of w and x (w and rt, as well as w and
1311 : ! theta-l) within the limits of -max_mag_correlation_flux to
1312 : ! max_mag_correlation_flux.
1313 : l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. TKE = 1/2
1314 : ! (u'^2 + v'^2 + w'^2)
1315 : l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3
1316 : l_use_wp3_lim_with_smth_Heaviside ! Flag to activate mods on wp3 limiters for conv test
1317 :
1318 : type (stats_metadata_type), intent(in) :: &
1319 : stats_metadata
1320 :
1321 : ! ----------------------- Input/Output Variables -----------------------
1322 : type (stats), target, dimension(ngrdcol), intent(inout) :: &
1323 : stats_zt, &
1324 : stats_zm, &
1325 : stats_sfc
1326 :
1327 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
1328 : wp2, & ! w'^2 (momentum levels) [m^2/s^2]
1329 : wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3]
1330 : wp3_zm ! w'^3 interpolated to momentum levels [m^3/s^3]
1331 :
1332 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
1333 : wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2]
1334 :
1335 : ! ----------------------- Local Variables -----------------------
1336 : real( kind = core_rknd ), dimension(ngrdcol,2*nz) :: &
1337 17870112 : rhs_save ! Saved RHS of band matrix
1338 :
1339 : real( kind = core_rknd ), dimension(ngrdcol,2*nz) :: &
1340 17870112 : solut, & ! Solution to band diagonal system.
1341 17870112 : old_solut ! Old solution, used as an initial guess in the bicgstab method
1342 :
1343 : real( kind = core_rknd ), dimension(ngrdcol) :: &
1344 17870112 : rcond ! Est. of the reciprocal of the condition #
1345 :
1346 : real( kind = core_rknd ) :: &
1347 : threshold ! Minimum value for wp2 [m^2/s^2]
1348 :
1349 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
1350 17870112 : lhs_wp2_ac_term, & ! w'^2 term ac, used for stats
1351 17870112 : lhs_wp2_pr2_term, & ! w'^2 term pr2, used for stats
1352 17870112 : lhs_wp3_ac_term, & ! w'^3 term ac, used for stats
1353 17870112 : lhs_wp3_pr2_term, & ! w'^3 term pr2, used for stats
1354 17870112 : threshold_array, & ! Minimum values for wp2 [m^2/s^2]
1355 17870112 : zero_vector
1356 :
1357 : real( kind = core_rknd ), dimension(ngrdcol) :: &
1358 17870112 : zero_vector_ngrdcol
1359 :
1360 : ! Array indices
1361 : integer :: k, km1, kp1, k_wp2, k_wp3, i
1362 :
1363 : real( kind = core_rknd ) :: &
1364 : C_uu_shr ! CLUBB tunable parameter C_uu_shr
1365 :
1366 : !------------------------- Begin Code -------------------------
1367 :
1368 : !$acc enter data create( rhs_save, solut, old_solut, rcond, threshold_array )
1369 :
1370 : ! Save the value of rhs, which will be overwritten with the solution as
1371 : ! part of the solving routine.
1372 : !$acc parallel loop gang vector collapse(2) default(present)
1373 768414816 : do k = 1, nz
1374 12690480816 : do i = 1, ngrdcol
1375 12681545760 : rhs_save(i,k) = rhs(i,k)
1376 : end do
1377 : end do
1378 : !$acc end parallel loop
1379 :
1380 8935056 : if ( penta_solve_method == penta_bicgstab ) then
1381 0 : do k = 1, nz
1382 0 : do i = 1, ngrdcol
1383 0 : old_solut(i,2*k-1) = wp3(i,k)
1384 0 : old_solut(i,2*k) = wp2(i,k)
1385 : end do
1386 : end do
1387 : end if
1388 :
1389 : ! Solve the system with LAPACK
1390 8935056 : if ( stats_metadata%l_stats_samp .and. stats_metadata%iwp23_matrix_condt_num > 0 ) then
1391 :
1392 : ! Solve the system and return condition number
1393 : ! Note: When using lapack this can change the answer slightly
1394 : call band_solve( "wp2_wp3", penta_solve_method, & ! intent(in)
1395 : ngrdcol, 2, 2, 2*nz, & ! intent(in)
1396 : old_solut, & ! Intent(in)
1397 : lhs, rhs, & ! intent(inout)
1398 0 : solut, rcond ) ! intent(out)
1399 :
1400 : ! Est. of the condition number of the w'^2/w^3 LHS matrix
1401 0 : do i = 1, ngrdcol
1402 : !$acc update host( rcond )
1403 0 : call stat_update_var_pt( stats_metadata%iwp23_matrix_condt_num, 1, one / rcond(i), & ! intent(in)
1404 0 : stats_sfc(i) ) ! intent(inout)
1405 : end do
1406 :
1407 : else
1408 :
1409 : ! Solve the system
1410 : call band_solve( "wp2_wp3", penta_solve_method, & ! intent(in)
1411 : ngrdcol, 2, 2, 2*nz, & ! intent(in)
1412 : old_solut, & ! Intent(in)
1413 : lhs, rhs, & ! intent(inout)
1414 8935056 : solut ) ! intent(out)
1415 :
1416 : end if
1417 :
1418 8935056 : if ( clubb_at_least_debug_level( 0 ) ) then
1419 8935056 : if ( err_code == clubb_fatal_error ) then
1420 :
1421 : !$acc update host( lhs, rhs_save )
1422 :
1423 0 : write(fstderr,*) "Error in wp23_solve calling band_solve for wp2_wp3"
1424 0 : write(fstderr,*) "wp2 & wp3 LU decomp. failed"
1425 0 : write(fstderr,*) "wp2 and wp3 LHS"
1426 0 : do k = 1, nz
1427 0 : do i = 1, ngrdcol
1428 0 : write(fstderr,*) "zt level = ", k, "height [m] = ", &
1429 0 : gr%zt(i,k), "LHS = ", lhs(1:5,i,2*k-1)
1430 0 : write(fstderr,*) "zm level = ", k, "height [m] = ", &
1431 0 : gr%zm(i,k), "LHS = ", lhs(1:5,i,2*k)
1432 : end do
1433 : end do ! k = 1, gr%nz
1434 0 : write(fstderr,*) "wp2 and wp3 RHS"
1435 0 : do k = 1, nz
1436 0 : do i = 1, ngrdcol
1437 0 : write(fstderr,*) "i = ", i, "zt level = ", k, "height [m] = ", &
1438 0 : gr%zt(i,k), "RHS = ", rhs_save(i,2*k-1)
1439 0 : write(fstderr,*) "zm level = ", k, "height [m] = ", &
1440 0 : gr%zm(i,k), "RHS = ", rhs_save(i,2*k)
1441 : end do
1442 : end do ! k = 1, gr%nz
1443 : return
1444 : end if
1445 : end if
1446 :
1447 : ! Copy result into output arrays and clip
1448 : !$acc parallel loop gang vector collapse(2) default(present)
1449 768414816 : do k = 1, nz
1450 12690480816 : do i = 1, ngrdcol
1451 11922066000 : k_wp3 = 2*k - 1
1452 11922066000 : k_wp2 = 2*k
1453 :
1454 11922066000 : wp2(i,k) = solut(i,k_wp2)
1455 12681545760 : wp3(i,k) = solut(i,k_wp3)
1456 : end do
1457 : end do
1458 :
1459 8935056 : if ( stats_metadata%l_stats_samp ) then
1460 :
1461 : !$acc update host( wm_zt, lhs_dp1_wp2, wp2, lhs_diff_zm, lhs_ta_wp2, &
1462 : !$acc wp3, lhs_ma_zm, lhs_pr1_wp2, lhs_pr1_wp3, lhs_diff_zt, &
1463 : !$acc wp3_term_ta_lhs_result, lhs_adv_tp_wp3, lhs_pr_tp_wp3, &
1464 : !$acc wp3_pr3_lhs, lhs_ma_zt, C11_Skw_fnc, wm_zm, clubb_params )
1465 :
1466 0 : zero_vector = zero
1467 0 : zero_vector_ngrdcol = zero
1468 :
1469 : ! Note: To find the contribution of w'^2 term ac, substitute 0 for the
1470 : ! C_uu_shr input to function wp2_terms_ac_pr2_lhs.
1471 : call wp2_terms_ac_pr2_lhs( nz, ngrdcol, gr, & ! intent(in)
1472 : zero_vector_ngrdcol, wm_zt, & ! intent(in)
1473 0 : lhs_wp2_ac_term ) ! intent(out)
1474 :
1475 : ! Note: To find the contribution of w'^2 term pr2, add 1 to the
1476 : ! C_uu_shr input to function wp2_terms_ac_pr2_lhs.
1477 : call wp2_terms_ac_pr2_lhs( nz, ngrdcol, gr, & ! intent(in)
1478 : (one+clubb_params(:,iC_uu_shr)), wm_zt, & ! intent(in)
1479 0 : lhs_wp2_pr2_term ) ! intent(out)
1480 :
1481 0 : do i = 1, ngrdcol
1482 :
1483 : ! Finalize implicit contributions for wp2
1484 0 : do k = 2, nz-1
1485 :
1486 0 : km1 = max( k-1, 1 )
1487 0 : kp1 = min( k+1, nz )
1488 :
1489 : ! w'^2 term dp1 has both implicit and explicit components;
1490 : ! Note: An "over-implicit" weighted time step is applied to this term.
1491 : ! A weighting factor of greater than 1 may be used to make the
1492 : ! term more numerically stable (see note below for w'^3 LHS
1493 : ! turbulent advection (ta) term).
1494 : call stat_end_update_pt( stats_metadata%iwp2_dp1, k, & ! intent(in)
1495 0 : (- gamma_over_implicit_ts * lhs_dp1_wp2(i,k)) * wp2(i,k), & ! intent(in)
1496 0 : stats_zm(i) ) ! intent(inout)
1497 :
1498 : ! w'^2 term dp2 has both implicit and explicit components (if the
1499 : ! Crank-Nicholson scheme is selected or if l_use_tke_in_wp2_wp3_K_dfsn is true);
1500 : ! call stat_end_update_pt.
1501 : ! If neither of these flags is true, then w'^2 term dp2 is
1502 : ! completely implicit; call stat_update_var_pt.
1503 0 : if ( l_crank_nich_diff .or. l_use_tke_in_wp2_wp3_K_dfsn ) then
1504 : call stat_end_update_pt( stats_metadata%iwp2_dp2, k, & ! intent(in)
1505 0 : - lhs_diff_zm(3,i,k) * wp2(i,km1) &
1506 : - lhs_diff_zm(2,i,k) * wp2(i,k) &
1507 0 : - lhs_diff_zm(1,i,k) * wp2(i,kp1), & ! intent(in)
1508 0 : stats_zm(i) ) ! intent(inout)
1509 : else
1510 : call stat_update_var_pt( stats_metadata%iwp2_dp2, k, & ! intent(in)
1511 0 : - lhs_diff_zm(3,i,k) * wp2(i,km1) &
1512 : - lhs_diff_zm(2,i,k) * wp2(i,k) &
1513 0 : - lhs_diff_zm(1,i,k) * wp2(i,kp1), & ! intent(in)
1514 0 : stats_zm(i) ) ! intent(inout)
1515 : endif
1516 :
1517 : ! w'^2 term ta is completely implicit; call stat_update_var_pt.
1518 : call stat_update_var_pt( stats_metadata%iwp2_ta, k, & ! intent(in)
1519 0 : (- lhs_ta_wp2(2,i,k)) * wp3(i,k) &
1520 0 : + (- lhs_ta_wp2(1,i,k)) * wp3(i,kp1), & ! intent(in)
1521 0 : stats_zm(i) ) ! intent(inout)
1522 :
1523 : ! w'^2 term ma is completely implicit; call stat_update_var_pt.
1524 : call stat_update_var_pt( stats_metadata%iwp2_ma, k, & ! intent(in)
1525 0 : - lhs_ma_zm(3,i,k) * wp2(i,km1) &
1526 : - lhs_ma_zm(2,i,k) * wp2(i,k) &
1527 : - lhs_ma_zm(1,i,k) * wp2(i,kp1), & ! intent(in)
1528 0 : stats_zm(i) ) ! intent(inout)
1529 :
1530 : ! w'^2 term ac is completely implicit; call stat_update_var_pt.
1531 : call stat_update_var_pt( stats_metadata%iwp2_ac, k, & ! intent(in)
1532 0 : -lhs_wp2_ac_term(i,k) * wp2(i,k), & ! intent(in)
1533 0 : stats_zm(i) ) ! intent(inout)
1534 :
1535 : ! w'^2 term pr1 has both implicit and explicit components;
1536 : ! Note: An "over-implicit" weighted time step is applied to this term.
1537 : ! A weighting factor of greater than 1 may be used to make the
1538 : ! term more numerically stable (see note below for w'^3 LHS
1539 : ! turbulent advection (ta) term).
1540 0 : if ( l_tke_aniso ) then
1541 : call stat_end_update_pt( stats_metadata%iwp2_pr1, k, & ! intent(in)
1542 0 : - gamma_over_implicit_ts * lhs_pr1_wp2(i,k) * wp2(i,k), & ! intent(in)
1543 0 : stats_zm(i) ) ! intent(inout)
1544 : endif
1545 :
1546 : ! w'^2 term pr2 has both implicit and explicit components;
1547 : ! call stat_end_update_pt.
1548 : call stat_end_update_pt( stats_metadata%iwp2_pr2, k, & ! intent(in)
1549 0 : -lhs_wp2_pr2_term(i,k) * wp2(i,k), & ! intent(in)
1550 0 : stats_zm(i) ) ! intent(inout)
1551 :
1552 : enddo
1553 : end do
1554 :
1555 : ! Finalize implicit contributions for wp3
1556 :
1557 : ! Note: To find the contribution of w'^3 term ac, substitute 0 for the
1558 : ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs.
1559 : call wp3_terms_ac_pr2_lhs( nz, ngrdcol, gr, zero_vector, wm_zm, & ! intent(in)
1560 0 : lhs_wp3_ac_term ) ! intent(out)
1561 :
1562 : ! Note: To find the contribution of w'^3 term pr2, add 1 to the
1563 : ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs.
1564 : call wp3_terms_ac_pr2_lhs( nz, ngrdcol, gr, (one+C11_Skw_fnc), wm_zm, & ! intent(in)
1565 0 : lhs_wp3_pr2_term ) ! intent(out)
1566 :
1567 0 : do i = 1, ngrdcol
1568 0 : do k = 3, nz-1, 1
1569 :
1570 0 : km1 = max( k-1, 1 )
1571 0 : kp1 = min( k+1, nz )
1572 :
1573 : ! w'^3 term pr1 has both implicit and explicit components;
1574 : ! Note: An "over-implicit" weighted time step is applied to this term.
1575 : ! A weighting factor of greater than 1 may be used to make the
1576 : ! term more numerically stable (see note above for LHS turbulent
1577 : ! advection (ta) term).
1578 : call stat_end_update_pt( stats_metadata%iwp3_pr1, k, & ! intent(in)
1579 0 : - gamma_over_implicit_ts * lhs_pr1_wp3(i,k) * wp3(i,k), & ! intent(in)
1580 0 : stats_zt(i) ) ! intent(inout)
1581 :
1582 : ! w'^3 term dp1 has both implicit and explicit components (if the
1583 : ! Crank-Nicholson scheme is selected or l_use_tke_in_wp2_wp3_K_dfsn is true);
1584 : ! call stat_end_update_pt.
1585 : ! If neither of these flags is true, then w'^3 term dp1 is
1586 : ! completely implicit; call stat_update_var_pt.
1587 0 : if ( l_crank_nich_diff .or. l_use_tke_in_wp2_wp3_K_dfsn ) then
1588 : call stat_end_update_pt( stats_metadata%iwp3_dp1, k, & ! intent(in)
1589 0 : - lhs_diff_zt(3,i,k) * wp3(i,km1) &
1590 : - lhs_diff_zt(2,i,k) * wp3(i,k) &
1591 0 : - lhs_diff_zt(1,i,k) * wp3(i,kp1), & ! intent(in)
1592 0 : stats_zt(i) ) ! intent(inout)
1593 : else
1594 : call stat_update_var_pt( stats_metadata%iwp3_dp1, k, & ! intent(in)
1595 0 : - lhs_diff_zt(3,i,k) * wp3(i,km1) &
1596 : - lhs_diff_zt(2,i,k) * wp3(i,k) &
1597 0 : - lhs_diff_zt(1,i,k) * wp3(i,kp1), & ! intent(in)
1598 0 : stats_zt(i) ) ! intent(inout)
1599 : endif
1600 :
1601 : ! w'^3 term ta has both implicit and explicit components;
1602 : ! call stat_end_update_pt.
1603 : call stat_end_update_pt( stats_metadata%iwp3_ta, k, & ! intent(in)
1604 0 : - gamma_over_implicit_ts * wp3_term_ta_lhs_result(5,i,k) * wp3(i,km1) &
1605 : - gamma_over_implicit_ts * wp3_term_ta_lhs_result(4,i,k) * wp2(i,km1) &
1606 : - gamma_over_implicit_ts * wp3_term_ta_lhs_result(3,i,k) * wp3(i,k) &
1607 : - gamma_over_implicit_ts * wp3_term_ta_lhs_result(2,i,k) * wp2(i,k) &
1608 0 : - gamma_over_implicit_ts * wp3_term_ta_lhs_result(1,i,k) * wp3(i,kp1), & ! intent(in)
1609 0 : stats_zt(i) ) ! intent(inout)
1610 :
1611 : ! w'^3 term tp has both implicit and explicit components;
1612 : ! Note: An "over-implicit" weighted time step is applied to this term.
1613 : ! A weighting factor of greater than 1 may be used to make the
1614 : ! term more numerically stable (see note above for LHS turbulent
1615 : ! advection (ta) term).
1616 : call stat_end_update_pt( stats_metadata%iwp3_tp, k, & ! intent(in)
1617 0 : - gamma_over_implicit_ts * lhs_adv_tp_wp3(2,i,k) * wp2(i,km1) &
1618 : - gamma_over_implicit_ts * lhs_adv_tp_wp3(1,i,k) * wp2(i,k), & ! intent(in)
1619 0 : stats_zt(i) ) ! intent(inout)
1620 :
1621 : ! w'^3 term pr_tp same as above tp term but opposite sign.
1622 : call stat_end_update_pt( stats_metadata%iwp3_pr_tp, k, & ! intent(in)
1623 0 : - gamma_over_implicit_ts * lhs_pr_tp_wp3(2,i,k) * wp2(i,km1) &
1624 : - gamma_over_implicit_ts * lhs_pr_tp_wp3(1,i,k) * wp2(i,k), & ! intent(in)
1625 0 : stats_zt(i) ) ! intent(inout)
1626 :
1627 : ! w'^3 pressure term 3 (pr3) has both implicit and explicit components;
1628 : ! call stat_end_update_pt
1629 : call stat_end_update_pt( stats_metadata%iwp3_pr3, k, & ! intent(in)
1630 0 : - wp3_pr3_lhs(5,i,k) * wp3(i,km1) &
1631 : - wp3_pr3_lhs(4,i,k) * wp2(i,km1) &
1632 : - wp3_pr3_lhs(3,i,k) * wp3(i,k) &
1633 : - wp3_pr3_lhs(2,i,k) * wp2(i,k) &
1634 : - wp3_pr3_lhs(1,i,k) * wp3(i,kp1), & ! intent(in)
1635 0 : stats_zt(i) ) ! intent(inout)
1636 :
1637 : ! w'^3 term ma is completely implicit; call stat_update_var_pt.
1638 : call stat_update_var_pt( stats_metadata%iwp3_ma, k, & ! intent(in)
1639 0 : - lhs_ma_zt(3,i,k) * wp3(i,km1) &
1640 : - lhs_ma_zt(2,i,k) * wp3(i,k) &
1641 : - lhs_ma_zt(1,i,k) * wp3(i,kp1), & ! intent(in)
1642 0 : stats_zt(i) ) ! intent(inout)
1643 :
1644 : ! w'^3 term ac is completely implicit; call stat_update_var_pt.
1645 : call stat_update_var_pt( stats_metadata%iwp3_ac, k, & ! intent(in)
1646 0 : -lhs_wp3_ac_term(i,k) * wp3(i,k), & ! intent(in)
1647 0 : stats_zt(i) ) ! intent(inout)
1648 :
1649 : ! w'^3 term pr2 has both implicit and explicit components;
1650 : ! call stat_end_update_pt.
1651 : call stat_end_update_pt( stats_metadata%iwp3_pr2, k, & ! intent(in)
1652 0 : -lhs_wp3_pr2_term(i,k) * wp3(i,k), & ! intent(in)
1653 0 : stats_zt(i) ) ! intent(inout)
1654 :
1655 : end do
1656 : end do
1657 :
1658 : end if ! stats_metadata%l_stats_samp
1659 :
1660 :
1661 8935056 : if ( stats_metadata%l_stats_samp ) then
1662 :
1663 : !$acc update host( wp2 )
1664 :
1665 : ! Store previous value for effect of the positive definite scheme
1666 0 : do i = 1, ngrdcol
1667 0 : call stat_begin_update( nz, stats_metadata%iwp2_pd, wp2(i,:) / dt, & ! intent(in)
1668 0 : stats_zm(i) ) ! intent(inout)
1669 : end do
1670 : end if
1671 :
1672 : if ( l_hole_fill ) then
1673 : ! Use a simple hole filling algorithm
1674 : ! upper_hf_level = nz-1 since we are filling the zm levels
1675 : call fill_holes_vertical( nz, ngrdcol, w_tol_sqd, nz-1, & ! In
1676 : gr%dzm, rho_ds_zm, & ! In
1677 8935056 : wp2 ) ! InOut
1678 : end if ! wp2
1679 :
1680 : ! Here we attempt to clip extreme values of wp2 to prevent a crash of the
1681 : ! type found on the Climate Process Team ticket #49. Chris Golaz found that
1682 : ! instability caused by large wp2 in CLUBB led unrealistic results in AM3.
1683 : ! -dschanen 11 Apr 2011
1684 :
1685 : ! Output to trace if wp2 needs to be capped
1686 : !$acc parallel loop gang vector collapse(2) default(present)
1687 768414816 : do k = 1, nz
1688 12690480816 : do i = 1, ngrdcol
1689 12681545760 : if ( wp2(i,k) > wp2_max ) then
1690 0 : wp2(i,k) = wp2_max
1691 0 : write(fstderr,*) "Warning: wp2 > ", wp2_max, " @ i = ", i, ". Large values are clipped."
1692 : end if
1693 : end do
1694 : end do
1695 : !$acc end parallel loop
1696 :
1697 8935056 : if ( stats_metadata%l_stats_samp ) then
1698 :
1699 : !$acc update host( wp2 )
1700 :
1701 : ! Store updated value for effect of the positive definite scheme
1702 0 : do i = 1, ngrdcol
1703 0 : call stat_end_update( nz, stats_metadata%iwp2_pd, wp2(i,:) / dt, & ! intent(in)
1704 0 : stats_zm(i) ) ! intent(inout)
1705 : end do
1706 : end if
1707 :
1708 :
1709 : ! Clip <w'^2> at a minimum threshold.
1710 :
1711 : ! The value of <w'^2> is not allowed to become smaller than the threshold
1712 : ! value of w_tol^2. Additionally, that threshold value may be boosted at
1713 : ! any grid level in order to keep the overall correlation of w and rt or
1714 : ! the overall correlation of w and theta-l between the values of
1715 : ! -max_mag_correlation_flux and max_mag_correlation_flux by boosting <w'^2>
1716 : ! rather than by limiting the magnitude of <w'rt'> or <w'thl'>.
1717 8935056 : if ( l_min_wp2_from_corr_wx ) then
1718 :
1719 : ! The overall correlation of w and rt is:
1720 : !
1721 : ! corr_w_rt = wprtp / ( sqrt( wp2 ) * sqrt( rtp2 ) );
1722 : !
1723 : ! and the overall correlation of w and thl is:
1724 : !
1725 : ! corr_w_thl = wpthlp / ( sqrt( wp2 ) * sqrt( thlp2 ) ).
1726 : !
1727 : ! Squaring both sides, the equations becomes:
1728 : !
1729 : ! corr_w_rt^2 = wprtp^2 / ( wp2 * rtp2 ); and
1730 : !
1731 : ! corr_w_thl^2 = wpthlp^2 / ( wp2 * thlp2 ).
1732 : !
1733 : ! Using max_mag_correlation_flux for the correlation and then solving for
1734 : ! the minimum of wp2, the equation becomes:
1735 : !
1736 : ! wp2|_min = max( wprtp^2 / ( rtp2 * max_mag_correlation_flux^2 ),
1737 : ! wpthlp^2 / ( thlp2 * max_mag_correlation_flux^2 ) ).
1738 : !$acc parallel loop gang vector collapse(2) default(present)
1739 768414816 : do k = 1, nz, 1
1740 12690480816 : do i = 1, ngrdcol
1741 23844132000 : threshold_array(i,k) &
1742 : = min( wp2_max, max( w_tol_sqd, &
1743 : wprtp(i,k)**2 / ( rtp2(i,k) * max_mag_correlation_flux**2 ), &
1744 36525677760 : wpthlp(i,k)**2 / ( thlp2(i,k) * max_mag_correlation_flux**2 ) ) )
1745 :
1746 : end do
1747 : end do
1748 : !$acc end parallel loop
1749 :
1750 : call clip_variance( nz, ngrdcol, gr, clip_wp2, dt, threshold_array, & ! intent(in)
1751 : stats_metadata, & ! intent(in)
1752 : stats_zm, & ! intent(inout)
1753 8935056 : wp2 ) ! intent(inout)
1754 : else
1755 :
1756 : ! Consider only the minimum tolerance threshold value for wp2.
1757 : !$acc parallel loop gang vector collapse(2) default(present)
1758 0 : do k = 1, nz, 1
1759 0 : do i = 1, ngrdcol
1760 0 : threshold_array(i,k) = w_tol_sqd
1761 : end do
1762 : end do
1763 : !$acc end parallel loop
1764 :
1765 : call clip_variance( nz, ngrdcol, gr, clip_wp2, dt, threshold_array, & ! intent(in)
1766 : stats_metadata, & ! intent(in)
1767 : stats_zm, & ! intent(inout)
1768 0 : wp2 ) ! intent(inout)
1769 : end if ! l_min_wp2_from_corr_wx
1770 :
1771 : ! Interpolate w'^2 from momentum levels to thermodynamic levels.
1772 : ! This is used for the clipping of w'^3 according to the value
1773 : ! of Sk_w now that w'^2 and w'^3 have been advanced one timestep.
1774 12690480816 : wp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, wp2, w_tol_sqd ) ! Positive definite quantity
1775 :
1776 : ! Clip w'^3 by limiting skewness.
1777 : call clip_skewness( nz, ngrdcol, gr, dt, sfc_elevation, & ! intent(in)
1778 : clubb_params(:,iSkw_max_mag), wp2_zt, & ! intent(in)
1779 : l_use_wp3_lim_with_smth_Heaviside, & ! intent(in)
1780 : stats_metadata, & ! intent(in)
1781 : stats_zt, & ! intent(inout)
1782 8935056 : wp3 ) ! intent(inout)
1783 :
1784 : ! Compute wp3_zm for output purposes
1785 12690480816 : wp3_zm(:,:) = zt2zm( nz, ngrdcol, gr, wp3 )
1786 :
1787 : !$acc exit data delete( rhs_save, solut, old_solut, rcond, threshold_array )
1788 :
1789 8935056 : return
1790 :
1791 : end subroutine wp23_solve
1792 :
1793 : !=================================================================================
1794 8935056 : subroutine wp23_lhs( nz, ngrdcol, gr, dt, &
1795 8935056 : wp3_term_ta_lhs_result, &
1796 8935056 : lhs_diff_zm, lhs_diff_zt, lhs_ma_zm, &
1797 8935056 : lhs_ma_zt, lhs_ta_wp2, &
1798 8935056 : lhs_tp_wp3, &
1799 8935056 : lhs_ac_pr2_wp2, lhs_ac_pr2_wp3, lhs_dp1_wp2, &
1800 8935056 : lhs_pr1_wp3, lhs_pr1_wp2, lhs_splat_wp2, lhs_splat_wp3, &
1801 : l_tke_aniso, &
1802 8935056 : lhs )
1803 :
1804 : ! Description:
1805 : ! Compute LHS band diagonal matrix for w'^2 and w'^3.
1806 : ! This subroutine computes the implicit portion
1807 : ! of the w'^2 and w'^3 equations.
1808 : !
1809 : ! Boundary conditions
1810 : !
1811 : ! Both wp2 and wp3 used fixed-point boundary conditions.
1812 : ! Therefore, anything set in the above loop at both the upper
1813 : ! and lower boundaries would be overwritten here. However, the
1814 : ! above loop does not extend to the boundary levels. An array
1815 : ! with a value of 1 at the main diagonal on the left-hand side
1816 : ! and with values of 0 at all other diagonals on the left-hand
1817 : ! side will preserve the right-hand side value at that level.
1818 : !
1819 : ! wp3(1) wp2(1) ... wp3(nzmax) wp2(nzmax)
1820 : ! [ 0.0 0.0 0.0 0.0 ]
1821 : ! [ 0.0 0.0 0.0 0.0 ]
1822 : ! [ 1.0 1.0 ... 1.0 1.0 ]
1823 : ! [ 0.0 0.0 0.0 0.0 ]
1824 : ! [ 0.0 0.0 0.0 0.0 ]
1825 : !
1826 : !
1827 : ! WARNING: This subroutine has been optimized. Significant changes could
1828 : ! noticeably impact computational efficiency. See clubb:ticket:834
1829 : !-------------------------------------------------------------------------------
1830 :
1831 : use grid_class, only: &
1832 : grid ! Type
1833 :
1834 : use constants_clubb, only: &
1835 : gamma_over_implicit_ts ! Constant(s)
1836 :
1837 : use model_flags, only: &
1838 : l_explicit_turbulent_adv_wp3 ! Variable(s)
1839 :
1840 : use clubb_precision, only: &
1841 : core_rknd
1842 :
1843 : implicit none
1844 :
1845 : ! ----------------------- Input Variables -----------------------
1846 : integer, intent(in) :: &
1847 : nz, &
1848 : ngrdcol
1849 :
1850 : type (grid), target, intent(in) :: &
1851 : gr
1852 :
1853 : real( kind = core_rknd ), intent(in) :: &
1854 : dt ! Timestep length [s]
1855 :
1856 : real( kind = core_rknd ), intent(in), dimension(ndiags5,ngrdcol,nz) :: &
1857 : wp3_term_ta_lhs_result
1858 :
1859 : real( kind = core_rknd ), intent(in), dimension(ndiags3,ngrdcol,nz) :: &
1860 : lhs_diff_zm, & ! Completely implicit diffusion term for w'2
1861 : lhs_diff_zt, & ! Completely implicit diffusion term for w'3
1862 : lhs_ma_zm, & ! Mean advection term for w'2
1863 : lhs_ma_zt ! Mean advection term for w'3
1864 :
1865 : real( kind = core_rknd ), intent(in), dimension(ndiags2,ngrdcol,nz) :: &
1866 : lhs_ta_wp2, & ! Turbulent advection terms for wp2
1867 : lhs_tp_wp3 ! Turbulent production terms of w'^3
1868 :
1869 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
1870 : lhs_ac_pr2_wp2, & ! Accumulation terms of w'^2 and w'^2 pressure term 2
1871 : lhs_ac_pr2_wp3, & ! Accumulation terms of w'^3 and w'^3 pressure term 2
1872 : lhs_dp1_wp2, & ! Dissipation terms 1 for w'^2
1873 : lhs_pr1_wp3, & ! Dissipation terms 1 for w'^3
1874 : lhs_pr1_wp2, & ! Pressure term 1 for w'2
1875 : lhs_splat_wp2, & ! LHS coefficient of wp2 splatting term [1/s]
1876 : lhs_splat_wp3 ! LHS coefficient of wp3 splatting term [1/s]
1877 :
1878 : logical, intent(in) :: &
1879 : l_tke_aniso ! For anisotropic turbulent kinetic energy, i.e. TKE = 1/2
1880 : ! (u'^2 + v'^2 + w'^2)
1881 :
1882 : ! ----------------------- Output Variable -----------------------
1883 : real( kind = core_rknd ), dimension(ndiags5,ngrdcol,2*nz), intent(out) :: &
1884 : lhs ! Implicit contributions to wp2/wp3 (band diag. matrix)
1885 :
1886 : ! ----------------------- Local Variables -----------------------
1887 : integer :: k, k_wp2, k_wp3, i, b
1888 :
1889 : real( kind = core_rknd) :: &
1890 : invrs_dt ! Inverse of dt, 1/dt, used for computational efficiency
1891 :
1892 : ! ----------------------- Begin Code -----------------------
1893 :
1894 : !$acc data copyin( wp3_term_ta_lhs_result, lhs_diff_zm, lhs_diff_zt, &
1895 : !$acc lhs_ma_zm, lhs_ma_zt, lhs_ta_wp2, lhs_tp_wp3, &
1896 : !$acc lhs_ac_pr2_wp2, lhs_ac_pr2_wp3, lhs_dp1_wp2, &
1897 : !$acc lhs_pr1_wp3, lhs_pr1_wp2, lhs_splat_wp2, lhs_splat_wp3 ) &
1898 : !$acc copyout( lhs )
1899 :
1900 : ! Calculate invrs_dt
1901 8935056 : invrs_dt = 1.0_core_rknd / dt
1902 :
1903 : !$acc parallel loop gang vector collapse(3) default(present)
1904 1527894576 : do k = 1, 2*nz
1905 25372026576 : do i = 1, ngrdcol
1906 >14458*10^7 : do b = 1, ndiags5
1907 >14306*10^7 : lhs(b,i,k) = 0.0_core_rknd
1908 : end do
1909 : end do
1910 : end do
1911 : !$acc end parallel loop
1912 :
1913 : ! Lower boundary for w'3
1914 : !$acc parallel loop gang vector collapse(2) default(present)
1915 149194656 : do i = 1, ngrdcol
1916 850492656 : do b = 1, ndiags5
1917 841557600 : if ( b /= 3 ) then
1918 561038400 : lhs(b,i,1) = 0.0_core_rknd
1919 : else
1920 140259600 : lhs(b,i,1) = 1.0_core_rknd
1921 : end if
1922 : end do
1923 : end do
1924 : !$acc end parallel loop
1925 :
1926 : ! Lower boundary for w'2
1927 : !$acc parallel loop gang vector collapse(2) default(present)
1928 149194656 : do i = 1, ngrdcol
1929 850492656 : do b = 1, ndiags5
1930 841557600 : if ( b /= 3 ) then
1931 561038400 : lhs(b,i,2) = 0.0_core_rknd
1932 : else
1933 140259600 : lhs(b,i,2) = 1.0_core_rknd
1934 : end if
1935 : end do
1936 : end do
1937 : !$acc end parallel loop
1938 :
1939 : ! Combine terms to calculate non-boundary lhs values
1940 : !$acc parallel loop gang vector collapse(2) default(present)
1941 750544704 : do k = 2, nz-1, 1
1942 12392091504 : do i = 1, ngrdcol
1943 :
1944 11641546800 : k_wp3 = 2*k - 1
1945 :
1946 : ! ------ w'3 ------
1947 :
1948 : ! LHS mean advection (ma) and diffusion (diff) terms
1949 11641546800 : lhs(1,i,k_wp3) = lhs(1,i,k_wp3) + lhs_ma_zt(1,i,k) + lhs_diff_zt(1,i,k)
1950 :
1951 : ! LHS turbulent production (tp) term.
1952 : ! Note: An "over-implicit" weighted time step is applied to this term.
1953 11641546800 : lhs(2,i,k_wp3) = lhs(2,i,k_wp3) + gamma_over_implicit_ts * lhs_tp_wp3(1,i,k)
1954 :
1955 : ! LHS mean advection (ma) and diffusion (diff) terms
1956 11641546800 : lhs(3,i,k_wp3) = lhs(3,i,k_wp3) + lhs_ma_zt(2,i,k) + lhs_diff_zt(2,i,k)
1957 :
1958 : ! LHS accumulation (ac) term and pressure term 2 (pr2).
1959 11641546800 : lhs(3,i,k_wp3) = lhs(3,i,k_wp3) + lhs_ac_pr2_wp3(i,k)
1960 :
1961 : ! LHS pressure term 1 (pr1).
1962 : ! Note: An "over-implicit" weighted time step is applied to this term.
1963 11641546800 : lhs(3,i,k_wp3) = lhs(3,i,k_wp3) + gamma_over_implicit_ts * lhs_pr1_wp3(i,k)
1964 :
1965 : ! Add implicit splatting
1966 11641546800 : lhs(3,i,k_wp3) = lhs(3,i,k_wp3) + lhs_splat_wp3(i,k)
1967 :
1968 : ! LHS time tendency.
1969 11641546800 : lhs(3,i,k_wp3) = lhs(3,i,k_wp3) + invrs_dt
1970 :
1971 : ! LHS turbulent production (tp) term.
1972 : ! Note: An "over-implicit" weighted time step is applied to this term.
1973 11641546800 : lhs(4,i,k_wp3) = lhs(4,i,k_wp3) + gamma_over_implicit_ts * lhs_tp_wp3(2,i,k)
1974 :
1975 : ! LHS mean advection (ma) and diffusion (diff) terms
1976 12383156448 : lhs(5,i,k_wp3) = lhs(5,i,k_wp3) + lhs_ma_zt(3,i,k) + lhs_diff_zt(3,i,k)
1977 : end do
1978 : end do
1979 : !$acc end parallel loop
1980 :
1981 : !$acc parallel loop gang vector collapse(2) default(present)
1982 750544704 : do k = 2, nz-1, 1
1983 12392091504 : do i = 1, ngrdcol
1984 :
1985 11641546800 : k_wp2 = 2*k
1986 :
1987 : ! ------ w'2 ------
1988 :
1989 : ! LHS mean advection (ma) and diffusion (diff) terms
1990 11641546800 : lhs(1,i,k_wp2) = lhs(1,i,k_wp2) + lhs_ma_zm(1,i,k) + lhs_diff_zm(1,i,k)
1991 :
1992 : ! LHS turbulent advection (ta) term.
1993 11641546800 : lhs(2,i,k_wp2) = lhs(2,i,k_wp2) + lhs_ta_wp2(1,i,k)
1994 :
1995 : ! LHS mean advection (ma) and diffusion (diff) terms
1996 11641546800 : lhs(3,i,k_wp2) = lhs(3,i,k_wp2) + lhs_ma_zm(2,i,k) + lhs_diff_zm(2,i,k)
1997 :
1998 : ! LHS accumulation (ac) term and pressure term 2 (pr2).
1999 11641546800 : lhs(3,i,k_wp2) = lhs(3,i,k_wp2) + lhs_ac_pr2_wp2(i,k)
2000 :
2001 : ! LHS dissipation term 1 (dp1).
2002 : ! Note: An "over-implicit" weighted time step is applied to this term.
2003 : ! A weighting factor of greater than 1 may be used to make the term
2004 : ! more numerically stable (see note below for w'^3 LHS turbulent
2005 : ! advection (ta) term).
2006 11641546800 : lhs(3,i,k_wp2) = lhs(3,i,k_wp2) + gamma_over_implicit_ts * lhs_dp1_wp2(i,k)
2007 :
2008 : ! LHS time tendency.
2009 11641546800 : lhs(3,i,k_wp2) = lhs(3,i,k_wp2) + invrs_dt
2010 :
2011 : ! LHS turbulent advection (ta) term.
2012 11641546800 : lhs(4,i,k_wp2) = lhs(4,i,k_wp2) + lhs_ta_wp2(2,i,k)
2013 :
2014 : ! LHS mean advection (ma) and diffusion (diff) terms
2015 12383156448 : lhs(5,i,k_wp2) = lhs(5,i,k_wp2) + lhs_ma_zm(3,i,k) + lhs_diff_zm(3,i,k)
2016 : end do
2017 : end do
2018 : !$acc end parallel loop
2019 :
2020 : ! Upper boundary for w'3
2021 : !$acc parallel loop gang vector collapse(2) default(present)
2022 149194656 : do i = 1, ngrdcol
2023 850492656 : do b = 1, ndiags5
2024 841557600 : if ( b /= 3 ) then
2025 561038400 : lhs(b,i,2*nz-1) = 0.0_core_rknd
2026 : else
2027 140259600 : lhs(b,i,2*nz-1) = 1.0_core_rknd
2028 : end if
2029 : end do
2030 : end do
2031 : !$acc end parallel loop
2032 :
2033 : ! Upper boundary for w'2
2034 : !$acc parallel loop gang vector collapse(2) default(present)
2035 149194656 : do i = 1, ngrdcol
2036 850492656 : do b = 1, ndiags5
2037 841557600 : if ( b /= 3 ) then
2038 561038400 : lhs(b,i,2*nz) = 0.0_core_rknd
2039 : else
2040 140259600 : lhs(b,i,2*nz) = 1.0_core_rknd
2041 : end if
2042 : end do
2043 : end do
2044 : !$acc end parallel loop
2045 :
2046 : ! LHS pressure term 1 (pr1) for wp2
2047 8935056 : if ( l_tke_aniso ) then
2048 :
2049 : ! Note: An "over-implicit" weighted time step is applied to this term.
2050 : ! A weighting factor of greater than 1 may be used to make the term
2051 : ! more numerically stable (see note below for w'^3 LHS turbulent
2052 : ! advection (ta) term).
2053 : ! Reference:
2054 : ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:wp2_pr
2055 :
2056 : ! Add terms to lhs
2057 : !$acc parallel loop gang vector collapse(2) default(present)
2058 750544704 : do k = 2, nz-1
2059 12392091504 : do i = 1, ngrdcol
2060 11641546800 : k_wp2 = 2*k
2061 :
2062 12383156448 : lhs(3,i,k_wp2) = lhs(3,i,k_wp2) + gamma_over_implicit_ts * lhs_pr1_wp2(i,k)
2063 : end do
2064 : end do
2065 : !$acc end parallel loop
2066 :
2067 : endif
2068 :
2069 : ! Add implicit splatting to wp2
2070 : !$acc parallel loop gang vector collapse(2) default(present)
2071 750544704 : do k = 2, nz-1
2072 12392091504 : do i = 1, ngrdcol
2073 11641546800 : k_wp2 = 2*k
2074 :
2075 12383156448 : lhs(3,i,k_wp2) = lhs(3,i,k_wp2) + lhs_splat_wp2(i,k)
2076 : end do
2077 : end do
2078 :
2079 : ! LHS turbulent advection (ta) term for wp3
2080 : if ( .not. l_explicit_turbulent_adv_wp3 ) then
2081 :
2082 : ! Note: An "over-implicit" weighted time step is applied to this term.
2083 : ! The weight of the implicit portion of this term is controlled
2084 : ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in
2085 : ! the expression below). A factor is added to the right-hand
2086 : ! side of the equation in order to balance a weight that is not
2087 : ! equal to 1, such that:
2088 : ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS;
2089 : ! where X is the variable that is being solved for in a
2090 : ! predictive equation (w'^3 in this case), y(t) is the
2091 : ! linearized portion of the term that gets treated implicitly,
2092 : ! and RHS is the portion of the term that is always treated
2093 : ! explicitly (in the case of the w'^3 turbulent advection term,
2094 : ! RHS = 0). A weight of greater than 1 can be applied to make
2095 : ! the term more numerically stable.
2096 :
2097 : ! Add terms to lhs
2098 : !$acc parallel loop gang vector collapse(3) default(present)
2099 750544704 : do k = 2, nz-1
2100 12392091504 : do i = 1, ngrdcol
2101 70590890448 : do b = 1, ndiags5
2102 58207734000 : k_wp3 = 2*k - 1
2103 :
2104 >17462*10^7 : lhs(b,i,k_wp3) = lhs(b,i,k_wp3) &
2105 >24447*10^7 : + gamma_over_implicit_ts * wp3_term_ta_lhs_result(b,i,k)
2106 : end do
2107 : end do
2108 : end do
2109 : !$acc end parallel loop
2110 :
2111 : endif
2112 :
2113 : ! Lower boundary for w'3 at t-level 2
2114 : !$acc parallel loop gang vector collapse(2) default(present)
2115 149194656 : do i = 1, ngrdcol
2116 850492656 : do b = 1, ndiags5
2117 841557600 : if ( b /= 3 ) then
2118 561038400 : lhs(b,i,3) = 0.0_core_rknd
2119 : else
2120 140259600 : lhs(b,i,3) = 1.0_core_rknd
2121 : end if
2122 : end do
2123 : end do
2124 : !$acc end parallel loop
2125 :
2126 : !$acc end data
2127 :
2128 8935056 : return
2129 :
2130 : end subroutine wp23_lhs
2131 :
2132 : !=================================================================================
2133 8935056 : subroutine wp23_rhs( nz, ngrdcol, gr, dt, &
2134 8935056 : wp3_term_ta_lhs_result, &
2135 8935056 : lhs_diff_zm, lhs_diff_zt, lhs_diff_zm_crank, lhs_diff_zt_crank, &
2136 8935056 : lhs_tp_wp3, lhs_adv_tp_wp3, lhs_pr_tp_wp3, &
2137 8935056 : lhs_ta_wp3, lhs_dp1_wp2, rhs_dp1_wp2, lhs_pr1_wp2, &
2138 8935056 : rhs_pr1_wp2, lhs_pr1_wp3, rhs_pr1_wp3, rhs_bp_pr2_wp2, &
2139 8935056 : rhs_pr_dfsn_wp2, rhs_bp1_pr2_wp3, rhs_pr3_wp2, rhs_pr3_wp3, &
2140 8935056 : rhs_ta_wp3, rhs_pr_turb_wp3, rhs_pr_dfsn_wp3, &
2141 8935056 : wp2, wp3, wpup2, wpvp2, &
2142 8935056 : wpthvp, wp2thvp, up2, vp2, &
2143 8935056 : C11_Skw_fnc, radf, thv_ds_zm, thv_ds_zt, &
2144 8935056 : lhs_splat_wp2, lhs_splat_wp3, &
2145 8935056 : clubb_params, &
2146 : iiPDF_type, &
2147 : l_tke_aniso, &
2148 : l_use_tke_in_wp2_wp3_K_dfsn, &
2149 : stats_metadata, &
2150 8935056 : stats_zt, stats_zm, &
2151 8935056 : rhs )
2152 :
2153 : ! Description:
2154 : ! Compute RHS vector for w'^2 and w'^3.
2155 : ! This subroutine computes the explicit portion of
2156 : ! the w'^2 and w'^3 equations.
2157 : !
2158 : ! Notes:
2159 : ! For LHS turbulent advection (ta) term.
2160 : ! An "over-implicit" weighted time step is applied to this term.
2161 : ! The weight of the implicit portion of this term is controlled
2162 : ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in
2163 : ! the expression below). A factor is added to the right-hand
2164 : ! side of the equation in order to balance a weight that is not
2165 : ! equal to 1, such that:
2166 : ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS;
2167 : ! where X is the variable that is being solved for in a
2168 : ! predictive equation (w'^3 in this case), y(t) is the
2169 : ! linearized portion of the term that gets treated implicitly,
2170 : ! and RHS is the portion of the term that is always treated
2171 : ! explicitly (in the case of the w'^3 turbulent advection term,
2172 : ! RHS = 0). A weight of greater than 1 can be applied to make
2173 : ! the term more numerically stable.
2174 : !
2175 : !
2176 : ! WARNING: This subroutine has been optimized. Significant changes could
2177 : ! noticeably impact computational efficiency. See clubb:ticket:834
2178 : !-------------------------------------------------------------------------------
2179 :
2180 : use grid_class, only: &
2181 : grid ! Variable
2182 :
2183 : use grid_class, only: &
2184 : ddzt, & ! Procedure
2185 : zm2zt, &
2186 : zt2zm
2187 :
2188 : use parameter_indices, only: &
2189 : nparams, & ! Variable(s)
2190 : iC_uu_buoy
2191 :
2192 : use constants_clubb, only: &
2193 : w_tol_sqd, & ! Variable(s)
2194 : one, &
2195 : zero, &
2196 : gamma_over_implicit_ts
2197 :
2198 : use model_flags, only: &
2199 : iiPDF_ADG1, & ! Variable(s)
2200 : iiPDF_new, &
2201 : iiPDF_new_hybrid, &
2202 : l_explicit_turbulent_adv_wp3
2203 :
2204 : use clubb_precision, only: &
2205 : core_rknd ! Variable
2206 :
2207 : use stats_variables, only: &
2208 : stats_metadata_type
2209 :
2210 : use stats_type_utilities, only: &
2211 : stat_update_var_pt, & ! Procedure(s)
2212 : stat_begin_update_pt, &
2213 : stat_modify_pt
2214 :
2215 : use stats_type, only: stats ! Type
2216 :
2217 : implicit none
2218 :
2219 : ! --------------------- Input Variables ---------------------
2220 : integer, intent(in) :: &
2221 : nz, &
2222 : ngrdcol
2223 :
2224 : type (grid), target, intent(in) :: &
2225 : gr
2226 :
2227 : real( kind = core_rknd ), intent(in) :: &
2228 : dt ! Timestep length [s]
2229 :
2230 : real( kind = core_rknd ), intent(in), dimension(ndiags5,ngrdcol,nz) :: &
2231 : wp3_term_ta_lhs_result
2232 :
2233 : real( kind = core_rknd ), intent(in), dimension(ndiags3,ngrdcol,nz) :: &
2234 : lhs_diff_zm, &
2235 : lhs_diff_zt, &
2236 : lhs_diff_zm_crank, &
2237 : lhs_diff_zt_crank
2238 :
2239 : real( kind = core_rknd ), intent(in), dimension(ndiags2,ngrdcol,nz) :: &
2240 : lhs_tp_wp3, & ! Turbulent production terms of w'^3
2241 : lhs_adv_tp_wp3, & ! Turbulent production terms of w'^3 (for stats)
2242 : lhs_pr_tp_wp3, & ! Pressure scrambling terms for turbulent production of w'^3 (for stats)
2243 : lhs_ta_wp3 ! Turbulent advection terms for wp3
2244 :
2245 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
2246 : lhs_dp1_wp2, & ! wp2 "over-implicit" dissipation term
2247 : rhs_dp1_wp2, & ! wp2 rhs dissipation term
2248 : lhs_pr1_wp2, & ! wp2 "over-implicit" pressure term 1
2249 : rhs_pr1_wp2, & ! wp2 rhs pressure term 1
2250 : lhs_pr1_wp3, & ! wp3 "over-implicit" pressure term 1
2251 : rhs_pr1_wp3, & ! wp3 rhs pressure term 1
2252 : rhs_bp_pr2_wp2, & ! wp2 bouyancy production and pressure term 2
2253 : rhs_pr_dfsn_wp2, & ! wp2 pressure diffusion term
2254 : rhs_bp1_pr2_wp3, & ! wp3 bouyancy production 1 and pressure term 2
2255 : rhs_pr3_wp2, & ! wp2 pressure term 3
2256 : rhs_pr3_wp3, & ! wp3 pressure term 3
2257 : rhs_ta_wp3, & ! wp3 turbulent advection term
2258 : rhs_pr_turb_wp3, & ! wp3 pressure-turbulence correlation term !--EXPERIMENTAL--!
2259 : rhs_pr_dfsn_wp3 ! wp3 pressure diffusion term
2260 :
2261 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
2262 : wp2, & ! w'^2 (momentum levels) [m^2/s^2]
2263 : wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3]
2264 : wpup2, & ! w'u'^2 (thermodynamic levels) [m^3/s^3]
2265 : wpvp2, & ! w'v'^2 (thermodynamic levels) [m^3/s^3]
2266 : wpthvp, & ! w'th_v' (momentum levels) [K m/s]
2267 : wp2thvp, & ! w'^2th_v' (thermodynamic levels) [K m^2/s^2]
2268 : up2, & ! u'^2 (momentum levels) [m^2/s^2]
2269 : vp2, & ! v'^2 (momentum levels) [m^2/s^2]
2270 : C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-]
2271 : radf, & ! Buoyancy production at the CL top [m^2/s^3]
2272 : thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K]
2273 : thv_ds_zt, & ! Dry, base-state theta_v on thermo. levs. [K]
2274 : lhs_splat_wp2, & ! LHS coefficient of wp2 splatting term [1/s]
2275 : lhs_splat_wp3 ! LHS coefficient of wp3 splatting term [1/s]
2276 :
2277 : real( kind = core_rknd ), dimension(ngrdcol,nparams), intent(in) :: &
2278 : clubb_params ! Array of CLUBB's tunable parameters [units vary]
2279 :
2280 : integer, intent(in) :: &
2281 : iiPDF_type ! Selected option for the two-component normal (double
2282 : ! Gaussian) PDF type to use for the w, rt, and theta-l (or
2283 : ! w, chi, and eta) portion of CLUBB's multivariate,
2284 : ! two-component PDF.
2285 :
2286 : logical, intent(in) :: &
2287 : l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. TKE = 1/2
2288 : ! (u'^2 + v'^2 + w'^2)
2289 : l_use_tke_in_wp2_wp3_K_dfsn ! Use TKE in eddy diffusion for wp2 and wp3
2290 :
2291 : type (stats_metadata_type), intent(in) :: &
2292 : stats_metadata
2293 :
2294 : ! --------------------- intent(inout) Variable ---------------------
2295 : type (stats), target, dimension(ngrdcol), intent(inout) :: &
2296 : stats_zt, &
2297 : stats_zm
2298 :
2299 : ! --------------------- Output Variable ---------------------
2300 : real( kind = core_rknd ), dimension(ngrdcol,2*nz), intent(out) :: &
2301 : rhs ! RHS of band matrix
2302 :
2303 : ! --------------------- Local Variables ---------------------
2304 : integer :: k, k_wp2, k_wp3, i
2305 :
2306 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
2307 17870112 : rhs_bp_wp2, & ! wp2 bouyancy production (stats only)
2308 17870112 : rhs_pr2_wp2, & ! wp2 pressure term 2 (stats only)
2309 17870112 : rhs_bp1_wp3, & ! wp3 bouyancy production 1 (stats only)
2310 17870112 : rhs_pr2_wp3 ! wp3 pressure term 2 (stats only)
2311 :
2312 : real( kind = core_rknd ) :: &
2313 : invrs_dt ! Inverse of dt, 1/dt, used for computational efficiency
2314 :
2315 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
2316 17870112 : zero_vector ! Vector of 0s
2317 :
2318 : real( kind = core_rknd ), dimension(ngrdcol) :: &
2319 17870112 : zero_vector_ngrdcol ! Vector of 0s
2320 :
2321 : real( kind = core_rknd ) :: &
2322 : C_uu_buoy ! CLUBB tunable parameter C_uu_buoy
2323 :
2324 : ! --------------------- Begin Code ---------------------
2325 :
2326 : !$acc data copyin( wp3_term_ta_lhs_result, lhs_diff_zm, lhs_diff_zt, &
2327 : !$acc lhs_diff_zm_crank, lhs_diff_zt_crank, lhs_tp_wp3, &
2328 : !$acc lhs_adv_tp_wp3, lhs_pr_tp_wp3, lhs_ta_wp3, lhs_dp1_wp2, &
2329 : !$acc rhs_dp1_wp2, lhs_pr1_wp2, rhs_pr1_wp2, lhs_pr1_wp3, &
2330 : !$acc rhs_pr1_wp3, rhs_bp_pr2_wp2, rhs_pr_dfsn_wp2, rhs_bp1_pr2_wp3, &
2331 : !$acc rhs_pr3_wp2, rhs_pr3_wp3, rhs_ta_wp3, rhs_pr_turb_wp3, &
2332 : !$acc rhs_pr_dfsn_wp3, wp2, wp3, wpup2, wpvp2, wpthvp, wp2thvp, &
2333 : !$acc up2, vp2, C11_Skw_fnc, radf, thv_ds_zm, thv_ds_zt, &
2334 : !$acc lhs_splat_wp2, lhs_splat_wp3, C_uu_buoy ) &
2335 : !$acc copyout( rhs )
2336 :
2337 : ! Calculate invers_dt
2338 8935056 : invrs_dt = 1.0_core_rknd / dt
2339 :
2340 : ! Initialize to zero
2341 : !$acc parallel loop gang vector collapse(2) default(present)
2342 1527894576 : do k = 1, 2*nz
2343 25372026576 : do i = 1, ngrdcol
2344 25363091520 : rhs(i,k) = 0.0_core_rknd
2345 : end do
2346 : end do
2347 : !$acc end parallel loop
2348 :
2349 : ! Experimental term from CLUBB TRAC ticket #411
2350 : !$acc parallel loop gang vector collapse(2) default(present)
2351 750544704 : do k = 2, nz-1
2352 12392091504 : do i = 1, ngrdcol
2353 11641546800 : k_wp3 = 2*k - 1
2354 12383156448 : rhs(i,k_wp3) = rhs_pr_turb_wp3(i,k) + rhs_pr_dfsn_wp3(i,k)
2355 : end do
2356 : end do
2357 : !$acc end parallel loop
2358 :
2359 : !$acc parallel loop gang vector collapse(2) default(present)
2360 750544704 : do k = 2, nz-1
2361 12392091504 : do i = 1, ngrdcol
2362 11641546800 : k_wp2 = 2*k
2363 12383156448 : rhs(i,k_wp2) = rhs(i,k_wp2) + rhs_pr_dfsn_wp2(i,k)
2364 : end do
2365 : end do
2366 : !$acc end parallel loop
2367 :
2368 : ! These lines are for the diffusional term with a Crank-Nicholson
2369 : ! time step. They are not used for completely implicit diffusion.
2370 : if ( l_crank_nich_diff ) then
2371 : ! Add diffusion terms
2372 : !$acc parallel loop gang vector collapse(2) default(present)
2373 : do k = 2, nz-1
2374 : do i = 1, ngrdcol
2375 : k_wp3 = 2*k - 1
2376 : k_wp2 = 2*k
2377 :
2378 : rhs(i,k_wp2) = rhs(i,k_wp2) &
2379 : - lhs_diff_zm_crank(3,i,k) * wp2(i,k-1) &
2380 : - lhs_diff_zm_crank(2,i,k) * wp2(i,k) &
2381 : - lhs_diff_zm_crank(1,i,k) * wp2(i,k+1)
2382 :
2383 : rhs(i,k_wp3) = rhs(i,k_wp3) &
2384 : - lhs_diff_zt_crank(3,i,k) * wp3(i,k-1) &
2385 : - lhs_diff_zt_crank(2,i,k) * wp3(i,k) &
2386 : - lhs_diff_zt_crank(1,i,k) * wp3(i,k+1)
2387 : end do
2388 : end do
2389 : !$acc end parallel loop
2390 : end if
2391 :
2392 : ! This code block adds terms to the right-hand side so that TKE is being
2393 : ! used in eddy diffusion instead of just wp2 or wp3. For example, in the
2394 : ! wp2 equation, if this flag is false, the eddy diffusion term would
2395 : ! normally be completely implicit (hence no right-hand side contribution),
2396 : ! and equal to +d/dz((K+nu)d/dz(wp2)). With this flag set to true, the eddy
2397 : ! diffusion term will be +d/dz((K+nu)d/dz(up2+vp2+wp2)), but the up2 and vp2
2398 : ! parts are added on here as if they were right-hand side terms. For the wp3
2399 : ! equation, with this flag false, the eddy diffusion term is
2400 : ! +d/dz((K+nu)d/dz(wp3)), but with this flag true, it will be
2401 : ! +d/dz((K+nu)d/dz(wpup2+wpvp2+wp3)).
2402 8935056 : if ( l_use_tke_in_wp2_wp3_K_dfsn ) then
2403 : !$acc parallel loop gang vector collapse(2) default(present)
2404 0 : do k = 2, nz-1
2405 0 : do i = 1, ngrdcol
2406 0 : k_wp2 = 2*k
2407 0 : rhs(i,k_wp2) = rhs(i,k_wp2) &
2408 0 : - lhs_diff_zm(3,i,k) * ( up2(i,k-1) + vp2(i,k-1) ) &
2409 : - lhs_diff_zm(2,i,k) * ( up2(i,k) + vp2(i,k) ) &
2410 0 : - lhs_diff_zm(1,i,k) * ( up2(i,k+1) + vp2(i,k+1) )
2411 : end do
2412 : end do
2413 : !$acc end parallel loop
2414 :
2415 : !$acc parallel loop gang vector collapse(2) default(present)
2416 0 : do k = 2, nz-1
2417 0 : do i = 1, ngrdcol
2418 0 : k_wp3 = 2*k - 1
2419 0 : rhs(i,k_wp3) = rhs(i,k_wp3) &
2420 0 : - lhs_diff_zt(3,i,k) * ( wpup2(i,k-1) + wpvp2(i,k-1) ) &
2421 : - lhs_diff_zt(2,i,k) * ( wpup2(i,k) + wpvp2(i,k) ) &
2422 0 : - lhs_diff_zt(1,i,k) * ( wpup2(i,k+1) + wpvp2(i,k+1) )
2423 : end do
2424 : end do
2425 : !$acc end parallel loop
2426 : end if
2427 :
2428 8935056 : if ( l_tke_aniso ) then
2429 :
2430 : ! Add pressure terms and splat terms
2431 : !$acc parallel loop gang vector collapse(2) default(present)
2432 750544704 : do k = 2, nz-1
2433 12392091504 : do i = 1, ngrdcol
2434 11641546800 : k_wp2 = 2*k
2435 :
2436 11641546800 : rhs(i,k_wp2) = rhs(i,k_wp2) + rhs_pr1_wp2(i,k)
2437 :
2438 : rhs(i,k_wp2) = rhs(i,k_wp2) + ( one - gamma_over_implicit_ts ) &
2439 11641546800 : * ( - lhs_pr1_wp2(i,k) * wp2(i,k) )
2440 :
2441 : ! Effect of vertical compression of eddies
2442 741609648 : rhs(i,k_wp2) = rhs(i,k_wp2)
2443 : end do
2444 : end do
2445 : !$acc end parallel loop
2446 : end if
2447 :
2448 : ! Combine terms
2449 : !$acc parallel loop gang vector collapse(2) default(present)
2450 750544704 : do k = 2, nz-1
2451 12392091504 : do i = 1, ngrdcol
2452 :
2453 11641546800 : k_wp3 = 2*k - 1
2454 :
2455 : ! ------ Combine terms for 3rd moment of vertical velocity, <w'^3> ------ !
2456 :
2457 : ! RHS time tendency.
2458 11641546800 : rhs(i,k_wp3) = rhs(i,k_wp3) + invrs_dt * wp3(i,k)
2459 :
2460 : ! RHS contribution from "over-implicit" turbulent production (tp) term.
2461 : rhs(i,k_wp3) = rhs(i,k_wp3) + ( one - gamma_over_implicit_ts ) &
2462 : * ( - lhs_tp_wp3(1,i,k) * wp2(i,k) &
2463 11641546800 : - lhs_tp_wp3(2,i,k) * wp2(i,k-1) )
2464 :
2465 : ! RHS buoyancy production (bp) term and pressure term 2 (pr2).
2466 11641546800 : rhs(i,k_wp3) = rhs(i,k_wp3) + rhs_bp1_pr2_wp3(i,k)
2467 :
2468 : ! RHS pressure term 1
2469 11641546800 : rhs(i,k_wp3) = rhs(i,k_wp3) + rhs_pr1_wp3(i,k)
2470 :
2471 : ! RHS "over implicit" pressure term 1 (pr1).
2472 : rhs(i,k_wp3) = rhs(i,k_wp3) + ( one - gamma_over_implicit_ts ) &
2473 12383156448 : * ( - lhs_pr1_wp3(i,k) * wp3(i,k) )
2474 : end do
2475 : end do
2476 : !$acc end parallel loop
2477 :
2478 :
2479 : !$acc parallel loop gang vector collapse(2) default(present)
2480 750544704 : do k = 2, nz-1
2481 12392091504 : do i = 1, ngrdcol
2482 :
2483 11641546800 : k_wp2 = 2*k
2484 :
2485 : ! ------ Combine terms for 2nd moment of vertical velocity, <w'^2> ------ !
2486 :
2487 : ! RHS time tendency.
2488 11641546800 : rhs(i,k_wp2) = rhs(i,k_wp2) + invrs_dt * wp2(i,k)
2489 :
2490 : ! RHS buoyancy production (bp) term and pressure term 2 (pr2).
2491 11641546800 : rhs(i,k_wp2) = rhs(i,k_wp2) + rhs_bp_pr2_wp2(i,k)
2492 :
2493 : ! RHS buoyancy production at CL top due to LW radiative cooling
2494 11641546800 : rhs(i,k_wp2) = rhs(i,k_wp2) + radf(i,k)
2495 :
2496 : ! RHS pressure term 3 (pr3).
2497 11641546800 : rhs(i,k_wp2) = rhs(i,k_wp2) + rhs_pr3_wp2(i,k)
2498 :
2499 : ! RHS dissipation term 1 (dp1).
2500 11641546800 : rhs(i,k_wp2) = rhs(i,k_wp2) + rhs_dp1_wp2(i,k)
2501 :
2502 : ! RHS "over implicit" pressure term 1 (pr1).
2503 : rhs(i,k_wp2) = rhs(i,k_wp2) + ( one - gamma_over_implicit_ts ) &
2504 12383156448 : * ( - lhs_dp1_wp2(i,k) * wp2(i,k) )
2505 : end do
2506 : end do
2507 : !$acc end parallel loop
2508 :
2509 : if ( l_explicit_turbulent_adv_wp3 ) then
2510 :
2511 : ! The turbulent advection term is being solved explicitly.
2512 :
2513 : ! Add RHS turbulent advection (ta) terms
2514 : !$acc parallel loop gang vector collapse(2) default(present)
2515 : do k = 2, nz-1
2516 : do i = 1, ngrdcol
2517 : k_wp3 = 2*k - 1
2518 :
2519 : rhs(i,k_wp3) = rhs(i,k_wp3) + rhs_ta_wp3(i,k)
2520 : end do
2521 : end do
2522 : !$acc end parallel loop
2523 :
2524 : else
2525 :
2526 : ! The turbulent advection term is being solved implicitly. See note above
2527 :
2528 8935056 : if ( iiPDF_type == iiPDF_ADG1 ) then
2529 :
2530 : ! The ADG1 PDF is used.
2531 :
2532 : ! Add terms
2533 : !$acc parallel loop gang vector collapse(2) default(present)
2534 750544704 : do k = 2, nz-1
2535 12392091504 : do i = 1, ngrdcol
2536 11641546800 : k_wp3 = 2*k - 1
2537 :
2538 23283093600 : rhs(i,k_wp3) = rhs(i,k_wp3) + ( one - gamma_over_implicit_ts ) &
2539 23283093600 : * ( - wp3_term_ta_lhs_result(1,i,k) * wp3(i,k+1) &
2540 : - wp3_term_ta_lhs_result(2,i,k) * wp2(i,k) &
2541 : - wp3_term_ta_lhs_result(3,i,k) * wp3(i,k) &
2542 11641546800 : - wp3_term_ta_lhs_result(4,i,k) * wp2(i,k-1) &
2543 70590890448 : - wp3_term_ta_lhs_result(5,i,k) * wp3(i,k-1) )
2544 : end do
2545 : end do
2546 : !$acc end parallel loop
2547 :
2548 0 : elseif ( iiPDF_type == iiPDF_new .or. iiPDF_type == iiPDF_new_hybrid ) then
2549 :
2550 : ! The new PDF or the new hybrid PDF is used.
2551 :
2552 : ! Add terms
2553 0 : do k = 2, nz-1
2554 0 : do i = 1, ngrdcol
2555 0 : k_wp3 = 2*k - 1
2556 :
2557 0 : rhs(i,k_wp3) = rhs(i,k_wp3) + ( one - gamma_over_implicit_ts ) &
2558 0 : * ( - lhs_ta_wp3(1,i,k) * wp2(i,k) &
2559 0 : - lhs_ta_wp3(2,i,k) * wp2(i,k-1) )
2560 : end do
2561 : end do
2562 :
2563 : end if ! iiPDF_type
2564 :
2565 : end if ! l_explicit_turbulent_adv_wp3
2566 :
2567 :
2568 :
2569 : ! --------- Boundary Conditions ---------
2570 :
2571 : ! Both wp2 and wp3 used fixed-point boundary conditions.
2572 : ! Therefore, anything set in the above loop at both the upper
2573 : ! and lower boundaries would be overwritten here. However, the
2574 : ! above loop does not extend to the boundary levels. An array
2575 : ! with a value of 1 at the main diagonal on the left-hand side
2576 : ! and with values of 0 at all other diagonals on the left-hand
2577 : ! side will preserve the right-hand side value at that level.
2578 :
2579 : ! The value of w'^2 at the lower boundary will remain the same.
2580 : ! When the lower boundary is at the surface, the surface value of
2581 : ! w'^2 is set in subroutine calc_surface_varnce (surface_varnce_module.F).
2582 :
2583 : ! The value of w'^3 at the lower boundary will be 0.
2584 :
2585 : ! The value of w'^2 at the upper boundary will be set to the threshold
2586 : ! minimum value of w_tol_sqd.
2587 :
2588 : ! The value of w'^3 at the upper boundary will be set to 0.
2589 : !$acc parallel loop gang vector default(present)
2590 149194656 : do i = 1, ngrdcol
2591 140259600 : rhs(i,1) = 0.0_core_rknd
2592 140259600 : rhs(i,2) = wp2(i,1)
2593 140259600 : rhs(i,3) = 0.0_core_rknd
2594 :
2595 140259600 : rhs(i,2*nz-1) = 0.0_core_rknd
2596 149194656 : rhs(i,2*nz) = w_tol_sqd
2597 : end do
2598 : !$acc end parallel loop
2599 :
2600 :
2601 : ! --------- Statistics output ---------
2602 8935056 : if ( stats_metadata%l_stats_samp ) then
2603 :
2604 : !$acc update host( thv_ds_zm, wpthvp, thv_ds_zt, wp2thvp, &
2605 : !$acc wp2, lhs_diff_zm_crank, up2, vp2, lhs_diff_zm, &
2606 : !$acc rhs_pr_dfsn_wp2, lhs_splat_wp2, rhs_pr1_wp2, &
2607 : !$acc lhs_pr1_wp2, rhs_dp1_wp2, lhs_dp1_wp2, rhs_pr3_wp2, &
2608 : !$acc rhs_ta_wp3, wp3_term_ta_lhs_result, wp3, lhs_ta_wp3, &
2609 : !$acc lhs_adv_tp_wp3, lhs_pr_tp_wp3, rhs_pr3_wp3, rhs_pr1_wp3, &
2610 : !$acc lhs_pr1_wp3, lhs_splat_wp3, lhs_diff_zt, wpup2, wpvp2, &
2611 : !$acc rhs_pr_turb_wp3, rhs_pr_dfsn_wp3, clubb_params )
2612 :
2613 0 : zero_vector = zero
2614 0 : zero_vector_ngrdcol = zero
2615 :
2616 : ! w'^2 term bp is completely explicit; call stat_update_var_pt.
2617 : ! Note: To find the contribution of w'^2 term bp, substitute 0 for the
2618 : ! C_uu_buoy input to function wp2_terms_bp_pr2_rhs.
2619 : call wp2_terms_bp_pr2_rhs( nz, ngrdcol, zero_vector_ngrdcol, & ! intent(in)
2620 : thv_ds_zm, wpthvp, & ! intent(in)
2621 0 : rhs_bp_wp2 ) ! intent(out)
2622 :
2623 : ! w'^2 term pr2 has both implicit and explicit components; call
2624 : ! stat_begin_update_pt. Since stat_begin_update_pt automatically
2625 : ! subtracts the value sent in, reverse the sign on wp2_terms_bp_pr2_rhs.
2626 : ! Note: To find the contribution of w'^2 term pr2, add 1 to the
2627 : ! C_uu_buoy input to function wp2_terms_bp_pr2_rhs.
2628 : call wp2_terms_bp_pr2_rhs( nz, ngrdcol, (one+clubb_params(:,iC_uu_buoy)), & ! intent(in)
2629 : thv_ds_zm, wpthvp, & ! intent(in)
2630 0 : rhs_pr2_wp2 ) ! intent(out)
2631 :
2632 :
2633 : ! w'^3 term bp is completely explicit; call stat_update_var_pt.
2634 : ! Note: To find the contribution of w'^3 term bp, substitute 0 for the
2635 : ! C_11 skewness function input to function wp3_terms_bp1_pr2_rhs.
2636 : call wp3_terms_bp1_pr2_rhs( nz, ngrdcol, zero_vector, & ! intent(in)
2637 : thv_ds_zt, wp2thvp, & ! intent(in)
2638 0 : rhs_bp1_wp3 ) ! intent(out)
2639 :
2640 : ! w'^3 term pr2 has both implicit and explicit components; call
2641 : ! stat_begin_update_pt. Since stat_begin_update_pt automatically
2642 : ! subtracts the value sent in, reverse the sign on wp3_terms_bp1_pr2_rhs.
2643 : ! Note: To find the contribution of w'^3 term pr2, add 1 to the
2644 : ! C_11 skewness function input to function wp3_terms_bp1_pr2_rhs.
2645 : call wp3_terms_bp1_pr2_rhs( nz, ngrdcol, ( one + C11_Skw_fnc ), & ! intent(in)
2646 : thv_ds_zt, wp2thvp, & ! intent(in)
2647 0 : rhs_pr2_wp3 ) ! intent(out)
2648 :
2649 0 : do i = 1, ngrdcol
2650 0 : do k = 2, nz-1
2651 :
2652 : ! ----------- w'2 -----------
2653 :
2654 : ! w'^2 term dp2 has both implicit and explicit components (if the
2655 : ! Crank-Nicholson scheme is selected); call stat_begin_update_pt.
2656 : ! Since stat_begin_update_pt automatically subtracts the value sent in,
2657 : ! reverse the sign on right-hand side diffusion component. If
2658 : ! Crank-Nicholson diffusion is not selected, the stat_begin_update_pt
2659 : ! will not be called.
2660 : if ( l_crank_nich_diff ) then
2661 : call stat_begin_update_pt( stats_metadata%iwp2_dp2, k, & ! intent(in)
2662 : lhs_diff_zm_crank(3,i,k) * wp2(i,k-1) &
2663 : + lhs_diff_zm_crank(2,i,k) * wp2(i,k) &
2664 : + lhs_diff_zm_crank(1,i,k) * wp2(i,k+1), & ! intent(in)
2665 : stats_zm(i) ) ! intent(out)
2666 : endif
2667 :
2668 : ! w'^2 term dp2 and w'^3 term dp1 have both implicit and explicit
2669 : ! components (if the l_use_tke_in_wp2_wp3_K_dfsn flag is true;
2670 : ! call stat_begin_update_pt.
2671 0 : if ( l_use_tke_in_wp2_wp3_K_dfsn ) then
2672 : call stat_begin_update_pt( stats_metadata%iwp2_dp2, k, &
2673 0 : + lhs_diff_zm(3,i,k) * ( up2(i,k-1) + vp2(i,k-1) ) &
2674 : + lhs_diff_zm(2,i,k) * ( up2(i,k) + vp2(i,k) ) &
2675 0 : + lhs_diff_zm(1,i,k) * ( up2(i,k+1) + vp2(i,k+1) ), &
2676 0 : stats_zm(i) )
2677 : endif
2678 :
2679 : ! w'^2 term bp is completely explicit; call stat_update_var_pt.
2680 : ! Note: To find the contribution of w'^2 term bp, substitute 0 for the
2681 : ! C_uu_buoy input to function wp2_terms_bp_pr2_rhs.
2682 0 : call stat_update_var_pt( stats_metadata%iwp2_bp, k, rhs_bp_wp2(i,k), & ! intent(in)
2683 0 : stats_zm(i) ) ! intent(out)
2684 :
2685 :
2686 0 : call stat_update_var_pt( stats_metadata%iwp2_pr_dfsn, k, rhs_pr_dfsn_wp2(i,k), & ! intent(in)
2687 0 : stats_zm(i) ) ! intent(out)
2688 :
2689 :
2690 : ! Include effect of vertical compression of eddies in wp2 budget
2691 0 : call stat_update_var_pt( stats_metadata%iwp2_splat, k, - lhs_splat_wp2(i,k) * wp2(i,k), & ! intent(in)
2692 0 : stats_zm(i) ) ! intent(out)
2693 :
2694 :
2695 0 : if ( l_tke_aniso ) then
2696 :
2697 : ! w'^2 term pr1 has both implicit and explicit components; call
2698 : ! stat_begin_update_pt. Since stat_begin_update_pt automatically
2699 : ! subtracts the value sent in, reverse the sign on wp2_term_pr1_rhs.
2700 0 : call stat_begin_update_pt( stats_metadata%iwp2_pr1, k, -rhs_pr1_wp2(i,k), & ! intent(in)
2701 0 : stats_zm(i) ) ! intent(out)
2702 :
2703 : ! Note: An "over-implicit" weighted time step is applied to this
2704 : ! term. A weighting factor of greater than 1 may be used to
2705 : ! make the term more numerically stable (see note below for
2706 : ! w'^3 RHS turbulent advection (ta) term).
2707 : call stat_modify_pt( stats_metadata%iwp2_pr1, k, & ! intent(in)
2708 : + ( one - gamma_over_implicit_ts ) &
2709 0 : * ( - lhs_pr1_wp2(i,k) * wp2(i,k) ), & ! intent(in)
2710 0 : stats_zm(i) ) ! intent(out)
2711 : endif
2712 :
2713 : ! w'^2 term pr2 has both implicit and explicit components; call
2714 : ! stat_begin_update_pt. Since stat_begin_update_pt automatically
2715 : ! subtracts the value sent in, reverse the sign on wp2_terms_bp_pr2_rhs.
2716 : ! Note: To find the contribution of w'^2 term pr2, add 1 to the
2717 : ! C_uu_buoy input to function wp2_terms_bp_pr2_rhs.
2718 0 : call stat_begin_update_pt( stats_metadata%iwp2_pr2, k, -rhs_pr2_wp2(i,k), & ! intent(in)
2719 0 : stats_zm(i) ) ! intent(out)
2720 :
2721 : ! w'^2 term dp1 has both implicit and explicit components; call
2722 : ! stat_begin_update_pt. Since stat_begin_update_pt automatically
2723 : ! subtracts the value sent in, reverse the sign on wp2_term_dp1_rhs.
2724 0 : call stat_begin_update_pt( stats_metadata%iwp2_dp1, k, -rhs_dp1_wp2(i,k), & ! intent(in)
2725 0 : stats_zm(i) ) ! intent(out)
2726 :
2727 :
2728 : ! Note: An "over-implicit" weighted time step is applied to this term.
2729 : ! A weighting factor of greater than 1 may be used to make the
2730 : ! term more numerically stable (see note below for w'^3 RHS
2731 : ! turbulent advection (ta) term).
2732 : call stat_modify_pt( stats_metadata%iwp2_dp1, k, & ! intent(in)
2733 : + ( one - gamma_over_implicit_ts ) &
2734 0 : * ( - lhs_dp1_wp2(i,k) * wp2(i,k) ), & ! intent(in)
2735 0 : stats_zm(i) ) ! intent(out)
2736 :
2737 : ! w'^2 term pr3 is completely explicit; call stat_update_var_pt.
2738 0 : call stat_update_var_pt( stats_metadata%iwp2_pr3, k, rhs_pr3_wp2(i,k), & ! intent(in)
2739 0 : stats_zm(i) ) ! intent(out)
2740 :
2741 : end do
2742 : end do
2743 :
2744 0 : do i = 1, ngrdcol
2745 0 : do k = 3, nz-1
2746 :
2747 : ! ----------- w'3 -----------
2748 :
2749 : if ( l_explicit_turbulent_adv_wp3 ) then
2750 :
2751 : ! The turbulent advection term is being solved explicitly.
2752 : !
2753 : ! The turbulent advection stats code is still set up in two parts,
2754 : ! so call stat_begin_update_pt. The implicit portion of the stat,
2755 : ! which has a value of 0, will still be called later. Since
2756 : ! stat_begin_update_pt automatically subtracts the value sent in,
2757 : ! reverse the sign on the input value.
2758 : call stat_begin_update_pt( stats_metadata%iwp3_ta, k, -rhs_ta_wp3(i,k), & ! intent(in)
2759 : stats_zt(i) ) ! intent(out)
2760 : else
2761 :
2762 : ! The turbulent advection term is being solved implicitly.
2763 : !
2764 : ! Note: An "over-implicit" weighted time step is applied to this
2765 : ! term. A weighting factor of greater than 1 may be used to
2766 : ! make the term more numerically stable (see note above for
2767 : ! RHS turbulent advection (ta) term).
2768 : ! Call stat_begin_update_pt. Since stat_begin_update_pt
2769 : ! automatically subtracts the value sent in, reverse the sign
2770 : ! on the input value.
2771 :
2772 0 : if ( iiPDF_type == iiPDF_ADG1 ) then
2773 :
2774 : ! The ADG1 PDF is used.
2775 :
2776 : call stat_begin_update_pt( stats_metadata%iwp3_ta, k, & ! intent(in)
2777 : - ( one - gamma_over_implicit_ts ) & ! intent(in)
2778 0 : * ( - wp3_term_ta_lhs_result(1,i,k) * wp3(i,k+1) &
2779 : - wp3_term_ta_lhs_result(2,i,k) * wp2(i,k) &
2780 : - wp3_term_ta_lhs_result(3,i,k) * wp3(i,k) &
2781 0 : - wp3_term_ta_lhs_result(4,i,k) * wp2(i,k-1) &
2782 : - wp3_term_ta_lhs_result(5,i,k) * wp3(i,k-1) ), &
2783 0 : stats_zt(i) ) ! intent(out)
2784 :
2785 : elseif ( iiPDF_type == iiPDF_new &
2786 0 : .or. iiPDF_type == iiPDF_new_hybrid ) then
2787 :
2788 : ! The new PDF or the new hybrid PDF is used.
2789 :
2790 : call stat_begin_update_pt( stats_metadata%iwp3_ta, k, & ! intent(in)
2791 : - ( one - gamma_over_implicit_ts ) &
2792 0 : * ( - lhs_ta_wp3(1,i,k) * wp2(i,k) &
2793 0 : - lhs_ta_wp3(2,i,k) * wp2(i,k-1) ), & ! intent(in)
2794 0 : stats_zt(i) ) ! intent(out)
2795 : endif
2796 :
2797 : endif
2798 :
2799 : ! Note: An "over-implicit" weighted time step is applied to this term.
2800 : ! A weighting factor of greater than 1 may be used to make the
2801 : ! term more numerically stable (see note above for RHS turbulent
2802 : ! production (tp) term). Call stat_begin_update_pt. Since
2803 : ! stat_begin_update_pt automatically subtracts the value sent in,
2804 : ! reverse the sign on the input value.
2805 : call stat_begin_update_pt( stats_metadata%iwp3_tp, k, & ! intent(in)
2806 : - ( one - gamma_over_implicit_ts ) &
2807 0 : * ( - lhs_adv_tp_wp3(1,i,k) * wp2(i,k) &
2808 0 : - lhs_adv_tp_wp3(2,i,k) * wp2(i,k-1) ), & ! intent(in)
2809 0 : stats_zt(i) ) ! intent(out)
2810 :
2811 : call stat_begin_update_pt( stats_metadata%iwp3_pr_tp, k, & ! intent(in)
2812 : - ( one - gamma_over_implicit_ts ) &
2813 0 : * ( - lhs_pr_tp_wp3(1,i,k) * wp2(i,k) &
2814 0 : - lhs_pr_tp_wp3(2,i,k) * wp2(i,k-1) ), & ! intent(in)
2815 0 : stats_zt(i) ) ! intent(out)
2816 :
2817 :
2818 : ! w'^3 pressure term 3 (pr3) explicit (rhs) contribution
2819 0 : call stat_begin_update_pt( stats_metadata%iwp3_pr3, k, rhs_pr3_wp3(i,k), & ! intent(in)
2820 0 : stats_zt(i) ) ! intent(out)
2821 :
2822 :
2823 : ! w'^3 term bp is completely explicit; call stat_update_var_pt.
2824 : ! Note: To find the contribution of w'^3 term bp, substitute 0 for the
2825 : ! C_11 skewness function input to function wp3_terms_bp1_pr2_rhs.
2826 0 : call stat_update_var_pt( stats_metadata%iwp3_bp1, k, rhs_bp1_wp3(i,k), & ! intent(in)
2827 0 : stats_zt(i) ) ! intent(out)
2828 :
2829 :
2830 : ! w'^3 term pr2 has both implicit and explicit components; call
2831 : ! stat_begin_update_pt. Since stat_begin_update_pt automatically
2832 : ! subtracts the value sent in, reverse the sign on wp3_terms_bp1_pr2_rhs.
2833 : ! Note: To find the contribution of w'^3 term pr2, add 1 to the
2834 : ! C_11 skewness function input to function wp3_terms_bp1_pr2_rhs.
2835 0 : call stat_begin_update_pt( stats_metadata%iwp3_pr2, k, -rhs_pr2_wp3(i,k), & ! intent(in)
2836 0 : stats_zt(i) ) ! intent(out)
2837 :
2838 : ! w'^3 term pr1 has both implicit and explicit components; call
2839 : ! stat_begin_update_pt. Since stat_begin_update_pt automatically
2840 : ! subtracts the value sent in, reverse the sign on wp3_term_pr1_rhs.
2841 0 : call stat_begin_update_pt( stats_metadata%iwp3_pr1, k, -rhs_pr1_wp3(i,k), & ! intent(in)
2842 0 : stats_zt(i) ) ! intent(out)
2843 :
2844 :
2845 : ! Note: An "over-implicit" weighted time step is applied to this term.
2846 : ! A weighting factor of greater than 1 may be used to make the
2847 : ! term more numerically stable (see note above for RHS turbulent
2848 : ! advection (ta) term).
2849 : call stat_modify_pt( stats_metadata%iwp3_pr1, k, & ! intent(in)
2850 : + ( one - gamma_over_implicit_ts ) &
2851 0 : * ( - lhs_pr1_wp3(i,k) * wp3(i,k) ), & ! intent(in)
2852 0 : stats_zt(i) ) ! intent(out)
2853 :
2854 : ! Include effect of vertical compression of eddies in wp2 budget
2855 0 : call stat_update_var_pt( stats_metadata%iwp3_splat, k, - lhs_splat_wp3(i,k) * wp3(i,k), & ! intent(in)
2856 0 : stats_zt(i) ) ! intent(out)
2857 :
2858 : if ( l_crank_nich_diff ) then
2859 :
2860 : ! w'^3 term dp1 has both implicit and explicit components (if the
2861 : ! Crank-Nicholson scheme is selected); call stat_begin_update_pt.
2862 : ! Since stat_begin_update_pt automatically subtracts the value sent in,
2863 : ! reverse the sign on right-hand side diffusion component. If
2864 : ! Crank-Nicholson diffusion is not selected, the stat_begin_update_pt
2865 : ! will not be called.
2866 : call stat_begin_update_pt( stats_metadata%iwp3_dp1, k, & ! intent(in)
2867 : lhs_diff_zt(3,i,k) * wp3(i,k-1) &
2868 : + lhs_diff_zt(2,i,k) * wp3(i,k) &
2869 : + lhs_diff_zt(1,i,k) * wp3(i,k+1), & ! intent(in)
2870 : stats_zt(i) ) ! intent(out)
2871 : endif
2872 :
2873 : ! w'^2 term dp2 and w'^3 term dp1 have both implicit and explicit
2874 : ! components (if the l_use_tke_in_wp2_wp3_K_dfsn flag is true;
2875 : ! call stat_begin_update_pt.
2876 0 : if ( l_use_tke_in_wp2_wp3_K_dfsn ) then
2877 : call stat_begin_update_pt( stats_metadata%iwp3_dp1, k, &
2878 0 : + lhs_diff_zt(3,i,k) * ( wpup2(i,k-1) + wpvp2(i,k-1) ) &
2879 : + lhs_diff_zt(2,i,k) * ( wpup2(i,k) + wpvp2(i,k) ) &
2880 0 : + lhs_diff_zt(1,i,k) * ( wpup2(i,k+1) + wpvp2(i,k+1) ), &
2881 0 : stats_zt(i) )
2882 : endif
2883 :
2884 : ! Experimental bouyancy term
2885 0 : call stat_update_var_pt( stats_metadata%iwp3_pr_turb, k, rhs_pr_turb_wp3(i,k), & ! intent(in)
2886 0 : stats_zt(i) ) ! intent(out)
2887 0 : call stat_update_var_pt( stats_metadata%iwp3_pr_dfsn, k, rhs_pr_dfsn_wp3(i,k), & ! intent(in)
2888 0 : stats_zt(i) ) ! intent(out)
2889 :
2890 : end do
2891 : end do
2892 :
2893 : endif
2894 :
2895 : !$acc end data
2896 :
2897 8935056 : return
2898 :
2899 : end subroutine wp23_rhs
2900 :
2901 : !=============================================================================
2902 8935056 : subroutine wp2_term_ta_lhs( nz, ngrdcol, gr, &
2903 8935056 : rho_ds_zt, invrs_rho_ds_zm, &
2904 8935056 : lhs_ta_wp2 )
2905 :
2906 : ! Description:
2907 : ! Turbulent advection term for w'^2: implicit portion of the code.
2908 : !
2909 : ! The d(w'^2)/dt equation contains a turbulent advection term:
2910 : !
2911 : ! - (1/rho_ds) * d( rho_ds * w'^3 )/dz.
2912 : !
2913 : ! The term is solved for completely implicitly, such that:
2914 : !
2915 : ! - (1/rho_ds) * d( rho_ds * w'^3(t+1) )/dz.
2916 : !
2917 : ! Note: When the term is brought over to the left-hand side, the sign
2918 : ! is reversed and the leading "-" in front of the term is changed
2919 : ! to a "+".
2920 : !
2921 : ! The timestep index (t+1) means that the value of w'^3 being used is from
2922 : ! the next timestep, which is being advanced to in solving the d(w'^2)/dt
2923 : ! and d(w'^3)/dt equations.
2924 : !
2925 : ! This term is discretized as follows:
2926 : !
2927 : ! While the values of w'^2 are found on the momentum levels, the values of
2928 : ! w'^3 are found on the thermodynamic levels. Additionally, the values of
2929 : ! rho_ds_zt are found on the thermodynamic levels, and the values of
2930 : ! invrs_rho_ds_zm are found on the momentum levels. On the thermodynamic
2931 : ! levels, the values of rho_ds_zt are multiplied by the values of w'^3. The
2932 : ! derivative of (rho_ds_zt * w'^3) is taken over the intermediate (central)
2933 : ! momentum level, where it is multiplied by invrs_rho_ds_zm, yielding the
2934 : ! desired results.
2935 : !
2936 : ! -----rho_ds_zt----------wp3------------------------------ t(k+1)
2937 : !
2938 : ! ========invrs_rho_ds_zm==========d(rho_ds*wp3)/dz======== m(k)
2939 : !
2940 : ! -----rho_ds_zt----------wp3------------------------------ t(k)
2941 : !
2942 : ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes
2943 : ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for
2944 : ! thermodynamic levels and the letter "m" is used for momentum levels.
2945 : !
2946 : ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) )
2947 :
2948 : ! References:
2949 : !-----------------------------------------------------------------------
2950 :
2951 : use constants_clubb, only: &
2952 : zero ! Constant(s)
2953 :
2954 : use grid_class, only: &
2955 : grid ! Type
2956 :
2957 : use clubb_precision, only: &
2958 : core_rknd ! Variable(s)
2959 :
2960 : implicit none
2961 :
2962 : ! Constant parameters
2963 : integer, parameter :: &
2964 : kp1_tdiag = 1, & ! Thermodynamic superdiagonal index.
2965 : k_tdiag = 2 ! Thermodynamic subdiagonal index.
2966 :
2967 : ! ------------------------ Input Variables ------------------------
2968 : integer, intent(in) :: &
2969 : nz, &
2970 : ngrdcol
2971 :
2972 : type (grid), target, intent(in) :: gr
2973 :
2974 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
2975 : rho_ds_zt, & ! Dry, static density at thermodynamic levels [kg/m^3]
2976 : invrs_rho_ds_zm ! Inv. dry, static density at momentum levels [m^3/kg]
2977 :
2978 : ! ------------------------ Return Variable ------------------------
2979 : real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(out) :: &
2980 : lhs_ta_wp2 ! LHS coefficient of wp2 turbulent advection [1/m]
2981 :
2982 : ! ------------------------ Local variables ------------------------
2983 : integer :: k, i
2984 :
2985 : ! ------------------------ Begin Code ------------------------
2986 :
2987 : !$acc data copyin( gr, invrs_rho_ds_zm, gr%invrs_dzm, rho_ds_zt ) &
2988 : !$acc copyout( lhs_ta_wp2 )
2989 :
2990 : ! Set lower boundary to 0
2991 : !$acc parallel loop gang vector collapse(2) default(present)
2992 149194656 : do k = 1, ngrdcol
2993 429713856 : do i = 1, 2
2994 280519200 : lhs_ta_wp2(i,k,1) = zero
2995 : ! Set upper boundary to 0
2996 420778800 : lhs_ta_wp2(i,k,gr%nz) = zero
2997 : end do
2998 : end do
2999 : !$acc end parallel loop
3000 :
3001 : ! Calculate term at all interior grid levels.
3002 : !$acc parallel loop gang vector collapse(2) default(present)
3003 750544704 : do k = 2, nz-1
3004 12392091504 : do i = 1, ngrdcol
3005 : ! Thermodynamic superdiagonal: [ x wp3(k+1,<t+1>) ]
3006 23283093600 : lhs_ta_wp2(kp1_tdiag,i,k) &
3007 34924640400 : = + invrs_rho_ds_zm(i,k) * gr%invrs_dzm(i,k) * rho_ds_zt(i,k+1)
3008 :
3009 : ! Thermodynamic subdiagonal: [ x wp3(k,<t+1>) ]
3010 : lhs_ta_wp2(k_tdiag,i,k) &
3011 12383156448 : = - invrs_rho_ds_zm(i,k) * gr%invrs_dzm(i,k) * rho_ds_zt(i,k)
3012 : end do
3013 : end do
3014 : !$acc end parallel loop
3015 :
3016 : !$acc end data
3017 :
3018 8935056 : return
3019 :
3020 : end subroutine wp2_term_ta_lhs
3021 :
3022 : !=============================================================================
3023 8935056 : subroutine wp2_terms_ac_pr2_lhs( nz, ngrdcol, gr, &
3024 8935056 : C_uu_shr, wm_zt, &
3025 8935056 : lhs_ac_pr2_wp2 )
3026 :
3027 : ! Description:
3028 : ! Accumulation of w'^2 and w'^2 pressure term 2: implicit portion of the
3029 : ! code.
3030 : !
3031 : ! The d(w'^2)/dt equation contains an accumulation term:
3032 : !
3033 : ! - 2 w'^2 dw/dz;
3034 : !
3035 : ! and pressure term 2:
3036 : !
3037 : ! - C_5 ( -2 w'^2 dw/dz + 2 (g/th_0) w'th_v' ).
3038 : !
3039 : ! The w'^2 accumulation term is completely implicit, while w'^2 pressure
3040 : ! term 2 has both implicit and explicit components. The accumulation term
3041 : ! and the implicit portion of pressure term 2 are combined and solved
3042 : ! together as:
3043 : !
3044 : ! + ( 1 - C_uu_shr ) ( -2 w'^2(t+1) dw/dz ).
3045 : !
3046 : ! Note 1: When the term is brought over to the left-hand side, the sign
3047 : ! is reversed and the leading "-" in front of the "2" is changed
3048 : ! to a "+".
3049 : ! Note 2: We have broken C5 up into C_uu_shr for this term
3050 : ! and C_uu_buoy for the buoyancy term.
3051 : !
3052 : ! The timestep index (t+1) means that the value of w'^2 being used is from
3053 : ! the next timestep, which is being advanced to in solving the d(w'^2)/dt
3054 : ! equation.
3055 : !
3056 : ! The terms are discretized as follows:
3057 : !
3058 : ! The values of w'^2 are found on the momentum levels, while the values of
3059 : ! wm_zt (mean vertical velocity on thermodynamic levels) are found on the
3060 : ! thermodynamic levels. The vertical derivative of wm_zt is taken over the
3061 : ! intermediate (central) momentum level. It is then multiplied by w'^2
3062 : ! (implicitly calculated at timestep (t+1)) and the coefficients to yield
3063 : ! the desired results.
3064 : !
3065 : ! -------wm_zt--------------------------------------------- t(k+1)
3066 : !
3067 : ! ===============d(wm_zt)/dz============wp2================ m(k)
3068 : !
3069 : ! -------wm_zt--------------------------------------------- t(k)
3070 : !
3071 : ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes
3072 : ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for
3073 : ! thermodynamic levels and the letter "m" is used for momentum levels.
3074 : !
3075 : ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) )
3076 :
3077 : ! References:
3078 : !-----------------------------------------------------------------------
3079 :
3080 : use grid_class, only: &
3081 : grid ! Type
3082 :
3083 : use constants_clubb, only: &
3084 : two, & ! Variable(s)
3085 : one, &
3086 : zero
3087 :
3088 : use clubb_precision, only: &
3089 : core_rknd ! Variable(s)
3090 :
3091 : implicit none
3092 :
3093 : ! ------------------------ Input Variables ------------------------
3094 : integer, intent(in) :: &
3095 : nz, &
3096 : ngrdcol
3097 :
3098 : type (grid), target, intent(in) :: gr
3099 :
3100 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3101 : wm_zt ! w wind component at thermodynamic levels [m/s]
3102 :
3103 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
3104 : C_uu_shr ! Model parameter C_uu_shr [-]
3105 :
3106 : ! ------------------------ Output Variable ------------------------
3107 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3108 : lhs_ac_pr2_wp2 ! LHS coefficient of wp2 ac and pr2 terms [1/s]
3109 :
3110 : ! ------------------------ Local Variables ------------------------
3111 : integer :: k, i
3112 :
3113 : ! ------------------------ Begin Code ------------------------
3114 :
3115 : !$acc data copyin( gr, gr%invrs_dzm, wm_zt, C_uu_shr ) &
3116 : !$acc copyout( lhs_ac_pr2_wp2 )
3117 :
3118 : ! Set lower boundary to 0
3119 : !$acc parallel loop gang vector default(present)
3120 149194656 : do i = 1, ngrdcol
3121 140259600 : lhs_ac_pr2_wp2(i,1) = zero
3122 : ! Set upper boundary to 0
3123 149194656 : lhs_ac_pr2_wp2(i,nz) = zero
3124 : end do
3125 : !$acc end parallel loop
3126 :
3127 : ! Calculate term at all interior grid levels.
3128 : !$acc parallel loop gang vector collapse(2) default(present)
3129 750544704 : do k = 2, nz-1
3130 12392091504 : do i = 1, ngrdcol
3131 : ! Momentum main diagonal: [ x wp2(k,<t+1>) ]
3132 23283093600 : lhs_ac_pr2_wp2(i,k) = + ( one - C_uu_shr(i) ) * two * gr%invrs_dzm(i,k) &
3133 35666250048 : * ( wm_zt(i,k+1) - wm_zt(i,k) )
3134 : end do
3135 : end do
3136 : !$acc end parallel loop
3137 :
3138 : !$acc end data
3139 8935056 : return
3140 :
3141 : end subroutine wp2_terms_ac_pr2_lhs
3142 :
3143 : !=============================================================================
3144 8935056 : subroutine wp2_term_dp1_lhs( nz, ngrdcol, &
3145 8935056 : C1_Skw_fnc, invrs_tau1m, &
3146 8935056 : lhs_dp1_wp2 )
3147 :
3148 : ! Description:
3149 : ! Dissipation term 1 for w'^2: implicit portion of the code.
3150 : !
3151 : ! The d(w'^2)/dt equation contains dissipation term 1:
3152 : !
3153 : ! - ( C_1 / tau_1m ) w'^2.
3154 : !
3155 : ! Since w'^2 has a minimum threshold, the term should be damped only to that
3156 : ! threshold. The term becomes:
3157 : !
3158 : ! - ( C_1 / tau_1m ) * ( w'^2 - threshold ).
3159 : !
3160 : ! This term is broken into implicit and explicit portions. The implicit
3161 : ! portion of this term is:
3162 : !
3163 : ! - ( C_1 / tau_1m ) w'^2(t+1).
3164 : !
3165 : ! Note: When the implicit term is brought over to the left-hand side, the
3166 : ! sign is reversed and the leading "-" in front of the term is
3167 : ! changed to a "+".
3168 : !
3169 : ! The timestep index (t+1) means that the value of w'^2 being used is from
3170 : ! the next timestep, which is being advanced to in solving the d(w'^2)/dt
3171 : ! equation.
3172 : !
3173 : ! The values of w'^2 are found on the momentum levels. The values of the
3174 : ! C_1 skewness function and time-scale tau1m are also found on the momentum
3175 : ! levels.
3176 :
3177 : ! References:
3178 : !-----------------------------------------------------------------------
3179 :
3180 : use grid_class, only: &
3181 : grid ! Type
3182 :
3183 : use constants_clubb, only: &
3184 : zero ! Constant(s)
3185 :
3186 : use clubb_precision, only: &
3187 : core_rknd ! Variable(s)
3188 :
3189 : implicit none
3190 :
3191 : ! ------------------ Input Variables ------------------
3192 : integer, intent(in) :: &
3193 : nz, &
3194 : ngrdcol
3195 :
3196 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3197 : C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-]
3198 : invrs_tau1m ! Inverse time-scale tau at momentum levels [1/s]
3199 :
3200 : ! ------------------ Output Variable ------------------
3201 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3202 : lhs_dp1_wp2 ! LHS coefficient of wp2 dissipation term 1 [1/s]
3203 :
3204 : ! ------------------ Local Variable ------------------
3205 : integer :: k, i
3206 :
3207 : ! ------------------ Begin Code ------------------
3208 :
3209 : !$acc data copyin( C1_Skw_fnc, invrs_tau1m ) &
3210 : !$acc copyout( lhs_dp1_wp2 )
3211 :
3212 : ! Set lower boundary to 0
3213 : !$acc parallel loop gang vector default(present)
3214 149194656 : do i = 1, ngrdcol
3215 140259600 : lhs_dp1_wp2(i,1) = zero
3216 : ! Set upper boundary to 0
3217 149194656 : lhs_dp1_wp2(i,nz) = zero
3218 : end do
3219 : !$acc end parallel loop
3220 :
3221 : ! Calculate term at all interior grid levels.
3222 : !$acc parallel loop gang vector collapse(2) default(present)
3223 750544704 : do k = 2, nz-1
3224 12392091504 : do i = 1, ngrdcol
3225 : ! Momentum main diagonal: [ x wp2(k,<t+1>) ]
3226 12383156448 : lhs_dp1_wp2(i,k) = + C1_Skw_fnc(i,k) * invrs_tau1m(i,k)
3227 : end do
3228 : end do
3229 : !$acc end parallel loop
3230 :
3231 : !$acc end data
3232 :
3233 8935056 : return
3234 :
3235 : end subroutine wp2_term_dp1_lhs
3236 :
3237 : !=============================================================================
3238 8935056 : subroutine wp2_term_pr1_lhs( nz, ngrdcol, C4, invrs_tau_C4_zm, &
3239 8935056 : lhs_pr1_wp2 )
3240 :
3241 : ! Description
3242 : ! Pressure term 1 for w'^2: implicit portion of the code.
3243 : !
3244 : ! The d(w'^2)/dt equation contains pressure term 1:
3245 : !
3246 : ! - ( C_4 / tau_1m ) * ( w'^2 - (2/3)*em ),
3247 : !
3248 : ! where em = (1/2) * ( w'^2 + u'^2 + v'^2 ).
3249 : !
3250 : ! This simplifies to:
3251 : !
3252 : ! - ( C_4 / tau_1m ) * (2/3) * w'^2
3253 : ! + ( C_4 / tau_1m ) * (1/3) * ( u'^2 + v'^2 ).
3254 : !
3255 : ! Pressure term 1 has both implicit and explicit components. The implicit
3256 : ! portion is:
3257 : !
3258 : ! - ( C_4 / tau_1m ) * (2/3) * w'^2(t+1);
3259 : !
3260 : ! and is computed in this function.
3261 : !
3262 : ! Note: When the implicit term is brought over to the left-hand side, the
3263 : ! sign is reversed and the leading "-" in front of the term is
3264 : ! changed to a "+".
3265 : !
3266 : ! The timestep index (t+1) means that the value of w'^2 being used is from
3267 : ! the next timestep, which is being advanced to in solving the d(w'^2)/dt
3268 : ! equation.
3269 : !
3270 : ! The values of w'^2 are found on momentum levels, as are the values of
3271 : ! tau1m.
3272 :
3273 : ! References:
3274 : !-----------------------------------------------------------------------
3275 :
3276 : use grid_class, only: &
3277 : grid ! Type
3278 :
3279 : use constants_clubb, only: &
3280 : three, & ! Variable(s)
3281 : two, &
3282 : zero
3283 :
3284 : use clubb_precision, only: &
3285 : core_rknd ! Variable(s)
3286 :
3287 : implicit none
3288 :
3289 : ! --------------------- Input Variables ---------------------
3290 : integer, intent(in) :: &
3291 : nz, &
3292 : ngrdcol
3293 :
3294 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3295 : invrs_tau_C4_zm ! Inverse time-scale tau at momentum levels [1/s]
3296 :
3297 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
3298 : C4 ! Model parameter C_4 [-]
3299 :
3300 : ! --------------------- Output Variable ---------------------
3301 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3302 : lhs_pr1_wp2 ! LHS coefficient of wp2 pressure term 1 [1/s]
3303 :
3304 : ! --------------------- Local Variables ---------------------
3305 : integer :: k, i
3306 :
3307 : ! --------------------- Begin Code ---------------------
3308 :
3309 : !$acc data copyin( invrs_tau_C4_zm ) &
3310 : !$acc copyout( lhs_pr1_wp2 )
3311 :
3312 : ! Set lower boundary to 0
3313 : !$acc parallel loop gang vector default(present)
3314 149194656 : do i = 1, ngrdcol
3315 140259600 : lhs_pr1_wp2(i,1) = zero
3316 :
3317 : ! Set upper boundary to 0
3318 149194656 : lhs_pr1_wp2(i,nz) = zero
3319 : end do
3320 : !$acc end parallel loop
3321 :
3322 : ! Calculate term at all interior grid levels.
3323 : !$acc parallel loop gang vector collapse(2) default(present)
3324 750544704 : do k = 2, nz-1
3325 12392091504 : do i = 1, ngrdcol
3326 : ! Momentum main diagonal: [ x wp2(k,<t+1>) ]
3327 12383156448 : lhs_pr1_wp2(i,k) = + ( two * C4(i) * invrs_tau_C4_zm(i,k) ) / three
3328 : end do
3329 : end do
3330 : !$acc end parallel loop
3331 :
3332 : !$acc end data
3333 :
3334 8935056 : return
3335 :
3336 : end subroutine wp2_term_pr1_lhs
3337 :
3338 : !=============================================================================
3339 8935056 : subroutine wp2_terms_bp_pr2_rhs( nz, ngrdcol, &
3340 8935056 : C_uu_buoy, &
3341 8935056 : thv_ds_zm, wpthvp, &
3342 8935056 : rhs_bp_pr2_wp2 )
3343 :
3344 : ! Description:
3345 : ! Buoyancy production of w'^2 and w'^2 pressure term 2: explicit portion of
3346 : ! the code.
3347 : !
3348 : ! The d(w'^2)/dt equation contains a buoyancy production term:
3349 : !
3350 : ! + 2 (g/thv_ds) w'th_v';
3351 : !
3352 : ! and pressure term 2:
3353 : !
3354 : ! - C_5 ( -2 w'^2 dw/dz + 2 (g/thv_ds) w'th_v' ).
3355 : !
3356 : ! The w'^2 buoyancy production term is completely explicit, while w'^2
3357 : ! pressure term 2 has both implicit and explicit components. The buoyancy
3358 : ! production term and the explicit portion of pressure term 2 are combined
3359 : ! and solved together as:
3360 : !
3361 : ! + ( 1 - C_uu_buoy ) ( 2 (g/thv_ds) w'th_v' ).
3362 : !
3363 : ! Note: We have broken C5 up into C_uu_shr for the accumulation term
3364 : ! and C_uu_buoy for the buoyancy term.
3365 : !
3366 : ! References:
3367 : !-----------------------------------------------------------------------
3368 :
3369 : use grid_class, only: &
3370 : grid ! Type
3371 :
3372 : use constants_clubb, only: & ! Variable(s)
3373 : grav, & ! Gravitational acceleration [m/s^2]
3374 : two, &
3375 : one, &
3376 : zero
3377 :
3378 : use clubb_precision, only: &
3379 : core_rknd ! Variable(s)
3380 :
3381 : implicit none
3382 :
3383 : ! ------------------ Input Variables ------------------
3384 : integer, intent(in) :: &
3385 : nz, &
3386 : ngrdcol
3387 :
3388 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
3389 : C_uu_buoy ! Model parameter C_uu_buoy [-]
3390 :
3391 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3392 : thv_ds_zm, & ! Dry, base-state theta_v at momentum levels [K]
3393 : wpthvp ! w'th_v' [K m/s]
3394 :
3395 : ! ------------------ Output Variable ------------------
3396 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3397 : rhs_bp_pr2_wp2 ! RHS portion of wp2 from terms bp and pr2 [m^2/s^3]
3398 :
3399 : ! ------------------ Local variables ------------------
3400 : integer :: k, i
3401 :
3402 : ! ------------------ Begin Code ------------------
3403 :
3404 : !$acc data copyin( thv_ds_zm, wpthvp, C_uu_buoy ) &
3405 : !$acc copyout( rhs_bp_pr2_wp2 )
3406 :
3407 : ! Set lower boundary to 0
3408 : !$acc parallel loop gang vector default(present)
3409 149194656 : do i = 1, ngrdcol
3410 140259600 : rhs_bp_pr2_wp2(i,1) = zero
3411 : ! Set upper boundary to 0
3412 149194656 : rhs_bp_pr2_wp2(i,nz) = zero
3413 : end do
3414 : !$acc end parallel loop
3415 :
3416 : ! Calculate term at all interior grid levels.
3417 : !$acc parallel loop gang vector collapse(2) default(present)
3418 750544704 : do k = 2, nz-1
3419 12392091504 : do i = 1, ngrdcol
3420 23283093600 : rhs_bp_pr2_wp2(i,k) = + ( one - C_uu_buoy(i) ) * two &
3421 35666250048 : * ( grav / thv_ds_zm(i,k) ) * wpthvp(i,k)
3422 : end do
3423 : end do
3424 : !$acc end parallel loop
3425 :
3426 : !$acc end data
3427 :
3428 8935056 : return
3429 :
3430 : end subroutine wp2_terms_bp_pr2_rhs
3431 :
3432 : !=============================================================================
3433 8935056 : subroutine wp2_term_dp1_rhs( nz, ngrdcol, C1_Skw_fnc, &
3434 8935056 : invrs_tau1m, threshold, up2, vp2, &
3435 : l_damp_wp2_using_em, &
3436 8935056 : rhs_dp1_wp2 )
3437 :
3438 : ! Description:
3439 : ! When l_damp_wp2_using_em == .false., then
3440 : ! Dissipation term 1 for w'^2: explicit portion of the code.
3441 : !
3442 : ! The d(w'^2)/dt equation contains dissipation term 1:
3443 : !
3444 : ! - ( C_1 / tau_1m ) w'^2.
3445 : !
3446 : ! Since w'^2 has a minimum threshold, the term should be damped only to that
3447 : ! threshold. The term becomes:
3448 : !
3449 : ! - ( C_1 / tau_1m ) * ( w'^2 - threshold ).
3450 : !
3451 : ! This term is broken into implicit and explicit portions. The explicit
3452 : ! portion of this term is:
3453 : !
3454 : ! + ( C_1 / tau_1m ) * threshold.
3455 : !
3456 : ! The values of the C_1 skewness function, time-scale tau1m, and the
3457 : ! threshold are found on the momentum levels.
3458 :
3459 : ! if l_damp_wp2_using_em == .true., then
3460 : ! we damp wp2 using a more standard turbulence closure, -(2/3)*em/tau
3461 : ! This only works if C1=C14 and l_stability_correct_tau_zm =.false.
3462 : ! A factor of (1/3) is absorbed into C1.
3463 : ! The threshold is implicitly set to 0.
3464 :
3465 :
3466 : ! References:
3467 : !-----------------------------------------------------------------------
3468 :
3469 : use grid_class, only: &
3470 : grid ! Type
3471 :
3472 : use constants_clubb, only: &
3473 : zero ! Constant(s)
3474 :
3475 : use clubb_precision, only: &
3476 : core_rknd ! Variable(s)
3477 :
3478 : implicit none
3479 :
3480 : ! -------------------- Input Variables --------------------
3481 : integer, intent(in) :: &
3482 : nz, &
3483 : ngrdcol
3484 :
3485 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3486 : C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-]
3487 : invrs_tau1m, & ! Inverse time-scale tau at momentum levels [1/s]
3488 : up2, & ! Horizontal (east-west) velocity variance, u'^2 [m^2/s^2]
3489 : vp2 ! Horizontal (north-south) velocity variance, v'^2 [m^2/s^2]
3490 :
3491 : real( kind = core_rknd ), intent(in) :: &
3492 : threshold ! Minimum allowable value of w'^2 [m^2/s^2]
3493 :
3494 : logical, intent(in) :: &
3495 : l_damp_wp2_using_em ! intent(in) wp2 equation, use a dissipation formula of -(2/3)*em/tau_zm,
3496 : ! as in Bougeault (1981)
3497 :
3498 : ! -------------------- Output Variable --------------------
3499 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3500 : rhs_dp1_wp2 ! RHS portion of wp2 from dissipation term 1 [m^2/s^3]
3501 :
3502 : ! -------------------- Local variables --------------------
3503 : integer :: k, i
3504 :
3505 : ! -------------------- Begin Code --------------------
3506 :
3507 : !$acc data copyin( C1_Skw_fnc, invrs_tau1m, up2, vp2 ) &
3508 : !$acc copyout( rhs_dp1_wp2 )
3509 :
3510 : ! Set lower boundary to 0
3511 : !$acc parallel loop gang vector default(present)
3512 149194656 : do i = 1, ngrdcol
3513 140259600 : rhs_dp1_wp2(i,1) = zero
3514 : ! Set upper boundary to 0
3515 149194656 : rhs_dp1_wp2(i,nz) = zero
3516 : end do
3517 : !$acc end parallel loop
3518 :
3519 : ! Calculate term at all interior grid levels.
3520 8935056 : if ( l_damp_wp2_using_em ) then
3521 : !$acc parallel loop gang vector collapse(2) default(present)
3522 0 : do k = 2, nz-1
3523 0 : do i = 1, ngrdcol
3524 0 : rhs_dp1_wp2(i,k) = - ( C1_Skw_fnc(i,k) * invrs_tau1m(i,k) ) * ( up2(i,k) + vp2(i,k) )
3525 : end do
3526 : end do
3527 : !$acc end parallel loop
3528 : else
3529 : !$acc parallel loop gang vector collapse(2) default(present)
3530 750544704 : do k = 2, nz-1
3531 12392091504 : do i = 1, ngrdcol
3532 12383156448 : rhs_dp1_wp2(i,k) = + ( C1_Skw_fnc(i,k) * invrs_tau1m(i,k) ) * threshold
3533 : end do
3534 : end do
3535 : !$acc end parallel loop
3536 : endif ! l_damp_wp2_using_em
3537 :
3538 : !$acc end data
3539 :
3540 8935056 : return
3541 :
3542 : end subroutine wp2_term_dp1_rhs
3543 :
3544 : !=============================================================================
3545 8935056 : subroutine wp2_term_pr3_rhs( nz, ngrdcol, gr, &
3546 8935056 : C_uu_shr, &
3547 8935056 : C_uu_buoy, &
3548 8935056 : thv_ds_zm, wpthvp, upwp, &
3549 8935056 : um, vpwp, vm, &
3550 8935056 : rhs_pr3_wp2 )
3551 :
3552 : ! Description:
3553 : ! Pressure term 3 for w'^2: explicit portion of the code.
3554 : !
3555 : ! The d(w'^2)/dt equation contains pressure term 3:
3556 : !
3557 : ! + (2/3) C_5 [ (g/thv_ds) w'th_v' - u'w' du/dz - v'w' dv/dz ].
3558 : !
3559 : ! Note that below we have broken up C5 into C_uu_shr for shear terms and
3560 : ! C_uu_buoy for buoyancy terms.
3561 : !
3562 : ! This term is solved for completely explicitly and is discretized as
3563 : ! follows:
3564 : !
3565 : ! The values of w'th_v', u'w', and v'w' are found on the momentum levels,
3566 : ! whereas the values of um and vm are found on the thermodynamic levels.
3567 : ! Additionally, the values of thv_ds_zm are found on the momentum levels.
3568 : ! The derivatives of both um and vm are taken over the intermediate
3569 : ! (central) momentum level. All the remaining mathematical operations take
3570 : ! place at the central momentum level, yielding the desired result.
3571 : !
3572 : ! -----um--------------vm---------------------------------------- t(k+1)
3573 : !
3574 : ! =upwp====d(um)/dz========d(vm)/dz==vpwp===thv_ds_zm==wpthvp==== m(k)
3575 : !
3576 : ! -----um--------------vm---------------------------------------- t(k)
3577 : !
3578 : ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes
3579 : ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for
3580 : ! thermodynamic levels and the letter "m" is used for momentum levels.
3581 : !
3582 : ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) )
3583 :
3584 : ! References:
3585 : !-----------------------------------------------------------------------
3586 :
3587 : use grid_class, only: &
3588 : grid ! Type
3589 :
3590 : use constants_clubb, only: & ! Variables
3591 : grav, & ! Gravitational acceleration [m/s^2]
3592 : two_thirds, &
3593 : zero, &
3594 : zero_threshold
3595 :
3596 : use clubb_precision, only: &
3597 : core_rknd ! Variable(s)
3598 :
3599 : implicit none
3600 :
3601 : ! --------------------- Input Variables ---------------------
3602 : integer, intent(in) :: &
3603 : nz, &
3604 : ngrdcol
3605 :
3606 : type (grid), target, intent(in) :: gr
3607 :
3608 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
3609 : C_uu_shr, & ! Model parameter [-]
3610 : C_uu_buoy ! Model parameter [-]
3611 :
3612 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3613 : thv_ds_zm, & ! Dry, base-state theta_v at momentum level (k) [K]
3614 : wpthvp, & ! w'th_v'(k) [K m/s]
3615 : upwp, & ! u'w'(k) [m^2/s^2]
3616 : um, & ! um(k) [m/s]
3617 : vpwp, & ! v'w'(k) [m^2/s^2]
3618 : vm ! vm(k) [m/s]
3619 :
3620 : ! --------------------- Output Variable ---------------------
3621 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3622 : rhs_pr3_wp2 ! RHS portion of wp2 from pressure term 3 [m^2/s^3]
3623 :
3624 : ! --------------------- Local variables ---------------------
3625 : integer :: k, i
3626 :
3627 : ! ---------------------Begin Code ---------------------
3628 :
3629 : !$acc data copyin( gr, gr%invrs_dzm, &
3630 : !$acc thv_ds_zm, wpthvp, upwp, um, vpwp, vm, C_uu_shr, C_uu_buoy ) &
3631 : !$acc copyout( rhs_pr3_wp2 )
3632 :
3633 : ! Set lower boundary to 0
3634 : !$acc parallel loop gang vector default(present)
3635 149194656 : do i = 1, ngrdcol
3636 140259600 : rhs_pr3_wp2(i,1) = zero
3637 : ! Set upper boundary to 0
3638 149194656 : rhs_pr3_wp2(i,nz) = zero
3639 : end do
3640 : !$acc end parallel loop
3641 :
3642 : ! Calculate term at all interior grid levels.
3643 : !$acc parallel loop gang vector collapse(2) default(present)
3644 750544704 : do k = 2, nz-1
3645 12392091504 : do i = 1, ngrdcol
3646 :
3647 : ! Michael Falk, 2 August 2007
3648 : ! Use the following code for standard mixing, with c_k=0.548:
3649 23283093600 : rhs_pr3_wp2(i,k) &
3650 : = + two_thirds * &
3651 : ( C_uu_buoy(i) &
3652 : * ( grav / thv_ds_zm(i,k) ) * wpthvp(i,k) &
3653 : + C_uu_shr(i) &
3654 11641546800 : * ( - upwp(i,k) * gr%invrs_dzm(i,k) * ( um(i,k+1) - um(i,k) ) &
3655 : - vpwp(i,k) * gr%invrs_dzm(i,k) * ( vm(i,k+1) - vm(i,k) ) &
3656 : ) &
3657 34924640400 : )
3658 :
3659 : ! Use the following code for alternate mixing, with c_k=0.1 or 0.2
3660 : ! = + two_thirds * C_uu_shr &
3661 : ! * ( ( grav / thv_ds_zm(k) ) * wpthvp(k) &
3662 : ! - 0. * upwp(k) * invrs_dzm(k) * ( um(k+1) - um(k) ) &
3663 : ! - 0. * vpwp(k) * invrs_dzm(k) * ( vm(k+1) - vm(k) ) &
3664 : ! )
3665 : ! eMFc
3666 :
3667 :
3668 : ! Added by dschanen for ticket #36
3669 : ! We have found that when shear generation is zero this term will only be
3670 : ! offset by hole-filling (wp2_pd) and reduces turbulence
3671 : ! unrealistically at lower altitudes to make up the difference.
3672 12383156448 : rhs_pr3_wp2(i,k) = max( rhs_pr3_wp2(i,k), zero_threshold )
3673 :
3674 : end do
3675 : end do
3676 : !$acc end parallel loop
3677 :
3678 : !$acc end data
3679 :
3680 8935056 : return
3681 :
3682 : end subroutine wp2_term_pr3_rhs
3683 :
3684 : !=============================================================================
3685 8935056 : subroutine wp2_term_pr1_rhs( nz, ngrdcol, C4, &
3686 8935056 : up2, vp2, invrs_tau_C4_zm, &
3687 8935056 : rhs_pr1_wp2 )
3688 :
3689 : ! Description:
3690 : ! Pressure term 1 for w'^2: explicit portion of the code.
3691 : !
3692 : ! The d(w'^2)/dt equation contains pressure term 1:
3693 : !
3694 : ! - ( C_4 / tau_1m ) * ( w'^2 - (2/3)*em );
3695 : !
3696 : ! where em = (1/2) * ( w'^2 + u'^2 + v'^2 ).
3697 : !
3698 : ! This simplifies to:
3699 : !
3700 : ! - ( C_4 / tau_1m ) * (2/3) * w'^2
3701 : ! + ( C_4 / tau_1m ) * (1/3) * ( u'^2 + v'^2 ).
3702 : !
3703 : ! Pressure term 1 has both implicit and explicit components.
3704 : ! The explicit portion is:
3705 : !
3706 : ! + ( C_4 / tau_1m ) * (1/3) * ( u'^2 + v'^2 );
3707 : !
3708 : ! and is computed in this function.
3709 : !
3710 : ! The values of u'^2 and v'^2 are found on momentum levels, as are the
3711 : ! values of tau1m.
3712 :
3713 : ! References:
3714 : !-----------------------------------------------------------------------
3715 :
3716 : use grid_class, only: &
3717 : grid ! Type
3718 :
3719 : use constants_clubb, only: &
3720 : three, & ! Constant9(s)
3721 : zero
3722 :
3723 : use clubb_precision, only: &
3724 : core_rknd ! Variable(s)
3725 :
3726 : implicit none
3727 :
3728 : ! ------------------------ Input Variables ------------------------
3729 : integer, intent(in) :: &
3730 : nz, &
3731 : ngrdcol
3732 :
3733 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
3734 : C4 ! Model parameter C_4 [-]
3735 :
3736 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3737 : up2, & ! u'^2(k) [m^2/s^2]
3738 : vp2, & ! v'^2(k) [m^2/s^2]
3739 : invrs_tau_C4_zm ! Inverse time-scale tau at momentum levels [1/s]
3740 :
3741 : ! ------------------------ Output Variable ------------------------
3742 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3743 : rhs_pr1_wp2 ! RHS portion of wp2 from pressure term 1 [m^2/s^3]
3744 :
3745 : ! ------------------------ Local Variables ------------------------
3746 : integer :: k, i
3747 :
3748 : ! ------------------------ Begin Code ------------------------
3749 :
3750 : !$acc data copyin( up2, vp2, invrs_tau_C4_zm, C4 ) &
3751 : !$acc copyout( rhs_pr1_wp2 )
3752 :
3753 : ! Set lower bounadry to 0
3754 : !$acc parallel loop gang vector default(present)
3755 149194656 : do i = 1, ngrdcol
3756 140259600 : rhs_pr1_wp2(i,1) = zero
3757 : ! Set upper boundary to 0
3758 149194656 : rhs_pr1_wp2(i,nz) = zero
3759 : end do
3760 : !$acc end parallel loop
3761 :
3762 : ! Calculate term at all interior grid levels.
3763 : !$acc parallel loop gang vector collapse(2) default(present)
3764 750544704 : do k = 2, nz-1
3765 12392091504 : do i = 1, ngrdcol
3766 12383156448 : rhs_pr1_wp2(i,k) = + ( C4(i) * ( up2(i,k) + vp2(i,k) ) * invrs_tau_C4_zm(i,k) ) / three
3767 : end do
3768 : end do
3769 : !$acc end parallel loop
3770 :
3771 : !$acc end data
3772 :
3773 8935056 : return
3774 :
3775 : end subroutine wp2_term_pr1_rhs
3776 :
3777 : !=============================================================================
3778 8935056 : subroutine wp2_term_pr_dfsn_rhs( nz, ngrdcol, gr, C_wp2_pr_dfsn, &
3779 8935056 : rho_ds_zt, invrs_rho_ds_zm, &
3780 8935056 : wpup2, wpvp2, wp3, &
3781 8935056 : rhs_pr_dfsn_wp2 )
3782 :
3783 : ! Description:
3784 : !
3785 : ! This term is intended to represent the "diffusion" part of the wp2
3786 : ! pressure correlation. The total pressure diffusion term,
3787 : !
3788 : ! -1 / rho * ( d( <u_k'p'> )/dx_i + d( <u_i'p'> )/dx_k )
3789 : !
3790 : ! becomes
3791 : !
3792 : ! -2 / rho * d( <w'p'> )/dz
3793 : !
3794 : ! for the w'^2 equation. The factor of 2 is replaced with a tunable
3795 : ! parameter, C_wp2_pr_dfsn, and p' is replaced with
3796 : !
3797 : ! p' ~ - rho * ( u_i*u_i - <u_i*u_i> ),
3798 : !
3799 : ! following Lumley 1978. The wp2 pressure diffusion term becomes
3800 : !
3801 : ! + C_wp2_pr_dfsn / rho * ( d( rho*<w'u_iu_i> )/dz )
3802 : !
3803 : ! References:
3804 : ! Lumley 1978, p. 170. See eq. 6.47 and accompanying discussion.
3805 : !-----------------------------------------------------------------------
3806 :
3807 : use grid_class, only: &
3808 : grid ! Type
3809 :
3810 : use constants_clubb, only: &
3811 : zero
3812 :
3813 : use clubb_precision, only: &
3814 : core_rknd ! Variable(s)
3815 :
3816 : implicit none
3817 :
3818 : ! ---------------------- Input Variables ----------------------
3819 : integer, intent(in) :: &
3820 : nz, &
3821 : ngrdcol
3822 :
3823 : type (grid), target, intent(in) :: &
3824 : gr
3825 :
3826 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
3827 : C_wp2_pr_dfsn ! Model parameter C_wp2_pr_dfsn [-]
3828 :
3829 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3830 : invrs_rho_ds_zm, & ! Inverse dry static density (thermo levels) [kg/m^3]
3831 : rho_ds_zt, & ! Dry static density on mom. levels [kg/m^3]
3832 : wpup2, & ! w'u'^2 on thermodynamic levels [m^4/s^4]
3833 : wpvp2, & ! w'v'^2 on thermodynamic levels [m^4/s^4]
3834 : wp3 ! w'^3 on thermo levels [m^4/s^4]
3835 :
3836 : ! ---------------------- Output Variable ----------------------
3837 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
3838 : rhs_pr_dfsn_wp2 ! RHS portion of wp2 from pressure-diffusion correlation [m^3/s^4]
3839 :
3840 : ! ---------------------- Local Variables ----------------------
3841 : integer :: k, i
3842 :
3843 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
3844 17870112 : wpuip2 ! 4th-order moment sum <w'u_i'u_i'> [m^4/s^4]
3845 :
3846 : ! ---------------------- Begin Code ----------------------
3847 :
3848 : !$acc data copyin( gr, invrs_rho_ds_zm, gr%invrs_dzm, &
3849 : !$acc rho_ds_zt, wpup2, wpvp2, wp3, C_wp2_pr_dfsn ) &
3850 : !$acc copyout(rhs_pr_dfsn_wp2 ) &
3851 : !$acc create( wpuip2 )
3852 :
3853 : !$acc parallel loop gang vector collapse(2) default(present)
3854 768414816 : do k = 1, nz
3855 12690480816 : do i = 1, ngrdcol
3856 12681545760 : wpuip2(i,k) = wpup2(i,k) + wpvp2(i,k) + wp3(i,k)
3857 : end do
3858 : end do
3859 : !$acc end parallel loop
3860 :
3861 : !$acc parallel loop gang vector default(present)
3862 149194656 : do i = 1, ngrdcol
3863 : ! Set lower boundary condition
3864 140259600 : rhs_pr_dfsn_wp2(i,1) = rhs_pr_dfsn_wp2(i,2)
3865 : ! Set upper boundary to 0
3866 149194656 : rhs_pr_dfsn_wp2(i,nz) = zero
3867 : end do
3868 : !$acc end parallel loop
3869 :
3870 : !$acc parallel loop gang vector collapse(2) default(present)
3871 750544704 : do k = 2, nz-1
3872 12392091504 : do i = 1, ngrdcol
3873 23283093600 : rhs_pr_dfsn_wp2(i,k) &
3874 0 : = + C_wp2_pr_dfsn(i) * invrs_rho_ds_zm(i,k) * gr%invrs_dzm(i,k) &
3875 35666250048 : * ( rho_ds_zt(i,k+1) * wpuip2(i,k+1) - rho_ds_zt(i,k) * wpuip2(i,k) )
3876 : end do
3877 : end do
3878 : !$acc end parallel loop
3879 :
3880 : !$acc end data
3881 :
3882 8935056 : return
3883 :
3884 : end subroutine wp2_term_pr_dfsn_rhs
3885 :
3886 : !=============================================================================
3887 0 : subroutine wp3_term_ta_new_pdf_lhs( nz, ngrdcol, gr, coef_wp4_implicit, &
3888 0 : wp2, rho_ds_zm, invrs_rho_ds_zt, &
3889 0 : lhs_ta_wp3 )
3890 :
3891 : ! Description:
3892 : ! Turbulent advection of <w'^3>: implicit portion of the code.
3893 : !
3894 : ! This implicit discretization is specifically for the new PDF.
3895 : !
3896 : ! The d<w'^3>/dt equation contains a turbulent advection term:
3897 : !
3898 : ! - (1/rho_ds) * d( rho_ds * <w'^4> )/dz.
3899 : !
3900 : ! A substitution, which is specific to the new PDF, is made in order to
3901 : ! close the turbulent advection term, such that:
3902 : !
3903 : ! <w'^4> = coef_wp4_implicit * <w'^2>^2.
3904 : !
3905 : ! The calculation of coef_wp4_implicit is detailed in function
3906 : ! calc_coef_wp4_implicit, which is found in module new_pdf in new_pdf.F90.
3907 : !
3908 : ! The turbulent advection term is rewritten as:
3909 : !
3910 : ! - (1/rho_ds) * d( rho_ds * coef_wp4_implicit * <w'^2>^2 )/dz.
3911 : !
3912 : ! The <w'^2>^2 term is timestep split so that it can be expressed linearly
3913 : ! intent(in) terms of <w'^2> at the (t+1) timestep, such that:
3914 : !
3915 : ! <w'^2>^2 = <w'^2>(t) * <w'^2>(t+1);
3916 : !
3917 : ! which allows the turbulent advection term to be expressed implicitly as:
3918 : !
3919 : ! - (1/rho_ds)
3920 : ! * d( rho_ds * coef_wp4_implicit * <w'^2>(t) * <w'^2>(t+1) )/dz.
3921 : !
3922 : ! Note: When the term is brought over to the left-hand side, the sign is
3923 : ! reversed and the leading "-" in front of all d[ ] / dz terms is
3924 : ! changed to a "+".
3925 : !
3926 : ! Timestep index (t) stands for the index of the current timestep, while
3927 : ! timestep index (t+1) stands for the index of the next timestep, which is
3928 : ! being advanced to in solving the d<w'^3>/dt and d<w'^2>/dt equations.
3929 : !
3930 : ! The implicit discretization of this term is as follows:
3931 : !
3932 : ! The values of <w'^3> are found on the thermodynamic levels, while the
3933 : ! values of <w'^2> are found on the momentum levels. The values of
3934 : ! coef_wp4_implicit_zt are originally calculated by the PDF on the
3935 : ! thermodynamic levels. They are interpolated to the intermediate momentum
3936 : ! levels as coef_wp4_implicit. Additionally, the values of rho_ds_zm are
3937 : ! found on the momentum levels, and the values of invrs_rho_ds_zt are found
3938 : ! on the thermodynamic levels. At the intermediate momentum levels, the
3939 : ! values of coef_wp4_implicit are multiplied by <w'^2>(t) * <w'^2>(t+1), and
3940 : ! the resulting product is also multiplied by rho_ds_zm. This product is
3941 : ! referred to as G below. Then, the derivative (d/dz) of that expression is
3942 : ! taken over the central thermodynamic level, where it is multiplied by
3943 : ! -invrs_rho_ds_zt. This yields the desired result. In this function,
3944 : ! the values of G are as follows:
3945 : !
3946 : ! G = rho_ds_zm * coef_wp4_implicit * <w'^2>(t) * <w'^2>(t+1).
3947 : !
3948 : ! -------coef_wp4_implicit_zt---------------------------------------- t(k+1)
3949 : !
3950 : ! =======coef_wp4_implicit(interp)=======wp2=========rho_ds_zm======= m(k)
3951 : !
3952 : ! -------coef_wp4_implicit_zt-----dG/dz-----invrs_rho_ds_zt----wp3--- t(k)
3953 : !
3954 : ! =======coef_wp4_implicit(interp)=======wp2=========rho_ds_zm======= m(k-1)
3955 : !
3956 : ! -------coef_wp4_implicit_zt---------------------------------------- t(k-1)
3957 : !
3958 : ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond
3959 : ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively.
3960 : ! The letter "t" is used for thermodynamic levels and the letter "m" is
3961 : ! used for momentum levels.
3962 : !
3963 : ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) )
3964 :
3965 : ! References:
3966 : !-----------------------------------------------------------------------
3967 :
3968 : use grid_class, only: &
3969 : grid ! Type
3970 :
3971 : use constants_clubb, only: &
3972 : zero
3973 :
3974 : use clubb_precision, only: &
3975 : core_rknd ! Variable(s)
3976 :
3977 : implicit none
3978 :
3979 : ! Constant parameters
3980 : integer, parameter :: &
3981 : k_mdiag = 1, & ! Momentum superdiagonal index.
3982 : km1_mdiag = 2 ! Momentum subdiagonal index.
3983 :
3984 : ! ------------------------ Input Variables ------------------------
3985 : integer, intent(in) :: &
3986 : nz, &
3987 : ngrdcol
3988 :
3989 : type (grid), target, intent(in) :: gr
3990 :
3991 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
3992 : coef_wp4_implicit, & ! <w'^4>=coef_wp4_implicit*<w'^2>^2; m-levs [-]
3993 : wp2, & ! <w'^2> [m^2/s^2]
3994 : rho_ds_zm, & ! Dry, static density at momentum levels [kg/m^3]
3995 : invrs_rho_ds_zt ! Inv dry, static density at thermo levels [m^3/kg]
3996 :
3997 : ! ------------------------ Output Variable ------------------------
3998 : real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(out) :: &
3999 : lhs_ta_wp3 ! LHS coefficient of wp3 turbulent advection [m/s^2]
4000 :
4001 : ! ------------------------ Local Variable ------------------------
4002 : integer :: i, k
4003 :
4004 : ! ------------------------ Begin Code ------------------------
4005 :
4006 : !$acc data copyin( gr, gr%invrs_dzt, invrs_rho_ds_zt, rho_ds_zm, &
4007 : !$acc coef_wp4_implicit, wp2 ) &
4008 : !$acc copyout(lhs_ta_wp3 )
4009 :
4010 : ! Set term at lower boundary to 0
4011 : !$acc parallel loop gang vector default(present)
4012 0 : do i = 1, ngrdcol
4013 0 : do k = 1, 2
4014 : ! Set term at lower boundary to 0
4015 0 : lhs_ta_wp3(k,i,1) = zero
4016 0 : lhs_ta_wp3(k,i,2) = zero
4017 : ! Set term at upper boundary to 0
4018 0 : lhs_ta_wp3(k,i,nz) = zero
4019 : end do
4020 : end do
4021 : !$acc end parallel loop
4022 :
4023 : ! Calculate term at all interior grid levels.
4024 : !$acc parallel loop gang vector collapse(2) default(present)
4025 0 : do k = 3, nz-1
4026 0 : do i = 1, ngrdcol
4027 :
4028 : ! Momentum superdiagonal: [ x wp2(k,<t+1>) ]
4029 0 : lhs_ta_wp3(k_mdiag,i,k) &
4030 0 : = + invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) * rho_ds_zm(i,k) &
4031 0 : * coef_wp4_implicit(i,k) * wp2(i,k)
4032 :
4033 : ! Momentum subdiagonal: [ x wp2(k-1,<t+1>) ]
4034 : lhs_ta_wp3(km1_mdiag,i,k) &
4035 0 : = - invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) * rho_ds_zm(i,k-1) &
4036 0 : * coef_wp4_implicit(i,k-1) * wp2(i,k-1)
4037 :
4038 : end do
4039 : end do
4040 : !$acc end parallel loop
4041 :
4042 : !$acc end data
4043 :
4044 0 : return
4045 :
4046 : end subroutine wp3_term_ta_new_pdf_lhs
4047 :
4048 : !=============================================================================
4049 8935056 : subroutine wp3_term_ta_ADG1_lhs( nz, ngrdcol, gr, &
4050 8935056 : wp2, a1, a1_zt, a3, a3_zt, &
4051 8935056 : wp3_on_wp2, rho_ds_zm, &
4052 8935056 : rho_ds_zt, invrs_rho_ds_zt, &
4053 : l_standard_term_ta, &
4054 : l_partial_upwind_wp3, &
4055 8935056 : lhs_ta_wp3 )
4056 :
4057 : ! Description:
4058 : ! Turbulent advection of w'^3: implicit portion of the code.
4059 : !
4060 : ! This implicit discretization is specifically for the ADG1 PDF.
4061 : !
4062 : ! The d(w'^3)/dt equation contains a turbulent advection term:
4063 : !
4064 : ! - (1/rho_ds) * d( rho_ds * w'^4 )/dz.
4065 : !
4066 : ! A substitution, which is specific to ADG1, is made in order to close the
4067 : ! turbulent advection term, such that:
4068 : !
4069 : ! w'^4 = a_3 * (w'^2)^2 + a_1 * ( (w'^3)^2 / w'^2 );
4070 : !
4071 : ! where both a_1 and a_3 are variables that are functions of sigma_sqd_w,
4072 : ! such that:
4073 : !
4074 : ! a_1 = 1 / (1 - sigma_sqd_w); and
4075 : !
4076 : ! a_3 = 3*(sigma_sqd_w)^2 + 6*(1 - sigma_sqd_w)*sigma_sqd_w
4077 : ! + (1 - sigma_sqd_w)^2.
4078 : !
4079 : ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:wp4_diagnosis
4080 : !
4081 : ! The turbulent advection term is rewritten as:
4082 : !
4083 : ! - (1/rho_ds) * d [ rho_ds * a_3 * (w'^2)^2 ] / dz
4084 : ! - (1/rho_ds) * d [ rho_ds * a_1 * ( (w'^3)^2 / w'^2 ) ] / dz.
4085 : !
4086 : ! The (w'^2)^2 and (w'^3)^2 terms are both timestep split so that they can
4087 : ! be expressed linearly in terms of w'^2 and w'^3, respectively, at the
4088 : ! (t+1) timestep, such that:
4089 : !
4090 : ! (w'^2)^2 = w'^2(t) * w'^2(t+1);
4091 : ! (w'^3)^2 = w'^3(t) * w'^3(t+1);
4092 : !
4093 : ! which allows these terms to be expressed implicitly as:
4094 : !
4095 : ! - (1/rho_ds) * d [ rho_ds * a_3 * w'^2(t) * w'^2(t+1) ] / dz
4096 : ! - (1/rho_ds) * d [ rho_ds * a_1 * w'^3(t) * w'^3(t+1) / w'^2(t) ] / dz.
4097 : !
4098 : ! Note: When the term is brought over to the left-hand side, the sign is
4099 : ! reversed and the leading "-" in front of all d[ ] / dz terms is
4100 : ! changed to a "+".
4101 : !
4102 : ! Timestep index (t) stands for the index of the current timestep, while
4103 : ! timestep index (t+1) stands for the index of the next timestep, which is
4104 : ! being advanced to in solving the d(w'^3)/dt and d(w'^2)/dt equations.
4105 : !
4106 : ! The implicit portion of these terms is discretized as follows:
4107 : !
4108 : ! The values of w'^3 are found on the thermodynamic levels, while the values
4109 : ! of w'^2, a_1, and a_3 are found on the momentum levels. Additionally, the
4110 : ! values of rho_ds_zm are found on the momentum levels, and the values of
4111 : ! invrs_rho_ds_zt are found on the thermodynamic levels. The variable w'^3
4112 : ! is interpolated to the intermediate momentum levels. The values of the
4113 : ! mathematical expressions (called F and G here) within the dF/dz and dG/dz
4114 : ! terms are computed on the momentum levels. Then, the derivatives (d/dz)
4115 : ! of the expressions (F and G) are taken over the central thermodynamic
4116 : ! level, where dF/dz and dG/dz are multiplied by -invrs_rho_ds_zt. This
4117 : ! yields the desired results. In this function, the values of F and G are
4118 : ! as follows:
4119 : !
4120 : ! F = rho_ds_zm * a_3(t) * w'^2(t) * w'^2(t+1); and
4121 : !
4122 : ! G = rho_ds_zm * a_1(t) * w'^3(t) * w'^3(t+1) / w'^2(t).
4123 : !
4124 : ! ------------------------------------------------wp3---------------- t(k+1)
4125 : !
4126 : ! ===a3====wp2====rho_ds_zm====a1======================wp3(interp)=== m(k)
4127 : !
4128 : ! -----------dF/dz----invrs_rho_ds_zt----dG/dz----wp3---------------- t(k)
4129 : !
4130 : ! ===a3====wp2====rho_ds_zm====a1======================wp3(interp)=== m(k-1)
4131 : !
4132 : ! ------------------------------------------------wp3---------------- t(k-1)
4133 : !
4134 : ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond
4135 : ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively.
4136 : ! The letter "t" is used for thermodynamic levels and the letter "m" is
4137 : ! used for momentum levels.
4138 : !
4139 : ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) )
4140 :
4141 : ! References:
4142 : !-----------------------------------------------------------------------
4143 :
4144 : use grid_class, only: &
4145 : grid ! Type
4146 :
4147 : use constants_clubb, only: &
4148 : zero
4149 :
4150 : use clubb_precision, only: &
4151 : core_rknd ! Variable(s)
4152 :
4153 : implicit none
4154 :
4155 : ! Constant parameters
4156 : integer, parameter :: &
4157 : kp1_tdiag = 1, & ! Thermodynamic superdiagonal index.
4158 : k_mdiag = 2, & ! Momentum superdiagonal index.
4159 : k_tdiag = 3, & ! Thermodynamic main diagonal index.
4160 : km1_mdiag = 4, & ! Momentum subdiagonal index.
4161 : km1_tdiag = 5 ! Thermodynamic subdiagonal index.
4162 :
4163 : integer, parameter :: &
4164 : t_above = 1, & ! Index for upper thermodynamic level grid weight.
4165 : t_below = 2 ! Index for lower thermodynamic level grid weight.
4166 :
4167 : ! ---------------------- Input Variables ----------------------
4168 : integer, intent(in) :: &
4169 : nz, &
4170 : ngrdcol
4171 :
4172 : type (grid), target, intent(in) :: gr
4173 :
4174 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
4175 : wp2, & ! w'^2 [m^2/s^2]
4176 : a1, & ! a_1 [-]
4177 : a1_zt, & ! a_1 interpolated to thermodynamic levels [-]
4178 : a3, & ! a_3 [-]
4179 : a3_zt, & ! a_3 interpolated to thermodynamic levels [-]
4180 : wp3_on_wp2, & ! w'^3 / w'^2 at momentum levels [m/s]
4181 : rho_ds_zm, & ! Dry, static density at momentum levels [kg/m^3]
4182 : rho_ds_zt, & ! Dry, static density at thermo. levels [kg/m^3]
4183 : invrs_rho_ds_zt ! Inv dry, static density at thermo levels [m^3/kg]
4184 :
4185 : logical, intent(in) :: &
4186 : l_standard_term_ta, & ! Use the standard discretization for the
4187 : ! turbulent advection terms. Setting to .false.
4188 : ! means that a_1 and a_3 are pulled outside of the
4189 : ! derivative in advance_wp2_wp3_module.F90 and in
4190 : ! advance_xp2_xpyp_module.F90.
4191 : l_partial_upwind_wp3 ! Flag to use an "upwind" discretization rather
4192 : ! than a centered discretization for the portion
4193 : ! of the wp3 turbulent advection term for ADG1
4194 : ! that is linearized in terms of wp3<t+1>.
4195 : ! (Requires ADG1 PDF and l_standard_term_ta).
4196 :
4197 : ! ---------------------- Output Variable ----------------------
4198 : real( kind = core_rknd ), dimension(ndiags5,ngrdcol,nz), intent(out) :: &
4199 : lhs_ta_wp3 ! LHS coefficient of wp3 turbulent advection
4200 :
4201 : ! ---------------------- Local variables ----------------------
4202 : integer :: k, i
4203 :
4204 : ! ---------------------- Begin Code ----------------------
4205 :
4206 : !$acc data copyin( gr, gr%invrs_dzt, gr%weights_zt2zm, wp2, &
4207 : !$acc a1, a1_zt, a3, a3_zt, wp3_on_wp2, rho_ds_zm, rho_ds_zt, &
4208 : !$acc invrs_rho_ds_zt ) &
4209 : !$acc copyout( lhs_ta_wp3 )
4210 :
4211 : ! Set lower boundary to 0
4212 : !$acc parallel loop gang vector collapse(2) default(present)
4213 149194656 : do k = 1, ngrdcol
4214 850492656 : do i = 1, 5
4215 : ! Set lower boundary to 0
4216 701298000 : lhs_ta_wp3(i,k,1) = zero
4217 701298000 : lhs_ta_wp3(i,k,2) = zero
4218 : ! Set upper boundary to 0
4219 841557600 : lhs_ta_wp3(i,k,nz) = zero
4220 : end do
4221 : end do
4222 : !$acc end parallel loop
4223 :
4224 : ! Calculate term at all interior grid levels.
4225 8935056 : if ( l_standard_term_ta ) then
4226 :
4227 : ! The turbulent advection term is discretized normally, in accordance
4228 : ! with the model equations found in the documentation and the description
4229 : ! listed above.
4230 :
4231 0 : if ( .not. l_partial_upwind_wp3 ) then
4232 :
4233 : ! All portions of the wp3 turbulent advection term for ADG1 use
4234 : ! centered discretization in accordance with description and diagram
4235 : ! shown above.
4236 : !$acc parallel loop gang vector collapse(2) default(present)
4237 0 : do k = 3, nz-2, 1
4238 0 : do i = 1, ngrdcol
4239 :
4240 : ! Thermodynamic superdiagonal: [ x wp3(k+1,<t+1>) ]
4241 0 : lhs_ta_wp3(kp1_tdiag,i,k) &
4242 : = + invrs_rho_ds_zt(i,k) &
4243 0 : * gr%invrs_dzt(i,k) &
4244 : * rho_ds_zm(i,k) * a1(i,k) * wp3_on_wp2(i,k) &
4245 0 : * gr%weights_zt2zm(i,k,t_above)
4246 :
4247 : ! Momentum superdiagonal: [ x wp2(k,<t+1>) ]
4248 : lhs_ta_wp3(k_mdiag,i,k) &
4249 0 : = + invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4250 0 : * rho_ds_zm(i,k) * a3(i,k) * wp2(i,k)
4251 :
4252 : ! Thermodynamic main diagonal: [ x wp3(k,<t+1>) ]
4253 : lhs_ta_wp3(k_tdiag,i,k) &
4254 : = + invrs_rho_ds_zt(i,k) &
4255 0 : * gr%invrs_dzt(i,k) &
4256 : * ( rho_ds_zm(i,k) * a1(i,k) * wp3_on_wp2(i,k) &
4257 0 : * gr%weights_zt2zm(i,k,t_below) &
4258 0 : - rho_ds_zm(i,k-1) * a1(i,k-1) * wp3_on_wp2(i,k-1) &
4259 0 : * gr%weights_zt2zm(i,k-1,t_above) )
4260 :
4261 : ! Momentum subdiagonal: [ x wp2(k-1,<t+1>) ]
4262 : lhs_ta_wp3(km1_mdiag,i,k) &
4263 0 : = - invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4264 0 : * rho_ds_zm(i,k-1) * a3(i,k-1) * wp2(i,k-1)
4265 :
4266 : ! Thermodynamic subdiagonal: [ x wp3(k-1,<t+1>) ]
4267 : lhs_ta_wp3(km1_tdiag,i,k) &
4268 : = - invrs_rho_ds_zt(i,k) &
4269 0 : * gr%invrs_dzt(i,k) &
4270 : * rho_ds_zm(i,k-1) * a1(i,k-1) * wp3_on_wp2(i,k-1) &
4271 0 : * gr%weights_zt2zm(i,k-1,t_below)
4272 :
4273 : end do
4274 : end do
4275 : !$acc end parallel loop
4276 :
4277 : ! Upper Boundary
4278 : ! The turbulent advection discretization assumes that wp3 has a value
4279 : ! of 0 at momentum level nz (which is immediately above thermodynamic
4280 : ! level nzt).
4281 : ! The model is presently applying the u.b. condition on the
4282 : ! 2nd highest thermodynamic level.
4283 0 : k = nz-1
4284 : !$acc parallel loop gang vector default(present)
4285 0 : do i = 1, ngrdcol
4286 :
4287 : ! Momentum superdiagonal: [ x wp2(k,<t+1>) ]
4288 0 : lhs_ta_wp3(k_mdiag,i,k) &
4289 0 : = + invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4290 0 : * rho_ds_zm(i,k) * a3(i,k) * wp2(i,k)
4291 :
4292 : ! Thermodynamic main diagonal: [ x wp3(k,<t+1>) ]
4293 : lhs_ta_wp3(k_tdiag,i,k) &
4294 : = - invrs_rho_ds_zt(i,k) &
4295 0 : * gr%invrs_dzt(i,k) &
4296 0 : * rho_ds_zm(i,k-1) * a1(i,k-1) * wp3_on_wp2(i,k-1) &
4297 0 : * gr%weights_zt2zm(i,k-1,t_above)
4298 :
4299 : ! Momentum subdiagonal: [ x wp2(k-1,<t+1>) ]
4300 : lhs_ta_wp3(km1_mdiag,i,k) &
4301 0 : = - invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4302 0 : * rho_ds_zm(i,k-1) * a3(i,k-1) * wp2(i,k-1)
4303 :
4304 : ! Thermodynamic subdiagonal: [ x wp3(k-1,<t+1>) ]
4305 : lhs_ta_wp3(km1_tdiag,i,k) &
4306 : = - invrs_rho_ds_zt(i,k) &
4307 0 : * gr%invrs_dzt(i,k) &
4308 : * rho_ds_zm(i,k-1) * a1(i,k-1) * wp3_on_wp2(i,k-1) &
4309 0 : * gr%weights_zt2zm(i,k-1,t_below)
4310 :
4311 : enddo
4312 : !$acc end parallel loop
4313 :
4314 : else ! l_partial_upwind_wp3
4315 :
4316 : ! Partial upwinding of the wp3 turbulent advection term, where the
4317 : ! portion of the wp3 turbulent advection term that is linearized in
4318 : ! terms of wp2<t+1> is still handled using centered discretization,
4319 : ! but the portion of the term that is linearized in terms of wp3<t+1>
4320 : ! is handled using an "upwind" discretization that also takes into
4321 : ! "winds" that converge or diverge around the central thermodynamic
4322 : ! grid level. Provided by Chris Vogl and Shixuan Zhang.
4323 : !$acc parallel loop gang vector collapse(2) default(present)
4324 0 : do k = 3, nz-2, 1
4325 0 : do i = 1, ngrdcol
4326 :
4327 : ! Thermodynamic superdiagonal: [ x wp3(k+1,<t+1>) ]
4328 0 : lhs_ta_wp3(kp1_tdiag,i,k) &
4329 : = + invrs_rho_ds_zt(i,k) &
4330 0 : * gr%invrs_dzt(i,k) * rho_ds_zt(i,k+1) &
4331 0 : * min( a1(i,k) * wp3_on_wp2(i,k), zero )
4332 :
4333 : ! Momentum superdiagonal: [ x wp2(k,<t+1>) ]
4334 : lhs_ta_wp3(k_mdiag,i,k) &
4335 0 : = + invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4336 0 : * rho_ds_zm(i,k) * a3(i,k) * wp2(i,k)
4337 :
4338 : ! Thermodynamic main diagonal: [ x wp3(k,<t+1>) ]
4339 : lhs_ta_wp3(k_tdiag,i,k) &
4340 : = + invrs_rho_ds_zt(i,k) &
4341 0 : * gr%invrs_dzt(i,k) * rho_ds_zt(i,k) &
4342 : * ( max( a1(i,k) * wp3_on_wp2(i,k), zero ) &
4343 0 : - min( a1(i,k-1) * wp3_on_wp2(i,k-1), zero ) )
4344 :
4345 : ! Momentum subdiagonal: [ x wp2(k-1,<t+1>) ]
4346 : lhs_ta_wp3(km1_mdiag,i,k) &
4347 0 : = - invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4348 0 : * rho_ds_zm(i,k-1) * a3(i,k-1) * wp2(i,k-1)
4349 :
4350 : ! Thermodynamic subdiagonal: [ x wp3(k-1,<t+1>) ]
4351 : lhs_ta_wp3(km1_tdiag,i,k) &
4352 : = - invrs_rho_ds_zt(i,k) &
4353 0 : * gr%invrs_dzt(i,k) * rho_ds_zt(i,k-1) &
4354 0 : * max( a1(i,k-1) * wp3_on_wp2(i,k-1), zero )
4355 :
4356 : end do
4357 : end do
4358 : !$acc end parallel loop
4359 :
4360 : ! Upper Boundary
4361 : ! The turbulent advection discretization assumes that wp3 has a value
4362 : ! of 0 at momentum level nz (which is immediately above thermodynamic
4363 : ! level nz).
4364 : ! The model is presently applying the u.b. condition on the
4365 : ! 2nd highest thermodynamic level.
4366 0 : k = nz-1
4367 : !$acc parallel loop gang vector default(present)
4368 0 : do i = 1, ngrdcol
4369 :
4370 : ! Momentum superdiagonal: [ x wp2(k,<t+1>) ]
4371 0 : lhs_ta_wp3(k_mdiag,i,k) &
4372 0 : = + invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4373 0 : * rho_ds_zm(i,k) * a3(i,k) * wp2(i,k)
4374 :
4375 : ! Thermodynamic main diagonal: [ x wp3(k,<t+1>) ]
4376 : lhs_ta_wp3(k_tdiag,i,k) &
4377 : = - invrs_rho_ds_zt(i,k) &
4378 0 : * gr%invrs_dzt(i,k) * rho_ds_zt(i,k) &
4379 0 : * min( a1(i,k-1) * wp3_on_wp2(i,k-1), zero )
4380 :
4381 : ! Momentum subdiagonal: [ x wp2(k-1,<t+1>) ]
4382 : lhs_ta_wp3(km1_mdiag,i,k) &
4383 0 : = - invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4384 0 : * rho_ds_zm(i,k-1) * a3(i,k-1) * wp2(i,k-1)
4385 :
4386 : ! Thermodynamic subdiagonal: [ x wp3(k-1,<t+1>) ]
4387 : lhs_ta_wp3(km1_tdiag,i,k) &
4388 : = - invrs_rho_ds_zt(i,k) &
4389 0 : * gr%invrs_dzt(i,k) * rho_ds_zt(i,k-1) &
4390 0 : * max( a1(i,k-1) * wp3_on_wp2(i,k-1), zero )
4391 :
4392 : enddo
4393 : !$acc end parallel loop
4394 :
4395 : end if ! .not. l_partial_upwind_wp3
4396 :
4397 : else
4398 :
4399 : ! Alternate discretization for the turbulent advection term, which
4400 : ! contains the term:
4401 : ! - (1/rho_ds) * d [ rho_ds * a_1 * (w'^3)^2 / w'^2 ] / dz. In order
4402 : ! to help stabilize w'^3, a_1 has been pulled outside of the derivative.
4403 : ! On the left-hand side of the equation, this effects the thermodynamic
4404 : ! superdiagonal (kp1_tdiag), the thermodynamic main diagonal (k_tdiag),
4405 : ! and the thermodynamic subdiagonal (km1_tdiag).
4406 :
4407 : ! Additionally, the discretization of the turbulent advection term, which
4408 : ! contains the term:
4409 : ! - (1/rho_ds) * d [ rho_ds * a_3 * (w'^2)^2 ] / dz, has been altered to
4410 : ! pull a_3 outside of the derivative. This was done in order to help
4411 : ! stabilize w'^3. On the left-hand side of the equation, this effects
4412 : ! the momentum superdiagonal (k_mdiag) and the momentum subdiagonal
4413 : ! (km1_mdiag).
4414 : !$acc parallel loop gang vector collapse(2) default(present)
4415 732674592 : do k = 3, nz-2
4416 12093702192 : do i = 1, ngrdcol
4417 :
4418 : ! Thermodynamic superdiagonal: [ x wp3(k+1,<t+1>) ]
4419 22722055200 : lhs_ta_wp3(kp1_tdiag,i,k) &
4420 : = + invrs_rho_ds_zt(i,k) &
4421 0 : * a1_zt(i,k) * gr%invrs_dzt(i,k) &
4422 : * rho_ds_zm(i,k) * wp3_on_wp2(i,k) &
4423 34083082800 : * gr%weights_zt2zm(i,k,t_above)
4424 :
4425 : ! Momentum superdiagonal: [ x wp2(k,<t+1>) ]
4426 : lhs_ta_wp3(k_mdiag,i,k) &
4427 0 : = + invrs_rho_ds_zt(i,k) * a3_zt(i,k) * gr%invrs_dzt(i,k) &
4428 11361027600 : * rho_ds_zm(i,k) * wp2(i,k)
4429 :
4430 : ! Thermodynamic main diagonal: [ x wp3(k,<t+1>) ]
4431 : lhs_ta_wp3(k_tdiag,i,k) &
4432 : = + invrs_rho_ds_zt(i,k) &
4433 0 : * a1_zt(i,k) * gr%invrs_dzt(i,k) &
4434 : * ( rho_ds_zm(i,k) * wp3_on_wp2(i,k) &
4435 0 : * gr%weights_zt2zm(i,k,t_below) &
4436 11361027600 : - rho_ds_zm(i,k-1) * wp3_on_wp2(i,k-1) &
4437 22722055200 : * gr%weights_zt2zm(i,k-1,t_above) )
4438 :
4439 : ! Momentum subdiagonal: [ x wp2(k-1,<t+1>) ]
4440 : lhs_ta_wp3(km1_mdiag,i,k) &
4441 0 : = - invrs_rho_ds_zt(i,k) * a3_zt(i,k) * gr%invrs_dzt(i,k) &
4442 11361027600 : * rho_ds_zm(i,k-1) * wp2(i,k-1)
4443 :
4444 : ! Thermodynamic subdiagonal: [ x wp3(k-1,<t+1>) ]
4445 : lhs_ta_wp3(km1_tdiag,i,k) &
4446 : = - invrs_rho_ds_zt(i,k) &
4447 0 : * a1_zt(i,k) * gr%invrs_dzt(i,k) &
4448 : * rho_ds_zm(i,k-1) * wp3_on_wp2(i,k-1) &
4449 12084767136 : * gr%weights_zt2zm(i,k-1,t_below)
4450 :
4451 : end do
4452 : end do
4453 : !$acc end parallel loop
4454 :
4455 : ! Upper Boundary
4456 : ! The turbulent advection discretization assumes that wp3 has a value
4457 : ! of 0 at momentum level nz (which is immediately above thermodynamic
4458 : ! level nz).
4459 : ! The model is presently applying the u.b. condition on the
4460 : ! 2nd highest thermodynamic level.
4461 8935056 : k = nz-1
4462 : !$acc parallel loop gang vector default(present)
4463 149194656 : do i = 1, ngrdcol
4464 :
4465 : ! Momentum superdiagonal: [ x wp2(k,<t+1>) ]
4466 280519200 : lhs_ta_wp3(k_mdiag,i,k) &
4467 0 : = + invrs_rho_ds_zt(i,k) * a3_zt(i,k) * gr%invrs_dzt(i,k) &
4468 420778800 : * rho_ds_zm(i,k) * wp2(i,k)
4469 :
4470 : ! Thermodynamic main diagonal: [ x wp3(k,<t+1>) ]
4471 : lhs_ta_wp3(k_tdiag,i,k) &
4472 : = - invrs_rho_ds_zt(i,k) &
4473 0 : * a1_zt(i,k) * gr%invrs_dzt(i,k) &
4474 140259600 : * rho_ds_zm(i,k-1) * wp3_on_wp2(i,k-1) &
4475 280519200 : * gr%weights_zt2zm(i,k-1,t_above)
4476 :
4477 : ! Momentum subdiagonal: [ x wp2(k-1,<t+1>) ]
4478 : lhs_ta_wp3(km1_mdiag,i,k) &
4479 0 : = - invrs_rho_ds_zt(i,k) * a3_zt(i,k) * gr%invrs_dzt(i,k) &
4480 140259600 : * rho_ds_zm(i,k-1) * wp2(i,k-1)
4481 :
4482 : ! Thermodynamic subdiagonal: [ x wp3(k-1,<t+1>) ]
4483 : lhs_ta_wp3(km1_tdiag,i,k) &
4484 : = - invrs_rho_ds_zt(i,k) &
4485 0 : * a1_zt(i,k) * gr%invrs_dzt(i,k) &
4486 : * rho_ds_zm(i,k-1) * wp3_on_wp2(i,k-1) &
4487 149194656 : * gr%weights_zt2zm(i,k-1,t_below)
4488 :
4489 : enddo
4490 : !$acc end parallel loop
4491 :
4492 : end if ! l_standard_term_ta
4493 :
4494 : !$acc end data
4495 :
4496 8935056 : return
4497 :
4498 : end subroutine wp3_term_ta_ADG1_lhs
4499 :
4500 : !=============================================================================
4501 17870112 : subroutine wp3_term_tp_lhs( nz, ngrdcol, gr, coef_wp3_tp, &
4502 17870112 : wp2, rho_ds_zm, invrs_rho_ds_zt, &
4503 17870112 : lhs_tp_wp3 )
4504 :
4505 : ! Description:
4506 : ! Turbulent production of w'^3: implicit portion of the code.
4507 : !
4508 : ! The d(w'^3)/dt equation contains a turbulent production term:
4509 : !
4510 : ! + 3 * ( w'^2 / rho_ds ) * d( rho_ds * w'^2 )/dz.
4511 : !
4512 : ! The turbulent production term is rewritten as:
4513 : !
4514 : ! + 3 * ( w'^2 / rho_ds ) * d[ rho_ds * w'^2 ]/dz
4515 : ! = + (3/rho_ds) * d[ rho_ds * (w'^2)^2 ]/dz - (3/2) * d[ (w'^2)^2 ]/dz.
4516 : !
4517 : ! The (w'^2)^2 terms are timestep split so that they can be expressed
4518 : ! linearly in terms of w'^2 at the (t+1) timestep, such that:
4519 : !
4520 : ! (w'^2)^2 = w'^2(t) * w'^2(t+1).
4521 : !
4522 : ! The term can now be expressed implicitly as:
4523 : !
4524 : ! + (3/rho_ds) * d [ rho_ds * w'^2(t) * w'^2(t+1) ] / dz
4525 : ! - (3/2) * d [ w'^2(t) * w'^2(t+1) ] /dz.
4526 : !
4527 : ! Note: When the term is brought over to the left-hand side, the sign is
4528 : ! reversed and the leading "-" in front of a d[ ] / dz term is
4529 : ! changed to a "+". Likewise, the leading "+" in front of a
4530 : ! d[ ] / dz term is changed to a "-".
4531 : !
4532 : ! Timestep index (t) stands for the index of the current timestep, while
4533 : ! timestep index (t+1) stands for the index of the next timestep, which is
4534 : ! being advanced to in solving the d(w'^3)/dt and d(w'^2)/dt equations.
4535 : !
4536 : ! The implicit portion of these terms is discretized as follows:
4537 : !
4538 : ! While the values of w'^3 are found on the thermodynamic levels, the values
4539 : ! of w'^2 are found on the momentum levels. Additionally, the values of
4540 : ! rho_ds_zm are found on the momentum levels, and the values of
4541 : ! invrs_rho_ds_zt are found on the thermodynamic levels. The values of the
4542 : ! mathematical expressions (called F and G below) within the dF/dz and dG/dz
4543 : ! terms are computed on the momentum levels. Then, the derivatives (d/dz)
4544 : ! of the expressions (F and G) are taken over the central thermodynamic
4545 : ! level, where dF/dz and dG/dz are multiplied by -3 * invrs_rho_ds_zt and
4546 : ! 3/2, respectively, yielding the desired results. In this function, the
4547 : ! values of F and G are as follows:
4548 : !
4549 : ! F = rho_ds_zm * w'^2(t) * w'^2(t+1);
4550 : !
4551 : ! G = w'^2(t) * w'^2(t+1).
4552 : !
4553 : ! ====wp2=========rho_ds_zm========================================== m(k)
4554 : !
4555 : ! -----------dF/dz----invrs_rho_ds_zt----dG/dz----wp3---------------- t(k)
4556 : !
4557 : ! ====wp2=========rho_ds_zm========================================== m(k-1)
4558 : !
4559 : ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes
4560 : ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for
4561 : ! thermodynamic levels and the letter "m" is used for momentum levels.
4562 : !
4563 : ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) )
4564 :
4565 : ! References:
4566 : !-----------------------------------------------------------------------
4567 :
4568 : use grid_class, only: &
4569 : grid ! Type
4570 :
4571 : use constants_clubb, only: &
4572 : three, & ! Constant(s)
4573 : three_halves, &
4574 : zero
4575 :
4576 : use clubb_precision, only: &
4577 : core_rknd ! Variable(s)
4578 :
4579 : implicit none
4580 :
4581 : ! Constant parameters
4582 : integer, parameter :: &
4583 : k_mdiag = 1, & ! Momentum superdiagonal index.
4584 : km1_mdiag = 2 ! Momentum subdiagonal index.
4585 :
4586 : ! -------------------- Input Variables --------------------
4587 : integer, intent(in) :: &
4588 : nz, &
4589 : ngrdcol
4590 :
4591 : type (grid), target, intent(in) :: &
4592 : gr
4593 :
4594 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
4595 : coef_wp3_tp ! Coefficient for tp pressure scrambling term [-]
4596 :
4597 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
4598 : wp2, & ! w'^2 [m^2/s^2]
4599 : rho_ds_zm, & ! Dry, static density at momentum levels [kg/m^3]
4600 : invrs_rho_ds_zt ! Inv dry, static density at thermo levels [m^3/kg]
4601 :
4602 : ! -------------------- Output Variable --------------------
4603 : real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(out) :: &
4604 : lhs_tp_wp3 ! LHS coefficient of wp3 turbulent production [1/s]
4605 :
4606 : ! -------------------- Local variables --------------------
4607 : integer :: k, i
4608 :
4609 : ! -------------------- Begin Code --------------------
4610 :
4611 : !$acc data copyin( gr, invrs_rho_ds_zt, &
4612 : !$acc gr%invrs_dzt, rho_ds_zm, wp2 ) &
4613 : !$acc copyout( lhs_tp_wp3 )
4614 :
4615 : ! Set lower boundary to 0
4616 : !$acc parallel loop gang vector default(present)
4617 298389312 : do k = 1, ngrdcol
4618 859427712 : do i = 1, 2
4619 : ! Set lower boundary to 0
4620 561038400 : lhs_tp_wp3(i,k,1) = zero
4621 561038400 : lhs_tp_wp3(i,k,2) = zero
4622 : ! Set upper boundary to 0
4623 841557600 : lhs_tp_wp3(i,k,nz) = zero
4624 : end do
4625 : end do
4626 : !$acc end parallel loop
4627 :
4628 : ! Calculate term at all interior grid levels.
4629 : !$acc parallel loop gang vector collapse(2) default(present)
4630 1483219296 : do k = 3, nz-1
4631 24485793696 : do i = 1, ngrdcol
4632 : ! Momentum superdiagonal: [ x wp2(k,<t+1>) ]
4633 46005148800 : lhs_tp_wp3(k_mdiag,i,k) &
4634 0 : = - coef_wp3_tp(i) * three * invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4635 : * rho_ds_zm(i,k) * wp2(i,k) &
4636 69007723200 : + coef_wp3_tp(i) * three_halves * gr%invrs_dzt(i,k) * wp2(i,k)
4637 :
4638 : ! Momentum subdiagonal: [ x wp2(k-1,<t+1>) ]
4639 : lhs_tp_wp3(km1_mdiag,i,k) &
4640 0 : = + coef_wp3_tp(i) * three * invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
4641 23002574400 : * rho_ds_zm(i,k-1) * wp2(i,k-1) &
4642 47470497984 : - coef_wp3_tp(i) * three_halves * gr%invrs_dzt(i,k) * wp2(i,k-1)
4643 : end do
4644 : end do
4645 : !$acc end parallel loop
4646 :
4647 : !$acc end data
4648 :
4649 17870112 : return
4650 :
4651 : end subroutine wp3_term_tp_lhs
4652 :
4653 : !=============================================================================
4654 8935056 : subroutine wp3_terms_ac_pr2_lhs( nz, ngrdcol, gr, C11_Skw_fnc, wm_zm, &
4655 8935056 : lhs_ac_pr2_wp3 )
4656 :
4657 : ! Description:
4658 : ! Accumulation of w'^3 and w'^3 pressure term 2: implicit portion of the
4659 : ! code.
4660 : !
4661 : ! The d(w'^3)/dt equation contains an accumulation term:
4662 : !
4663 : ! - 3 w'^3 dw/dz;
4664 : !
4665 : ! and pressure term 2:
4666 : !
4667 : ! - C_11 ( -3 w'^3 dw/dz + 3 (g/th_0) w'^2th_v' ).
4668 : !
4669 : ! The w'^3 accumulation term is completely implicit, while w'^3 pressure
4670 : ! term 2 has both implicit and explicit components. The accumulation term
4671 : ! and the implicit portion of pressure term 2 are combined and solved
4672 : ! together as:
4673 : !
4674 : ! + ( 1 - C_11 ) ( -3 w'^3(t+1) dw/dz ).
4675 : !
4676 : ! Note: When the term is brought over to the left-hand side, the sign
4677 : ! is reversed and the leading "-" in front of the "3" is changed
4678 : ! to a "+".
4679 : !
4680 : ! The timestep index (t+1) means that the value of w'^3 being used is from
4681 : ! the next timestep, which is being advanced to in solving the d(w'^3)/dt
4682 : ! equation.
4683 : !
4684 : ! The terms are discretized as follows:
4685 : !
4686 : ! The values of w'^3 are found on thermodynamic levels, while the values of
4687 : ! wm_zm (mean vertical velocity on momentum levels) are found on momentum
4688 : ! levels. The vertical derivative of wm_zm is taken over the intermediate
4689 : ! (central) thermodynamic level. It is then multiplied by w'^3 (implicitly
4690 : ! calculated at timestep (t+1)) and the coefficients to yield the desired
4691 : ! results.
4692 : !
4693 : ! =======wm_zm============================================= m(k)
4694 : !
4695 : ! ---------------d(wm_zm)/dz------------wp3---------------- t(k)
4696 : !
4697 : ! =======wm_zm============================================= m(k-1)
4698 : !
4699 : ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes
4700 : ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for
4701 : ! thermodynamic levels and the letter "m" is used for momentum levels.
4702 : !
4703 : ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) )
4704 :
4705 : ! References:
4706 : !-----------------------------------------------------------------------
4707 :
4708 : use grid_class, only: &
4709 : grid ! Type
4710 :
4711 : use constants_clubb, only: &
4712 : three, & ! Variable(s)
4713 : one, &
4714 : zero
4715 :
4716 : use clubb_precision, only: &
4717 : core_rknd ! Variable(s)
4718 :
4719 : implicit none
4720 :
4721 : ! ------------------------ Input Variables ------------------------
4722 : integer, intent(in) :: &
4723 : nz, &
4724 : ngrdcol
4725 :
4726 : type (grid), target, intent(in) :: gr
4727 :
4728 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
4729 : C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-]
4730 : wm_zm ! w wind component at momentum levels [m/s]
4731 :
4732 : ! ------------------------ Output Variable ------------------------
4733 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
4734 : lhs_ac_pr2_wp3 ! LHS coefficient of wp3 from terms ac and pr2 [1/s]
4735 :
4736 : ! ------------------------ Local variable ------------------------
4737 : integer :: k, i
4738 :
4739 : ! ------------------------ Begin Code ------------------------
4740 :
4741 : !$acc data copyin( gr, gr%invrs_dzt, C11_Skw_fnc, gr%invrs_dzt, wm_zm) &
4742 : !$acc copyout( lhs_ac_pr2_wp3 )
4743 :
4744 : ! Set lower boundary to 0
4745 : !$acc parallel loop gang vector default(present)
4746 149194656 : do i = 1, ngrdcol
4747 : ! Set lower boundary to 0
4748 140259600 : lhs_ac_pr2_wp3(i,1) = zero
4749 140259600 : lhs_ac_pr2_wp3(i,2) = zero
4750 : ! Set upper boundary to 0
4751 149194656 : lhs_ac_pr2_wp3(i,nz) = zero
4752 : end do
4753 : !$acc end parallel loop
4754 :
4755 : ! Calculate term at all interior grid levels.
4756 : !$acc parallel loop gang vector collapse(2) default(present)
4757 741609648 : do k = 3, nz-1
4758 12242896848 : do i = 1, ngrdcol
4759 :
4760 : ! Thermodynamic main diagonal: [ x wp3(k,<t+1>) ]
4761 23002574400 : lhs_ac_pr2_wp3(i,k) = + ( one - C11_Skw_fnc(i,k) ) &
4762 35236536192 : * three * gr%invrs_dzt(i,k) * ( wm_zm(i,k) - wm_zm(i,k-1) )
4763 :
4764 : end do
4765 : end do
4766 : !$acc end parallel loop
4767 :
4768 : !$acc end data
4769 :
4770 8935056 : return
4771 :
4772 : end subroutine wp3_terms_ac_pr2_lhs
4773 :
4774 : !=============================================================================
4775 8935056 : subroutine wp3_term_pr1_lhs( nz, ngrdcol, &
4776 8935056 : C8, C8b, &
4777 8935056 : invrs_tau_wp3_zt, Skw_zt, &
4778 : l_damp_wp3_Skw_squared, &
4779 8935056 : lhs_pr1_wp3 )
4780 :
4781 : ! Description:
4782 : ! Pressure term 1 for w'^3: implicit portion of the code.
4783 : !
4784 : ! Pressure term 1 is the term:
4785 : !
4786 : ! - (C_8/tau_w3t) * ( C_8b * Sk_wt^2 + 1 ) * w'^3;
4787 : !
4788 : ! where Sk_wt = w'^3 / (w'^2)^(3/2).
4789 : !
4790 : ! This term needs to be linearized, so function L(w'^3) is defined to be
4791 : ! equal to this term (pressure term 1), such that:
4792 : !
4793 : ! L(w'^3) = - (C_8/tau_w3t) * ( C_8b * (w'^3)^3 / (w'^2)^3 + w'^3 ).
4794 : !
4795 : ! A Taylor Series expansion (truncated after the first derivative term) of
4796 : ! L(w'^3) around w'^3 = w'^3(t) is used to linearize pressure term 1.
4797 : ! Evaluating L(w'^3) at w'^3(t+1):
4798 : !
4799 : ! L( w'^3(t+1) ) = L( w'^3(t) )
4800 : ! + ( d L(w'^3) / d w'^3 )|_(w'^3=w'^3(t))
4801 : ! * ( w'^3(t+1) - w'^3(t) ).
4802 : !
4803 : ! After evaluating the expression above, the term has become linearized. It
4804 : ! is broken down into implicit (LHS) and explicit (RHS) components.
4805 : ! The implicit portion is:
4806 : !
4807 : ! - (C_8/tau_w3t) * ( 3 * C_8b * Sk_wt^2 + 1 ) * w'^3(t+1).
4808 : !
4809 : ! Note: When the term is brought over to the left-hand side, the sign
4810 : ! is reversed and the leading "-" in front of the term is changed
4811 : ! to a "+".
4812 : !
4813 : ! Timestep index (t) stands for the index of the current timestep, while
4814 : ! timestep index (t+1) stands for the index of the next timestep, which is
4815 : ! being advanced to in solving the d(w'^3)/dt equation.
4816 : !
4817 : ! The values of w'^3 are found on the thermodynamic levels, as are the
4818 : ! values of tau_w3t and Sk_wt (in Sk_wt, w'^3 is found on thermodynamic
4819 : ! levels and w'^2 is interpolated to thermodynamic levels).
4820 :
4821 : ! References:
4822 : !-----------------------------------------------------------------------
4823 :
4824 : use grid_class, only: &
4825 : grid ! Type
4826 :
4827 : use constants_clubb, only: &
4828 : one, & ! Variable(s)
4829 : three, &
4830 : five, &
4831 : zero
4832 :
4833 : use clubb_precision, only: &
4834 : core_rknd ! Variable(s)
4835 :
4836 : implicit none
4837 :
4838 : ! ---------------------- Input Variables ----------------------
4839 : integer, intent(in) :: &
4840 : nz, &
4841 : ngrdcol
4842 :
4843 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
4844 : invrs_tau_wp3_zt, & ! Inverse time-scale tau at thermodynamic levels [1/s]
4845 : Skw_zt ! Skewness of w at thermodynamic levels [-]
4846 :
4847 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
4848 : C8, & ! Model parameter C_8 [-]
4849 : C8b ! Model parameter C_8b [-]
4850 :
4851 : logical, intent(in) :: &
4852 : l_damp_wp3_Skw_squared ! Set damping on wp3 to use Skw^2 rather than Skw^4
4853 :
4854 : ! ---------------------- Output Variable ----------------------
4855 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
4856 : lhs_pr1_wp3 ! LHS coefficient of wp3 from pressure term 1 [1/s]
4857 :
4858 : ! ---------------------- Local variables ----------------------
4859 : integer :: k, i
4860 :
4861 : ! ---------------------- Begin Code ----------------------
4862 :
4863 : !$acc data copyin( invrs_tau_wp3_zt, Skw_zt, C8, C8b ) &
4864 : !$acc copyout( lhs_pr1_wp3 )
4865 :
4866 : ! Set lower boundary to 0
4867 : !$acc parallel loop gang vector default(present)
4868 149194656 : do i = 1, ngrdcol
4869 : ! Set lower boundary to 0
4870 140259600 : lhs_pr1_wp3(i,1) = zero
4871 140259600 : lhs_pr1_wp3(i,2) = zero
4872 : ! Set upper boundary to 0
4873 149194656 : lhs_pr1_wp3(i,nz) = zero
4874 : end do
4875 : !$acc end parallel loop
4876 :
4877 : ! Calculate term at all interior grid levels.
4878 8935056 : if ( l_damp_wp3_Skw_squared ) then
4879 : !$acc parallel loop gang vector collapse(2) default(present)
4880 0 : do k = 3, nz-1
4881 0 : do i = 1, ngrdcol
4882 : ! Thermodynamic main diagonal: [ x wp3(k,<t+1>) ]
4883 0 : lhs_pr1_wp3(i,k) = + ( C8(i) * invrs_tau_wp3_zt(i,k) ) &
4884 0 : * ( three * C8b(i) * Skw_zt(i,k)**2 + one )
4885 : end do
4886 : end do
4887 : !$acc end parallel loop
4888 :
4889 : else
4890 : !$acc parallel loop gang vector collapse(2) default(present)
4891 741609648 : do k = 3, nz-1
4892 12242896848 : do i = 1, ngrdcol
4893 : ! Thermodynamic main diagonal: [ x wp3(k,<t+1>) ]
4894 23002574400 : lhs_pr1_wp3(i,k) = + ( C8(i) * invrs_tau_wp3_zt(i,k) ) &
4895 35236536192 : * ( five * C8b(i) * Skw_zt(i,k)**4 + one )
4896 : end do
4897 : end do
4898 : !$acc end parallel loop
4899 :
4900 : end if ! l_damp_wp3_Skw_squared
4901 :
4902 : !$acc end data
4903 :
4904 8935056 : return
4905 :
4906 : end subroutine wp3_term_pr1_lhs
4907 :
4908 : !=============================================================================
4909 : subroutine wp3_term_ta_explicit_rhs( nz, ngrdcol, gr, &
4910 : wp4, rho_ds_zm, invrs_rho_ds_zt, &
4911 : rhs_ta_wp3 )
4912 :
4913 : ! Description:
4914 : ! Turbulent advection of <w'^3>: explicit portion of the code.
4915 : !
4916 : ! This explicit discretization works generally for any PDF.
4917 : !
4918 : ! The d<w'^3>/dt equation contains a turbulent advection term:
4919 : !
4920 : ! - (1/rho_ds) * d( rho_ds * <w'^4> )/dz.
4921 : !
4922 : ! The value of <w'^4> is found by integrating over the PDF of w, as detailed
4923 : ! intent(in) function calc_wp4_pdf, which is found in module pdf_closure_module in
4924 : ! pdf_closure_module.F90.
4925 : !
4926 : ! The explicit discretization of this term is as follows:
4927 : !
4928 : ! The values of <w'^3> are found on the thermodynamic levels, while the
4929 : ! values of <w'^4> are found on the momentum levels. The values of
4930 : ! <w'^4>|_zt are originally calculated by the PDF on the thermodynamic
4931 : ! levels. They are interpolated to the intermediate momentum levels as
4932 : ! <w'^4>. Additionally, the values of rho_ds_zm are found on the momentum
4933 : ! levels, and the values of invrs_rho_ds_zt are found on the thermodynamic
4934 : ! levels. At the intermediate momentum levels, the values of <w'^4> are
4935 : ! multiplied by rho_ds_zm. Then, the derivative (d/dz) of that expression
4936 : ! is taken over the central thermodynamic level, where it is multiplied by
4937 : ! -invrs_rho_ds_zt. This yields the desired result.
4938 : !
4939 : ! ---------wp4_zt---------------------------------------------------- t(k+1)
4940 : !
4941 : ! =========wp4(interp)===========rho_ds_zm=========================== m(k)
4942 : !
4943 : ! ---------wp4_zt-----d( rho_ds_zm * wp4 )/dz-----invrs_rho_ds_zt---- t(k)
4944 : !
4945 : ! =========wp4(interp)===========rho_ds_zm=========================== m(k-1)
4946 : !
4947 : ! ---------wp4_zt---------------------------------------------------- t(k-1)
4948 : !
4949 : ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond
4950 : ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively.
4951 : ! The letter "t" is used for thermodynamic levels and the letter "m" is
4952 : ! used for momentum levels.
4953 : !
4954 : ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) )
4955 :
4956 : ! References:
4957 : !-----------------------------------------------------------------------
4958 :
4959 : use grid_class, only: &
4960 : grid ! Type
4961 :
4962 : use constants_clubb, only: &
4963 : zero ! Constant(s)
4964 :
4965 : use clubb_precision, only: &
4966 : core_rknd ! Variable(s)
4967 :
4968 : implicit none
4969 :
4970 : ! ---------------------- Input Variables ----------------------
4971 : integer, intent(in) :: &
4972 : nz, &
4973 : ngrdcol
4974 :
4975 : type (grid), target, intent(in) :: gr
4976 :
4977 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
4978 : wp4, & ! <w'^4> [m^4/s^4]
4979 : rho_ds_zm, & ! Dry, static density at momentum level [kg/m^3]
4980 : invrs_rho_ds_zt ! Inv dry, static density at thermo level [m^3/kg]
4981 :
4982 : ! ---------------------- Output Variable ----------------------
4983 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
4984 : rhs_ta_wp3 ! Rate of change of wp3 from turbulent advection [m^3/s^4]
4985 :
4986 : ! ---------------------- Output variables ----------------------
4987 : integer :: k, i
4988 :
4989 : ! ---------------------- Begin Code ----------------------
4990 :
4991 : !$acc data copyin( wp4, rho_ds_zm, invrs_rho_ds_zt, gr, gr%invrs_dzt ) &
4992 : !$acc copyout( rhs_ta_wp3 )
4993 :
4994 : ! Set lower boundary to 0
4995 : !$acc parallel loop gang vector default(present)
4996 : do i = 1, ngrdcol
4997 : ! Set lower boundary to 0
4998 : rhs_ta_wp3(i,1) = zero
4999 : rhs_ta_wp3(i,2) = zero
5000 : ! Set upper boundary to 0
5001 : rhs_ta_wp3(i,nz) = zero
5002 : end do
5003 : !$acc end parallel loop
5004 :
5005 : ! Calculate term at all interior grid levels.
5006 : !$acc parallel loop gang vector collapse(2) default(present)
5007 : do k = 3, nz
5008 : do i = 1, ngrdcol
5009 : rhs_ta_wp3(i,k) = - invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
5010 : * ( rho_ds_zm(i,k) * wp4(i,k) - rho_ds_zm(i,k-1) * wp4(i,k-1) )
5011 : end do
5012 : end do
5013 : !$acc end parallel loop
5014 :
5015 : !$acc end data
5016 :
5017 : return
5018 :
5019 : end subroutine wp3_term_ta_explicit_rhs
5020 :
5021 : !=============================================================================
5022 8935056 : subroutine wp3_terms_bp1_pr2_rhs( nz, ngrdcol, C11_Skw_fnc, &
5023 8935056 : thv_ds_zt, wp2thvp, &
5024 8935056 : rhs_bp1_pr2_wp3 )
5025 :
5026 : ! Description:
5027 : ! Buoyancy production of w'^3 and w'^3 pressure term 2: explicit portion of
5028 : ! the code.
5029 : !
5030 : ! The d(w'^3)/dt equation contains a buoyancy production term:
5031 : !
5032 : ! + 3 (g/thv_ds) w'^2th_v';
5033 : !
5034 : ! and pressure term 2:
5035 : !
5036 : ! - C_11 ( -3 w'^3 dw/dz + 3 (g/thv_ds) w'^2th_v' ).
5037 : !
5038 : ! The w'^3 buoyancy production term is completely explicit, while w'^3
5039 : ! pressure term 2 has both implicit and explicit components. The buoyancy
5040 : ! production term and the explicit portion of pressure term 2 are combined
5041 : ! and solved together as:
5042 : !
5043 : ! + ( 1 - C_ll ) ( 3 (g/thv_ds) w'^2th_v' ).
5044 :
5045 : ! References:
5046 : !-----------------------------------------------------------------------
5047 :
5048 : use grid_class, only: &
5049 : grid ! Type
5050 :
5051 : use constants_clubb, only: & ! Constant(s)
5052 : grav, & ! Gravitational acceleration [m/s^2]
5053 : three, &
5054 : one, &
5055 : zero
5056 :
5057 : use clubb_precision, only: &
5058 : core_rknd ! Variable(s)
5059 :
5060 : implicit none
5061 :
5062 : ! -------------------- Input Variables --------------------
5063 : integer, intent(in) :: &
5064 : nz, &
5065 : ngrdcol
5066 :
5067 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
5068 : C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-]
5069 : thv_ds_zt, & ! Dry, base-state theta_v at thermo. levs [K]
5070 : wp2thvp ! w'^2 th_v' [K m^2/s^2]
5071 :
5072 : ! -------------------- Output Variable --------------------
5073 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
5074 : rhs_bp1_pr2_wp3 ! RHS portion of wp3 from terms bp1 and pr2 [m^3/s^4]
5075 :
5076 : ! -------------------- Local Variables --------------------
5077 : integer :: k, i
5078 :
5079 : ! -------------------- Begin Code --------------------
5080 :
5081 : !$acc data copyin( C11_Skw_fnc, thv_ds_zt, wp2thvp ) &
5082 : !$acc copyout( rhs_bp1_pr2_wp3 )
5083 :
5084 : ! Set lower boundary to 0
5085 : !$acc parallel loop gang vector default(present)
5086 149194656 : do i = 1, ngrdcol
5087 : ! Set lower boundary to 0
5088 140259600 : rhs_bp1_pr2_wp3(i,1) = zero
5089 140259600 : rhs_bp1_pr2_wp3(i,2) = zero
5090 : ! Set upper boundary to 0
5091 149194656 : rhs_bp1_pr2_wp3(i,nz) = zero
5092 : end do
5093 : !$acc end parallel loop
5094 :
5095 : ! Calculate term at all interior grid levels.
5096 : !$acc parallel loop gang vector collapse(2) default(present)
5097 741609648 : do k = 3, nz-1
5098 12242896848 : do i = 1, ngrdcol
5099 23002574400 : rhs_bp1_pr2_wp3(i,k) = + ( one - C11_Skw_fnc(i,k) ) &
5100 35236536192 : * three * ( grav / thv_ds_zt(i,k) ) * wp2thvp(i,k)
5101 : end do
5102 : end do
5103 : !$acc end parallel loop
5104 :
5105 : !$acc end data
5106 :
5107 8935056 : return
5108 :
5109 : end subroutine wp3_terms_bp1_pr2_rhs
5110 :
5111 : !=============================================================================
5112 8935056 : subroutine wp3_term_pr_turb_rhs( nz, ngrdcol, gr, C_wp3_pr_turb, Kh_zt, wpthvp, &
5113 8935056 : dum_dz, dvm_dz, &
5114 8935056 : upwp, vpwp, &
5115 8935056 : thv_ds_zt, &
5116 8935056 : rho_ds_zm, invrs_rho_ds_zt, &
5117 8935056 : em, wp2, &
5118 8935056 : rhs_pr_turb_wp3, &
5119 : l_use_tke_in_wp3_pr_turb_term )
5120 : ! Description:
5121 : ! Experimental term from CLUBB TRAC ticket #411. The derivative here is of
5122 : ! the form:
5123 : ! - C_15 * Kh * ∂{ grav / thv_ds * [w'th_v'(k) - w'th_v'(k-1)]
5124 : ! -[ u'w'(k) * ∂u(k)/∂z - u'w'(k-1) * ∂u(k-1)/∂z ]
5125 : ! -[ v'w'(k) * ∂v(k)/∂z - v'w'(k-1) * ∂v(k-1)/∂z ] }/∂z.
5126 : !
5127 : ! This does not appear in Andre et al. 1976 or Bougeault et al. 1981, but
5128 : ! is based on experiments in matching LES data.
5129 : !
5130 : ! References:
5131 : ! None
5132 : !-----------------------------------------------------------------------
5133 :
5134 : use grid_class, only: &
5135 : grid, &
5136 : zm2zt ! Variable type(s)
5137 :
5138 : use constants_clubb, only: & ! Constant(s)
5139 : grav, & ! Gravitational acceleration [m/s^2]
5140 : zero
5141 :
5142 : use clubb_precision, only: &
5143 : core_rknd ! Variable(s)
5144 :
5145 : implicit none
5146 :
5147 : ! --------------------- Input Variables ---------------------
5148 : integer, intent(in) :: &
5149 : nz, &
5150 : ngrdcol
5151 :
5152 : type (grid), target, intent(in) :: &
5153 : gr
5154 :
5155 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
5156 : C_wp3_pr_turb ! Model parameter C_wp3_pr_turb [-]
5157 :
5158 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
5159 : Kh_zt, & ! Eddy-diffusivity on moment. levels [m^2/s]
5160 : wpthvp, & ! w'th_v' [K m/s]
5161 : dum_dz, & ! derivative of u wind with respect to z [m/s]
5162 : dvm_dz, & ! derivative of v wind with respect to z [m/s]
5163 : upwp, & ! u'v' [m^2/s^2]
5164 : vpwp, & ! v'w' [m^2/s^2]
5165 : thv_ds_zt, & ! Dry, base-state theta_v at thermo. levs [K]
5166 : rho_ds_zm, & ! Dry static density on mom. levels [kg/m^3]
5167 : invrs_rho_ds_zt, & ! Inverse dry static density on thermo. levs [kg/m^3]
5168 : wp2, & ! w'^2 [m^2/s^2]
5169 : em ! Turbulence kinetic energy [m^2/s^2]
5170 :
5171 : logical, intent(in) :: &
5172 : l_use_tke_in_wp3_pr_turb_term ! Use TKE formulation for wp3 pr_turb term
5173 :
5174 : ! Return Variable
5175 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
5176 : rhs_pr_turb_wp3 ! RHS portion of wp3 from pressure-turbulence correlation [m^3/s^4]
5177 :
5178 : ! --------------------- Local Variables ---------------------
5179 : integer :: i, k
5180 :
5181 : ! --------------------- Begin Code ---------------------
5182 :
5183 : !$acc data copyin( Kh_zt, wpthvp, dum_dz, dvm_dz, upwp, vpwp, &
5184 : !$acc thv_ds_zt, rho_ds_zm, invrs_rho_ds_zt, invrs_rho_ds_zt, &
5185 : !$acc wp2, em, gr, gr%invrs_dzt ) &
5186 : !$acc copyout( rhs_pr_turb_wp3 )
5187 :
5188 : ! Set lower boundary to 0
5189 : !$acc parallel loop gang vector default(present)
5190 149194656 : do i = 1, ngrdcol
5191 : ! Set lower boundary to 0
5192 140259600 : rhs_pr_turb_wp3(i,1) = zero
5193 140259600 : rhs_pr_turb_wp3(i,2) = zero
5194 : ! Set upper boundary to 0
5195 149194656 : rhs_pr_turb_wp3(i,nz) = zero
5196 : end do
5197 : !$acc end parallel loop
5198 :
5199 8935056 : if ( .not. l_use_tke_in_wp3_pr_turb_term ) then
5200 :
5201 : !$acc parallel loop gang vector collapse(2) default(present)
5202 741609648 : do k = 3, nz-1
5203 12242896848 : do i = 1, ngrdcol
5204 23002574400 : rhs_pr_turb_wp3(i,k) &
5205 0 : = - C_wp3_pr_turb(i) * Kh_zt(i,k) * gr%invrs_dzt(i,k) &
5206 11501287200 : * ( grav / thv_ds_zt(i,k) * ( wpthvp(i,k) - wpthvp(i,k-1) ) &
5207 : - ( upwp(i,k) * dum_dz(i,k) - upwp(i,k-1) * dum_dz(i,k-1) ) &
5208 46737823392 : - ( vpwp(i,k) * dvm_dz(i,k) - vpwp(i,k-1) * dvm_dz(i,k-1) ) )
5209 : end do
5210 : end do
5211 : !$acc end parallel loop
5212 :
5213 : else
5214 :
5215 : !$acc parallel loop gang vector collapse(2) default(present)
5216 0 : do k = 3, nz-1
5217 0 : do i = 1, ngrdcol
5218 0 : rhs_pr_turb_wp3(i,k) &
5219 0 : = - C_wp3_pr_turb(i) * invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
5220 0 : * ( rho_ds_zm(i,k) * wp2(i,k) * em(i,k) - rho_ds_zm(i,k-1) * wp2(i,k-1) * em(i,k-1) )
5221 : end do
5222 : end do
5223 : !$acc end parallel loop
5224 :
5225 : endif
5226 :
5227 : !$acc end data
5228 :
5229 8935056 : return
5230 :
5231 : end subroutine wp3_term_pr_turb_rhs
5232 :
5233 : !=============================================================================
5234 8935056 : subroutine wp3_term_pr_dfsn_rhs( nz, ngrdcol, gr, C_wp3_pr_dfsn, &
5235 8935056 : rho_ds_zm, invrs_rho_ds_zt, &
5236 8935056 : wp2up2, wp2vp2, wp4, &
5237 8935056 : up2, vp2, wp2, &
5238 8935056 : rhs_pr_dfsn_wp3 )
5239 :
5240 : ! Description:
5241 : !
5242 : ! This term is intended to represent the "diffusion" part of the total wp3
5243 : ! pressure correlation. The total wp3 pressure term, -3w'^2/rho*dp'/dz, can be
5244 : ! split into
5245 : !
5246 : ! -3w'^2/rho*dp'/dz = + 3p'/rho*d(w'^2)/dz - 3/rho*d(w'^2p')/dz
5247 : !
5248 : ! using the product rule. The second term on the RHS we consider to be the
5249 : ! diffusion part, calculated by this subroutine. We replace the factor of 3
5250 : ! with a tunable parameter, C_wp3_pr_dfsn, and we replace p' with
5251 : !
5252 : ! p' ~ - rho * ( u_i*u_i - <u_i*u_i> ),
5253 : !
5254 : ! following Lumley 1978. The wp3 pressure diffusion term then becomes
5255 : !
5256 : ! + C_wp3_pr_dfsn / rho * ( d( rho*( <w'^2u_i'u_i'> - <w'^2>*<u_i'u_i'> ) )/dz )
5257 : !
5258 : ! References:
5259 : ! Lumley 1978, p. 170. See eq. 6.47 and accompanying discussion.
5260 : !-----------------------------------------------------------------------
5261 :
5262 : use grid_class, only: &
5263 : grid ! Type
5264 :
5265 : use constants_clubb, only: &
5266 : zero
5267 :
5268 : use clubb_precision, only: &
5269 : core_rknd ! Variable(s)
5270 :
5271 : implicit none
5272 :
5273 : ! ---------------------- Input Variables ----------------------
5274 : integer, intent(in) :: &
5275 : nz, &
5276 : ngrdcol
5277 :
5278 : type (grid), target, intent(in) :: gr
5279 :
5280 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
5281 : C_wp3_pr_dfsn ! Model parameter C_wp3_pr_dfsn [-]
5282 :
5283 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
5284 : invrs_rho_ds_zt, & ! Inverse dry static density (thermo levels) [kg/m^3]
5285 : rho_ds_zm, & ! Dry static density on mom. levels [kg/m^3]
5286 : wp2up2, & ! w'^2u'^2 on momentum levels [m^4/s^4]
5287 : wp2vp2, & ! w'^2v'^2 on momentum levels [m^4/s^4]
5288 : wp4, & ! w'^4 on momentum levels [m^4/s^4]
5289 : up2, & ! u'^2 on momentum levels [m^2/s^2]
5290 : vp2, & ! v'^2 on momentum levels [m^2/s^2]
5291 : wp2 ! w'^2 on momentum levels [m^2/s^2]
5292 :
5293 : ! ---------------------- Output Variable ----------------------
5294 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
5295 : rhs_pr_dfsn_wp3 ! RHS portion of wp3 from pressure-diffusion correlation [m^3/s^4]
5296 :
5297 : ! ---------------------- Local Variables ----------------------
5298 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
5299 17870112 : wp2uip2, & ! 4th-order moment sum <w'^2u_i'u_i'> [m^4/s^4]
5300 17870112 : wp2_uip2 ! 2nd-order moment sum <w'^2>*<u_i'u_i'> [m^4/s^4]
5301 :
5302 : integer :: k, i
5303 :
5304 : ! ---------------------- Begin Code ----------------------
5305 :
5306 : !$acc data copyin( invrs_rho_ds_zt, rho_ds_zm, wp2up2, wp2vp2, &
5307 : !$acc wp4, up2, vp2, wp2, &
5308 : !$acc gr, gr%invrs_dzt ) &
5309 : !$acc copyout( rhs_pr_dfsn_wp3 ) &
5310 : !$acc create( wp2uip2, wp2_uip2 )
5311 :
5312 : !$acc parallel loop gang vector collapse(2) default(present)
5313 768414816 : do k = 1, nz
5314 12690480816 : do i = 1, ngrdcol
5315 11922066000 : wp2uip2(i,k) = wp2up2(i,k) + wp2vp2(i,k) + wp4(i,k)
5316 12681545760 : wp2_uip2(i,k) = wp2(i,k)*up2(i,k) + wp2(i,k)*vp2(i,k) + wp2(i,k)*wp2(i,k)
5317 : end do
5318 : end do
5319 : !$acc end parallel loop
5320 :
5321 : !$acc parallel loop gang vector default(present)
5322 149194656 : do i = 1, ngrdcol
5323 : ! Set lower boundary condition
5324 140259600 : rhs_pr_dfsn_wp3(i,1) = zero
5325 140259600 : rhs_pr_dfsn_wp3(i,2) = zero
5326 : ! Set upper boundary to 0
5327 149194656 : rhs_pr_dfsn_wp3(i,nz) = zero
5328 : end do
5329 : !$acc end parallel loop
5330 :
5331 : !$acc parallel loop gang vector collapse(2) default(present)
5332 741609648 : do k = 3, nz-1
5333 12242896848 : do i = 1, ngrdcol
5334 23002574400 : rhs_pr_dfsn_wp3(i,k) &
5335 0 : = + C_wp3_pr_dfsn(i) * invrs_rho_ds_zt(i,k) * gr%invrs_dzt(i,k) &
5336 : * ( rho_ds_zm(i,k) * ( wp2uip2(i,k) - wp2_uip2(i,k) ) &
5337 35236536192 : - rho_ds_zm(i,k-1) * ( wp2uip2(i,k-1) - wp2_uip2(i,k-1) ) )
5338 : end do
5339 : end do
5340 : !$acc end parallel loop
5341 :
5342 : !$acc end data
5343 :
5344 8935056 : return
5345 :
5346 : end subroutine wp3_term_pr_dfsn_rhs
5347 :
5348 : !=============================================================================
5349 8935056 : subroutine wp3_term_pr1_rhs( nz, ngrdcol, gr, &
5350 8935056 : C8, C8b, &
5351 8935056 : invrs_tau_wp3_zt, Skw_zt, wp3, &
5352 : l_damp_wp3_Skw_squared, &
5353 8935056 : rhs_pr1_wp3 )
5354 :
5355 : ! Description:
5356 : ! Pressure term 1 for w'^3: explicit portion of the code.
5357 : !
5358 : ! Pressure term 1 is the term:
5359 : !
5360 : ! - (C_8/tau_w3t) * ( C_8b * Sk_wt^2 + 1 ) * w'^3;
5361 : !
5362 : ! where Sk_wt = w'^3 / (w'^2)^(3/2).
5363 : !
5364 : ! This term needs to be linearized, so function L(w'^3) is defined to be
5365 : ! equal to this term (pressure term 1), such that:
5366 : !
5367 : ! L(w'^3) = - (C_8/tau_w3t) * ( C_8b * (w'^3)^3 / (w'^2)^3 + w'^3 ).
5368 : !
5369 : ! A Taylor Series expansion (truncated after the first derivative term) of
5370 : ! L(w'^3) around w'^3 = w'^3(t) is used to linearize pressure term 1.
5371 : ! Evaluating L(w'^3) at w'^3(t+1):
5372 : !
5373 : ! L( w'^3(t+1) ) = L( w'^3(t) )
5374 : ! + ( d L(w'^3) / d w'^3 )|_(w'^3=w'^3(t))
5375 : ! * ( w'^3(t+1) - w'^3(t) ).
5376 : !
5377 : ! After evaluating the expression above, the term has become linearized. It
5378 : ! is broken down into implicit (LHS) and explicit (RHS) components.
5379 : ! The explicit portion is:
5380 : !
5381 : ! + (C_8/tau_w3t) * ( 2 * C_8b * Sk_wt^2 + 1 ) * w'^3(t).
5382 : !
5383 : ! Timestep index (t) stands for the index of the current timestep, while
5384 : ! timestep index (t+1) stands for the index of the next timestep, which is
5385 : ! being advanced to in solving the d(w'^3)/dt equation.
5386 : !
5387 : ! The values of w'^3 are found on the thermodynamic levels, as are the
5388 : ! values of tau_w3t and Sk_wt (in Sk_wt, w'^3 is found on thermodynamic
5389 : ! levels and w'^2 is interpolated to thermodynamic levels).
5390 :
5391 : ! References:
5392 : !-----------------------------------------------------------------------
5393 :
5394 : use grid_class, only: &
5395 : grid ! Type
5396 :
5397 : use constants_clubb, only: &
5398 : two, & ! Constant(s)
5399 : four, &
5400 : zero
5401 :
5402 : use clubb_precision, only: &
5403 : core_rknd ! Variable(s)
5404 :
5405 : implicit none
5406 :
5407 : ! --------------------- Input Variables ---------------------
5408 : integer, intent(in) :: &
5409 : nz, &
5410 : ngrdcol
5411 :
5412 : type (grid), target, intent(in) :: gr
5413 :
5414 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
5415 : C8, & ! Model parameter C_8 [-]
5416 : C8b ! Model parameter C_8b [-]
5417 :
5418 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
5419 : invrs_tau_wp3_zt, & ! Inverse time-scale tau at thermodynamic levels [1/s]
5420 : Skw_zt, & ! Skewness of w at thermodynamic levels [-]
5421 : wp3 ! w'^3 [m^3/s^3]
5422 :
5423 : logical, intent(in) :: &
5424 : l_damp_wp3_Skw_squared ! Set damping on wp3 to use Skw^2 rather than Skw^4
5425 :
5426 : ! --------------------- Output Variable ---------------------
5427 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
5428 : rhs_pr1_wp3 ! RHS portion of wp3 from pressure term 1 [m^3/s^4]
5429 :
5430 : ! --------------------- Local Variables ---------------------
5431 : integer :: k, i
5432 :
5433 : ! --------------------- Begin Code ---------------------
5434 :
5435 : !$acc data copyin( invrs_tau_wp3_zt, Skw_zt, wp3 ) &
5436 : !$acc copyout( rhs_pr1_wp3 )
5437 :
5438 : ! Set lower boundary to 0
5439 : !$acc parallel loop gang vector default(present)
5440 149194656 : do i = 1, ngrdcol
5441 : ! Set lower boundary to 0
5442 140259600 : rhs_pr1_wp3(i,1) = zero
5443 140259600 : rhs_pr1_wp3(i,2) = zero
5444 : ! Set upper boundary to 0
5445 149194656 : rhs_pr1_wp3(i,nz) = zero
5446 : end do
5447 : !$acc end parallel loop
5448 :
5449 : ! Calculate term at all interior grid levels.
5450 8935056 : if ( l_damp_wp3_Skw_squared ) then
5451 : !$acc parallel loop gang vector collapse(2) default(present)
5452 0 : do k = 3, nz-1
5453 0 : do i = 1, ngrdcol
5454 0 : rhs_pr1_wp3(i,k) = + ( C8(i) * invrs_tau_wp3_zt(i,k) ) &
5455 0 : * ( two * C8b(i) * Skw_zt(i,k)**2 ) * wp3(i,k)
5456 : end do
5457 : end do
5458 : !$acc end parallel loop
5459 : else
5460 : !$acc parallel loop gang vector collapse(2) default(present)
5461 741609648 : do k = 3, nz-1
5462 12242896848 : do i = 1, ngrdcol
5463 23002574400 : rhs_pr1_wp3(i,k) = + ( C8(i) * invrs_tau_wp3_zt(i,k) ) &
5464 35236536192 : * ( four * C8b(i) * Skw_zt(i,k)**4 ) * wp3(i,k)
5465 : end do
5466 : end do
5467 : !$acc end parallel loop
5468 : endif ! l_damp_wp3_Skw_squared
5469 :
5470 : !$acc end data
5471 :
5472 8935056 : return
5473 :
5474 : end subroutine wp3_term_pr1_rhs
5475 :
5476 : !===============================================================================
5477 :
5478 : end module advance_wp2_wp3_module
|