LCOV - code coverage report
Current view: | top level - physics/clubb/src/CLUBB_core - advance_wp2_wp3_module.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 604 | 1005 | 60.1 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 21 | 22 | 95.5 %

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

Generated by: LCOV version 1.14