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

Generated by: LCOV version 1.14