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