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