LCOV - code coverage report
Current view: top level - physics/clubb/src/CLUBB_core - advance_xp2_xpyp_module.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 569 1372 41.5 %
Date: 2025-03-13 18:42:46 Functions: 13 16 81.2 %

          Line data    Source code
       1             : !-----------------------------------------------------------------------
       2             : ! $Id$
       3             : !===============================================================================
       4             : module advance_xp2_xpyp_module
       5             : 
       6             :   ! Description:
       7             :   ! Contains the subroutine advance_xp2_xpyp and ancillary functions.
       8             :   !-----------------------------------------------------------------------
       9             : 
      10             :   implicit none
      11             : 
      12             :   public :: advance_xp2_xpyp, &
      13             :             update_xp2_mc
      14             : 
      15             :   private :: xp2_xpyp_lhs, & 
      16             :              xp2_xpyp_solve, & 
      17             :              xp2_xpyp_uv_rhs, & 
      18             :              xp2_xpyp_rhs, & 
      19             :              xp2_xpyp_implicit_stats, & 
      20             :              term_tp_rhs, & 
      21             :              term_dp1_lhs, & 
      22             :              term_dp1_rhs, & 
      23             :              term_pr1, & 
      24             :              term_pr2
      25             : 
      26             :   private    ! Set default scope
      27             : 
      28             :   ! Private named constants to avoid string comparisons
      29             :   integer, parameter, private :: &
      30             :     xp2_xpyp_rtp2 = 1, &        ! Named constant for rtp2 solves
      31             :     xp2_xpyp_thlp2 = 2, &       ! Named constant for thlp2 solves
      32             :     xp2_xpyp_rtpthlp = 3, &     ! Named constant for rtpthlp solves
      33             :     xp2_xpyp_up2_vp2 = 4, &     ! Named constant for up2_vp2 solves
      34             :     xp2_xpyp_vp2 = 6, &         ! Named constant for vp2 solves
      35             :     xp2_xpyp_up2 = 5, &         ! Named constant for up2 solves
      36             :     xp2_xpyp_scalars = 7, &     ! Named constant for scalar solves
      37             :     xp2_xpyp_sclrp2 = 8, &      ! Named constant for sclrp2 solves
      38             :     xp2_xpyp_sclrprtp = 9, &    ! Named constant for sclrprtp solves
      39             :     xp2_xpyp_sclrpthlp = 10, &  ! Named constant for sclrpthlp solves
      40             :     xp2_xpyp_single_lhs = 11    ! Named constant for single lhs solve
      41             : 
      42             :   integer, parameter :: &
      43             :     ndiags2 = 2,  &
      44             :     ndiags3 = 3,  &
      45             :     ndiags5 = 5
      46             : 
      47             :   contains
      48             : 
      49             :   !=============================================================================
      50      352944 :   subroutine advance_xp2_xpyp( nz, ngrdcol, gr,                           & ! In
      51      352944 :                                invrs_tau_xp2_zm, invrs_tau_C4_zm,         & ! In
      52      352944 :                                invrs_tau_C14_zm, wm_zm,                   & ! In
      53      352944 :                                rtm, wprtp, thlm, wpthlp, wpthvp, um, vm,  & ! In
      54      352944 :                                wp2, wp2_zt, wp3, upwp, vpwp,              & ! In
      55      352944 :                                sigma_sqd_w, wprtp2, wpthlp2,              & ! In
      56      352944 :                                wprtpthlp, Kh_zt, rtp2_forcing,            & ! In
      57      352944 :                                thlp2_forcing, rtpthlp_forcing,            & ! In
      58      352944 :                                rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm,     & ! In
      59      352944 :                                thv_ds_zm, cloud_frac,                     & ! In
      60      352944 :                                wp3_on_wp2, wp3_on_wp2_zt,                 & ! In
      61             :                                pdf_implicit_coefs_terms,                  & ! In
      62             :                                dt,                                        & ! In
      63      352944 :                                sclrm, wpsclrp,                            & ! In
      64      352944 :                                wpsclrp2, wpsclrprtp, wpsclrpthlp,         & ! In
      65      352944 :                                lhs_splat_wp2,                             & ! In
      66             :                                clubb_params, nu_vert_res_dep,             & ! In
      67             :                                iiPDF_type,                                & ! In
      68             :                                tridiag_solve_method,                      & ! In
      69             :                                l_predict_upwp_vpwp,                       & ! In
      70             :                                l_min_xp2_from_corr_wx,                    & ! In
      71             :                                l_C2_cloud_frac,                           & ! In
      72             :                                l_upwind_xpyp_ta,                          & ! In
      73             :                                l_godunov_upwind_xpyp_ta,                  & ! In
      74             :                                l_lmm_stepping,                            & ! In
      75             :                                stats_metadata,                            & ! In
      76      352944 :                                stats_zt, stats_zm, stats_sfc,             & ! In
      77      352944 :                                rtp2, thlp2, rtpthlp, up2, vp2,            & ! Inout
      78      352944 :                                sclrp2, sclrprtp, sclrpthlp)                 ! Inout
      79             : 
      80             :     ! Description:
      81             :     ! Prognose scalar variances, scalar covariances, and horizontal turbulence components.
      82             : 
      83             :     ! References:
      84             :     ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:xpyp_eqns
      85             :     !
      86             :     ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:up2_vp2_eqns
      87             :     !  
      88             :     !   Eqn. 13, 14, 15  on p. 3545 of
      89             :     !   ``A PDF-Based Model for Boundary Layer Clouds. Part I:
      90             :     !     Method and Model Description'' Golaz, et al. (2002)
      91             :     !   JAS, Vol. 59, pp. 3540--3551.
      92             : 
      93             :     ! See also:
      94             :     !   ``Equations for CLUBB'', Section 4:
      95             :     !   /Steady-state solution for the variances/
      96             :     !-----------------------------------------------------------------------
      97             : 
      98             :     use constants_clubb, only: & 
      99             :         w_tol_sqd,  & ! Constant(s)
     100             :         rt_tol, & 
     101             :         thl_tol, &
     102             :         max_mag_correlation_flux, &
     103             :         cloud_frac_min, &
     104             :         fstderr, &
     105             :         one, &
     106             :         two_thirds, &
     107             :         one_half, &
     108             :         one_third, &
     109             :         zero,   &
     110             :         eps, &
     111             :         gamma_over_implicit_ts
     112             : 
     113             :     use model_flags, only: & 
     114             :         iiPDF_ADG1,       & ! integer constants
     115             :         iiPDF_new_hybrid, &
     116             :         l_hole_fill,      & ! logical constants
     117             :         l_explicit_turbulent_adv_xpyp
     118             : 
     119             :     use parameter_indices, only: &
     120             :         nparams,         & ! Variable(s)
     121             :         iC2rt,           &
     122             :         iC2thl,          &
     123             :         iC2rtthl,        &
     124             :         iC4,             &
     125             :         iC14,            &
     126             :         ic_K2,           &
     127             :         ic_K9,           &
     128             :         iC_uu_shr,       &
     129             :         iC_uu_buoy,      &
     130             :         ibeta,           &
     131             :         irtp2_clip_coef
     132             : 
     133             :     use parameters_tunable, only: &
     134             :         nu_vertical_res_dep    ! Type(s)
     135             : 
     136             :     use parameters_model, only: &
     137             :         sclr_dim, & ! Variable(s)
     138             :         sclr_tol
     139             : 
     140             :     use grid_class, only: & 
     141             :         grid, & ! Type
     142             :         zm2zt, & ! Procedure(s)
     143             :         zt2zm
     144             : 
     145             :     use pdf_parameter_module, only: &
     146             :         implicit_coefs_terms    ! Variable Type
     147             : 
     148             :     use clubb_precision, only:  & 
     149             :         core_rknd ! Variable(s)
     150             : 
     151             :     use clip_explicit, only: & 
     152             :         clip_covar,  & ! Procedure(s)
     153             :         clip_variance, &
     154             :         clip_sclrp2, &
     155             :         clip_sclrprtp, &
     156             :         clip_sclrpthlp
     157             : 
     158             :     use sponge_layer_damping, only: &
     159             :         up2_vp2_sponge_damp_settings, & ! Variable(s)
     160             :         up2_vp2_sponge_damp_profile,  &
     161             :         sponge_damp_xp2                 ! Procedure(s)
     162             :       
     163             :     use stats_type_utilities, only: &
     164             :         stat_begin_update, & ! Procedure(s)
     165             :         stat_end_update,   &
     166             :         stat_modify,       &
     167             :         stat_update_var
     168             : 
     169             :     use error_code, only: &
     170             :         clubb_at_least_debug_level,  & ! Procedure
     171             :         err_code,                    & ! Error Indicator
     172             :         clubb_fatal_error              ! Constants
     173             : 
     174             :     use stats_variables, only: &
     175             :         stats_metadata_type
     176             : 
     177             :     use array_index, only: &
     178             :         iisclr_rt, &
     179             :         iisclr_thl
     180             :         
     181             :     use mean_adv, only:  & 
     182             :         term_ma_zm_lhs      ! Procedure(s)
     183             : 
     184             :     use diffusion, only:  & 
     185             :         diffusion_zm_lhs    ! Procedure(s)
     186             : 
     187             :     use stats_type, only: stats ! Type
     188             : 
     189             :     implicit none
     190             : 
     191             :     !------------------------------ Input Variables ------------------------------
     192             :     integer, intent(in) :: &
     193             :       nz, &
     194             :       ngrdcol
     195             :     
     196             :     type (grid), target, intent(in) :: gr
     197             :     
     198             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) ::  & 
     199             :       invrs_tau_xp2_zm, & ! Inverse time-scale for xp2 on momentum levels [1/s]
     200             :       invrs_tau_C4_zm,  & ! Inverse time-scale for C4 terms on mom. levels [1/s]
     201             :       invrs_tau_C14_zm, & ! Inverse time-scale for C14 terms on mom. levels [1/s]
     202             :       wm_zm,            & ! w-wind component on momentum levels   [m/s]
     203             :       rtm,              & ! Total water mixing ratio (t-levs)     [kg/kg]
     204             :       wprtp,            & ! <w'r_t'> (momentum levels)            [(m/s)(kg/kg)]
     205             :       thlm,             & ! Liquid potential temp. (t-levs)       [K]
     206             :       wpthlp,           & ! <w'th_l'> (momentum levels)           [(m K)/s]
     207             :       wpthvp,           & ! <w'th_v'> (momentum levels)           [(m K)/s]
     208             :       um,               & ! u wind (thermodynamic levels)         [m/s]
     209             :       vm,               & ! v wind (thermodynamic levels)         [m/s]
     210             :       wp2,              & ! <w'^2> (momentum levels)              [m^2/s^2]
     211             :       wp2_zt,           & ! <w'^2> interpolated to thermo. levels [m^2/s^2]
     212             :       wp3,              & ! <w'^3> (thermodynamic levels)         [m^3/s^3]
     213             :       upwp,             & ! <u'w'> (momentum levels)              [m^2/s^2]
     214             :       vpwp,             & ! <v'w'> (momentum levels)              [m^2/s^2]
     215             :       sigma_sqd_w,      & ! sigma_sqd_w (momentum levels)         [-]
     216             :       wprtp2,           & ! <w'r_t'^2> (thermodynamic levels)     [m/s (kg/kg)^2]
     217             :       wpthlp2,          & ! <w'th_l'^2> (thermodynamic levels)    [m/s K^2]
     218             :       wprtpthlp,        & ! <w'r_t'th_l'> (thermodynamic levels)  [m/s (kg/kg) K]
     219             :       Kh_zt,            & ! Eddy diffusivity on thermo. levels    [m^2/s]
     220             :       rtp2_forcing,     & ! <r_t'^2> forcing (momentum levels)    [(kg/kg)^2/s]
     221             :       thlp2_forcing,    & ! <th_l'^2> forcing (momentum levels)   [K^2/s]
     222             :       rtpthlp_forcing,  & ! <r_t'th_l'> forcing (momentum levels) [(kg/kg)K/s]
     223             :       rho_ds_zm,        & ! Dry, static density on momentum levs. [kg/m^3]
     224             :       rho_ds_zt,        & ! Dry, static density on thermo. levels [kg/m^3]
     225             :       invrs_rho_ds_zm,  & ! Inv. dry, static density @ mom. levs. [m^3/kg]
     226             :       thv_ds_zm,        & ! Dry, base-state theta_v on mom. levs. [K]
     227             :       cloud_frac,       & ! Cloud fraction (thermodynamic levels) [-]
     228             :       wp3_on_wp2,       & ! Smoothed version of <w'^3>/<w'^2> zm  [m/s]
     229             :       wp3_on_wp2_zt       ! Smoothed version of <w'^3>/<w'^2> zt  [m/s]
     230             : 
     231             :     type(implicit_coefs_terms), intent(in) :: &
     232             :       pdf_implicit_coefs_terms    ! Implicit coefs / explicit terms [units vary]
     233             : 
     234             :     real( kind = core_rknd ), intent(in) :: &
     235             :       dt             ! Model timestep                                [s]
     236             : 
     237             :     ! Passive scalar input
     238             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) ::  & 
     239             :       sclrm,       & ! Mean value; pass. scalar (t-levs.) [{sclr units}]
     240             :       wpsclrp,     & ! <w'sclr'> (momentum levels)        [m/s{sclr units}]
     241             :       wpsclrp2,    & ! <w'sclr'^2> (thermodynamic levels) [m/s{sclr units}^2]
     242             :       wpsclrprtp,  & ! <w'sclr'r_t'> (thermo. levels)     [m/s{sclr units)kg/kg]
     243             :       wpsclrpthlp    ! <w'sclr'th_l'> (thermo. levels)    [m/s{sclr units}K]
     244             : 
     245             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: & 
     246             :       lhs_splat_wp2  ! LHS coefficient of wp2 splatting term  [1/s]
     247             : 
     248             :     real( kind = core_rknd ), dimension(nparams), intent(in) :: &
     249             :       clubb_params    ! Array of CLUBB's tunable parameters    [units vary]
     250             : 
     251             :     type(nu_vertical_res_dep), intent(in) :: &
     252             :       nu_vert_res_dep    ! Vertical resolution dependent nu values
     253             : 
     254             :     integer, intent(in) :: &
     255             :       iiPDF_type,         & ! Selected option for the two-component normal (double
     256             :                             ! Gaussian) PDF type to use for the w, rt, and theta-l (or
     257             :                             ! w, chi, and eta) portion of CLUBB's multivariate,
     258             :                             ! two-component PDF.
     259             :       tridiag_solve_method  ! Specifier for method to solve tridiagonal systems
     260             : 
     261             :     logical, intent(in) :: &
     262             :       l_predict_upwp_vpwp,    & ! Flag to predict <u'w'> and <v'w'> along with <u> and <v>
     263             :                                 ! alongside the advancement of <rt>, <w'rt'>, <thl>, <wpthlp>,
     264             :                                 ! <sclr>, and <w'sclr'> in subroutine advance_xm_wpxp.  Otherwise,
     265             :                                 ! <u'w'> and <v'w'> are still approximated by eddy diffusivity when
     266             :                                 ! <u> and <v> are advanced in subroutine advance_windm_edsclrm.
     267             :       l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and thlp2)
     268             :                                 ! on keeping the overall correlation of w and x within the limits
     269             :                                 ! of -max_mag_correlation_flux to max_mag_correlation_flux.
     270             :       l_C2_cloud_frac,        & ! Flag to use cloud fraction to adjust the value of the turbulent
     271             :                                 ! dissipation coefficient, C2.
     272             :       l_upwind_xpyp_ta,       & ! This flag determines whether we want to use an upwind
     273             :                                 ! differencing approximation rather than a centered differencing
     274             :                                 ! for turbulent or mean advection terms. It affects rtp2, thlp2,
     275             :                                 ! up2, vp2, sclrp2, rtpthlp, sclrprtp, & sclrpthlp.
     276             :       l_godunov_upwind_xpyp_ta,  & ! This flag determines whether we want to use a Godunov-like 
     277             :                                    ! upwind differencing approximation rather than a
     278             :                                    ! centered differencing for turbulent or mean advection terms.
     279             :                                    ! It affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, 
     280             :                                    ! & sclrpthlp.
     281             :       l_lmm_stepping               ! Apply Linear Multistep Method (LMM) Stepping
     282             : 
     283             :     type (stats_metadata_type), intent(in) :: &
     284             :       stats_metadata
     285             : 
     286             :     !------------------------------ Input/Output Variables ------------------------------
     287             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
     288             :       stats_zt, &
     289             :       stats_zm, &
     290             :       stats_sfc
     291             :       
     292             :     ! An attribute of (inout) is also needed to import the value of the variances
     293             :     ! at the surface.  Brian.  12/18/05.
     294             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  & 
     295             :       rtp2,    & ! <r_t'^2>                      [(kg/kg)^2]
     296             :       thlp2,   & ! <th_l'^2>                     [K^2]
     297             :       rtpthlp, & ! <r_t'th_l'>                   [(kg K)/kg]
     298             :       up2,     & ! <u'^2>                        [m^2/s^2]
     299             :       vp2        ! <v'^2>                        [m^2/s^2]
     300             : 
     301             :     ! Passive scalar output
     302             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) ::  & 
     303             :       sclrp2, sclrprtp, sclrpthlp
     304             : 
     305             :     !------------------------------ Local Variables ------------------------------
     306             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  &
     307      705888 :       rtp2_old,    & ! Saved value of <r_t'^2>         [(kg/kg)^2]
     308      705888 :       thlp2_old,   & ! Saved value of <th_l'^2>        [K^2]
     309      705888 :       rtpthlp_old, & ! Saved value of <r_t'th_l'>      [(kg K)/kg]
     310      705888 :       up2_old,     & ! Saved value of <u'^2>           [m^2/s^2]
     311      705888 :       vp2_old        ! Saved value of <v'^2>           [m^2/s^2]
     312             : 
     313             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) ::  & 
     314      705888 :       sclrp2_old,    & ! Saved value of <sclr'^2>     [units vary]
     315      705888 :       sclrprtp_old,  & ! Saved value of <sclr'rt'>    [units vary]
     316      705888 :       sclrpthlp_old    ! Saved value of <sclr'thl'>   [units vary]
     317             : 
     318             :     real( kind = core_rknd ) :: & 
     319             :       C2rt,    & ! CLUBB tunable parameter C2rt
     320             :       C2thl,   & ! CLUBB tunable parameter C2thl
     321             :       C2rtthl, & ! CLUBB tunable parameter C2rtthl
     322             :       C4,      & ! CLUBB tunable parameter C4
     323             :       C14,     & ! CLUBB tunable parameter C14
     324             :       C_K2,    & ! CLUBB tunable parameter C_K2
     325             :       C_K9,    & ! CLUBB tunable parameter C_K9
     326             :       rtp2_clip_coef
     327             : 
     328             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: & 
     329      705888 :       C2sclr_1d, C2rt_1d, C2thl_1d, C2rtthl_1d, &
     330      705888 :       C4_1d, C14_1d
     331             : 
     332             :     real( kind = core_rknd ) :: & 
     333             :       threshold     ! Minimum value for variances                   [units vary]
     334             : 
     335             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     336      705888 :       threshold_array ! Minimum value for variances [units vary]
     337             : 
     338             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz) ::  & 
     339      705888 :       lhs ! Tridiagonal matrix
     340             : 
     341             :     real( kind = core_rknd ), dimension(ngrdcol,nz,2) :: & 
     342      705888 :       uv_rhs,    &! RHS vectors of tridiagonal system for up2/vp2
     343      705888 :       uv_solution ! Solution to the tridiagonal system for up2/vp2
     344             : 
     345             :     ! Eddy Diffusion for Variances and Covariances.
     346             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  & 
     347      705888 :       Kw2, & ! For rtp2, thlp2, rtpthlp, and passive scalars  [m^2/s]
     348      705888 :       Kw9,    & ! For up2 and vp2                                [m^2/s]
     349      705888 :       Kw2_zm, & ! Eddy diffusivity coefficient, momentum levels [m2/s]
     350      705888 :       Kw9_zm    ! Eddy diffusivity coefficient, momentum levels [m2/s]
     351             : 
     352             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     353      705888 :       rtpthlp_chnge    ! Net change in r_t'th_l' due to clipping [(kg/kg) K]
     354             : 
     355             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
     356      705888 :       sclrprtp_chnge,  & ! Net change in sclr'r_t' due to clipping  [units vary]
     357      705888 :       sclrpthlp_chnge    ! Net change in sclr'th_l' due to clipping [units vary]
     358             :       
     359             :     ! Turbulent advection terms
     360             :     
     361             :     ! Implicit (LHS) turbulent advection terms
     362             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz) :: & 
     363      705888 :       lhs_ta_wprtp2,    & ! For <w'rt'^2>
     364      705888 :       lhs_ta_wpthlp2,   & ! For <w'thl'^2>
     365      705888 :       lhs_ta_wprtpthlp, & ! For <w'rt'thl'>
     366      705888 :       lhs_ta_wpup2,     & ! For <w'u'^2>
     367      705888 :       lhs_ta_wpvp2        ! For <w'v'^2>
     368             :       
     369             :     ! Explicit (RHS) turbulent advection terms
     370             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     371      705888 :       rhs_ta_wprtp2,    & ! For <w'rt'^2>
     372      705888 :       rhs_ta_wpthlp2,   & ! For <w'thl'^2>
     373      705888 :       rhs_ta_wprtpthlp, & ! For <w'rt'thl'>
     374      705888 :       rhs_ta_wpup2,     & ! For <w'u'^2>
     375      705888 :       rhs_ta_wpvp2        ! For <w'v'^2>
     376             :     
     377             :     ! Implicit (LHS) turbulent advection terms for scalars
     378             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz,sclr_dim) :: & 
     379      705888 :       lhs_ta_wpsclrp2,    & ! For <w'sclr'^2>
     380      705888 :       lhs_ta_wprtpsclrp,  & ! For <w'rt'sclr'>
     381      705888 :       lhs_ta_wpthlpsclrp    ! For <w'thl'sclr'>
     382             : 
     383             :     ! Explicit (RHS) turbulent advection terms for scalars
     384             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
     385      705888 :       rhs_ta_wpsclrp2,      & ! For <w'sclr'^2>
     386      705888 :       rhs_ta_wprtpsclrp,    & ! For <w'sclr'rt'>
     387      705888 :       rhs_ta_wpthlpsclrp      ! For <w'sclr'thl'>
     388             :       
     389             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz) :: & 
     390      705888 :       lhs_diff,     & ! Diffusion contributions to lhs, dissipation term 2
     391      705888 :       lhs_diff_uv,  & ! Diffusion contributions to lhs for <w'u'^2> and <w'v'^2>
     392      705888 :       lhs_ma          ! Mean advection contributions to lhs
     393             : 
     394             :     logical :: l_scalar_calc, l_first_clip_ts, l_last_clip_ts
     395             : 
     396             :     ! Constant parameters
     397             :     logical, parameter :: &
     398             :       l_clip_large_rtp2 = .true. ! Clip rtp2 to be < rtm^2 * coef
     399             : 
     400             :     ! Minimum value of cloud fraction to multiply C2 by to calculate the
     401             :     ! adjusted value of C2.
     402             :     real( kind = core_rknd ), parameter ::  & 
     403             :       min_cloud_frac_mult = 0.10_core_rknd
     404             :       
     405             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     406      705888 :       lhs_dp1, &     ! LHS dissipation term 1
     407      705888 :       lhs_dp1_C14, & ! LHS dissipation term 1, for up2 vp2 using C14
     408      705888 :       lhs_dp1_C4     ! LHS dissipation term 1, for up2 vp2 using C4
     409             :       
     410             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     411      705888 :       rtm_zm, test
     412             : 
     413             :     ! Loop indices
     414             :     integer :: sclr, k, i
     415             :     
     416             :     !------------------------------ Begin Code ------------------------------
     417             :     
     418             :     !$acc enter data create( rtp2_old, thlp2_old, rtpthlp_old, up2_old, vp2_old, &
     419             :     !$acc                    C2sclr_1d, C2rt_1d, C2thl_1d, &
     420             :     !$acc                    C2rtthl_1d, C4_1d, C14_1d, threshold_array, lhs, uv_rhs, &
     421             :     !$acc                    uv_solution, Kw2, Kw9, Kw2_zm, Kw9_zm, rtpthlp_chnge, &
     422             :     !$acc                    lhs_ta_wprtp2, lhs_ta_wpthlp2, &
     423             :     !$acc                    lhs_ta_wprtpthlp, lhs_ta_wpup2, lhs_ta_wpvp2, rhs_ta_wprtp2, &
     424             :     !$acc                    rhs_ta_wpthlp2, rhs_ta_wprtpthlp, rhs_ta_wpup2, rhs_ta_wpvp2, &
     425             :     !$acc                    lhs_diff, lhs_diff_uv, lhs_ma, lhs_dp1, rtm_zm, &
     426             :     !$acc                    lhs_dp1_C4, lhs_dp1_C14 )
     427             : 
     428             :     !$acc enter data if( sclr_dim > 0 ) &
     429             :     !$acc      create( sclrp2_old, sclrprtp_old, sclrpthlp_old, sclrprtp_chnge, &
     430             :     !$acc              lhs_ta_wpsclrp2, lhs_ta_wprtpsclrp, lhs_ta_wpthlpsclrp, &
     431             :     !$acc              rhs_ta_wpsclrp2, rhs_ta_wprtpsclrp, rhs_ta_wpthlpsclrp, &
     432             :     !$acc              sclrpthlp_chnge ) 
     433             :     
     434             :     ! Unpack CLUBB tunable parameters
     435      352944 :     C2rt    = clubb_params(iC2rt)
     436      352944 :     C2thl   = clubb_params(iC2thl)
     437      352944 :     C2rtthl = clubb_params(iC2rtthl)
     438      352944 :     C4      = clubb_params(iC4)
     439      352944 :     C14     = clubb_params(iC14)
     440      352944 :     C_K2    = clubb_params(ic_K2)
     441      352944 :     C_K9    = clubb_params(ic_K9)
     442      352944 :     rtp2_clip_coef = clubb_params(irtp2_clip_coef)
     443             : 
     444      352944 :     if ( clubb_at_least_debug_level( 0 ) ) then
     445             :       ! Assertion check for C_uu_shr
     446             :       if ( clubb_params(iC_uu_shr) > one &
     447      352944 :            .or. clubb_params(iC_uu_shr) < zero ) then
     448           0 :         write(fstderr,*) "The C_uu_shr variable is outside the valid range"
     449           0 :         err_code = clubb_fatal_error
     450           0 :         return
     451             :       end if
     452             :       if ( clubb_params(iC_uu_buoy) > one &
     453      352944 :            .or. clubb_params(iC_uu_buoy) < zero ) then
     454           0 :         write(fstderr,*) "The C_uu_buoy variable is outside the valid range"
     455           0 :         err_code = clubb_fatal_error
     456           0 :         return
     457             :       end if
     458             :     end if
     459             : 
     460             :     ! Use 3 different values of C2 for rtp2, thlp2, rtpthlp.
     461      352944 :     if ( l_C2_cloud_frac ) then
     462             :       !$acc parallel loop gang vector collapse(2) default(present)
     463           0 :       do k = 1, nz, 1
     464           0 :         do i = 1, ngrdcol
     465           0 :           if ( cloud_frac(i,k) >= cloud_frac_min ) then
     466           0 :             C2rt_1d(i,k)    = C2rt * max( min_cloud_frac_mult, cloud_frac(i,k) )
     467           0 :             C2thl_1d(i,k)   = C2thl * max( min_cloud_frac_mult, cloud_frac(i,k) )
     468           0 :             C2rtthl_1d(i,k) = C2rtthl* max( min_cloud_frac_mult, cloud_frac(i,k) )
     469             :           else ! cloud_frac(k) < cloud_frac_min
     470           0 :             C2rt_1d(i,k)    = C2rt
     471           0 :             C2thl_1d(i,k)   = C2thl
     472           0 :             C2rtthl_1d(i,k) = C2rtthl
     473             :           end if ! cloud_frac(k) >= cloud_frac_min
     474             :         end do
     475             :       end do ! k = 1, nz, 1
     476             :       !$acc end parallel loop
     477             :     else
     478             :       !$acc parallel loop gang vector collapse(2) default(present)
     479    30353184 :       do k = 1, nz
     480   501287184 :         do i = 1, ngrdcol
     481   470934000 :           C2rt_1d(i,k)    = C2rt
     482   470934000 :           C2thl_1d(i,k)   = C2thl
     483   500934240 :           C2rtthl_1d(i,k) = C2rtthl
     484             :         end do
     485             :       end do
     486             :       !$acc end parallel loop
     487             :     endif ! l_C2_cloud_frac
     488             : 
     489             :     !$acc parallel loop gang vector collapse(2) default(present)
     490    30353184 :     do k = 1, nz
     491   501287184 :       do i = 1, ngrdcol
     492   470934000 :         C2sclr_1d(i,k) = C2rt  ! Use rt value for now
     493   470934000 :         C4_1d(i,k)     = two_thirds * C4
     494   500934240 :         C14_1d(i,k)    = one_third  * C14
     495             :       end do
     496             :     end do
     497             :     !$acc end parallel loop
     498             :     
     499             :     ! Are we solving for passive scalars as well?
     500      352944 :     if ( sclr_dim > 0 ) then
     501           0 :       l_scalar_calc = .true.
     502             :     else
     503      352944 :       l_scalar_calc = .false.
     504             :     end if
     505             : 
     506             :     ! Define the Coefficent of Eddy Diffusivity for the variances
     507             :     ! and covariances.
     508             :     !$acc parallel loop gang vector collapse(2) default(present)
     509    30353184 :     do k = 1, nz
     510   501287184 :       do i = 1, ngrdcol
     511             :         ! Kw2 is used for variances and covariances rtp2, thlp2, rtpthlp, and
     512             :         ! passive scalars.  The variances and covariances are located on the
     513             :         ! momentum levels.  Kw2 is located on the thermodynamic levels.
     514             :         ! Kw2 = c_K2 * Kh_zt
     515   470934000 :         Kw2(i,k) = C_K2 * Kh_zt(i,k)
     516             : 
     517             :         ! Kw9 is used for variances up2 and vp2.  The variances are located on
     518             :         ! the momentum levels.  Kw9 is located on the thermodynamic levels.
     519             :         ! Kw9 = c_K9 * Kh_zt
     520   500934240 :         Kw9(i,k) = C_K9 * Kh_zt(i,k)
     521             :       end do
     522             :     end do
     523             :     !$acc end parallel loop
     524             : 
     525      352944 :     Kw2_zm = zt2zm( nz, ngrdcol, gr, Kw2 )
     526      352944 :     Kw9_zm = zt2zm( nz, ngrdcol, gr, Kw9 )
     527             : 
     528             :     !$acc parallel loop gang vector collapse(2) default(present)
     529    30353184 :     do k = 1, nz
     530   501287184 :       do i = 1, ngrdcol
     531   470934000 :         Kw2_zm(i,k) = max( Kw2_zm(i,k), zero )
     532   500934240 :         Kw9_zm(i,k) = max( Kw9_zm(i,k), zero )
     533             :       end do
     534             :     end do
     535             :     !$acc end parallel loop
     536             : 
     537      352944 :     if ( l_lmm_stepping ) then
     538             : 
     539             :       !$acc parallel loop gang vector collapse(2) default(present)
     540           0 :       do k = 1, nz
     541           0 :         do i = 1, ngrdcol
     542           0 :           thlp2_old(i,k)   = thlp2(i,k)
     543           0 :           rtp2_old(i,k)    = rtp2(i,k)
     544           0 :           rtpthlp_old(i,k) = rtpthlp(i,k)
     545             :         end do
     546             :       end do
     547             :       !$acc end parallel loop
     548             : 
     549           0 :       if ( sclr_dim > 0 ) then
     550             :         !$acc parallel loop gang vector collapse(3) default(present)
     551           0 :         do sclr = 1, sclr_dim
     552           0 :           do k = 1, nz
     553           0 :             do i = 1, ngrdcol
     554           0 :               sclrp2_old(i,k,sclr)    = sclrp2(i,k,sclr)
     555           0 :               sclrprtp_old(i,k,sclr)  = sclrprtp(i,k,sclr)
     556           0 :               sclrpthlp_old(i,k,sclr) = sclrpthlp(i,k,sclr)
     557             :             end do
     558             :           end do
     559             :         end do
     560             :         !$acc end parallel loop
     561             :       end if ! sclr_dim > 0
     562             : 
     563             :     end if ! l_lmm_stepping
     564             :    
     565             :     ! Calculate all the explicit and implicit turbulent advection terms 
     566             :     call calc_xp2_xpyp_ta_terms( nz, ngrdcol, gr, wprtp, wprtp2, wpthlp, wpthlp2, wprtpthlp,      & ! In
     567             :                                  rtp2, thlp2, rtpthlp, upwp, vpwp, up2, vp2, wp2,    & ! In
     568             :                                  wp2_zt, wpsclrp, wpsclrp2, wpsclrprtp, wpsclrpthlp, & ! In
     569             :                                  sclrp2, sclrprtp, sclrpthlp,                        & ! In
     570             :                                  rho_ds_zt, invrs_rho_ds_zm, rho_ds_zm,              & ! In
     571             :                                  wp3_on_wp2, wp3_on_wp2_zt, sigma_sqd_w,             & ! In
     572             :                                  pdf_implicit_coefs_terms, l_scalar_calc,            & ! In
     573             :                                  clubb_params(ibeta), iiPDF_type, l_upwind_xpyp_ta,  & ! In
     574             :                                  l_godunov_upwind_xpyp_ta,                           & ! In 
     575             :                                  stats_metadata,                                     & ! In 
     576             :                                  stats_zt,                                           & ! InOut
     577             :                                  lhs_ta_wprtp2, lhs_ta_wpthlp2, lhs_ta_wprtpthlp,    & ! Out
     578             :                                  lhs_ta_wpup2, lhs_ta_wpvp2, lhs_ta_wpsclrp2,        & ! Out
     579             :                                  lhs_ta_wprtpsclrp, lhs_ta_wpthlpsclrp,              & ! Out
     580             :                                  rhs_ta_wprtp2, rhs_ta_wpthlp2, rhs_ta_wprtpthlp,    & ! Out
     581             :                                  rhs_ta_wpup2, rhs_ta_wpvp2, rhs_ta_wpsclrp2,        & ! Out
     582      352944 :                                  rhs_ta_wprtpsclrp, rhs_ta_wpthlpsclrp               ) ! Out
     583             :                                    
     584             :     ! Calculate LHS eddy diffusion term: dissipation term 2 (dp2). This is the 
     585             :     ! diffusion term for all LHS matrices except <w'u'^2> and <w'v'^2>
     586             :     call diffusion_zm_lhs( nz, ngrdcol, gr, Kw2, Kw2_zm, nu_vert_res_dep%nu2, & ! In
     587             :                            invrs_rho_ds_zm, rho_ds_zt,                        & ! In
     588      352944 :                            lhs_diff )                                           ! Out
     589             :                                  
     590             :     ! Calculate LHS mean advection (ma) term, this term is equal for all LHS matrices
     591             :     call term_ma_zm_lhs( nz, ngrdcol, wm_zm,              & ! In
     592             :                          gr%invrs_dzm, gr%weights_zm2zt,  & ! In
     593      352944 :                          lhs_ma )                           ! Out
     594             :                                
     595             :                                
     596             :     if ( ( abs(C2rt - C2thl)   < abs(C2rt + C2thl)   / 2 * eps   .and. &
     597      352944 :            abs(C2rt - C2rtthl) < abs(C2rt + C2rtthl) / 2 * eps ) .and. &
     598             :          ( l_explicit_turbulent_adv_xpyp .or. &
     599             :            .not. l_explicit_turbulent_adv_xpyp .and. iiPDF_type == iiPDF_ADG1 ) ) then
     600             :            
     601             :       ! All left hand side matricies are equal for rtp2, thlp2, rtpthlp, and scalars.
     602             :       ! Thus only one solve is neccesary, using combined right hand sides
     603             :       call solve_xp2_xpyp_with_single_lhs( nz, ngrdcol, gr,                                 & ! In
     604             :                                            C2rt_1d, invrs_tau_xp2_zm, rtm, thlm, wprtp,     & ! In
     605             :                                            wpthlp, rtp2_forcing, thlp2_forcing,             & ! In
     606             :                                            rtpthlp_forcing, sclrm, wpsclrp,                 & ! In
     607             :                                            lhs_ta_wprtp2, lhs_ma, lhs_diff,                 & ! In
     608             :                                            rhs_ta_wprtp2, rhs_ta_wpthlp2,                   & ! In
     609             :                                            rhs_ta_wprtpthlp, rhs_ta_wpsclrp2,               & ! In
     610             :                                            rhs_ta_wprtpsclrp, rhs_ta_wpthlpsclrp,           & ! In
     611             :                                            dt, l_scalar_calc, l_lmm_stepping,               & ! In
     612             :                                            tridiag_solve_method,                            & ! In
     613             :                                            stats_metadata,                                  & ! In
     614             :                                            stats_zm, stats_sfc,                             & ! In
     615             :                                            rtp2, thlp2, rtpthlp,                            & ! Out
     616           0 :                                            sclrp2, sclrprtp, sclrpthlp )                      ! Out
     617             :     else
     618             :           
     619             :       ! Left hand sides are potentially different, this requires multiple solves
     620             :       call solve_xp2_xpyp_with_multiple_lhs( nz, ngrdcol, gr,                              & ! In
     621             :                                              C2rt_1d, C2thl_1d, C2rtthl_1d, C2sclr_1d,     & ! In
     622             :                                              invrs_tau_xp2_zm, rtm, thlm, wprtp, wpthlp,   & ! In
     623             :                                              rtp2_forcing, thlp2_forcing, rtpthlp_forcing, & ! In
     624             :                                              sclrm, wpsclrp,                               & ! In
     625             :                                              lhs_ta_wprtp2, lhs_ta_wpthlp2,                & ! In
     626             :                                              lhs_ta_wprtpthlp, lhs_ta_wpsclrp2,            & ! In
     627             :                                              lhs_ta_wprtpsclrp, lhs_ta_wpthlpsclrp,        & ! In
     628             :                                              lhs_ma, lhs_diff,                             & ! In
     629             :                                              rhs_ta_wprtp2, rhs_ta_wpthlp2,                & ! In
     630             :                                              rhs_ta_wprtpthlp, rhs_ta_wpsclrp2,            & ! In
     631             :                                              rhs_ta_wprtpsclrp, rhs_ta_wpthlpsclrp,        & ! In
     632             :                                              dt, iiPDF_type, l_scalar_calc,                & ! In
     633             :                                              l_lmm_stepping,                               & ! In
     634             :                                              tridiag_solve_method,                         & ! In
     635             :                                              stats_metadata,                               & ! In
     636             :                                              stats_zm, stats_sfc,                          & ! In
     637             :                                              rtp2, thlp2, rtpthlp,                         & ! Out
     638      352944 :                                              sclrp2, sclrprtp, sclrpthlp )                   ! Out
     639             :     end if
     640             : 
     641             :     !!!!!***** u'^2 / v'^2 *****!!!!!
     642             :       
     643             :     ! Calculate LHS eddy diffusion term: dissipation term 2 (dp2), for <w'u'^2> and <w'v'^2>
     644             :     call diffusion_zm_lhs( nz, ngrdcol, gr, Kw9, Kw9_zm, nu_vert_res_dep%nu9, & ! In
     645             :                            invrs_rho_ds_zm, rho_ds_zt,                        & ! In
     646      352944 :                            lhs_diff_uv )                                        ! Out
     647             : 
     648      352944 :     if ( l_lmm_stepping ) then
     649             :       !$acc parallel loop gang vector collapse(2) default(present)
     650           0 :       do k = 1, nz
     651           0 :         do i = 1, ngrdcol
     652           0 :           up2_old(i,k) = up2(i,k)
     653           0 :           vp2_old(i,k) = vp2(i,k)      
     654             :         end do       
     655             :       end do ! k=2..gr%nz-1
     656             :       !$acc end parallel loop
     657             :     endif ! l_lmm_stepping
     658             : 
     659             :     ! Dissipation term 1 using C4
     660             :     call term_dp1_lhs( nz, ngrdcol, &
     661             :                        C4_1d, invrs_tau_C4_zm, &
     662      352944 :                        lhs_dp1_C4 )
     663             : 
     664             :     ! Dissipation term 1 using C14
     665             :     call term_dp1_lhs( nz, ngrdcol, &
     666             :                        C14_1d, invrs_tau_C14_zm, &
     667      352944 :                        lhs_dp1_C14 )
     668             :     
     669             :     !$acc parallel loop gang vector collapse(2) default(present)
     670    29647296 :     do k = 2, nz-1
     671   489500496 :       do i = 1, ngrdcol
     672   489147552 :         lhs_dp1(i,k) = ( lhs_dp1_C4(i,k) + lhs_dp1_C14(i,k) ) * gamma_over_implicit_ts
     673             :       end do       
     674             :     end do ! k=2..gr%nz-1
     675             :     !$acc end parallel loop
     676             : 
     677             : 
     678      352944 :     if ( iiPDF_type == iiPDF_new_hybrid ) then
     679             : 
     680             :       ! Different LHS required for up2 and vp2.
     681             : 
     682             :       ! Solve for up2
     683             : 
     684             :       ! Implicit contributions to term up2
     685             :       call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
     686             :                          lhs_ta_wpup2, lhs_ma, lhs_diff_uv, lhs_dp1, & ! In
     687           0 :                          lhs ) ! Out
     688             : 
     689             :       ! Explicit contributions to up2
     690             :       call xp2_xpyp_uv_rhs( nz, ngrdcol, gr, xp2_xpyp_up2, dt, & ! In
     691             :                             wp2, wpthvp, & ! In
     692             :                             C4_1d, invrs_tau_C4_zm, C14_1d, invrs_tau_C14_zm, & ! In
     693             :                             um, vm, upwp, vpwp, up2, vp2, & ! In
     694             :                             thv_ds_zm, C4, clubb_params(iC_uu_shr), & ! In
     695             :                             clubb_params(iC_uu_buoy), C14, lhs_splat_wp2, & ! In
     696             :                             lhs_ta_wpup2, rhs_ta_wpup2, & ! In
     697             :                             lhs_dp1_C4, lhs_dp1_C14, & ! In
     698             :                             stats_metadata, & ! In
     699             :                             stats_zm, & ! intent(inout)
     700           0 :                             uv_rhs(:,:,1) ) ! Out
     701             : 
     702             :       ! Solve the tridiagonal system
     703             :        call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_up2_vp2, 1, & ! Intent(in)
     704             :                             tridiag_solve_method,             & ! Intent(in)
     705             :                             stats_metadata,                   & ! Intent(in)
     706             :                             stats_sfc,                        & ! intent(inout)
     707             :                             uv_rhs, lhs,                      & ! Intent(inout)
     708           0 :                             uv_solution )                       ! Intent(out)
     709             :       
     710           0 :       up2 = uv_solution(:,:,1)
     711             :          
     712           0 :       if ( l_lmm_stepping ) then 
     713           0 :         up2 = one_half * ( up2_old + up2 )
     714             :       end if
     715             : 
     716           0 :       if ( stats_metadata%l_stats_samp ) then
     717           0 :         do i = 1, ngrdcol
     718           0 :           call xp2_xpyp_implicit_stats( nz, xp2_xpyp_up2, up2(i,:), & !intent(in)
     719           0 :                                         gamma_over_implicit_ts*lhs_dp1_C14(i,:), &
     720             :                                         gamma_over_implicit_ts*lhs_dp1_C4(i,:), &
     721             :                                         lhs_diff_uv(:,i,:), lhs_ta_wpup2(:,i,:), lhs_ma(:,i,:), &
     722             :                                         stats_metadata, & 
     723           0 :                                         stats_zm(i) ) ! intent(inout)
     724             :         end do
     725             :       endif
     726             : 
     727             :       ! Implicit contributions to term vp2
     728             :       call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
     729             :                          lhs_ta_wpvp2, lhs_ma, lhs_diff_uv, lhs_dp1, & ! In
     730           0 :                          lhs ) ! Out
     731             : 
     732             :       ! Explicit contributions to vp2
     733             :       call xp2_xpyp_uv_rhs( nz, ngrdcol, gr, xp2_xpyp_vp2, dt, & ! In
     734             :                             wp2, wpthvp, & ! In
     735             :                             C4_1d, invrs_tau_C4_zm, C14_1d, invrs_tau_C14_zm, & ! In
     736             :                             vm, um, vpwp, upwp, vp2, up2, & ! In
     737             :                             thv_ds_zm, C4, clubb_params(iC_uu_shr), & ! In
     738             :                             clubb_params(iC_uu_buoy), C14, lhs_splat_wp2, & ! In
     739             :                             lhs_ta_wpvp2, rhs_ta_wpvp2, & ! In
     740             :                             lhs_dp1_C4, lhs_dp1_C14, & ! In
     741             :                             stats_metadata, & ! In
     742             :                             stats_zm, & ! intent(inout)
     743           0 :                             uv_rhs(:,:,1) ) ! Out
     744             : 
     745             :       ! Solve the tridiagonal system
     746             :       call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_up2_vp2, 1,  & ! Intent(in)
     747             :                            tridiag_solve_method,              & ! Intent(in)
     748             :                            stats_metadata,                    & ! Intent(in)
     749             :                            stats_sfc,                         & ! intent(inout)
     750             :                            uv_rhs, lhs,                       & ! Intent(inout)
     751           0 :                            uv_solution )                        ! Intent(out)
     752             : 
     753           0 :       vp2 = uv_solution(:,:,1)
     754             : 
     755           0 :       if ( l_lmm_stepping ) then
     756           0 :         vp2 = one_half * ( vp2_old + vp2 )
     757             :       end if
     758             : 
     759           0 :       if ( stats_metadata%l_stats_samp ) then
     760           0 :         do i = 1, ngrdcol
     761           0 :           call xp2_xpyp_implicit_stats( nz, xp2_xpyp_vp2, vp2(i,:), & !intent(in)
     762           0 :                                         gamma_over_implicit_ts*lhs_dp1_C14(i,:), &
     763             :                                         gamma_over_implicit_ts*lhs_dp1_C4(i,:), &
     764             :                                         lhs_diff_uv(:,i,:), lhs_ta_wpvp2(:,i,:), lhs_ma(:,i,:), &
     765             :                                         stats_metadata, & 
     766           0 :                                         stats_zm(i) ) ! intent(inout)
     767             :         end do
     768             :       endif
     769             : 
     770             :     else ! ADG1 and other types
     771             : 
     772             :       ! ADG1 allows up2 and vp2 to use the same LHS.
     773             : 
     774             :       ! Implicit contributions to term up2/vp2
     775             :       call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
     776             :                          lhs_ta_wpup2, lhs_ma, lhs_diff_uv, lhs_dp1, & ! In
     777      352944 :                          lhs ) ! Out
     778             : 
     779             :       ! Explicit contributions to up2
     780             :       call xp2_xpyp_uv_rhs( nz, ngrdcol, gr, xp2_xpyp_up2, dt, & ! In
     781             :                             wp2, wpthvp, & ! In
     782             :                             C4_1d, invrs_tau_C4_zm, C14_1d, invrs_tau_C14_zm, & ! In
     783             :                             um, vm, upwp, vpwp, up2, vp2, & ! In
     784             :                             thv_ds_zm, C4, clubb_params(iC_uu_shr), & ! In
     785             :                             clubb_params(iC_uu_buoy), C14, lhs_splat_wp2, & ! In
     786             :                             lhs_ta_wpup2, rhs_ta_wpup2, & ! In
     787             :                             lhs_dp1_C4, lhs_dp1_C14, & ! In
     788             :                             stats_metadata, & ! In
     789             :                             stats_zm, & ! intent(inout)
     790      352944 :                             uv_rhs(:,:,1) ) ! Out
     791             : 
     792             :       ! Explicit contributions to vp2
     793             :       call xp2_xpyp_uv_rhs( nz, ngrdcol, gr, xp2_xpyp_vp2, dt, & ! In
     794             :                             wp2, wpthvp, & ! In
     795             :                             C4_1d, invrs_tau_C4_zm, C14_1d, invrs_tau_C14_zm, & ! In
     796             :                             vm, um, vpwp, upwp, vp2, up2, & ! In
     797             :                             thv_ds_zm, C4, clubb_params(iC_uu_shr), & ! In
     798             :                             clubb_params(iC_uu_buoy), C14, lhs_splat_wp2, & ! In
     799             :                             lhs_ta_wpup2, rhs_ta_wpvp2, & ! In
     800             :                             lhs_dp1_C4, lhs_dp1_C14, & ! In
     801             :                             stats_metadata, & ! In
     802             :                             stats_zm, & ! intent(inout)
     803      352944 :                             uv_rhs(:,:,2) ) ! Out
     804             : 
     805             :       ! Solve the tridiagonal system
     806             :       call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_up2_vp2, 2, & ! Intent(in)
     807             :                            tridiag_solve_method,             & ! Intent(in)
     808             :                            stats_metadata,                   & ! Intent(in)
     809             :                            stats_sfc,                        & ! Intent(inout)
     810             :                            uv_rhs, lhs,                      & ! Intent(inout)
     811      352944 :                            uv_solution )                       ! Intent(out)
     812             : 
     813             :       !$acc parallel loop gang vector collapse(2) default(present)
     814    30353184 :       do k = 1, nz
     815   501287184 :         do i = 1, ngrdcol
     816   470934000 :           up2(i,k) = uv_solution(i,k,1)
     817   500934240 :           vp2(i,k) = uv_solution(i,k,2)
     818             :         end do
     819             :       end do
     820             :       !$acc end parallel loop
     821             : 
     822      352944 :       if ( l_lmm_stepping ) then
     823             :         !$acc parallel loop gang vector collapse(2) default(present)
     824           0 :         do k = 1, nz
     825           0 :           do i = 1, ngrdcol
     826           0 :             up2(i,k) = one_half * ( up2_old(i,k) + up2(i,k) )
     827           0 :             vp2(i,k) = one_half * ( vp2_old(i,k) + vp2(i,k) )
     828             :           end do
     829             :         end do
     830             :         !$acc end parallel loop
     831             :       end if
     832             : 
     833      352944 :       if ( stats_metadata%l_stats_samp ) then
     834             : 
     835             :         !$acc update host( up2, lhs_diff_uv, lhs_ta_wpup2, &
     836             :         !$acc              lhs_ma, vp2, lhs_dp1_C4, lhs_dp1_C14 )
     837             : 
     838           0 :         do i = 1, ngrdcol
     839           0 :           call xp2_xpyp_implicit_stats( nz, xp2_xpyp_up2, up2(i,:), & !intent(in)
     840           0 :                                         gamma_over_implicit_ts*lhs_dp1_C14(i,:), &
     841             :                                         gamma_over_implicit_ts*lhs_dp1_C4(i,:), &
     842             :                                         lhs_diff_uv(:,i,:), lhs_ta_wpup2(:,i,:), lhs_ma(:,i,:), &
     843             :                                         stats_metadata, & 
     844           0 :                                         stats_zm(i) ) ! intent(inout)
     845             :           call xp2_xpyp_implicit_stats( nz, xp2_xpyp_vp2, vp2(i,:), & !intent(in)
     846             :                                         gamma_over_implicit_ts*lhs_dp1_C14(i,:), &
     847             :                                         gamma_over_implicit_ts*lhs_dp1_C4(i,:), &
     848             :                                         lhs_diff_uv(:,i,:), lhs_ta_wpup2(:,i,:), lhs_ma(:,i,:), &
     849             :                                         stats_metadata, &
     850           0 :                                         stats_zm(i) ) ! intent(inout)
     851             :         end do
     852             :       endif
     853             : 
     854             :     endif ! iiPDF_type
     855             : 
     856             : 
     857             :     ! Apply the positive definite scheme to variances
     858             :     if ( l_hole_fill ) then
     859             :       call pos_definite_variances( nz, ngrdcol, gr,               & ! In
     860             :                                    xp2_xpyp_rtp2, dt, rt_tol**2,  & ! In
     861             :                                    rho_ds_zm, rho_ds_zt,          & ! In
     862             :                                    stats_metadata,                & ! In
     863             :                                    stats_zm,                      & ! InOut
     864      352944 :                                    rtp2 )                           ! InOut
     865             :       call pos_definite_variances( nz, ngrdcol, gr,                 & ! In
     866             :                                    xp2_xpyp_thlp2, dt, thl_tol**2,  & ! In
     867             :                                    rho_ds_zm, rho_ds_zt,            & ! In
     868             :                                    stats_metadata,                  & ! In
     869             :                                    stats_zm,                        & ! InOut
     870      352944 :                                    thlp2 )                            ! InOut
     871             :       call pos_definite_variances( nz, ngrdcol, gr,                 & ! In
     872             :                                    xp2_xpyp_up2, dt, w_tol_sqd,     & ! In
     873             :                                    rho_ds_zm, rho_ds_zt,            & ! In
     874             :                                    stats_metadata,                  & ! In
     875             :                                    stats_zm,                        & ! InOut
     876      352944 :                                    up2 )                              ! InOut
     877             :       call pos_definite_variances( nz, ngrdcol, gr,                 & ! In
     878             :                                    xp2_xpyp_vp2, dt, w_tol_sqd,     & ! In
     879             :                                    rho_ds_zm, rho_ds_zt,            & ! In
     880             :                                    stats_metadata,                  & ! In
     881             :                                    stats_zm,                        & ! InOut
     882      352944 :                                    vp2 )                              ! InOut
     883             :     endif
     884             :     
     885             :     ! Clipping for r_t'^2
     886             : 
     887             :     !threshold = zero_threshold
     888             :     !
     889             :     !where ( wp2 >= w_tol_sqd ) &
     890             :     !   threshold = rt_tol*rt_tol
     891             : 
     892             :     ! The value of rtp2 is not allowed to become smaller than the threshold
     893             :     ! value of rt_tol^2.  Additionally, that threshold value may be boosted at
     894             :     ! any grid level in order to keep the overall correlation of w and rt
     895             :     ! between the values of -max_mag_correlation_flux and
     896             :     ! max_mag_correlation_flux by boosting rtp2 rather than by limiting the
     897             :     ! magnitude of wprtp.
     898      352944 :     if ( l_min_xp2_from_corr_wx ) then
     899             : 
     900             :       ! The overall correlation of w and rt is:
     901             :       !
     902             :       ! corr_w_rt = wprtp / ( sqrt( wp2 ) * sqrt( rtp2 ) ).
     903             :       !
     904             :       ! Squaring both sides, the equation becomes:
     905             :       !
     906             :       ! corr_w_rt^2 = wprtp^2 / ( wp2 * rtp2 ).
     907             :       !
     908             :       ! Using max_mag_correlation_flux for the correlation and then solving for
     909             :       ! the minimum of rtp2, the equation becomes:
     910             :       !
     911             :       ! rtp2|_min = wprtp^2 / ( wp2 * max_mag_correlation_flux^2 ).
     912             :       !$acc parallel loop gang vector collapse(2) default(present)
     913    30353184 :       do k = 1, nz, 1
     914   501287184 :         do i = 1, ngrdcol
     915             : 
     916   941868000 :           threshold_array(i,k) &
     917             :           = max( rt_tol**2, &
     918  1442802240 :                  wprtp(i,k)**2 / ( wp2(i,k) * max_mag_correlation_flux**2 ) )
     919             :         end do
     920             :       end do ! k = 1, nz, 1
     921             :       !$acc end parallel loop
     922             : 
     923             :       call clip_variance( nz, ngrdcol, gr, xp2_xpyp_rtp2, dt, threshold_array,  & ! In
     924             :                           stats_metadata,                                       & ! In  
     925             :                           stats_zm,                                             & ! In/out
     926      352944 :                           rtp2 )                                                  ! In/out
     927             :     else
     928             : 
     929             :       ! Consider only the minimum tolerance threshold value for rtp2.
     930             :       !$acc parallel loop gang vector collapse(2) default(present)
     931           0 :       do k = 1, nz, 1
     932           0 :         do i = 1, ngrdcol
     933           0 :           threshold_array(i,k) = rt_tol**2
     934             :         end do
     935             :       end do ! k = 1, nz, 1
     936             :       !$acc end parallel loop
     937             : 
     938             :       call clip_variance( nz, ngrdcol, gr, xp2_xpyp_rtp2, dt, threshold_array,  & ! Intent(in)
     939             :                           stats_metadata,                                       & ! In  
     940             :                           stats_zm,                                             & ! In/out
     941           0 :                           rtp2 )                                                  ! Intent(inout)
     942             : 
     943             :     endif ! l_min_xp2_from_corr_wx
     944             : 
     945             :     ! Special clipping on the variance of rt to prevent a large variance at
     946             :     ! higher altitudes.  This is done because we don't want the PDF to extend
     947             :     ! into the negative, and found that for latin hypercube sampling a large
     948             :     ! variance aloft leads to negative samples of total water.
     949             :     ! -dschanen 8 Dec 2010
     950             :     if ( l_clip_large_rtp2 ) then
     951             :     
     952             :       ! This overwrites stats clipping data from clip_variance
     953      352944 :       if ( stats_metadata%l_stats_samp ) then
     954             : 
     955             :         !$acc update host( rtp2 )
     956             : 
     957           0 :         do i = 1, ngrdcol
     958           0 :           call stat_modify( nz, stats_metadata%irtp2_cl, -rtp2(i,:) / dt, & ! intent(in)
     959           0 :                             stats_zm(i) )              ! intent(inout)
     960             :         end do
     961             :       endif
     962             :       
     963      352944 :       rtm_zm = zt2zm( nz, ngrdcol, gr, rtm )
     964             :       
     965             :       !$acc parallel loop gang vector collapse(2) default(present)
     966    30353184 :       do k = 1, nz
     967   501287184 :         do i = 1, ngrdcol
     968   470934000 :           threshold = max( rt_tol**2, rtp2_clip_coef * rtm_zm(i,k)**2 )
     969   500934240 :           if ( rtp2(i,k) > threshold ) then
     970       66559 :             rtp2(i,k) = threshold
     971             :           end if
     972             :         end do
     973             :       end do ! k = 1..nz
     974             :       !$acc end parallel loop
     975             : 
     976      352944 :       if ( stats_metadata%l_stats_samp ) then
     977             : 
     978             :         !$acc update host( rtp2 )
     979             : 
     980           0 :         do i = 1, ngrdcol
     981           0 :           call stat_modify( nz, stats_metadata%irtp2_cl, rtp2(i,:) / dt, & ! intent(in)
     982           0 :                             stats_zm(i) )             ! intent(inout)
     983             :         end do
     984             :       endif
     985             :       
     986             :     end if ! l_clip_large_rtp2
     987             :  
     988             : 
     989             :     ! Clipping for th_l'^2
     990             : 
     991             :     !threshold = zero_threshold
     992             :     !
     993             :     !where ( wp2 >= w_tol_sqd ) &
     994             :     !   threshold = thl_tol*thl_tol
     995             : 
     996             :     ! The value of thlp2 is not allowed to become smaller than the threshold
     997             :     ! value of thl_tol^2.  Additionally, that threshold value may be boosted at
     998             :     ! any grid level in order to keep the overall correlation of w and theta-l
     999             :     ! between the values of -max_mag_correlation_flux and
    1000             :     ! max_mag_correlation_flux by boosting thlp2 rather than by limiting the
    1001             :     ! magnitude of wpthlp.
    1002      352944 :     if ( l_min_xp2_from_corr_wx ) then
    1003             : 
    1004             :       ! The overall correlation of w and theta-l is:
    1005             :       !
    1006             :       ! corr_w_thl = wpthlp / ( sqrt( wp2 ) * sqrt( thlp2 ) ).
    1007             :       !
    1008             :       ! Squaring both sides, the equation becomes:
    1009             :       !
    1010             :       ! corr_w_thl^2 = wpthlp^2 / ( wp2 * thlp2 ).
    1011             :       !
    1012             :       ! Using max_mag_correlation_flux for the correlation and then solving for
    1013             :       ! the minimum of thlp2, the equation becomes:
    1014             :       !
    1015             :       ! thlp2|_min = wpthlp^2 / ( wp2 * max_mag_correlation_flux^2 ).
    1016             :       !$acc parallel loop gang vector collapse(2) default(present)
    1017    30353184 :       do k = 1, nz, 1
    1018   501287184 :         do i = 1, ngrdcol
    1019   941868000 :           threshold_array(i,k) &
    1020             :           = max( thl_tol**2, &
    1021  1442802240 :                  wpthlp(i,k)**2 / ( wp2(i,k) * max_mag_correlation_flux**2 ) )
    1022             :         end do
    1023             :       end do ! k = 1, nz, 1
    1024             :       !$acc end parallel loop
    1025             : 
    1026             :       call clip_variance( nz, ngrdcol, gr, xp2_xpyp_thlp2, dt, threshold_array, & ! In
    1027             :                           stats_metadata,                                       & ! In  
    1028             :                           stats_zm,                                             & ! In/out
    1029      352944 :                           thlp2 )                                                 ! In/out
    1030             : 
    1031             :     else
    1032             : 
    1033             :       ! Consider only the minimum tolerance threshold value for thlp2.
    1034             :       !$acc parallel loop gang vector collapse(2) default(present)
    1035           0 :       do k = 1, nz, 1
    1036           0 :         do i = 1, ngrdcol
    1037           0 :           threshold_array(i,k) = thl_tol**2
    1038             :         end do
    1039             :       end do ! k = 1, nz, 1
    1040             :       !$acc end parallel loop
    1041             : 
    1042             :       call clip_variance( nz, ngrdcol, gr, xp2_xpyp_thlp2, dt, threshold_array, & ! Intent(in)
    1043             :                           stats_metadata,                                       & ! In  
    1044             :                           stats_zm,                                             & ! In/out
    1045           0 :                           thlp2 )                                                 ! Intent(inout)
    1046             : 
    1047             :     endif ! l_min_xp2_from_corr_wx
    1048             : 
    1049             : 
    1050             :     ! Clipping for u'^2
    1051             : 
    1052             :     ! Clip negative values of up2
    1053             :     !$acc parallel loop gang vector collapse(2) default(present)
    1054    30353184 :     do k = 1, nz, 1
    1055   501287184 :       do i = 1, ngrdcol
    1056   500934240 :         threshold_array(i,k) = w_tol_sqd
    1057             :       end do
    1058             :     end do ! k = 1, nz, 1
    1059             :     !$acc end parallel loop
    1060             : 
    1061             :     call clip_variance( nz, ngrdcol, gr, xp2_xpyp_up2, dt, threshold_array, & ! Intent(in)
    1062             :                         stats_metadata,                                     & ! In  
    1063             :                         stats_zm,                                           & ! In/out
    1064      352944 :                         up2 )                                                 ! Intent(inout)
    1065             : 
    1066             :     ! Clip excessively large values of up2
    1067      352944 :     if ( stats_metadata%l_stats_samp ) then
    1068             : 
    1069             :       !$acc update host( up2 )
    1070             : 
    1071             :       ! Store previous value in order to calculate clipping
    1072           0 :       do i = 1, ngrdcol
    1073           0 :         call stat_modify( nz, stats_metadata%iup2_cl, -up2(i,:) / dt, &   ! Intent(in)
    1074           0 :                                 stats_zm(i) )             ! Intent(inout)
    1075             :       end do
    1076             :     endif
    1077             : 
    1078             :     !$acc parallel loop gang vector collapse(2) default(present)
    1079    30353184 :     do k = 1, nz, 1
    1080   501287184 :       do i = 1, ngrdcol
    1081   500934240 :         up2(i,k) = min( up2(i,k), 1000._core_rknd )
    1082             :       end do
    1083             :     end do
    1084             :     !$acc end parallel loop
    1085             : 
    1086      352944 :     if ( stats_metadata%l_stats_samp ) then
    1087             : 
    1088             :       !$acc update host( up2 )
    1089             : 
    1090             :       ! Store final value in order to calculate clipping
    1091           0 :       do i = 1, ngrdcol
    1092           0 :         call stat_modify( nz, stats_metadata%iup2_cl, up2(i,:) / dt, &   ! Intent(in)
    1093           0 :                                 stats_zm(i) )             ! Intent(inout)
    1094             :       end do
    1095             :     end if
    1096             : 
    1097             :     ! Clipping for v'^2
    1098             : 
    1099             :     ! Clip negative values of vp2
    1100             :     !$acc parallel loop gang vector collapse(2) default(present)
    1101    30353184 :     do k = 1, nz, 1
    1102   501287184 :       do i = 1, ngrdcol
    1103   500934240 :         threshold_array(i,k) = w_tol_sqd
    1104             :       end do
    1105             :     end do ! k = 1, nz, 1
    1106             :     !$acc end parallel loop
    1107             : 
    1108             :     call clip_variance( nz, ngrdcol, gr, xp2_xpyp_vp2, dt, threshold_array, & ! Intent(in)
    1109             :                         stats_metadata,                                     & ! In  
    1110             :                         stats_zm,                                           & ! In/out
    1111      352944 :                         vp2 )                                                 ! Intent(inout)
    1112             : 
    1113      352944 :     if ( stats_metadata%l_stats_samp ) then
    1114             : 
    1115             :       !$acc update host( vp2 )
    1116             : 
    1117             :       ! Store previous value in order to calculate clipping
    1118           0 :       do i = 1, ngrdcol
    1119           0 :         call stat_modify( nz, stats_metadata%ivp2_cl, -vp2(i,:) / dt, &   ! Intent(in)
    1120           0 :                           stats_zm(i) )             ! Intent(inout)
    1121             :       end do
    1122             :     end if
    1123             :     
    1124             :     !$acc parallel loop gang vector collapse(2) default(present)
    1125    30353184 :     do k = 1, nz, 1
    1126   501287184 :       do i = 1, ngrdcol
    1127   500934240 :         vp2(i,k) = min( vp2(i,k), 1000._core_rknd )
    1128             :       end do
    1129             :     end do
    1130             :     !$acc end parallel loop
    1131             : 
    1132      352944 :     if ( stats_metadata%l_stats_samp ) then
    1133             : 
    1134             :       !$acc update host( vp2 )
    1135             : 
    1136             :       ! Store final value in order to calculate clipping
    1137           0 :       do i = 1, ngrdcol
    1138           0 :         call stat_modify( nz, stats_metadata%ivp2_cl, vp2(i,:) / dt, &   ! Intent(in)
    1139           0 :                                 stats_zm(i) )             ! Intent(inout)
    1140             :       end do
    1141             :     endif
    1142             : 
    1143             :     ! When selected, apply sponge damping after up2 and vp2 have been advanced.
    1144      352944 :     if ( up2_vp2_sponge_damp_settings%l_sponge_damping ) then
    1145             : 
    1146             :       !$acc update host( up2, vp2 )
    1147             : 
    1148           0 :       if ( stats_metadata%l_stats_samp ) then
    1149           0 :         do i = 1, ngrdcol
    1150           0 :           call stat_begin_update( nz, stats_metadata%iup2_sdmp, up2(i,:) / dt, & ! intent(in)
    1151           0 :                                   stats_zm(i) )             ! intent(inout)
    1152             :           call stat_begin_update( nz, stats_metadata%ivp2_sdmp, vp2(i,:) / dt, & ! intent(in)
    1153           0 :                                   stats_zm(i) )             ! intent(inout)
    1154             :         end do
    1155             :       end if
    1156             : 
    1157           0 :       do i = 1, ngrdcol
    1158           0 :         up2(i,:) = sponge_damp_xp2( nz, dt, gr%zm(i,:), up2(i,:), w_tol_sqd, &
    1159           0 :                                     up2_vp2_sponge_damp_profile )
    1160             :       end do
    1161             : 
    1162           0 :       do i = 1, ngrdcol
    1163           0 :         vp2(i,:) = sponge_damp_xp2( nz, dt, gr%zm(i,:), vp2(i,:), w_tol_sqd, &
    1164           0 :                                     up2_vp2_sponge_damp_profile )
    1165             :       end do
    1166             : 
    1167           0 :       if ( stats_metadata%l_stats_samp ) then
    1168           0 :         do i = 1, ngrdcol
    1169           0 :           call stat_end_update( nz, stats_metadata%iup2_sdmp, up2(i,:) / dt, & ! intent(in)
    1170           0 :                                 stats_zm(i) )             ! intent(inout)
    1171             :           call stat_end_update( nz, stats_metadata%ivp2_sdmp, vp2(i,:) / dt, & ! intent(in)
    1172           0 :                                 stats_zm(i) )             ! intent(inout)
    1173             :         end do
    1174             :       end if
    1175             : 
    1176             :       !$acc update device( up2, vp2 )
    1177             : 
    1178             :     end if ! up2_vp2_sponge_damp_settings%l_sponge_damping
    1179             : 
    1180             : 
    1181             :     ! Clipping for r_t'th_l'
    1182             :     ! Clipping r_t'th_l' at each vertical level, based on the
    1183             :     ! correlation of r_t and th_l at each vertical level, such that:
    1184             :     ! corr_(r_t,th_l) = r_t'th_l' / [ sqrt(r_t'^2) * sqrt(th_l'^2) ];
    1185             :     ! -1 <= corr_(r_t,th_l) <= 1.
    1186             :     ! Since r_t'^2, th_l'^2, and r_t'th_l' are all computed in the
    1187             :     ! same place, clipping for r_t'th_l' only has to be done once.
    1188      352944 :     l_first_clip_ts = .true.
    1189      352944 :     l_last_clip_ts = .true.
    1190             :     call clip_covar( nz, ngrdcol, gr, xp2_xpyp_rtpthlp, l_first_clip_ts,  & ! Intent(in)
    1191             :                      l_last_clip_ts, dt, rtp2, thlp2,                     & ! Intent(in)
    1192             :                      l_predict_upwp_vpwp,                                 & ! Intent(in)
    1193             :                      stats_metadata,                                      & ! Intent(in)
    1194             :                      stats_zm,                                            & ! intent(inout)
    1195      352944 :                      rtpthlp, rtpthlp_chnge )                               ! Intent(inout)
    1196             : 
    1197      352944 :     if ( l_scalar_calc ) then
    1198             : 
    1199             :       ! Apply hole filling algorithm to the scalar variance terms
    1200             :       if ( l_hole_fill ) then
    1201           0 :         do sclr = 1, sclr_dim, 1
    1202             :           call pos_definite_variances( nz, ngrdcol, gr,                         & ! In
    1203           0 :                                        xp2_xpyp_sclrp2, dt, sclr_tol(sclr)**2,  & ! In
    1204             :                                        rho_ds_zm, rho_ds_zt,                    & ! In
    1205             :                                        stats_metadata,                          & ! In
    1206             :                                        stats_zm,                                & ! InOut
    1207           0 :                                        sclrp2(:,:,sclr) )                         ! InOut
    1208           0 :           if ( sclr == iisclr_rt ) then
    1209             :             ! Here again, we do this kluge here to make sclr'rt' == rt'^2
    1210             :             call pos_definite_variances( nz, ngrdcol, gr,                           & ! In
    1211           0 :                                          xp2_xpyp_sclrprtp, dt, sclr_tol(sclr)**2,  & ! In
    1212             :                                          rho_ds_zm, rho_ds_zt,                      & ! In
    1213             :                                          stats_metadata,                            & ! In
    1214             :                                          stats_zm,                                  & ! InOut
    1215           0 :                                          sclrprtp(:,:,sclr) )                         ! InOut
    1216             :           end if
    1217           0 :           if ( sclr == iisclr_thl ) then
    1218             :             ! As with sclr'rt' above, but for sclr'thl'
    1219             :             call pos_definite_variances( nz, ngrdcol, gr,                           & ! In
    1220           0 :                                          xp2_xpyp_sclrpthlp, dt, sclr_tol(sclr)**2, & ! In
    1221             :                                          rho_ds_zm, rho_ds_zt,                      & ! In
    1222             :                                          stats_metadata,                            & ! In
    1223             :                                          stats_zm,                                  & ! InOut
    1224           0 :                                          sclrpthlp(:,:,sclr) )                        ! InOut
    1225             :           end if
    1226             :         enddo
    1227             :       endif
    1228             : 
    1229             : 
    1230             :       ! Clipping for sclr'^2
    1231           0 :       do sclr = 1, sclr_dim, 1
    1232             : 
    1233             :         !$acc parallel loop gang vector collapse(2) default(present)
    1234           0 :         do k = 1, nz, 1
    1235           0 :           do i = 1, ngrdcol
    1236           0 :             threshold_array(i,k) = sclr_tol(sclr)**2
    1237             :           end do
    1238             :         end do ! k = 1, nz, 1
    1239             :         !$acc end parallel loop
    1240             : 
    1241             :         call clip_variance( nz, ngrdcol, gr, clip_sclrp2, dt, threshold_array,  & ! Intent(in)
    1242             :                             stats_metadata,                                     & ! In  
    1243             :                             stats_zm,                                           & ! In/out
    1244           0 :                             sclrp2(:,:,sclr) )                                    ! Intent(inout)
    1245             : 
    1246             :       enddo
    1247             : 
    1248             : 
    1249             :       ! Clipping for sclr'r_t'
    1250             :       ! Clipping sclr'r_t' at each vertical level, based on the
    1251             :       ! correlation of sclr and r_t at each vertical level, such that:
    1252             :       ! corr_(sclr,r_t) = sclr'r_t' / [ sqrt(sclr'^2) * sqrt(r_t'^2) ];
    1253             :       ! -1 <= corr_(sclr,r_t) <= 1.
    1254             :       ! Since sclr'^2, r_t'^2, and sclr'r_t' are all computed in the
    1255             :       ! same place, clipping for sclr'r_t' only has to be done once.
    1256           0 :       do sclr = 1, sclr_dim, 1
    1257             : 
    1258           0 :         if  ( sclr == iisclr_rt ) then
    1259             :           ! Treat this like a variance if we're emulating rt
    1260             :           !$acc parallel loop gang vector collapse(2) default(present)
    1261           0 :           do k = 1, nz, 1
    1262           0 :             do i = 1, ngrdcol
    1263           0 :               threshold_array(i,k) = sclr_tol(sclr) * rt_tol
    1264             :             end do
    1265             :           end do ! k = 1, nz, 1
    1266             :           !$acc end parallel loop
    1267             : 
    1268             :           call clip_variance( nz, ngrdcol, gr, clip_sclrprtp, dt, threshold_array, & ! Intent(in)
    1269             :                               stats_metadata,                                      & ! In  
    1270             :                               stats_zm,                                            & ! In/out
    1271           0 :                               sclrprtp(:,:,sclr) )                                   ! Intent(inout)
    1272             :         else
    1273           0 :           l_first_clip_ts = .true.
    1274           0 :           l_last_clip_ts = .true.
    1275             :           call clip_covar( nz, ngrdcol, gr, clip_sclrprtp, l_first_clip_ts, & ! Intent(in) 
    1276             :                            l_last_clip_ts, dt, sclrp2(:,:,sclr), rtp2,      & ! Intent(in)
    1277             :                            l_predict_upwp_vpwp,                             & ! Intent(in)
    1278             :                            stats_metadata,                                  & ! Intent(in)
    1279             :                            stats_zm,                                        & ! intent(inout)
    1280           0 :                            sclrprtp(:,:,sclr), sclrprtp_chnge(:,:,sclr) )     ! Intent(inout)
    1281             :         end if
    1282             :       enddo
    1283             : 
    1284             : 
    1285             :       ! Clipping for sclr'th_l'
    1286             :       ! Clipping sclr'th_l' at each vertical level, based on the
    1287             :       ! correlation of sclr and th_l at each vertical level, such that:
    1288             :       ! corr_(sclr,th_l) = sclr'th_l' / [ sqrt(sclr'^2) * sqrt(th_l'^2) ];
    1289             :       ! -1 <= corr_(sclr,th_l) <= 1.
    1290             :       ! Since sclr'^2, th_l'^2, and sclr'th_l' are all computed in the
    1291             :       ! same place, clipping for sclr'th_l' only has to be done once.
    1292           0 :       do sclr = 1, sclr_dim, 1
    1293           0 :         if ( sclr == iisclr_thl ) then
    1294             :           ! As above, but for thl
    1295             :           !$acc parallel loop gang vector collapse(2) default(present)
    1296           0 :           do k = 1, nz, 1
    1297           0 :             do i = 1, ngrdcol
    1298           0 :               threshold_array(i,k) = sclr_tol(sclr) * thl_tol
    1299             :             end do
    1300             :           end do ! k = 1, nz, 1
    1301             :           !$acc end parallel loop
    1302             : 
    1303             :           call clip_variance( nz, ngrdcol, gr, clip_sclrpthlp, dt, threshold_array, & ! Intent(in)
    1304             :                               stats_metadata,                                       & ! In  
    1305             :                               stats_zm,                                             & ! In/out
    1306           0 :                               sclrpthlp(:,:,sclr) )                                   ! Intent(inout)
    1307             :         else
    1308           0 :           l_first_clip_ts = .true.
    1309           0 :           l_last_clip_ts = .true.
    1310             :           call clip_covar( nz, ngrdcol, gr, clip_sclrpthlp, l_first_clip_ts,  & ! Intent(in) 
    1311             :                            l_last_clip_ts, dt, sclrp2(:,:,sclr), thlp2,       & ! Intent(in)
    1312             :                            l_predict_upwp_vpwp,                               & ! Intent(in)
    1313             :                            stats_metadata,                                    & ! Intent(in)
    1314             :                            stats_zm,                                          & ! intent(inout)
    1315           0 :                            sclrpthlp(:,:,sclr), sclrpthlp_chnge(:,:,sclr) )     ! Intent(inout)
    1316             :         end if
    1317             :       enddo
    1318             : 
    1319             :     endif ! l_scalar_calc
    1320             : 
    1321      352944 :     if ( clubb_at_least_debug_level( 0 ) ) then
    1322             : 
    1323      352944 :       if ( err_code == clubb_fatal_error ) then
    1324             : 
    1325             :         !$acc update host( invrs_tau_xp2_zm, invrs_tau_C4_zm, invrs_tau_C14_zm, &
    1326             :         !$acc              wm_zm, rtm, wprtp, thlm, wpthlp, wpthvp, um, vm, wp2, &
    1327             :         !$acc              wp3, upwp, vpwp, sigma_sqd_w, Kh_zt, rtp2_forcing, &
    1328             :         !$acc              thlp2_forcing, rtpthlp_forcing, rho_ds_zm, rho_ds_zt, &
    1329             :         !$acc              invrs_rho_ds_zm, thv_ds_zm, wp2_zt, sclrm, wpsclrp, &
    1330             :         !$acc              rtp2_old, rtp2, thlp2_old, thlp2, rtpthlp_old, rtpthlp, &
    1331             :         !$acc              up2_old, up2, vp2_old, vp2, sclrp2_old, sclrp2, &
    1332             :         !$acc              sclrprtp_old, sclrprtp, sclrpthlp_old, sclrpthlp )
    1333             : 
    1334           0 :         write(fstderr,*) "Error in advance_xp2_xpyp"
    1335             : 
    1336           0 :         write(fstderr,*) "Intent(in)"
    1337             : 
    1338           0 :         write(fstderr,*) "invrs_tau_xp2_zm = ", invrs_tau_xp2_zm(:,:)
    1339           0 :         write(fstderr,*) "invrs_tau_C4_zm = ",invrs_tau_C4_zm(:,:)
    1340           0 :         write(fstderr,*) "invrs_tau_C14_zm = ",invrs_tau_C14_zm(:,:)
    1341           0 :         write(fstderr,*) "wm_zm = ", wm_zm(:,:)
    1342           0 :         write(fstderr,*) "rtm = ", rtm(:,:)
    1343           0 :         write(fstderr,*) "wprtp = ", wprtp(:,:)
    1344           0 :         write(fstderr,*) "thlm = ", thlm(:,:)
    1345           0 :         write(fstderr,*) "wpthlp = ", wpthlp(:,:)
    1346           0 :         write(fstderr,*) "wpthvp = ", wpthvp(:,:)
    1347           0 :         write(fstderr,*) "um = ", um(:,:)
    1348           0 :         write(fstderr,*) "vm = ", vm(:,:)
    1349           0 :         write(fstderr,*) "wp2 = ", wp2(:,:)
    1350           0 :         write(fstderr,*) "wp3 = ", wp3(:,:)
    1351           0 :         write(fstderr,*) "upwp = ", upwp(:,:)
    1352           0 :         write(fstderr,*) "vpwp = ", vpwp(:,:)
    1353           0 :         write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w(:,:)
    1354           0 :         write(fstderr,*) "Kh_zt = ", Kh_zt(:,:)
    1355           0 :         write(fstderr,*) "rtp2_forcing = ", rtp2_forcing(:,:)
    1356           0 :         write(fstderr,*) "thlp2_forcing = ", thlp2_forcing(:,:)
    1357           0 :         write(fstderr,*) "rtpthlp_forcing = ", rtpthlp_forcing(:,:)
    1358           0 :         write(fstderr,*) "rho_ds_zm = ", rho_ds_zm(:,:)
    1359           0 :         write(fstderr,*) "rho_ds_zt = ", rho_ds_zt(:,:)
    1360           0 :         write(fstderr,*) "invrs_rho_ds_zm = ", invrs_rho_ds_zm(:,:)
    1361           0 :         write(fstderr,*) "thv_ds_zm = ", thv_ds_zm(:,:)
    1362           0 :         write(fstderr,*) "wp2_zt = ", wp2_zt(:,:)
    1363             : 
    1364           0 :         do sclr = 1, sclr_dim
    1365           0 :           write(fstderr,*) "sclrm = ", sclr, sclrm(:,:,sclr)
    1366           0 :           write(fstderr,*) "wpsclrp = ", sclr, wpsclrp(:,:,sclr)
    1367             :         enddo
    1368             : 
    1369           0 :         write(fstderr,*) "Intent(In/Out)"
    1370             : 
    1371           0 :         if ( l_lmm_stepping ) &
    1372           0 :            write(fstderr,*) "rtp2 (pre-solve) = ", rtp2_old(:,:)
    1373           0 :         write(fstderr,*) "rtp2 = ", rtp2(:,:)
    1374           0 :         if ( l_lmm_stepping ) &
    1375           0 :            write(fstderr,*) "thlp2 (pre-solve) = ", thlp2_old(:,:)
    1376           0 :         write(fstderr,*) "thlp2 = ", thlp2(:,:)
    1377           0 :         if ( l_lmm_stepping ) &
    1378           0 :            write(fstderr,*) "rtpthlp (pre-solve) = ", rtpthlp_old(:,:)
    1379           0 :         write(fstderr,*) "rtpthlp = ", rtpthlp(:,:)
    1380           0 :         if ( l_lmm_stepping ) &
    1381           0 :            write(fstderr,*) "up2 (pre-solve) = ", up2_old(:,:)
    1382           0 :         write(fstderr,*) "up2 = ", up2(:,:)
    1383           0 :         if ( l_lmm_stepping ) &
    1384           0 :            write(fstderr,*) "vp2 (pre-solve) = ", vp2_old(:,:)
    1385           0 :         write(fstderr,*) "vp2 = ", vp2(:,:)
    1386             : 
    1387           0 :         do sclr = 1, sclr_dim
    1388           0 :           if ( l_lmm_stepping ) &
    1389           0 :              write(fstderr,*) "sclrp2 (pre-solve) = ", sclr, sclrp2_old(:,:,sclr)
    1390           0 :           write(fstderr,*) "sclrp2 = ", sclr, sclrp2(:,:,sclr)
    1391           0 :           if ( l_lmm_stepping ) &
    1392           0 :              write(fstderr,*) "sclrprtp (pre-solve) = ", sclr, sclrprtp_old(:,:,sclr)
    1393           0 :           write(fstderr,*) "sclrprtp = ", sclr, sclrprtp(:,:,sclr)
    1394           0 :           if ( l_lmm_stepping ) &
    1395           0 :              write(fstderr,*) "sclrthlp (pre-solve) = ", sclr, sclrpthlp_old(:,:,sclr)
    1396           0 :           write(fstderr,*) "sclrthlp = ", sclr, sclrpthlp(:,:,sclr)
    1397             :         enddo
    1398             : 
    1399             :       endif
    1400             :     end if
    1401             : 
    1402             :     !$acc exit data delete( rtp2_old, thlp2_old, rtpthlp_old, up2_old, vp2_old, &
    1403             :     !$acc                    C2sclr_1d, C2rt_1d, C2thl_1d, &
    1404             :     !$acc                    C2rtthl_1d, C4_1d, C14_1d, threshold_array, lhs, uv_rhs, &
    1405             :     !$acc                    uv_solution, Kw2, Kw9, Kw2_zm, Kw9_zm, rtpthlp_chnge, &
    1406             :     !$acc                    lhs_ta_wprtp2, lhs_ta_wpthlp2, &
    1407             :     !$acc                    lhs_ta_wprtpthlp, lhs_ta_wpup2, lhs_ta_wpvp2, rhs_ta_wprtp2, &
    1408             :     !$acc                    rhs_ta_wpthlp2, rhs_ta_wprtpthlp, rhs_ta_wpup2, rhs_ta_wpvp2, &
    1409             :     !$acc                    lhs_diff, lhs_diff_uv, lhs_ma, lhs_dp1, rtm_zm, &
    1410             :     !$acc                    lhs_dp1_C4, lhs_dp1_C14 )
    1411             : 
    1412             :     !$acc exit data if( sclr_dim > 0 ) &
    1413             :     !$acc      delete( sclrp2_old, sclrprtp_old, sclrpthlp_old, sclrprtp_chnge, &
    1414             :     !$acc              lhs_ta_wpsclrp2, lhs_ta_wprtpsclrp, lhs_ta_wpthlpsclrp, &
    1415             :     !$acc              rhs_ta_wpsclrp2, rhs_ta_wprtpsclrp, rhs_ta_wpthlpsclrp, &
    1416             :     !$acc              sclrpthlp_chnge ) 
    1417             : 
    1418             :     return
    1419             : 
    1420             :   end subroutine advance_xp2_xpyp
    1421             :   
    1422             :   !============================================================================================
    1423           0 :   subroutine solve_xp2_xpyp_with_single_lhs( nz, ngrdcol, gr, C2x, invrs_tau_xp2_zm, rtm, thlm, wprtp, &
    1424           0 :                                              wpthlp, rtp2_forcing, thlp2_forcing, &
    1425           0 :                                              rtpthlp_forcing, sclrm, wpsclrp, &
    1426           0 :                                              lhs_ta, lhs_ma, lhs_diff, &
    1427           0 :                                              rhs_ta_wprtp2, rhs_ta_wpthlp2, &
    1428           0 :                                              rhs_ta_wprtpthlp, rhs_ta_wpsclrp2, &
    1429           0 :                                              rhs_ta_wprtpsclrp, rhs_ta_wpthlpsclrp, &
    1430             :                                              dt, l_scalar_calc, l_lmm_stepping, &
    1431             :                                              tridiag_solve_method, & 
    1432             :                                              stats_metadata, &
    1433           0 :                                              stats_zm, stats_sfc, & 
    1434           0 :                                              rtp2, thlp2, rtpthlp, &
    1435           0 :                                              sclrp2, sclrprtp, sclrpthlp )
    1436             :     ! Description:
    1437             :     !     This subroutine generates a single lhs matrix and multiple rhs matricies, then 
    1438             :     !     solves the system. This should only be used when the lhs matrices for 
    1439             :     !     <w'r_t'>, <w'th_l'>, <w'rt'thl'> ,<w'sclr'^2>, <w'sclr'rt'>,  and <w'sclr'thl'>
    1440             :     !     are identical. Otherwise multiple lhs matrices and multiple solves are required.
    1441             :     !
    1442             :     !     The ADG1 PDF must be in use for this subroutine to have the
    1443             :     !     potential to be called.
    1444             :     !----------------------------------------------------------------------------------
    1445             :     
    1446             :     use grid_class, only: &
    1447             :       grid ! Type
    1448             :       
    1449             :     use clubb_precision, only:  & 
    1450             :       core_rknd ! Variable(s)
    1451             :       
    1452             :     use constants_clubb, only: & 
    1453             :       rt_tol, & 
    1454             :       thl_tol, &
    1455             :       zero, &
    1456             :       zero_threshold, &
    1457             :       gamma_over_implicit_ts, &
    1458             :       one_half
    1459             :     
    1460             :     use parameters_model, only: &
    1461             :       sclr_dim, & ! Variable(s)
    1462             :       sclr_tol
    1463             :         
    1464             :     use array_index, only: &
    1465             :       iisclr_rt, &
    1466             :       iisclr_thl
    1467             : 
    1468             :     use stats_type, only: &
    1469             :       stats ! Type
    1470             : 
    1471             :     use stats_variables, only: &
    1472             :       stats_metadata_type
    1473             : 
    1474             :     implicit none
    1475             :       
    1476             :     ! -------- Input Variables --------
    1477             :     integer, intent(in) :: &
    1478             :       nz, &
    1479             :       ngrdcol
    1480             : 
    1481             :     type (grid), target, intent(in) :: gr
    1482             :     
    1483             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) ::  & 
    1484             :       C2x,              &
    1485             :       invrs_tau_xp2_zm, & ! Inverse time-scale for xp2 on momentum levels [1/s]
    1486             :       rtm,              & ! Total water mixing ratio (t-levs)     [kg/kg]
    1487             :       thlm,             & ! Liquid potential temp. (t-levs)       [K]
    1488             :       wprtp,            & ! <w'r_t'> (momentum levels)            [(m/s)(kg/kg)]
    1489             :       wpthlp,           & ! <w'th_l'> (momentum levels)           [(m K)/s]
    1490             :       rtp2_forcing,     & ! <r_t'^2> forcing (momentum levels)    [(kg/kg)^2/s]
    1491             :       thlp2_forcing,    & ! <th_l'^2> forcing (momentum levels)   [K^2/s]
    1492             :       rtpthlp_forcing     ! <r_t'th_l'> forcing (momentum levels) [(kg/kg)K/s]
    1493             : 
    1494             :     logical, intent(in) :: &
    1495             :       l_scalar_calc, &
    1496             :       l_lmm_stepping
    1497             : 
    1498             :     real( kind = core_rknd ), intent(in) :: &
    1499             :       dt             ! Model timestep                                [s]
    1500             :       
    1501             :     ! Passive scalar input
    1502             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) ::  & 
    1503             :       sclrm,       & ! Mean value; pass. scalar (t-levs.) [{sclr units}]
    1504             :       wpsclrp        ! <w'sclr'> (momentum levels)        [m/s{sclr units}]
    1505             : 
    1506             :     real( kind = core_rknd ), intent(in), dimension(ndiags3,ngrdcol,nz) :: & 
    1507             :       lhs_ta, &
    1508             :       lhs_diff,     & ! Diffusion contributions to lhs, dissipation term 2
    1509             :       lhs_ma          ! Mean advection contributions to lhs
    1510             : 
    1511             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
    1512             :       rhs_ta_wprtp2,    & ! For <w'rt'^2>
    1513             :       rhs_ta_wpthlp2,   & ! For <w'thl'^2>
    1514             :       rhs_ta_wprtpthlp    ! For <w'rt'thl'>
    1515             :       
    1516             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) :: &
    1517             :       rhs_ta_wpsclrp2,      & ! For <w'sclr'^2>
    1518             :       rhs_ta_wprtpsclrp,    & ! For <w'sclr'rt'><w'sclr'^2><w'sclr'thl'>
    1519             :       rhs_ta_wpthlpsclrp      ! For <w'sclr'thl'>
    1520             : 
    1521             :     integer, intent(in) :: &
    1522             :       tridiag_solve_method  ! Specifier for method to solve tridiagonal systems
    1523             : 
    1524             :     type (stats_metadata_type), intent(in) :: &
    1525             :           stats_metadata
    1526             : 
    1527             :     ! -------- In/Out Variables --------
    1528             : 
    1529             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
    1530             :       stats_zm, &
    1531             :       stats_sfc
    1532             :     
    1533             :     ! An attribute of (inout) is also needed to import the value of the variances
    1534             :     ! at the surface.  Brian.  12/18/05.
    1535             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  & 
    1536             :       rtp2,    & ! <r_t'^2>                      [(kg/kg)^2]
    1537             :       thlp2,   & ! <th_l'^2>                     [K^2]
    1538             :       rtpthlp    ! <r_t'th_l'>                   [(kg K)/kg]
    1539             :       
    1540             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) ::  & 
    1541             :       sclrp2, sclrprtp, sclrpthlp
    1542             :       
    1543             :     ! -------- Local Variables --------
    1544             :     
    1545             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz) ::  & 
    1546           0 :       lhs ! Tridiagonal matrix
    1547             :     
    1548             :     real( kind = core_rknd ), dimension(ngrdcol,nz,3+3*sclr_dim) :: &
    1549           0 :       rhs, &
    1550           0 :       solution
    1551             :       
    1552             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    1553           0 :       sclrp2_forcing,    & ! <sclr'^2> forcing (momentum levels)    [units vary]
    1554           0 :       sclrprtp_forcing,  & ! <sclr'r_t'> forcing (momentum levels)  [units vary]
    1555           0 :       sclrpthlp_forcing    ! <sclr'th_l'> forcing (momentum levels) [units vary]
    1556             :       
    1557             :     real( kind = core_rknd ) :: & 
    1558             :       threshold     ! Minimum value for variances                   [units vary]
    1559             :       
    1560             :     ! LHS dissipation term 1 (dp1). An "over-implicit" weighted time 
    1561             :     ! step is applied to this term (and to pressure term 1 for u'^2 and v'^2).
    1562             :     ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:xp2_dp
    1563             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    1564           0 :       lhs_dp1   ! LHS dissipation term 1
    1565             :       
    1566             :     real( kind = core_rknd ), dimension(nz) :: &
    1567           0 :       zeros
    1568             :       
    1569             :     integer :: sclr, k, i, j
    1570             :     
    1571             :     ! -------- Begin Code --------
    1572             : 
    1573             :     !$acc enter data create( lhs, rhs, solution, lhs_dp1 )
    1574             : 
    1575             :     !$acc enter data if( sclr_dim > 0 ) &
    1576             :     !$acc            create( sclrp2_forcing, sclrprtp_forcing, sclrpthlp_forcing )
    1577             : 
    1578             :     call term_dp1_lhs( nz, ngrdcol, &
    1579             :                        C2x, invrs_tau_xp2_zm, &
    1580           0 :                        lhs_dp1 )
    1581             : 
    1582             :     !$acc parallel loop gang vector collapse(2) default(present)
    1583           0 :     do k = 2, nz-1
    1584           0 :       do i = 1, ngrdcol
    1585           0 :         lhs_dp1(i,k) = lhs_dp1(i,k) * gamma_over_implicit_ts
    1586             :       end do
    1587             :     end do
    1588             :     !$acc end parallel loop
    1589             : 
    1590             :     ! Calculate lhs matrix
    1591             :     call xp2_xpyp_lhs( nz, ngrdcol, dt,                   & ! In
    1592             :                        lhs_ta, lhs_ma, lhs_diff, lhs_dp1, & ! In
    1593           0 :                        lhs )                                ! Out
    1594             :       
    1595             :     ! Calculate rhs matricies
    1596             :     call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_rtp2, dt,  & ! In
    1597             :                        wprtp, wprtp,                        & ! In
    1598             :                        rtm, rtm, rtp2, rtp2_forcing,        & ! In
    1599             :                        C2x, invrs_tau_xp2_zm, rt_tol**2,    & ! In
    1600             :                        lhs_ta, rhs_ta_wprtp2,               & ! In
    1601             :                        stats_metadata,                      & ! In
    1602             :                        stats_zm,                            & ! InOut
    1603           0 :                        rhs(:,:,1) )                           ! Out
    1604             :                        
    1605             :     call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_thlp2, dt, & ! In
    1606             :                        wpthlp, wpthlp,                      & ! In
    1607             :                        thlm, thlm, thlp2, thlp2_forcing,    & ! In
    1608             :                        C2x, invrs_tau_xp2_zm, thl_tol**2,   & ! In
    1609             :                        lhs_ta, rhs_ta_wpthlp2,              & ! In
    1610             :                        stats_metadata,                      & ! In
    1611             :                        stats_zm,                            & ! InOut
    1612           0 :                        rhs(:,:,2) )                           ! Out
    1613             :    
    1614             :     call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_rtpthlp, dt,   & ! In
    1615             :                        wprtp, wpthlp,                           & ! In
    1616             :                        rtm, thlm, rtpthlp, rtpthlp_forcing,     & ! In
    1617             :                        C2x, invrs_tau_xp2_zm, zero_threshold,   & ! In
    1618             :                        lhs_ta, rhs_ta_wprtpthlp,                & ! In
    1619             :                        stats_metadata,                          & ! In
    1620             :                        stats_zm,                                & ! InOut
    1621           0 :                        rhs(:,:,3) )                               ! Out
    1622             :      
    1623           0 :     if ( l_scalar_calc ) then
    1624             :     
    1625           0 :       do sclr = 1, sclr_dim
    1626             : 
    1627             :         ! Forcing for <sclr'^2>.
    1628             :         !$acc parallel loop gang vector collapse(2) default(present)
    1629           0 :         do k = 1, nz
    1630           0 :           do i = 1, ngrdcol
    1631           0 :             sclrp2_forcing(i,k) = zero
    1632             :           end do
    1633             :         end do
    1634             :         !$acc end parallel loop
    1635             : 
    1636             :         !!!!!***** sclr'^2 *****!!!!!
    1637             :         call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_sclrp2, dt,      & ! In
    1638             :                            wpsclrp(:,:,sclr), wpsclrp(:,:,sclr),      & ! In
    1639             :                            sclrm(:,:,sclr), sclrm(:,:,sclr),          & ! In
    1640             :                            sclrp2(:,:,sclr), sclrp2_forcing,          & ! In
    1641           0 :                            C2x, invrs_tau_xp2_zm, sclr_tol(sclr)**2,  & ! In
    1642             :                            lhs_ta, rhs_ta_wpsclrp2(:,:,sclr),         & ! In
    1643             :                            stats_metadata,                            & ! In
    1644             :                            stats_zm,                                  & ! InOut
    1645           0 :                            rhs(:,:,3+sclr) )                            ! Out
    1646             : 
    1647             :         !!!!!***** sclr'r_t' *****!!!!!
    1648           0 :         if ( sclr == iisclr_rt ) then
    1649             :           ! In this case we're trying to emulate rt'^2 with sclr'rt', so we
    1650             :           ! handle this as we would a variance, even though generally speaking
    1651             :           ! the scalar is not rt
    1652             :           !$acc parallel loop gang vector collapse(2) default(present)
    1653           0 :           do k = 1, nz
    1654           0 :             do i = 1, ngrdcol
    1655           0 :               sclrprtp_forcing(i,k) = rtp2_forcing(i,k)
    1656             :             end do
    1657             :           end do
    1658             :           !$acc end parallel loop
    1659             : 
    1660           0 :           threshold = rt_tol**2
    1661             :         else
    1662             :           !$acc parallel loop gang vector collapse(2) default(present)
    1663           0 :           do k = 1, nz
    1664           0 :             do i = 1, ngrdcol
    1665           0 :               sclrprtp_forcing(i,k) = zero
    1666             :             end do
    1667             :           end do
    1668             :           !$acc end parallel loop
    1669             : 
    1670           0 :           threshold = zero_threshold
    1671             :         endif
    1672             :        
    1673             :         call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_sclrprtp, dt,    & ! In
    1674             :                            wpsclrp(:,:,sclr), wprtp,                  & ! In
    1675             :                            sclrm(:,:,sclr), rtm, sclrprtp(:,:,sclr),  & ! In
    1676             :                            sclrprtp_forcing,                          & ! In
    1677             :                            C2x, invrs_tau_xp2_zm, threshold,          & ! In
    1678             :                            lhs_ta, rhs_ta_wprtpsclrp(:,:,sclr),       & ! In
    1679             :                            stats_metadata,                            & ! In
    1680             :                            stats_zm,                                  & ! InOut
    1681           0 :                            rhs(:,:,3+sclr+sclr_dim) )                   ! Out
    1682             : 
    1683             :         !!!!!***** sclr'th_l' *****!!!!!
    1684           0 :         if ( sclr == iisclr_thl ) then
    1685             :           ! In this case we're trying to emulate thl'^2 with sclr'thl', so we
    1686             :           ! handle this as we did with sclr_rt, above.
    1687             :           !$acc parallel loop gang vector collapse(2) default(present)
    1688           0 :           do k = 1, nz
    1689           0 :             do i = 1, ngrdcol
    1690           0 :               sclrpthlp_forcing(i,k) = thlp2_forcing(i,k)
    1691             :             end do
    1692             :           end do
    1693             :           !$acc end parallel loop
    1694             : 
    1695           0 :           threshold = thl_tol**2
    1696             :         else
    1697             :           !$acc parallel loop gang vector collapse(2) default(present)
    1698           0 :           do k = 1, nz
    1699           0 :             do i = 1, ngrdcol
    1700           0 :               sclrpthlp_forcing(i,k) = zero
    1701             :             end do
    1702             :           end do
    1703             :           !$acc end parallel loop
    1704             : 
    1705           0 :           threshold = zero_threshold
    1706             :         endif
    1707             : 
    1708             :         call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_sclrpthlp, dt,     & ! In
    1709             :                            wpsclrp(:,:,sclr), wpthlp,                   & ! In
    1710             :                            sclrm(:,:,sclr), thlm, sclrpthlp(:,:,sclr),  & ! In
    1711             :                            sclrpthlp_forcing,                           & ! In
    1712             :                            C2x, invrs_tau_xp2_zm, threshold,            & ! In
    1713             :                            lhs_ta, rhs_ta_wpthlpsclrp(:,:,sclr),        & ! In
    1714             :                            stats_metadata,                              & ! In
    1715             :                            stats_zm,                                    & ! InOut
    1716           0 :                            rhs(:,:,3+sclr+2*sclr_dim) )                   ! Out
    1717             : 
    1718             :       end do ! 1..sclr_dim
    1719             :      
    1720             :     end if
    1721             :      
    1722             :     ! Solve multiple rhs with single lhs
    1723             :     call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_single_lhs, 3+3*sclr_dim,  & ! Intent(in)
    1724             :                          tridiag_solve_method,                            & ! Intent(in)
    1725             :                          stats_metadata,                                  & ! Intent(in)
    1726             :                          stats_sfc,                                       & ! intent(inout)
    1727           0 :                          rhs, lhs, solution )                               ! Intent(inout)
    1728             :                           
    1729           0 :     if ( l_lmm_stepping ) then
    1730             : 
    1731             :       !$acc parallel loop gang vector collapse(2) default(present)
    1732           0 :       do k = 1, nz
    1733           0 :         do i = 1, ngrdcol
    1734           0 :           rtp2(i,k)    = one_half * ( rtp2(i,k)     + solution(i,k,1) )
    1735           0 :           thlp2(i,k)   = one_half * ( thlp2(i,k)    + solution(i,k,2) )
    1736           0 :           rtpthlp(i,k) = one_half * ( rtpthlp(i,k)  + solution(i,k,3) )
    1737             :         end do
    1738             :       end do
    1739             :       !$acc end parallel loop
    1740             : 
    1741           0 :       if ( sclr_dim > 0 ) then
    1742             :         !$acc parallel loop gang vector collapse(3) default(present)
    1743           0 :         do sclr = 1, sclr_dim
    1744           0 :           do k = 1, nz
    1745           0 :             do i = 1, ngrdcol
    1746           0 :               sclrp2(i,k,sclr)    = one_half * ( sclrp2(i,k,sclr)    &
    1747           0 :                                                  + solution(i,k,3+sclr) )
    1748             :               sclrprtp(i,k,sclr)  = one_half * ( sclrprtp(i,k,sclr)  &
    1749           0 :                                                  + solution(i,k,3+sclr_dim+sclr) )
    1750             :               sclrpthlp(i,k,sclr) = one_half * ( sclrpthlp(i,k,sclr) &
    1751           0 :                                                  + solution(i,k,3+2*sclr_dim+sclr) )
    1752             :             end do
    1753             :           end do
    1754             :         end do
    1755             :         !$acc end parallel loop
    1756             :       endif ! sclr_dim > 0
    1757             :       
    1758             :     else
    1759             : 
    1760             :       !$acc parallel loop gang vector collapse(2) default(present)
    1761           0 :       do k = 1, nz
    1762           0 :         do i = 1, ngrdcol
    1763           0 :           rtp2(i,k)    = solution(i,k,1)
    1764           0 :           thlp2(i,k)   = solution(i,k,2)
    1765           0 :           rtpthlp(i,k) = solution(i,k,3)
    1766             :         end do
    1767             :       end do
    1768             :       !$acc end parallel loop
    1769             : 
    1770           0 :       if ( sclr_dim > 0 ) then
    1771             :         !$acc parallel loop gang vector collapse(3) default(present)
    1772           0 :         do sclr = 1, sclr_dim
    1773           0 :           do k = 1, nz
    1774           0 :             do i = 1, ngrdcol
    1775           0 :               sclrp2(i,k,sclr)     = solution(i,k,3+sclr)
    1776           0 :               sclrprtp(i,k,sclr)   = solution(i,k,3+sclr_dim+sclr)
    1777           0 :               sclrpthlp(i,k,sclr)  = solution(i,k,3+2*sclr_dim+sclr)
    1778             :             end do
    1779             :           end do
    1780             :         end do
    1781             :         !$acc end parallel loop
    1782             :       endif ! sclr_dim > 0
    1783             :       
    1784             :     endif ! l_lmm_stepping
    1785             : 
    1786           0 :     if ( stats_metadata%l_stats_samp ) then
    1787             : 
    1788             :       !$acc update host( rtp2, thlp2, rtpthlp, lhs_dp1, lhs_diff, &
    1789             :       !$acc              lhs_ta, lhs_ma )
    1790             :      
    1791           0 :       zeros(:) = zero
    1792             :      
    1793           0 :       do i = 1, ngrdcol
    1794           0 :         call xp2_xpyp_implicit_stats( nz, xp2_xpyp_rtp2, rtp2(i,:), & !intent(in)
    1795           0 :                                       lhs_dp1(i,:), zeros(:), &
    1796           0 :                                       lhs_diff(:,i,:), lhs_ta(:,i,:), lhs_ma(:,i,:), &
    1797             :                                       stats_metadata, & 
    1798           0 :                                       stats_zm(i) ) ! intent(inout)
    1799             :         call xp2_xpyp_implicit_stats( nz, xp2_xpyp_thlp2, thlp2(i,:), & !intent(in)
    1800             :                                       lhs_dp1(i,:), zeros(:), &
    1801             :                                       lhs_diff(:,i,:), lhs_ta(:,i,:), lhs_ma(:,i,:), &
    1802             :                                       stats_metadata, & 
    1803           0 :                                       stats_zm(i) ) ! intent(inout)
    1804             :         call xp2_xpyp_implicit_stats( nz, xp2_xpyp_rtpthlp, rtpthlp(i,:), & !intent(in)
    1805             :                                       lhs_dp1(i,:), zeros(:), &
    1806             :                                       lhs_diff(:,i,:), lhs_ta(:,i,:), lhs_ma(:,i,:), &
    1807             :                                       stats_metadata, & 
    1808           0 :                                       stats_zm(i) ) ! intent(inout)
    1809             :       end do
    1810             :     end if
    1811             : 
    1812             :     !$acc exit data delete( lhs, rhs, solution, lhs_dp1 )
    1813             : 
    1814             :     !$acc exit data if( sclr_dim > 0 ) &
    1815             :     !$acc           delete( sclrp2_forcing, sclrprtp_forcing, sclrpthlp_forcing )
    1816             : 
    1817           0 :     return
    1818             :       
    1819             :   end subroutine solve_xp2_xpyp_with_single_lhs
    1820             :   
    1821             :   !============================================================================================
    1822      352944 :   subroutine solve_xp2_xpyp_with_multiple_lhs( nz, ngrdcol, gr, &
    1823      352944 :                                                C2rt_1d, C2thl_1d, C2rtthl_1d, C2sclr_1d, &
    1824      352944 :                                                invrs_tau_xp2_zm, rtm, thlm, wprtp, wpthlp, &
    1825      352944 :                                                rtp2_forcing, thlp2_forcing, rtpthlp_forcing, &
    1826      352944 :                                                sclrm, wpsclrp, &
    1827      352944 :                                                lhs_ta_wprtp2, lhs_ta_wpthlp2, &
    1828      352944 :                                                lhs_ta_wprtpthlp, lhs_ta_wpsclrp2, &
    1829      352944 :                                                lhs_ta_wprtpsclrp, lhs_ta_wpthlpsclrp, &
    1830      352944 :                                                lhs_ma, lhs_diff, &
    1831      352944 :                                                rhs_ta_wprtp2, rhs_ta_wpthlp2, rhs_ta_wprtpthlp, &
    1832      352944 :                                                rhs_ta_wpsclrp2, rhs_ta_wprtpsclrp, rhs_ta_wpthlpsclrp, &
    1833             :                                                dt, iiPDF_type, l_scalar_calc, &
    1834             :                                                l_lmm_stepping, &
    1835             :                                                tridiag_solve_method, &
    1836             :                                                stats_metadata, &
    1837      352944 :                                                stats_zm, stats_sfc, & 
    1838      352944 :                                                rtp2, thlp2, rtpthlp, &
    1839      352944 :                                                sclrp2, sclrprtp, sclrpthlp )
    1840             :     ! Description:
    1841             :     !     This subroutine generates different lhs and rhs matrices to solve for.
    1842             :     !     
    1843             :     !-----------------------------------------------------------------------
    1844             :       
    1845             :     use grid_class, only: &
    1846             :         grid ! Type
    1847             :         
    1848             :     use clubb_precision, only:  & 
    1849             :         core_rknd ! Variable(s)
    1850             :         
    1851             :     use constants_clubb, only: & 
    1852             :         rt_tol, & 
    1853             :         thl_tol, &
    1854             :         zero, &
    1855             :         zero_threshold, &
    1856             :         gamma_over_implicit_ts, &
    1857             :         one_half
    1858             :       
    1859             :     use parameters_model, only: &
    1860             :         sclr_dim, & ! Variable(s)
    1861             :         sclr_tol
    1862             : 
    1863             :     use model_flags, only: &
    1864             :         iiPDF_ADG1    ! Variable(s)
    1865             :           
    1866             :     use array_index, only: &
    1867             :         iisclr_rt, &
    1868             :         iisclr_thl
    1869             : 
    1870             :     use stats_type, only: &
    1871             :         stats ! Type
    1872             : 
    1873             :     use stats_variables, only: &
    1874             :         stats_metadata_type
    1875             : 
    1876             :     implicit none
    1877             :       
    1878             :     !------------------------ Input Variables ------------------------
    1879             :     integer, intent(in) :: &
    1880             :       nz, &
    1881             :       ngrdcol
    1882             : 
    1883             :     type (grid), target, intent(in) :: gr
    1884             :       
    1885             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) ::  & 
    1886             :       C2rt_1d, C2thl_1d, C2rtthl_1d, C2sclr_1d, &
    1887             :       invrs_tau_xp2_zm, & ! Inverse time-scale for xp2 on momentum levels [1/s]
    1888             :       rtm,             & ! Total water mixing ratio (t-levs)     [kg/kg]
    1889             :       thlm,            & ! Liquid potential temp. (t-levs)       [K]
    1890             :       wprtp,           & ! <w'r_t'> (momentum levels)            [(m/s)(kg/kg)]
    1891             :       wpthlp,          & ! <w'th_l'> (momentum levels)           [(m K)/s]
    1892             :       rtp2_forcing,    & ! <r_t'^2> forcing (momentum levels)    [(kg/kg)^2/s]
    1893             :       thlp2_forcing,   & ! <th_l'^2> forcing (momentum levels)   [K^2/s]
    1894             :       rtpthlp_forcing    ! <r_t'th_l'> forcing (momentum levels) [(kg/kg)K/s]
    1895             : 
    1896             :     integer, intent(in) :: &
    1897             :       iiPDF_type    ! Selected option for the two-component normal (double
    1898             :                     ! Gaussian) PDF type to use for the w, rt, and theta-l (or
    1899             :                     ! w, chi, and eta) portion of CLUBB's multivariate,
    1900             :                     ! two-component PDF.
    1901             : 
    1902             :     logical, intent(in) :: &
    1903             :       l_scalar_calc, &
    1904             :       l_lmm_stepping
    1905             : 
    1906             :     real( kind = core_rknd ), intent(in) :: &
    1907             :       dt             ! Model timestep                                [s]
    1908             :         
    1909             :     ! Passive scalar input
    1910             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) ::  & 
    1911             :       sclrm,       & ! Mean value; pass. scalar (t-levs.) [{sclr units}]
    1912             :       wpsclrp        ! <w'sclr'> (momentum levels)        [m/s{sclr units}]
    1913             : 
    1914             :     real( kind = core_rknd ), intent(in), dimension(ndiags3,ngrdcol,nz) :: & 
    1915             :       lhs_ta_wprtp2,    & ! Turbulent advection term for <w'rt'^2>
    1916             :       lhs_ta_wpthlp2,   & ! Turbulent advection term for <w'thl'^2>
    1917             :       lhs_ta_wprtpthlp, & ! Turbulent advection term for <w'rtp'thl'>
    1918             :       lhs_diff,         & ! Diffusion contributions to lhs, dissipation term 2
    1919             :       lhs_ma              ! Mean advection contributions to lhs
    1920             : 
    1921             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
    1922             :       rhs_ta_wprtp2,    & ! For <w'rt'^2>
    1923             :       rhs_ta_wpthlp2,   & ! For <w'thl'^2>
    1924             :       rhs_ta_wprtpthlp    ! For <w'rt'thl'>
    1925             :         
    1926             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz,sclr_dim), intent(in) :: & 
    1927             :       lhs_ta_wpsclrp2,    & ! For <w'sclr'^2>
    1928             :       lhs_ta_wprtpsclrp,  & ! For <w'rt'sclr'>
    1929             :       lhs_ta_wpthlpsclrp    ! For <w'thl'sclr'>
    1930             : 
    1931             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) :: &
    1932             :       rhs_ta_wpsclrp2,    & ! For <w'sclr'^2>
    1933             :       rhs_ta_wprtpsclrp,  & ! For <w'sclr'rt'>
    1934             :       rhs_ta_wpthlpsclrp    ! For <w'sclr'thl'>
    1935             :       
    1936             :     integer, intent(in) :: &
    1937             :       tridiag_solve_method  ! Specifier for method to solve tridiagonal systems
    1938             : 
    1939             :     type (stats_metadata_type), intent(in) :: &
    1940             :       stats_metadata
    1941             : 
    1942             :     !------------------------ In/Out Variables ------------------------
    1943             :     
    1944             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
    1945             :       stats_zm, &
    1946             :       stats_sfc
    1947             : 
    1948             :     ! Input/Output variables
    1949             :     ! An attribute of (inout) is also needed to import the value of the variances
    1950             :     ! at the surface.  Brian.  12/18/05.
    1951             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  & 
    1952             :       rtp2,    & ! <r_t'^2>                      [(kg/kg)^2]
    1953             :       thlp2,   & ! <th_l'^2>                     [K^2]
    1954             :       rtpthlp    ! <r_t'th_l'>                   [(kg K)/kg]
    1955             :         
    1956             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) ::  & 
    1957             :       sclrp2, sclrprtp, sclrpthlp
    1958             :         
    1959             :     !------------------------ Local Variables ------------------------
    1960             :       
    1961             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz) ::  & 
    1962      705888 :       lhs ! Tridiagonal matrix
    1963             :       
    1964             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    1965      705888 :       rhs
    1966             :         
    1967             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    1968      705888 :       sclrp2_forcing,    & ! <sclr'^2> forcing (momentum levels)    [units vary]
    1969      705888 :       sclrprtp_forcing,  & ! <sclr'r_t'> forcing (momentum levels)  [units vary]
    1970      705888 :       sclrpthlp_forcing    ! <sclr'th_l'> forcing (momentum levels) [units vary]
    1971             :         
    1972             :     real( kind = core_rknd ), dimension(ngrdcol,nz,3*sclr_dim) ::  & 
    1973      705888 :       sclr_rhs,   & ! RHS vectors of tridiagonal system for the passive scalars
    1974      705888 :       sclr_solution ! Solution to tridiagonal system for the passive scalars
    1975             :  
    1976             :     real( kind = core_rknd ) :: & 
    1977             :       threshold     ! Minimum value for variances                   [units vary]
    1978             :       
    1979             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    1980      705888 :       lhs_dp1   ! LHS dissipation term 1
    1981             :       
    1982             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  & 
    1983      705888 :       rtp2_solution,    & ! <r_t'^2>                      [(kg/kg)^2]
    1984      705888 :       thlp2_solution,   & ! <th_l'^2>                     [K^2]
    1985      705888 :       rtpthlp_solution    ! <r_t'th_l'>                   [(kg K)/kg]
    1986             :         
    1987             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) ::  & 
    1988      705888 :       sclrp2_solution, &
    1989      705888 :       sclrprtp_solution, &
    1990      705888 :       sclrpthlp_solution
    1991             :       
    1992             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  & 
    1993      705888 :       zeros
    1994             :         
    1995             :     integer :: sclr, k, i
    1996             :       
    1997             :     !------------------------ Begin Code ------------------------
    1998             : 
    1999             :     !$acc enter data  create( lhs, rhs, threshold, lhs_dp1, rtp2_solution, &
    2000             :     !$acc                     thlp2_solution, rtpthlp_solution )
    2001             : 
    2002             :     !$acc enter data if( sclr_dim > 0 ) &
    2003             :     !$acc            create( sclrprtp_solution, sclrpthlp_solution, sclr_solution, &
    2004             :     !$acc                    sclr_rhs, sclrp2_forcing, sclrprtp_forcing, sclrpthlp_forcing, &
    2005             :     !$acc                    sclrp2_solution )
    2006             : 
    2007             :     !!!!!***** r_t'^2 *****!!!!!
    2008             :     call term_dp1_lhs( nz, ngrdcol, &
    2009             :                        C2rt_1d, invrs_tau_xp2_zm, &
    2010      352944 :                        lhs_dp1 )
    2011             : 
    2012             :     !$acc parallel loop gang vector collapse(2) default(present)
    2013    29647296 :     do k = 2, nz-1
    2014   489500496 :       do i = 1, ngrdcol
    2015   489147552 :         lhs_dp1(i,k) = lhs_dp1(i,k) * gamma_over_implicit_ts
    2016             :       end do
    2017             :     end do
    2018             :     !$acc end parallel loop
    2019             :       
    2020             :     ! Implicit contributions to term rtp2
    2021             :     call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
    2022             :                        lhs_ta_wprtp2, lhs_ma, lhs_diff, lhs_dp1, & ! In
    2023      352944 :                        lhs ) ! Out
    2024             : 
    2025             :     call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_rtp2, dt, & ! In
    2026             :                        wprtp, wprtp, & ! In
    2027             :                        rtm, rtm, rtp2, rtp2_forcing, & ! In
    2028             :                        C2rt_1d, invrs_tau_xp2_zm, rt_tol**2, & ! In
    2029             :                        lhs_ta_wprtp2, rhs_ta_wprtp2, & ! In
    2030             :                        stats_metadata, & ! In
    2031             :                        stats_zm, & ! intent(inout)
    2032      352944 :                        rhs ) ! Out
    2033             :                            
    2034             :     ! Solve the tridiagonal system
    2035             :     call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_rtp2, 1, & ! Intent(in)
    2036             :                          tridiag_solve_method,          & ! Intent(in)
    2037             :                          stats_metadata,                & ! Intent(in)
    2038             :                          stats_sfc,                     & ! intent(inout)
    2039      352944 :                          rhs, lhs, rtp2_solution )        ! Intent(inout)
    2040             :                            
    2041      352944 :     if ( l_lmm_stepping ) then
    2042             :       !$acc parallel loop gang vector collapse(2) default(present)
    2043           0 :       do k = 1, nz
    2044           0 :         do i = 1, ngrdcol
    2045           0 :           rtp2(i,k) = one_half * ( rtp2(i,k) + rtp2_solution(i,k) )
    2046             :         end do
    2047             :       end do
    2048             :       !$acc end parallel loop
    2049             :     else
    2050             :       !$acc parallel loop gang vector collapse(2) default(present)
    2051    30353184 :       do k = 1, nz
    2052   501287184 :         do i = 1, ngrdcol
    2053   500934240 :           rtp2(i,k) = rtp2_solution(i,k)
    2054             :         end do
    2055             :       end do
    2056             :       !$acc end parallel loop
    2057             :     endif ! l_lmm_stepping
    2058             :    
    2059      352944 :     if ( stats_metadata%l_stats_samp ) then
    2060             : 
    2061             :       !$acc update host( rtp2, lhs_dp1, lhs_diff, lhs_ta_wprtp2, lhs_ma )
    2062             : 
    2063           0 :       zeros(:,:) = zero
    2064           0 :       do i = 1, ngrdcol
    2065           0 :         call xp2_xpyp_implicit_stats( nz, xp2_xpyp_rtp2, rtp2(i,:), & !intent(in)
    2066           0 :                                       lhs_dp1(i,:), zeros(i,:), &
    2067           0 :                                       lhs_diff(:,i,:), lhs_ta_wprtp2(:,i,:), lhs_ma(:,i,:), &
    2068             :                                       stats_metadata, & 
    2069           0 :                                       stats_zm(i) ) ! intent(inout)
    2070             :       end do
    2071             :     end if
    2072             :       
    2073             :     !!!!!***** th_l'^2 *****!!!!!
    2074             :     call term_dp1_lhs( nz, ngrdcol, &
    2075             :                        C2thl_1d, invrs_tau_xp2_zm, &
    2076      352944 :                        lhs_dp1 )
    2077             : 
    2078             :     !$acc parallel loop gang vector collapse(2) default(present)
    2079    29647296 :     do k = 2, nz-1
    2080   489500496 :       do i = 1, ngrdcol
    2081   489147552 :         lhs_dp1(i,k) = lhs_dp1(i,k) * gamma_over_implicit_ts
    2082             :       end do
    2083             :     end do
    2084             :     !$acc end parallel loop
    2085             : 
    2086             :     ! Implicit contributions to term thlp2
    2087             :     call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
    2088             :                        lhs_ta_wpthlp2, lhs_ma, lhs_diff, lhs_dp1, & ! In
    2089      352944 :                        lhs ) ! Out
    2090             : 
    2091             :     ! Explicit contributions to thlp2
    2092             :     call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_thlp2, dt, & ! In
    2093             :                        wpthlp, wpthlp, & ! In
    2094             :                        thlm, thlm, thlp2, thlp2_forcing, & ! In
    2095             :                        C2thl_1d, invrs_tau_xp2_zm, thl_tol**2, & ! In
    2096             :                        lhs_ta_wpthlp2, rhs_ta_wpthlp2, & ! In
    2097             :                        stats_metadata, & ! In
    2098             :                        stats_zm, & ! intent(inout)
    2099      352944 :                        rhs ) ! Out
    2100             : 
    2101             :     ! Solve the tridiagonal system
    2102             :     call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_thlp2, 1,  & ! Intent(in)
    2103             :                          tridiag_solve_method,            & ! Intent(in)
    2104             :                          stats_metadata,                  & ! Intent(in)
    2105             :                          stats_sfc,                       & ! intent(inout)
    2106      352944 :                          rhs, lhs, thlp2_solution )         ! Intent(inout)
    2107             :                            
    2108      352944 :     if ( l_lmm_stepping ) then
    2109             :       !$acc parallel loop gang vector collapse(2) default(present)
    2110           0 :       do k = 1, nz
    2111           0 :         do i = 1, ngrdcol
    2112           0 :           thlp2(i,k) = one_half * ( thlp2(i,k) + thlp2_solution(i,k) )
    2113             :         end do
    2114             :       end do
    2115             :       !$acc end parallel loop
    2116             :     else
    2117             :       !$acc parallel loop gang vector collapse(2) default(present)
    2118    30353184 :       do k = 1, nz
    2119   501287184 :         do i = 1, ngrdcol
    2120   500934240 :           thlp2(i,k) = thlp2_solution(i,k)
    2121             :         end do
    2122             :       end do
    2123             :       !$acc end parallel loop
    2124             :     endif ! l_lmm_stepping
    2125             :    
    2126      352944 :     if ( stats_metadata%l_stats_samp ) then
    2127             : 
    2128             :       !$acc update host( thlp2, lhs_dp1, lhs_diff, lhs_ta_wpthlp2, lhs_ma )
    2129             : 
    2130           0 :       do i = 1, ngrdcol
    2131           0 :         call xp2_xpyp_implicit_stats( nz, xp2_xpyp_thlp2, thlp2(i,:), & !intent(in)
    2132           0 :                                       lhs_dp1(i,:), zeros(i,:), &
    2133           0 :                                       lhs_diff(:,i,:), lhs_ta_wpthlp2(:,i,:), lhs_ma(:,i,:), &
    2134             :                                       stats_metadata, & 
    2135           0 :                                       stats_zm(i) ) ! intent(inout)
    2136             :       end do
    2137             :     end if
    2138             : 
    2139             :     !!!!!***** r_t'th_l' *****!!!!!
    2140             :     call term_dp1_lhs( nz, ngrdcol, &
    2141             :                        C2rtthl_1d, invrs_tau_xp2_zm, &
    2142      352944 :                        lhs_dp1 )
    2143             : 
    2144             :     !$acc parallel loop gang vector collapse(2) default(present)
    2145    29647296 :     do k = 2, nz-1
    2146   489500496 :       do i = 1, ngrdcol
    2147   489147552 :         lhs_dp1(i,k) = lhs_dp1(i,k) * gamma_over_implicit_ts
    2148             :       end do
    2149             :     end do
    2150             :     !$acc end parallel loop
    2151             : 
    2152             :     ! Implicit contributions to term rtpthlp
    2153             :     call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
    2154             :                        lhs_ta_wprtpthlp, lhs_ma, lhs_diff, lhs_dp1, & ! In
    2155      352944 :                        lhs ) ! Out
    2156             : 
    2157             :     ! Explicit contributions to rtpthlp
    2158             :     call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_rtpthlp, dt, & ! In
    2159             :                        wprtp, wpthlp, & ! In
    2160             :                        rtm, thlm, rtpthlp, rtpthlp_forcing, & ! In
    2161             :                        C2rtthl_1d, invrs_tau_xp2_zm, zero_threshold, & ! In
    2162             :                        lhs_ta_wprtpthlp, rhs_ta_wprtpthlp, & ! In
    2163             :                        stats_metadata, & ! In
    2164             :                        stats_zm, & ! intent(inout)
    2165      352944 :                        rhs ) ! Out
    2166             : 
    2167             :     ! Solve the tridiagonal system
    2168             :     call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_rtpthlp, 1,  & ! Intent(in)
    2169             :                          tridiag_solve_method,              & ! Intent(in)
    2170             :                          stats_metadata,                    & ! Intent(in)
    2171             :                          stats_sfc,                         & ! intent(inout)
    2172      352944 :                          rhs, lhs, rtpthlp_solution )         ! Intent(inout)
    2173             :                            
    2174      352944 :     if ( l_lmm_stepping ) then
    2175             :       !$acc parallel loop gang vector collapse(2) default(present)
    2176           0 :       do k = 1, nz
    2177           0 :         do i = 1, ngrdcol
    2178           0 :           rtpthlp(i,k) = one_half * ( rtpthlp(i,k) + rtpthlp_solution(i,k) )
    2179             :         end do
    2180             :       end do
    2181             :       !$acc end parallel loop
    2182             :     else
    2183             :       !$acc parallel loop gang vector collapse(2) default(present)
    2184    30353184 :       do k = 1, nz
    2185   501287184 :         do i = 1, ngrdcol
    2186   500934240 :           rtpthlp(i,k) = rtpthlp_solution(i,k)
    2187             :         end do
    2188             :       end do
    2189             :       !$acc end parallel loop
    2190             :     endif ! l_lmm_stepping
    2191             :    
    2192      352944 :     if ( stats_metadata%l_stats_samp ) then
    2193             : 
    2194             :       !$acc update host( rtpthlp, lhs_dp1, lhs_diff, lhs_ta_wprtpthlp, lhs_ma )
    2195             : 
    2196           0 :       do i = 1, ngrdcol
    2197           0 :         call xp2_xpyp_implicit_stats( nz, xp2_xpyp_rtpthlp, rtpthlp(i,:), & !intent(in)
    2198           0 :                                       lhs_dp1(i,:), zeros(i,:), &
    2199           0 :                                       lhs_diff(:,i,:), lhs_ta_wprtpthlp(:,i,:), lhs_ma(:,i,:), &
    2200             :                                       stats_metadata, & 
    2201           0 :                                       stats_zm(i) ) ! intent(inout)
    2202             :       end do
    2203             :     end if
    2204             :     
    2205      352944 :     if ( l_scalar_calc ) then
    2206             : 
    2207             :       call term_dp1_lhs( nz, ngrdcol, &
    2208             :                          C2sclr_1d, invrs_tau_xp2_zm, &
    2209           0 :                          lhs_dp1 )
    2210             :       
    2211             :       !$acc parallel loop gang vector collapse(2) default(present)
    2212           0 :       do k = 1, nz
    2213           0 :         do i = 1, ngrdcol
    2214           0 :           lhs_dp1(i,k) = lhs_dp1(i,k) * gamma_over_implicit_ts
    2215             :         end do
    2216             :       end do
    2217             :       !$acc end parallel loop
    2218             : 
    2219           0 :       if ( iiPDF_type /= iiPDF_ADG1 ) then
    2220             : 
    2221             :         ! Any PDF besides ADG1 is used
    2222             : 
    2223           0 :         do sclr = 1, sclr_dim, 1
    2224             : 
    2225             :           ! Forcing for <sclr'^2>.
    2226           0 :           sclrp2_forcing(:,:) = zero
    2227             : 
    2228             :           !!!!!***** sclr'^2 *****!!!!!
    2229             :           call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
    2230             :                              lhs_ta_wpsclrp2(:,:,:,sclr), lhs_ma, lhs_diff, lhs_dp1, & ! In
    2231           0 :                              lhs ) ! Out
    2232             : 
    2233             :           call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_sclrp2, dt, & ! In
    2234             :                              wpsclrp(:,:,sclr), wpsclrp(:,:,sclr), & ! In
    2235             :                              sclrm(:,:,sclr), sclrm(:,:,sclr), & ! In
    2236             :                              sclrp2(:,:,sclr), sclrp2_forcing(:,:), & ! In
    2237           0 :                              C2sclr_1d, invrs_tau_xp2_zm(:,:), sclr_tol(sclr)**2, & ! In
    2238             :                              lhs_ta_wpsclrp2(:,:,:,sclr), rhs_ta_wpsclrp2(:,:,sclr), & ! In
    2239             :                              stats_metadata, & ! In
    2240             :                              stats_zm, & ! intent(inout)
    2241           0 :                              rhs ) ! Out
    2242             : 
    2243             :           ! Solve the tridiagonal system
    2244             :           call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_scalars, 1,      & ! Intent(in)
    2245             :                                tridiag_solve_method,                  & ! Intent(in)
    2246             :                                stats_metadata,                        & ! Intent(in)
    2247             :                                stats_sfc,                             & ! intent(inout)
    2248           0 :                                rhs, lhs, sclrp2_solution(:,:,sclr) )    ! Intent(inout)
    2249             :                                
    2250           0 :           if ( l_lmm_stepping ) then
    2251           0 :             sclrp2(:,:,sclr) = one_half * ( sclrp2(:,:,sclr) + sclrp2_solution(:,:,sclr) )
    2252             :           else
    2253           0 :             sclrp2(:,:,sclr) = sclrp2_solution(:,:,sclr)
    2254             :           endif ! l_lmm_stepping
    2255             :       
    2256             :           !!!!!***** sclr'r_t' *****!!!!!
    2257           0 :           if ( sclr == iisclr_rt ) then
    2258             :              ! In this case we're trying to emulate rt'^2 with sclr'rt', so we
    2259             :              ! handle this as we would a variance, even though generally speaking
    2260             :              ! the scalar is not rt
    2261           0 :              sclrprtp_forcing(:,:) = rtp2_forcing(:,:)
    2262           0 :              threshold = rt_tol**2
    2263             :           else
    2264           0 :              sclrprtp_forcing(:,:) = zero
    2265           0 :              threshold = zero_threshold
    2266             :           endif
    2267             :           
    2268             :           call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
    2269             :                              lhs_ta_wprtpsclrp(:,:,:,sclr), lhs_ma, lhs_diff, lhs_dp1, & ! In
    2270           0 :                              lhs ) ! Out
    2271             : 
    2272             :           call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_sclrprtp, dt, & ! In
    2273             :                              wpsclrp(:,:,sclr), wprtp, & ! In
    2274             :                              sclrm(:,:,sclr), rtm, sclrprtp(:,:,sclr), & ! In
    2275             :                              sclrprtp_forcing, & ! In
    2276             :                              C2sclr_1d, invrs_tau_xp2_zm, threshold, & ! In
    2277             :                              lhs_ta_wprtpsclrp(:,:,:,sclr), rhs_ta_wprtpsclrp(:,:,sclr), & ! In
    2278             :                              stats_metadata, & ! In
    2279             :                              stats_zm, & ! intent(inout)
    2280           0 :                              rhs ) ! Out
    2281             : 
    2282             :           ! Solve the tridiagonal system
    2283             :           call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_scalars, 1,        & ! Intent(in)
    2284             :                                tridiag_solve_method,                    & ! Intent(in)
    2285             :                                stats_metadata,                          & ! Intent(in)
    2286             :                                stats_sfc,                               & ! intent(inout)
    2287           0 :                                rhs, lhs, sclrprtp_solution(:,:,sclr) )    ! Intent(inout)
    2288             :                                
    2289           0 :           if ( l_lmm_stepping ) then
    2290           0 :             sclrprtp(:,:,sclr) = one_half * ( sclrprtp(:,:,sclr) + sclrprtp_solution(:,:,sclr) )
    2291             :           else
    2292           0 :             sclrprtp(:,:,sclr) = sclrprtp_solution(:,:,sclr)
    2293             :           endif ! l_lmm_stepping
    2294             :       
    2295             :           !!!!!***** sclr'th_l' *****!!!!!
    2296             : 
    2297           0 :           if ( sclr == iisclr_thl ) then
    2298             :             ! In this case we're trying to emulate thl'^2 with sclr'thl', so we
    2299             :             ! handle this as we did with sclr_rt, above.
    2300           0 :             sclrpthlp_forcing(:,:) = thlp2_forcing(:,:)
    2301           0 :             threshold = thl_tol**2
    2302             :           else
    2303           0 :             sclrpthlp_forcing(:,:) = zero
    2304           0 :             threshold = zero_threshold
    2305             :           endif
    2306             : 
    2307             :           call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
    2308             :                              lhs_ta_wpthlpsclrp(:,:,:,sclr), lhs_ma, lhs_diff, lhs_dp1, & ! In
    2309           0 :                              lhs ) ! Out
    2310             : 
    2311             :           call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_sclrpthlp, dt, & ! In
    2312             :                              wpsclrp(:,:,sclr), wpthlp, & ! In
    2313             :                              sclrm(:,:,sclr), thlm, sclrpthlp(:,:,sclr), & ! In
    2314             :                              sclrpthlp_forcing, & ! In
    2315             :                              C2sclr_1d, invrs_tau_xp2_zm, threshold, & ! In
    2316             :                              lhs_ta_wpthlpsclrp(:,:,:,sclr), rhs_ta_wpthlpsclrp(:,:,sclr), & ! In
    2317             :                              stats_metadata, & ! In
    2318             :                              stats_zm, & ! intent(inout)
    2319           0 :                              rhs ) ! Out
    2320             : 
    2321             :           ! Solve the tridiagonal system
    2322             :           call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_scalars, 1,        & ! Intent(in)
    2323             :                                tridiag_solve_method,                    & ! Intent(in)
    2324             :                                stats_metadata,                          & ! Intent(in)
    2325             :                                stats_sfc,                               & ! intent(inout)
    2326           0 :                                rhs, lhs, sclrpthlp_solution(:,:,sclr) )   ! Intent(inout)
    2327             :                                
    2328           0 :           if ( l_lmm_stepping ) then
    2329           0 :             sclrpthlp(:,:,sclr) = one_half * ( sclrpthlp(:,:,sclr) + sclrpthlp_solution(:,:,sclr) )
    2330             :           else
    2331           0 :             sclrpthlp(:,:,sclr) = sclrpthlp_solution(:,:,sclr)
    2332             :           endif ! l_lmm_stepping
    2333             :       
    2334             :         enddo ! 1..sclr_dim
    2335             : 
    2336             : 
    2337             :       else ! iiPDF_type == iiPDF_ADG1
    2338             : 
    2339             :         ! The ADG1 PDF is used.
    2340             : 
    2341             :         ! Implicit contributions to passive scalars
    2342             : 
    2343             :         !!!!!***** sclr'^2, sclr'r_t', sclr'th_l' *****!!!!!
    2344             :         ! Note:  For ADG1, the LHS arrays are the same for all scalar variables,
    2345             :         !        and also for <sclr'^2>, <sclr'r_t'>, and <sclr'th_l'>.
    2346             :         call xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
    2347             :                            lhs_ta_wpsclrp2(:,:,:,1), lhs_ma, lhs_diff, lhs_dp1, & ! In
    2348           0 :                            lhs ) ! Out
    2349             : 
    2350             :         ! Explicit contributions to passive scalars
    2351           0 :         do sclr = 1, sclr_dim
    2352             : 
    2353             :           ! Forcing for <sclr'^2>.
    2354             :           !$acc parallel loop gang vector collapse(2) default(present)
    2355           0 :           do k = 1, nz
    2356           0 :             do i = 1, ngrdcol
    2357           0 :               sclrp2_forcing(i,k) = zero
    2358             :             end do
    2359             :           end do
    2360             :           !$acc end parallel loop
    2361             : 
    2362             :           !!!!!***** sclr'^2 *****!!!!!
    2363             :           call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_sclrp2, dt, & ! In
    2364             :                              wpsclrp(:,:,sclr), wpsclrp(:,:,sclr), & ! In
    2365             :                              sclrm(:,:,sclr), sclrm(:,:,sclr), & ! In
    2366             :                              sclrp2(:,:,sclr), sclrp2_forcing, & ! In
    2367           0 :                              C2sclr_1d, invrs_tau_xp2_zm, sclr_tol(sclr)**2, & ! In
    2368             :                              lhs_ta_wpsclrp2(:,:,:,1), rhs_ta_wpsclrp2(:,:,sclr), & ! In
    2369             :                              stats_metadata, & ! In
    2370             :                              stats_zm, & ! intent(inout)
    2371           0 :                              sclr_rhs(:,:,sclr) ) ! Out
    2372             : 
    2373             :           !!!!!***** sclr'r_t' *****!!!!!
    2374           0 :           if ( sclr == iisclr_rt ) then
    2375             :             ! In this case we're trying to emulate rt'^2 with sclr'rt', so we
    2376             :             ! handle this as we would a variance, even though generally speaking
    2377             :             ! the scalar is not rt
    2378             :             !$acc parallel loop gang vector collapse(2) default(present)
    2379           0 :             do k = 1, nz
    2380           0 :               do i = 1, ngrdcol
    2381           0 :                 sclrprtp_forcing(i,k) = rtp2_forcing(i,k)
    2382             :               end do
    2383             :             end do
    2384             :             !$acc end parallel loop
    2385             : 
    2386           0 :             threshold = rt_tol**2
    2387             :           else
    2388             :             !$acc parallel loop gang vector collapse(2) default(present)
    2389           0 :             do k = 1, nz
    2390           0 :               do i = 1, ngrdcol
    2391           0 :                 sclrprtp_forcing(i,k) = zero
    2392             :               end do
    2393             :             end do
    2394             :             !$acc end parallel loop
    2395             : 
    2396           0 :             threshold = zero_threshold
    2397             :           endif
    2398             :           
    2399             :           call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_sclrprtp, dt, & ! In
    2400             :                              wpsclrp(:,:,sclr), wprtp, & ! In
    2401             :                              sclrm(:,:,sclr), rtm, sclrprtp(:,:,sclr), & ! In
    2402             :                              sclrprtp_forcing, & ! In
    2403             :                              C2sclr_1d, invrs_tau_xp2_zm, threshold, & ! In
    2404             :                              lhs_ta_wpsclrp2(:,:,:,1), rhs_ta_wprtpsclrp(:,:,sclr), & ! In
    2405             :                              stats_metadata, & ! In
    2406             :                              stats_zm, & ! intent(inout)
    2407           0 :                              sclr_rhs(:,:,sclr+sclr_dim) ) ! Out
    2408             : 
    2409             :           !!!!!***** sclr'th_l' *****!!!!!
    2410             : 
    2411           0 :           if ( sclr == iisclr_thl ) then
    2412             :             ! In this case we're trying to emulate thl'^2 with sclr'thl', so we
    2413             :             ! handle this as we did with sclr_rt, above.
    2414             :             !$acc parallel loop gang vector collapse(2) default(present)
    2415           0 :             do k = 1, nz
    2416           0 :               do i = 1, ngrdcol
    2417           0 :                 sclrpthlp_forcing(i,k) = thlp2_forcing(i,k)
    2418             :               end do
    2419             :             end do
    2420             :             !$acc end parallel loop
    2421             : 
    2422           0 :             threshold = thl_tol**2
    2423             :           else
    2424             :             !$acc parallel loop gang vector collapse(2) default(present)
    2425           0 :             do k = 1, nz
    2426           0 :               do i = 1, ngrdcol
    2427           0 :                 sclrpthlp_forcing(i,k) = zero
    2428             :               end do
    2429             :             end do
    2430             :             !$acc end parallel loop
    2431             : 
    2432           0 :             threshold = zero_threshold
    2433             :           endif
    2434             : 
    2435             :           call xp2_xpyp_rhs( nz, ngrdcol, gr, xp2_xpyp_sclrpthlp, dt, & ! In
    2436             :                              wpsclrp(:,:,sclr), wpthlp, & ! In
    2437             :                              sclrm(:,:,sclr), thlm, sclrpthlp(:,:,sclr), & ! In
    2438             :                              sclrpthlp_forcing, & ! In
    2439             :                              C2sclr_1d, invrs_tau_xp2_zm, threshold, & ! In
    2440             :                              lhs_ta_wpsclrp2(:,:,:,1), rhs_ta_wpthlpsclrp(:,:,sclr), & ! In
    2441             :                              stats_metadata, & ! In
    2442             :                              stats_zm, & ! intent(inout)
    2443           0 :                              sclr_rhs(:,:,sclr+2*sclr_dim) ) ! Out
    2444             : 
    2445             :         enddo ! 1..sclr_dim
    2446             : 
    2447             :         ! Solve the tridiagonal system
    2448             :         call xp2_xpyp_solve( nz, ngrdcol, xp2_xpyp_scalars, 3*sclr_dim, & ! Intent(in)
    2449             :                              tridiag_solve_method,                      & ! Intent(in)
    2450             :                              stats_metadata,                            & ! Intent(in)
    2451             :                              stats_sfc,                                 & ! intent(inout)
    2452           0 :                              sclr_rhs, lhs, sclr_solution )               ! Intent(inout)
    2453             :         
    2454           0 :         if ( l_lmm_stepping ) then
    2455             : 
    2456             :           !$acc parallel loop gang vector collapse(3) default(present)
    2457           0 :           do sclr = 1, sclr_dim
    2458           0 :             do k = 1, nz
    2459           0 :               do i = 1, ngrdcol
    2460           0 :                 sclrp2(i,k,sclr)    = one_half * ( sclrp2(i,k,sclr)    &
    2461           0 :                                                    + sclr_solution(i,k,sclr) )
    2462             :                 sclrprtp(i,k,sclr)  = one_half * ( sclrprtp(i,k,sclr)  &
    2463           0 :                                                    + sclr_solution(i,k,sclr_dim+sclr) )
    2464             :                 sclrpthlp(i,k,sclr) = one_half * ( sclrpthlp(i,k,sclr) &
    2465           0 :                                                    + sclr_solution(i,k,2*sclr_dim+sclr) )
    2466             :               end do
    2467             :             end do
    2468             :           end do
    2469             :           !$acc end parallel loop
    2470             : 
    2471             :         else
    2472             : 
    2473             :           !$acc parallel loop gang vector collapse(3) default(present)
    2474           0 :           do sclr = 1, sclr_dim
    2475           0 :             do k = 1, nz
    2476           0 :               do i = 1, ngrdcol
    2477           0 :                 sclrp2(i,k,sclr)    = sclr_solution(i,k,sclr)
    2478           0 :                 sclrprtp(i,k,sclr)  = sclr_solution(i,k,sclr_dim+sclr)
    2479           0 :                 sclrpthlp(i,k,sclr) = sclr_solution(i,k,2*sclr_dim+sclr)
    2480             :               end do
    2481             :             end do
    2482             :           end do
    2483             :           !$acc end parallel loop
    2484             :         endif ! l_lmm_stepping
    2485             : 
    2486             : 
    2487             :       endif ! iiPDF_type
    2488             : 
    2489             :     end if
    2490             : 
    2491             :     !$acc exit data delete( lhs, rhs, threshold, lhs_dp1, rtp2_solution, &
    2492             :     !$acc                     thlp2_solution, rtpthlp_solution )
    2493             : 
    2494             :     !$acc exit data if( sclr_dim > 0 ) &
    2495             :     !$acc           delete( sclrprtp_solution, sclrpthlp_solution, sclr_solution, &
    2496             :     !$acc                   sclr_rhs, sclrp2_forcing, sclrprtp_forcing, sclrpthlp_forcing, &
    2497             :     !$acc                   sclrp2_solution )
    2498             : 
    2499      352944 :     return
    2500             :       
    2501             :   end subroutine solve_xp2_xpyp_with_multiple_lhs
    2502             : 
    2503             :   !=============================================================================
    2504     1411776 :   subroutine xp2_xpyp_lhs( nz, ngrdcol, dt, & ! In
    2505     1411776 :                            lhs_ta, lhs_ma, lhs_diff, lhs_dp1, & ! In
    2506     1411776 :                            lhs ) ! Out
    2507             : 
    2508             :   ! Description:
    2509             :   !     Compute LHS tridiagonal matrix for a variance or covariance term
    2510             :   ! 
    2511             :   ! Notes:
    2512             :   !     For LHS turbulent advection terms:
    2513             :   !         An "over-implicit" weighted time step is applied to this term.
    2514             :   !         The weight of the implicit portion of this term is controlled by
    2515             :   !         the factor gamma_over_implicit_ts (abbreviated "gamma" in the
    2516             :   !         expression below).  A factor is added to the right-hand side of
    2517             :   !         the equation in order to balance a weight that is not equal to 1,
    2518             :   !         such that:
    2519             :   !              -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS;
    2520             :   !         where X is the variable that is being solved for in a predictive
    2521             :   !         equation (<x'^2> or <x'y'> in this case), y(t) is the linearized
    2522             :   !         portion of the term that gets treated implicitly, and RHS is the
    2523             :   !         portion of the term that is always treated explicitly.  A weight
    2524             :   !         of greater than 1 can be applied to make the term more
    2525             :   !         numerically stable.
    2526             :   ! 
    2527             :   !----------------------------------------------------------------------------------
    2528             : 
    2529             :     use grid_class, only: & 
    2530             :         grid ! Type
    2531             : 
    2532             :     use constants_clubb, only:  &
    2533             :         gamma_over_implicit_ts, &
    2534             :         one, & ! constants
    2535             :         zero
    2536             : 
    2537             :     use diffusion, only:  & 
    2538             :         diffusion_zm_lhs
    2539             : 
    2540             :     use clubb_precision, only:  & 
    2541             :         core_rknd ! Variable(s)
    2542             : 
    2543             :     use advance_helper_module, only: &
    2544             :         set_boundary_conditions_lhs    ! Procedure(s)
    2545             : 
    2546             :     implicit none
    2547             : 
    2548             :     !------------------- Input Variables -------------------
    2549             :     integer, intent(in) :: &
    2550             :       nz, &
    2551             :       ngrdcol
    2552             :       
    2553             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: & 
    2554             :      lhs_ta     ! Turbulent advection contributions to lhs
    2555             : 
    2556             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: & 
    2557             :       lhs_diff, & ! Diffusion contributions to lhs, dissipation term 2
    2558             :       lhs_ma      ! Mean advection contributions to lhs
    2559             :       
    2560             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    2561             :       lhs_dp1   ! LHS dissipation term 1
    2562             : 
    2563             :     !------------------- Output Variables -------------------
    2564             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(out) :: & 
    2565             :       lhs         ! Implicit contributions to the term
    2566             : 
    2567             :     !---------------- Local Variables -------------------
    2568             :     real( kind = core_rknd ), intent(in) :: & 
    2569             :       dt
    2570             : 
    2571             :     ! Array indices
    2572             :     integer :: i, k, low_bound, high_bound
    2573             : 
    2574             :     !---------------- Begin Code -------------------
    2575             : 
    2576             :     ! Combine all lhs terms into lhs, should be fully vectorized
    2577             :     !$acc parallel loop gang vector collapse(2) default(present)    
    2578   118589184 :     do k = 2, nz-1
    2579  1958001984 :       do i = 1, ngrdcol
    2580  1839412800 :         lhs(1,i,k) = lhs_diff(1,i,k) + lhs_ma(1,i,k) + lhs_ta(1,i,k) * gamma_over_implicit_ts
    2581             : 
    2582             :         lhs(2,i,k) = lhs_diff(2,i,k) + lhs_ma(2,i,k) + lhs_ta(2,i,k) * gamma_over_implicit_ts &
    2583  1839412800 :                                                      + lhs_dp1(i,k)
    2584             :           
    2585  1956590208 :         lhs(3,i,k) = lhs_diff(3,i,k) + lhs_ma(3,i,k) + lhs_ta(3,i,k) * gamma_over_implicit_ts
    2586             :       end do
    2587             :     enddo ! k=2..gr%nz-1
    2588             :     !$acc end parallel loop
    2589             : 
    2590             :     ! LHS time tendency.
    2591             :     !$acc parallel loop gang vector collapse(2) default(present)    
    2592   118589184 :     do k =2, nz-1
    2593  1958001984 :       do i = 1, ngrdcol
    2594  1956590208 :         lhs(2,i,k) = lhs(2,i,k) + (one / dt)
    2595             :       end do
    2596             :     end do
    2597             :     !$acc end parallel loop
    2598             : 
    2599             :     ! Boundary Conditions
    2600             :     ! These are set so that the surface_varnce value of the variances and
    2601             :     ! covariances can be used at the lowest boundary and the values of those
    2602             :     ! variables can be set to their respective threshold minimum values at the
    2603             :     ! top boundary.  Fixed-point boundary conditions are used for both the
    2604             :     ! variances and the covariances.
    2605             : 
    2606             :     !$acc parallel loop gang vector default(present)    
    2607    23573376 :     do i = 1, ngrdcol
    2608             :       ! Set the lower boundaries for the first variable
    2609    22161600 :       lhs(1,i,1)  = zero
    2610    22161600 :       lhs(2,i,1)  = one
    2611    22161600 :       lhs(3,i,1)  = zero
    2612             : 
    2613             :       ! Set the upper boundaries for the first variable
    2614    22161600 :       lhs(1,i,nz) = zero
    2615    22161600 :       lhs(2,i,nz) = one
    2616    23573376 :       lhs(3,i,nz) = zero
    2617             :     end do
    2618             :     !$acc end parallel loop
    2619             : 
    2620     1411776 :     return
    2621             : 
    2622             :   end subroutine xp2_xpyp_lhs
    2623             : 
    2624             :   !=============================================================================
    2625     1411776 :   subroutine xp2_xpyp_solve( nz, ngrdcol, solve_type, nrhs, &
    2626             :                              tridiag_solve_method, & 
    2627             :                              stats_metadata, &
    2628     1411776 :                              stats_sfc, &
    2629     1411776 :                              rhs, lhs, xapxbp )
    2630             : 
    2631             :     ! Description:
    2632             :     ! Solve a tridiagonal system
    2633             :     !
    2634             :     ! References:
    2635             :     !   None
    2636             :     !-----------------------------------------------------------------------
    2637             : 
    2638             :     use constants_clubb, only: &
    2639             :         one  ! Constant(s)
    2640             : 
    2641             :     use matrix_solver_wrapper, only:  & 
    2642             :         tridiag_solve ! Procedure(s)
    2643             : 
    2644             :     use grid_class, only: & 
    2645             :         grid ! Type
    2646             : 
    2647             :     use stats_type_utilities, only: & 
    2648             :         stat_update_var_pt  ! Procedure(s)
    2649             : 
    2650             :     use stats_variables, only: & 
    2651             :         stats_metadata_type
    2652             : 
    2653             :     use clubb_precision, only: &
    2654             :         core_rknd ! Variable(s)
    2655             : 
    2656             :     use stats_type, only: stats ! Type
    2657             : 
    2658             :     implicit none
    2659             : 
    2660             :     ! External
    2661             :     intrinsic :: trim
    2662             : 
    2663             :     ! Constant parameters
    2664             :     integer, parameter :: & 
    2665             :       kp1_mdiag = 1, & ! Momentum superdiagonal index.
    2666             :       k_mdiag   = 2, & ! Momentum main diagonal index.
    2667             :       km1_mdiag = 3    ! Momentum subdiagonal index.
    2668             : 
    2669             :     ! ---------------------- Input variables ----------------------
    2670             :     integer, intent(in) :: &
    2671             :       nz, &
    2672             :       ngrdcol
    2673             :       
    2674             :     integer, intent(in) :: &
    2675             :       nrhs  ! Number of right hand side vectors
    2676             : 
    2677             :     integer, intent(in) ::  & 
    2678             :       solve_type ! Variable(s) description
    2679             : 
    2680             :     integer, intent(in) :: &
    2681             :       tridiag_solve_method  ! Specifier for method to solve tridiagonal systems
    2682             : 
    2683             :     type (stats_metadata_type), intent(in) :: &
    2684             :       stats_metadata
    2685             : 
    2686             :     ! ---------------------- Input/Ouput variables ----------------------
    2687             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
    2688             :       stats_sfc
    2689             :       
    2690             :     real( kind = core_rknd ), dimension(ngrdcol,nz,nrhs), intent(inout) :: & 
    2691             :       rhs  ! Explicit contributions to x variance/covariance term [units vary]
    2692             : 
    2693             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(inout) :: & 
    2694             :       lhs  ! Implicit contributions to x variance/covariance term [units vary]
    2695             : 
    2696             :     ! ---------------------- Output Variables ----------------------
    2697             :     real( kind = core_rknd ), dimension(ngrdcol,nz,nrhs), intent(out) ::  & 
    2698             :       xapxbp ! Computed value of the variable(s) at <t+1> [units vary]
    2699             : 
    2700             :     ! ---------------------- Local variables ----------------------
    2701     2823552 :     real( kind = core_rknd ), dimension(ngrdcol) :: rcond  ! Est. of the reciprocal of the condition # on the matrix
    2702             : 
    2703             :     integer ::  ixapxbp_matrix_condt_num ! Stat index
    2704             :     
    2705             :     logical :: l_single_lhs_solve
    2706             : 
    2707             :     character(len=20) :: &
    2708             :       solve_type_str ! solve_type in string format for debug output purposes
    2709             :       
    2710             :     integer :: i
    2711             : 
    2712             :     ! --- Begin Code ---
    2713             :     
    2714     1411776 :     l_single_lhs_solve = .false.
    2715             : 
    2716     1764720 :     select case ( solve_type )
    2717             :       !------------------------------------------------------------------------
    2718             :       ! Note that these are diagnostics from inverting the matrix, not a budget
    2719             :       !------------------------------------------------------------------------
    2720             :     case ( xp2_xpyp_rtp2 )
    2721      352944 :       ixapxbp_matrix_condt_num  = stats_metadata%irtp2_matrix_condt_num
    2722      352944 :       solve_type_str = "rtp2"
    2723             :     case ( xp2_xpyp_thlp2 )
    2724      352944 :       ixapxbp_matrix_condt_num  = stats_metadata%ithlp2_matrix_condt_num
    2725      352944 :       solve_type_str = "thlp2"
    2726             :     case ( xp2_xpyp_rtpthlp )
    2727      352944 :       ixapxbp_matrix_condt_num  = stats_metadata%irtpthlp_matrix_condt_num
    2728      352944 :       solve_type_str = "rtpthlp"
    2729             :     case ( xp2_xpyp_up2_vp2 )
    2730      352944 :       ixapxbp_matrix_condt_num  = stats_metadata%iup2_vp2_matrix_condt_num
    2731      352944 :       solve_type_str = "up2_vp2"
    2732             :     case ( xp2_xpyp_single_lhs )
    2733             :       ! In single solve tpype, condition number is either output for none or all 
    2734             :       ! rtp2, thlp2, and rtpthlp together
    2735             :       ixapxbp_matrix_condt_num = max( stats_metadata%irtp2_matrix_condt_num, stats_metadata%ithlp2_matrix_condt_num, &
    2736           0 :                                       stats_metadata%irtpthlp_matrix_condt_num )
    2737           0 :       l_single_lhs_solve = .true.
    2738           0 :       solve_type_str = "xp2_xpyp_single_lhs"
    2739             :     case default
    2740             :       ! No condition number is setup for the passive scalars
    2741           0 :       ixapxbp_matrix_condt_num  = 0
    2742     1411776 :       solve_type_str = "scalar"
    2743             :     end select
    2744             : 
    2745     1411776 :     if ( stats_metadata%l_stats_samp .and. ixapxbp_matrix_condt_num > 0 ) then
    2746             :       
    2747             :       call tridiag_solve( solve_type_str, tridiag_solve_method, & ! Intent(in) 
    2748             :                           ngrdcol, nz, nrhs,                    & ! Intent(in) 
    2749             :                           lhs, rhs,                             & ! Intent(inout)
    2750           0 :                           xapxbp, rcond )                         ! Intent(out)
    2751             : 
    2752           0 :       if ( l_single_lhs_solve ) then
    2753           0 :         do i = 1, ngrdcol
    2754             :           ! Single lhs solve including rtp2, thlp2, rtpthlp. Estimate for each.
    2755           0 :           call stat_update_var_pt( stats_metadata%irtp2_matrix_condt_num, 1, one / rcond(i), &  ! Intent(in)
    2756           0 :                                    stats_sfc(i) )                                ! Intent(inout)
    2757             :                                    
    2758             :           call stat_update_var_pt( stats_metadata%ithlp2_matrix_condt_num, 1, one / rcond(i), &  ! Intent(in)
    2759           0 :                                    stats_sfc(i) )                                 ! Intent(inout)
    2760             :                                    
    2761             :           call stat_update_var_pt( stats_metadata%irtpthlp_matrix_condt_num, 1, one / rcond(i), & ! Intent(in)
    2762           0 :                                    stats_sfc(i) )                                  ! Intent(inout)
    2763             :         end do
    2764             :       else
    2765             :         
    2766             :         ! Est. of the condition number of the variance LHS matrix
    2767           0 :         do i = 1, ngrdcol
    2768           0 :           call stat_update_var_pt( ixapxbp_matrix_condt_num, 1, one / rcond(i), &  ! Intent(in)
    2769           0 :                                    stats_sfc(i) )                                  ! Intent(inout)
    2770             :         end do
    2771             :                                  
    2772             :       end if
    2773             : 
    2774             :     else
    2775             :       
    2776             :       call tridiag_solve( solve_type_str, tridiag_solve_method, & ! Intent(in)
    2777             :                           ngrdcol, nz, nrhs,                    & ! Intent(in)
    2778             :                           lhs, rhs,                             & ! Intent(inout)
    2779     1411776 :                           xapxbp )                                ! Intent(out)
    2780             :     end if
    2781             : 
    2782     1411776 :     return
    2783             :   end subroutine xp2_xpyp_solve
    2784             : 
    2785             :   !=============================================================================
    2786           0 :   subroutine xp2_xpyp_implicit_stats( nz, solve_type, xapxbp, & !intent(in)
    2787           0 :                                       lhs_dp1_C14, lhs_dp1_C4, &
    2788           0 :                                       lhs_diff, lhs_ta, lhs_ma, &
    2789             :                                       stats_metadata, &
    2790             :                                       stats_zm ) ! intent(inout)
    2791             : 
    2792             :     ! Description:
    2793             :     ! Finalize implicit contributions for r_t'^2, th_l'^2, r_t'th_l',
    2794             :     ! u'^2, and v'^2.
    2795             :     !
    2796             :     ! References:
    2797             :     !   None
    2798             :     !-----------------------------------------------------------------------
    2799             : 
    2800             :     use stats_type_utilities, only: & 
    2801             :         stat_end_update_pt, & ! Procedure(s)
    2802             :         stat_update_var_pt
    2803             : 
    2804             :     use clubb_precision, only: &
    2805             :         core_rknd ! Variable(s)
    2806             :         
    2807             :     use constants_clubb, only: &
    2808             :         gamma_over_implicit_ts
    2809             : 
    2810             :     use stats_type, only: &
    2811             :         stats ! Type
    2812             : 
    2813             :     use stats_variables, only: &
    2814             :         stats_metadata_type
    2815             : 
    2816             :     implicit none
    2817             : 
    2818             :     !----------------------- Input variables -----------------------
    2819             :     integer, intent(in) :: &
    2820             :       nz
    2821             :     
    2822             :     integer, intent(in) ::  & 
    2823             :       solve_type ! Variable(s) description
    2824             : 
    2825             :     real( kind = core_rknd ), dimension(nz), intent(in) ::  & 
    2826             :       xapxbp ! Computed value of the variable at <t+1> [units vary]
    2827             :       
    2828             :     real( kind = core_rknd ), intent(in), dimension(nz) ::  & 
    2829             :       lhs_dp1_C14, & ! LHS dissipation term 1
    2830             :       lhs_dp1_C4    ! LHS dissipation term 2
    2831             :       
    2832             :     real( kind = core_rknd ), dimension(ndiags3,nz), intent(in) :: & 
    2833             :      lhs_ta     ! Turbulent advection contributions to lhs
    2834             : 
    2835             :     real( kind = core_rknd ), dimension(ndiags3,nz), intent(in) :: & 
    2836             :       lhs_diff, & ! Diffusion contributions to lhs, dissipation term 2
    2837             :       lhs_ma      ! Mean advection contributions to lhs
    2838             : 
    2839             :     type (stats_metadata_type), intent(in) :: &
    2840             :       stats_metadata
    2841             : 
    2842             :     !----------------------- InOut variables -----------------------
    2843             :     type (stats), target, intent(inout) :: &
    2844             :       stats_zm
    2845             : 
    2846             :     !----------------------- Local Variables -----------------------
    2847             :     integer :: k, kp1, km1 ! Array indices
    2848             : 
    2849             :     ! Budget indices
    2850             :     integer :: & 
    2851             :       ixapxbp_dp1, & 
    2852             :       ixapxbp_dp2, & 
    2853             :       ixapxbp_ta, & 
    2854             :       ixapxbp_ma, & 
    2855             :       ixapxbp_pr1
    2856             : 
    2857             :     !-----------------------Begin Code -----------------------
    2858             : 
    2859           0 :     select case ( solve_type )
    2860             :     case ( xp2_xpyp_rtp2 )
    2861           0 :       ixapxbp_dp1 = stats_metadata%irtp2_dp1
    2862           0 :       ixapxbp_dp2 = stats_metadata%irtp2_dp2
    2863           0 :       ixapxbp_ta  = stats_metadata%irtp2_ta
    2864           0 :       ixapxbp_ma  = stats_metadata%irtp2_ma
    2865           0 :       ixapxbp_pr1 = 0
    2866             : 
    2867             :     case ( xp2_xpyp_thlp2 )
    2868           0 :       ixapxbp_dp1 = stats_metadata%ithlp2_dp1
    2869           0 :       ixapxbp_dp2 = stats_metadata%ithlp2_dp2
    2870           0 :       ixapxbp_ta  = stats_metadata%ithlp2_ta
    2871           0 :       ixapxbp_ma  = stats_metadata%ithlp2_ma
    2872           0 :       ixapxbp_pr1 = 0
    2873             : 
    2874             :     case ( xp2_xpyp_rtpthlp )
    2875           0 :       ixapxbp_dp1 = stats_metadata%irtpthlp_dp1
    2876           0 :       ixapxbp_dp2 = stats_metadata%irtpthlp_dp2
    2877           0 :       ixapxbp_ta  = stats_metadata%irtpthlp_ta
    2878           0 :       ixapxbp_ma  = stats_metadata%irtpthlp_ma
    2879           0 :       ixapxbp_pr1 = 0
    2880             : 
    2881             :     case ( xp2_xpyp_up2 )
    2882           0 :       ixapxbp_dp1 = stats_metadata%iup2_dp1
    2883           0 :       ixapxbp_dp2 = stats_metadata%iup2_dp2
    2884           0 :       ixapxbp_ta  = stats_metadata%iup2_ta
    2885           0 :       ixapxbp_ma  = stats_metadata%iup2_ma
    2886           0 :       ixapxbp_pr1 = stats_metadata%iup2_pr1
    2887             : 
    2888             :     case ( xp2_xpyp_vp2 )
    2889           0 :       ixapxbp_dp1 = stats_metadata%ivp2_dp1
    2890           0 :       ixapxbp_dp2 = stats_metadata%ivp2_dp2
    2891           0 :       ixapxbp_ta  = stats_metadata%ivp2_ta
    2892           0 :       ixapxbp_ma  = stats_metadata%ivp2_ma
    2893           0 :       ixapxbp_pr1 = stats_metadata%ivp2_pr1
    2894             : 
    2895             :     case default ! No budgets are setup for the passive scalars
    2896           0 :       ixapxbp_dp1 = 0
    2897           0 :       ixapxbp_dp2 = 0
    2898           0 :       ixapxbp_ta  = 0
    2899           0 :       ixapxbp_ma  = 0
    2900           0 :       ixapxbp_pr1 = 0
    2901             : 
    2902             :     end select
    2903             : 
    2904           0 :     do k = 2, nz-1
    2905             : 
    2906           0 :       km1 = max( k-1, 1 )
    2907           0 :       kp1 = min( k+1, nz )
    2908             : 
    2909             :       ! x'y' term dp1 has both implicit and explicit components;
    2910             :       ! call stat_end_update_pt.
    2911             :       call stat_end_update_pt( ixapxbp_dp1, k, &          ! Intent(in)
    2912           0 :                                (-lhs_dp1_C14(k)) * xapxbp(k), & ! Intent(in)
    2913           0 :                                stats_zm )                 ! Intent(inout)
    2914             : 
    2915             :       ! x'y' term dp2 is completely implicit; call stat_update_var_pt.
    2916             :       call stat_update_var_pt( ixapxbp_dp2, k, &            ! Intent(in)
    2917           0 :                                  (-lhs_diff(3,k)) * xapxbp(km1) & ! Intent(in)
    2918             :                                + (-lhs_diff(2,k)) * xapxbp(k) & 
    2919           0 :                                + (-lhs_diff(1,k)) * xapxbp(kp1), &
    2920           0 :                                stats_zm )                   ! Intent(inout)
    2921             : 
    2922             :       ! x'y' term ta has both implicit and explicit components;
    2923             :       ! call stat_end_update_pt.
    2924             :       call stat_end_update_pt( ixapxbp_ta, k, &              ! Intent(in)
    2925           0 :                                (-gamma_over_implicit_ts * lhs_ta(3,k)) * xapxbp(km1) &  ! Intent(in)
    2926             :                              + (-gamma_over_implicit_ts * lhs_ta(2,k)) * xapxbp(k) &  
    2927             :                              + (-gamma_over_implicit_ts * lhs_ta(1,k)) * xapxbp(kp1), &
    2928           0 :                              stats_zm )                    ! Intent(inout)
    2929             : 
    2930             :       ! x'y' term ma is completely implicit; call stat_update_var_pt.
    2931             :       call stat_update_var_pt( ixapxbp_ma, k, &              ! Intent(in)
    2932           0 :                                  (-lhs_ma(3,k)) * xapxbp(km1) &  ! Intent(in)
    2933             :                                + (-lhs_ma(2,k)) * xapxbp(k) & 
    2934             :                                + (-lhs_ma(1,k)) * xapxbp(kp1), &
    2935           0 :                                stats_zm )                    ! Intent(inout)
    2936             : 
    2937             :       ! x'y' term pr1 has both implicit and explicit components;
    2938             :       ! call stat_end_update_pt.
    2939             :       call stat_end_update_pt( ixapxbp_pr1, k, &          ! Intent(in)
    2940           0 :                                (-lhs_dp1_C4(k)) * xapxbp(k), & ! Intent(in)
    2941           0 :                                stats_zm )                 ! Intent(inout)
    2942             : 
    2943             :     end do ! k=2..nz-1
    2944             : 
    2945           0 :     return
    2946             :   end subroutine xp2_xpyp_implicit_stats
    2947             : 
    2948             :   !==================================================================================
    2949      705888 :   subroutine xp2_xpyp_uv_rhs( nz, ngrdcol, gr, solve_type, dt, & ! In
    2950      705888 :                               wp2, wpthvp, & ! In
    2951      705888 :                               C4_1d, invrs_tau_C4_zm, C14_1d, invrs_tau_C14_zm, & ! In
    2952      705888 :                               xam, xbm, wpxap, wpxbp, xap2, xbp2, & ! In
    2953      705888 :                               thv_ds_zm, C4, C_uu_shr, C_uu_buoy, C14, lhs_splat_wp2, & ! In
    2954      705888 :                               lhs_ta, rhs_ta, & ! In
    2955      705888 :                               lhs_dp1_C4, lhs_dp1_C14, & ! In
    2956             :                               stats_metadata, & ! In
    2957      705888 :                               stats_zm, & ! InOut
    2958      705888 :                               rhs ) ! Out
    2959             : 
    2960             :   ! Description:
    2961             :   !     Explicit contributions to u'^2 or v'^2
    2962             :   ! 
    2963             :   ! Notes:
    2964             :   !    For LHS turbulent advection (ta) term:
    2965             :   !        An "over-implicit" weighted time step is applied to this term.
    2966             :   !        The weight of the implicit portion of this term is controlled by
    2967             :   !        the factor gamma_over_implicit_ts (abbreviated "gamma" in the
    2968             :   !        expression below).  A factor is added to the right-hand side of
    2969             :   !        the equation in order to balance a weight that is not equal to 1,
    2970             :   !        such that:
    2971             :   !             -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS;
    2972             :   !        where X is the variable that is being solved for in a predictive
    2973             :   !        equation (x'^2 or x'y' in this case), y(t) is the linearized
    2974             :   !        portion of the term that gets treated implicitly, and RHS is the
    2975             :   !        portion of the term that is always treated explicitly.  A weight
    2976             :   !        of greater than 1 can be applied to make the term more
    2977             :   !        numerically stable.
    2978             :   ! 
    2979             :   ! 
    2980             :   !   --- THIS SUBROUTINE HAS BEEN OPTIMIZED ---
    2981             :   !   Significant changes to this routine may adversely affect computational speed
    2982             :   !       - Gunther Huebler, Aug. 2018, clubb:ticket:834
    2983             :   !----------------------------------------------------------------------------------
    2984             : 
    2985             :     use grid_class, only: & 
    2986             :         grid ! Type
    2987             : 
    2988             :     use constants_clubb, only:  & 
    2989             :         gamma_over_implicit_ts, & ! Constant(s)
    2990             :         w_tol_sqd, &
    2991             :         one, &
    2992             :         two_thirds, &
    2993             :         one_third, &
    2994             :         zero
    2995             : 
    2996             :     use clubb_precision, only:  & 
    2997             :         core_rknd ! Variable(s)
    2998             : 
    2999             :     use stats_type_utilities, only: & 
    3000             :         stat_begin_update_pt, & ! Procedure(s)
    3001             :         stat_update_var_pt, &
    3002             :         stat_modify_pt
    3003             : 
    3004             :     use stats_variables, only: & 
    3005             :         stats_metadata_type
    3006             : 
    3007             :     use stats_type, only: stats ! Type
    3008             : 
    3009             :     implicit none
    3010             : 
    3011             :     !------------------- Input Variables -------------------
    3012             :     integer, intent(in) :: &
    3013             :       nz, &
    3014             :       ngrdcol
    3015             : 
    3016             :     type (grid), target, intent(in) :: gr
    3017             :     
    3018             :     integer, intent(in) :: solve_type
    3019             :       
    3020             :     ! For "over-implicit" weighted time step.
    3021             :     ! This vector holds output from the LHS (implicit) portion of a term at a
    3022             :     ! given vertical level.  This output is weighted and applied to the RHS.
    3023             :     ! This is used if the implicit portion of the term is "over-implicit", which
    3024             :     ! means that the LHS contribution is given extra weight (>1) in order to
    3025             :     ! increase numerical stability.  A weighted factor must then be applied to
    3026             :     ! the RHS in order to balance the weight.
    3027             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: & 
    3028             :       lhs_ta     ! LHS turbulent advection term
    3029             : 
    3030             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: & 
    3031             :       rhs_ta,           & ! RHS turbulent advection terms
    3032             :       wp2,              & ! w'^2 (momentum levels)                      [m^2/s^2]
    3033             :       wpthvp,           & ! w'th_v' (momentum levels)                     [K m/s]
    3034             :       C4_1d,            & ! C4 in a 1-d array                                 [-]
    3035             :       C14_1d,           & ! C14 in a 1-d array                                [-]
    3036             :       invrs_tau_C4_zm,  & ! Inverse time-scale for C4 terms on mom. levels  [1/s]
    3037             :       invrs_tau_C14_zm, & ! Inverse time-scale for C14 terms on mom. levels [1/s]
    3038             :       xam,              & ! x_am (thermodynamic levels)                     [m/s]
    3039             :       xbm,              & ! x_bm (thermodynamic levels)                     [m/s]
    3040             :       wpxap,            & ! w'x_a' (momentum levels)                    [m^2/s^2]
    3041             :       wpxbp,            & ! w'x_b' (momentum levels)                    [m^2/s^2]
    3042             :       xap2,             & ! x_a'^2 (momentum levels)                    [m^2/s^2]
    3043             :       xbp2,             & ! x_b'^2 (momentum levels)                    [m^2/s^2]
    3044             :       thv_ds_zm,        & ! Dry, base-state theta_v on momentum levs.         [K]
    3045             :       lhs_splat_wp2       ! LHS coefficient of wp2 splatting term           [1/s]
    3046             : 
    3047             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: & 
    3048             :       lhs_dp1_C4,  & ! LHS dissipation term 1, for up2 vp2 using C14
    3049             :       lhs_dp1_C14    ! LHS dissipation term 1, for up2 vp2 using C4
    3050             : 
    3051             :     real( kind = core_rknd ), intent(in) :: & 
    3052             :       C4,        & ! Model parameter C_4                         [-]
    3053             :       C_uu_shr,  & ! Model parameter C_uu_shr                    [-]
    3054             :       C_uu_buoy, & ! Model parameter C_uu_buoy                   [-]
    3055             :       C14          ! Model parameter C_{14}                      [-]
    3056             : 
    3057             :     type (stats_metadata_type), intent(in) :: &
    3058             :       stats_metadata
    3059             : 
    3060             :     !------------------- InOut Variables -------------------
    3061             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
    3062             :       stats_zm
    3063             : 
    3064             :     !------------------- Output Variables -------------------
    3065             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: & 
    3066             :       rhs    ! Explicit contributions to x variance/covariance terms
    3067             : 
    3068             :     !---------------- Local Variables -------------------
    3069             : 
    3070             :     ! Array indices
    3071             :     integer :: i, k
    3072             : 
    3073             :     real( kind = core_rknd ) :: tmp
    3074             : 
    3075             :     real( kind = core_rknd ), intent(in) :: & 
    3076             :       dt
    3077             :       
    3078             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3079     1411776 :       rhs_pr1, &
    3080     1411776 :       rhs_pr2
    3081             : 
    3082             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3083     1411776 :       stats_pr1, &
    3084     1411776 :       stats_pr2
    3085             : 
    3086             :     integer :: & 
    3087             :       ixapxbp_ta, & 
    3088             :       ixapxbp_tp, & 
    3089             :       ixapxbp_dp1, & 
    3090             :       ixapxbp_pr1, & 
    3091             :       ixapxbp_pr2, &
    3092             :       ixapxbp_splat
    3093             : 
    3094             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: & 
    3095     1411776 :       rhs_term_tp
    3096             : 
    3097             :     !----------------------------- Begin Code ----------------------------------
    3098             : 
    3099             :     !$acc enter data create( rhs_pr1, rhs_pr2, rhs_term_tp )
    3100             : 
    3101     1058832 :     select case ( solve_type )
    3102             :     case ( xp2_xpyp_vp2 )
    3103      352944 :       ixapxbp_ta  = stats_metadata%ivp2_ta
    3104      352944 :       ixapxbp_tp  = stats_metadata%ivp2_tp
    3105      352944 :       ixapxbp_dp1 = stats_metadata%ivp2_dp1
    3106      352944 :       ixapxbp_pr1 = stats_metadata%ivp2_pr1
    3107      352944 :       ixapxbp_pr2 = stats_metadata%ivp2_pr2
    3108      352944 :       ixapxbp_splat = stats_metadata%ivp2_splat
    3109             :     case ( xp2_xpyp_up2 )
    3110      352944 :       ixapxbp_ta  = stats_metadata%iup2_ta
    3111      352944 :       ixapxbp_tp  = stats_metadata%iup2_tp
    3112      352944 :       ixapxbp_dp1 = stats_metadata%iup2_dp1
    3113      352944 :       ixapxbp_pr1 = stats_metadata%iup2_pr1
    3114      352944 :       ixapxbp_pr2 = stats_metadata%iup2_pr2
    3115      352944 :       ixapxbp_splat = stats_metadata%iup2_splat
    3116             :     case default ! No budgets for passive scalars
    3117           0 :       ixapxbp_ta  = 0
    3118           0 :       ixapxbp_tp  = 0
    3119           0 :       ixapxbp_dp1 = 0
    3120           0 :       ixapxbp_pr1 = 0
    3121           0 :       ixapxbp_pr2 = 0
    3122      705888 :       ixapxbp_splat = 0
    3123             :     end select
    3124             : 
    3125             :     ! Vertical compression of eddies causes gustiness (increase in up2 and vp2)
    3126             :     ! Add half the contribution to up2 and half to vp2
    3127             :     !$acc parallel loop gang vector collapse(2) default(present)
    3128    59294592 :     do k = 2, nz-1
    3129   979000992 :       do i = 1, ngrdcol
    3130   978295104 :         rhs(i,k) = rhs_ta(i,k) + 0.5_core_rknd * lhs_splat_wp2(i,k) * wp2(i,k)
    3131             :       end do
    3132             :     end do
    3133             :     !$acc end parallel loop
    3134             : 
    3135             :     ! Calculate RHS pressure term 1 (pr1).
    3136             :     call term_pr1( nz, ngrdcol, C4, C14, xbp2, &
    3137             :                    wp2, invrs_tau_C4_zm, invrs_tau_C14_zm, &
    3138      705888 :                    rhs_pr1 )
    3139             : 
    3140             :     ! Calculate RHS pressure term 2 (pr2).
    3141             :     call term_pr2( nz, ngrdcol, gr, &
    3142             :                    C_uu_shr, C_uu_buoy, thv_ds_zm, wpthvp, wpxap, &
    3143             :                    wpxbp, xam, xbm, &
    3144      705888 :                    rhs_pr2 )
    3145             : 
    3146             :     ! RHS turbulent production (tp) term.
    3147             :     ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:up2_pr 
    3148             :     call term_tp_rhs( nz, ngrdcol, xam, xam,  & 
    3149             :                       wpxap, wpxap, gr%invrs_dzm, &
    3150      705888 :                       rhs_term_tp )
    3151             : 
    3152             :     ! Finish RHS calc with vectorizable loop, functions are in source file and should
    3153             :     ! be inlined with an -O2 or above compiler optimization flag
    3154             :     !$acc parallel loop gang vector collapse(2) default(present)
    3155    59294592 :     do k = 2, nz-1, 1
    3156   979000992 :       do i = 1, ngrdcol
    3157             :         
    3158  1839412800 :         rhs(i,k) = rhs(i,k) + ( one - gamma_over_implicit_ts ) &
    3159   919706400 :                              * ( - lhs_ta(1,i,k) * xap2(i,k+1) &
    3160             :                                  - lhs_ta(2,i,k) * xap2(i,k) &
    3161  3678825600 :                                  - lhs_ta(3,i,k) * xap2(i,k-1) )
    3162             : 
    3163             :         ! RHS turbulent production (tp) term.
    3164             :         ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:up2_pr 
    3165   919706400 :         rhs(i,k) = rhs(i,k) + ( one - C_uu_shr ) * rhs_term_tp(i,k)
    3166             : 
    3167             :         ! RHS pressure term 1 (pr1) (and dissipation term 1 (dp1)).
    3168   919706400 :         rhs(i,k) = rhs(i,k) + rhs_pr1(i,k)
    3169             : 
    3170             :         ! RHS contribution from "over-implicit" weighted time step
    3171             :         ! for LHS dissipation term 1 (dp1) and pressure term 1 (pr1).
    3172             :         rhs(i,k) = rhs(i,k) + ( one - gamma_over_implicit_ts ) &
    3173   919706400 :                               * ( - lhs_dp1_C4(i,k) - lhs_dp1_C14(i,k) ) * xap2(i,k)
    3174             : 
    3175             :         ! RHS pressure term 2 (pr2).
    3176   978295104 :         rhs(i,k) = rhs(i,k) + rhs_pr2(i,k)
    3177             :                                   
    3178             :       end do                    
    3179             :     end do ! k=2..gr%nz-1
    3180             :     !$acc end parallel loop
    3181             : 
    3182             :     ! RHS time tendency.
    3183             :     !$acc parallel loop gang vector collapse(2) default(present)
    3184    59294592 :     do k = 2, nz-1
    3185   979000992 :       do i = 1, ngrdcol
    3186   978295104 :         rhs(i,k) = rhs(i,k) + one/dt * xap2(i,k)
    3187             :       end do
    3188             :     end do
    3189             : 
    3190             :     !$acc end parallel loop
    3191      705888 :     if ( stats_metadata%l_stats_samp ) then
    3192             : 
    3193             :       !$acc update host( rhs_ta, lhs_ta, xap2, xbp2, wp2, invrs_tau_C14_zm, invrs_tau_C4_zm, &
    3194             :       !$acc              rhs_pr2, lhs_splat_wp2, rhs_term_tp, lhs_dp1_C14, lhs_dp1_C4 )
    3195             : 
    3196             :       ! Statistics: explicit contributions for up2 or vp2.
    3197             : 
    3198             :       ! x'y' term ta has both implicit and explicit components; call
    3199             :       ! stat_begin_update_pt.  Since stat_begin_update_pt automatically
    3200             :       ! subtracts the value sent in, reverse the sign on term_ta_ADG1_rhs.
    3201             : 
    3202             :       call term_pr1( nz, ngrdcol, C4, zero, xbp2, &
    3203             :                      wp2, invrs_tau_C4_zm, invrs_tau_C14_zm, &
    3204           0 :                      stats_pr1 )
    3205             : 
    3206             :       call term_pr1( nz, ngrdcol, zero, C14, xbp2, &
    3207             :                      wp2, invrs_tau_C4_zm, invrs_tau_C14_zm, &
    3208           0 :                      stats_pr2 )
    3209             : 
    3210           0 :       do k = 2, nz-1
    3211           0 :         do i = 1, ngrdcol
    3212             :           
    3213             :           call stat_begin_update_pt( ixapxbp_ta, k, &    ! Intent(in)
    3214           0 :                                      -rhs_ta(i,k), &
    3215           0 :                                      stats_zm(i) )          ! Intent(inout)
    3216             : 
    3217             :           call stat_modify_pt( ixapxbp_ta, k,  &          ! Intent(in)
    3218             :                                + ( one - gamma_over_implicit_ts )  & ! Intent(in)
    3219           0 :                                  * ( - lhs_ta(1,i,k) * xap2(i,k+1) &
    3220             :                                      - lhs_ta(2,i,k) * xap2(i,k) &
    3221           0 :                                      - lhs_ta(3,i,k) * xap2(i,k-1) ), &
    3222           0 :                                stats_zm(i) )                 ! Intent(inout)
    3223             : 
    3224           0 :           if ( ixapxbp_pr1 > 0 ) then
    3225             : 
    3226             :             call stat_begin_update_pt( ixapxbp_pr1, k,  & ! Intent(in)
    3227           0 :                                        -stats_pr1(i,k), & ! Intent(in)
    3228           0 :                                        stats_zm(i) )      ! Intent(inout)
    3229             : 
    3230             :             call stat_modify_pt( ixapxbp_pr1, k,                        & ! Intent(in)
    3231             :                                  + ( one - gamma_over_implicit_ts )     & 
    3232           0 :                                    * ( - lhs_dp1_C4(i,k) * xap2(i,k) ), & ! Intent(in)
    3233           0 :                                  stats_zm(i) )                            ! Intent(inout)
    3234             : 
    3235             :           endif
    3236             : 
    3237           0 :           if ( ixapxbp_dp1 > 0 ) then
    3238             : 
    3239             :             call stat_begin_update_pt( ixapxbp_dp1, k,  & ! Intent(in)  
    3240           0 :                                        -stats_pr2(i,k), & ! Intent(in)
    3241           0 :                                        stats_zm(i) )      ! Intent(inout)
    3242             : 
    3243             :             call stat_modify_pt( ixapxbp_dp1, k,                          & ! Intent(in)
    3244             :                                   + ( one - gamma_over_implicit_ts )      &
    3245           0 :                                     * ( - lhs_dp1_C14(i,k) * xap2(i,k) ), & ! Intent(in)
    3246           0 :                                  stats_zm(i) )                              ! Intent(inout)
    3247             : 
    3248             :           endif
    3249             : 
    3250             :           ! x'y' term pr2 is completely explicit; call stat_update_var_pt.
    3251             :           call stat_update_var_pt( ixapxbp_pr2, k,  & ! Intent(in)
    3252           0 :                                    rhs_pr2(i,k),    & ! intent(in)
    3253           0 :                                    stats_zm(i))       ! intent(inout)
    3254             : 
    3255             :           ! x'y' term tp is completely explicit; call stat_update_var_pt.
    3256             :           call stat_update_var_pt( ixapxbp_tp, k,                         & ! Intent(in) 
    3257           0 :                                    ( one - C_uu_shr ) * rhs_term_tp(i,k), & ! intent(in)
    3258           0 :                                    stats_zm(i) )                            ! Intent(inout)
    3259             : 
    3260             :           ! Vertical compression of eddies.
    3261             :           call stat_update_var_pt( ixapxbp_splat, k, & ! Intent(in) 
    3262           0 :                         + 0.5_core_rknd * lhs_splat_wp2(i,k) * wp2(i,k),  & ! Intent(in)
    3263           0 :                                    stats_zm(i) )       ! Intent(inout)
    3264             :         end do
    3265             :       end do
    3266             : 
    3267             :     endif ! stats_metadata%l_stats_samp
    3268             : 
    3269             : 
    3270             :     ! Boundary Conditions
    3271             :     ! These are set so that the surface_varnce value of u'^2 or v'^2 can be
    3272             :     ! used at the lowest boundary and the values of those variables can be
    3273             :     ! set to their respective threshold minimum values at the top boundary.
    3274             :     ! Fixed-point boundary conditions are used for the variances.
    3275             :     
    3276             :     !$acc parallel loop gang vector default(present)
    3277    11786688 :     do i = 1, ngrdcol
    3278    11080800 :       rhs(i,1) = xap2(i,1)
    3279             :       ! The value of u'^2 or v'^2 at the upper boundary will be set to the
    3280             :       ! threshold minimum value of w_tol_sqd.
    3281    11786688 :       rhs(i,nz) = w_tol_sqd
    3282             :     end do
    3283             :     !$acc end parallel loop
    3284             : 
    3285             :     !$acc exit data delete( rhs_pr1, rhs_pr2, rhs_term_tp )
    3286             :     
    3287      705888 :     return
    3288             : 
    3289             :   end subroutine xp2_xpyp_uv_rhs
    3290             : 
    3291             :   !=============================================================================
    3292     1058832 :   subroutine xp2_xpyp_rhs( nz, ngrdcol, gr, solve_type, dt, & ! In
    3293     1058832 :                            wpxap, wpxbp, & ! In
    3294     1058832 :                            xam, xbm, xapxbp, xpyp_forcing, & ! In
    3295     1058832 :                            Cn, invrs_tau_zm, threshold, & ! In
    3296     1058832 :                            lhs_ta, rhs_ta, & ! In
    3297             :                            stats_metadata, & ! In
    3298     1058832 :                            stats_zm, & ! In
    3299     1058832 :                            rhs ) ! Out
    3300             : 
    3301             :   ! Description:
    3302             :   !   Explicit contributions to r_t'^2, th_l'^2, r_t'th_l', sclr'r_t',
    3303             :   !   sclr'th_l', or sclr'^2.
    3304             :   ! 
    3305             :   !   Note:  
    3306             :   !     For LHS turbulent advection term:
    3307             :   !        An "over-implicit" weighted time step is applied to this term.
    3308             :   !        The weight of the implicit portion of this term is controlled by
    3309             :   !        the factor gamma_over_implicit_ts (abbreviated "gamma" in the
    3310             :   !        expression below).  A factor is added to the right-hand side of
    3311             :   !        the equation in order to balance a weight that is not equal to 1,
    3312             :   !        such that:
    3313             :   !             -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS;
    3314             :   !        where X is the variable that is being solved for in a predictive
    3315             :   !        equation (x'^2 or x'y' in this case), y(t) is the linearized
    3316             :   !        portion of the term that gets treated implicitly, and RHS is the
    3317             :   !        portion of the term that is always treated explicitly.  A weight
    3318             :   !        of greater than 1 can be applied to make the term more
    3319             :   !        numerically stable.
    3320             :   ! 
    3321             :   !   --- THIS SUBROUTINE HAS BEEN OPTIMIZED ---
    3322             :   !   Significant changes to this routine may adversely affect computational speed
    3323             :   !       - Gunther Huebler, Aug. 2018, clubb:ticket:834
    3324             :   !----------------------------------------------------------------------------------
    3325             : 
    3326             :     use grid_class, only: & 
    3327             :         grid ! Type
    3328             : 
    3329             :     use constants_clubb, only: &
    3330             :         gamma_over_implicit_ts, & ! Constant(s)
    3331             :         one, &
    3332             :         zero
    3333             : 
    3334             :     use clubb_precision, only:  & 
    3335             :         core_rknd ! Variable(s)
    3336             : 
    3337             :     use stats_type_utilities, only: & 
    3338             :         stat_begin_update_pt, & ! Procedure(s)
    3339             :         stat_update_var_pt, &
    3340             :         stat_modify_pt
    3341             : 
    3342             :     use stats_variables, only: & 
    3343             :         stats_metadata_type
    3344             :   
    3345             :     use advance_helper_module, only: &
    3346             :         set_boundary_conditions_rhs    ! Procedure(s)
    3347             : 
    3348             :     use stats_type, only: stats ! Type
    3349             : 
    3350             :     implicit none
    3351             : 
    3352             :     !------------------- Input Variables -------------------
    3353             :     integer, intent(in) :: &
    3354             :       nz, &
    3355             :       ngrdcol
    3356             : 
    3357             :     type (grid), target, intent(in) :: gr
    3358             :     
    3359             :     integer, intent(in) :: solve_type
    3360             : 
    3361             :     real( kind = core_rknd ), intent(in) :: & 
    3362             :       dt                 ! Model timestep                              [s]
    3363             :       
    3364             :     ! For "over-implicit" weighted time step.
    3365             :     ! This vector holds output from the LHS (implicit) portion of a term at a
    3366             :     ! given vertical level.  This output is weighted and applied to the RHS.
    3367             :     ! This is used if the implicit portion of the term is "over-implicit", which
    3368             :     ! means that the LHS contribution is given extra weight (>1) in order to
    3369             :     ! increase numerical stability.  A weighted factor must then be applied to
    3370             :     ! the RHS in order to balance the weight.
    3371             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: & 
    3372             :       lhs_ta    ! LHS turbulent advection (ta) term
    3373             : 
    3374             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: & 
    3375             :       rhs_ta,                  & ! RHS turbulent advection (ta) term
    3376             :       wpxap,                   & ! w'x_a' (momentum levels)     [m/s{x_a units}]
    3377             :       wpxbp,                   & ! w'x_b' (momentum levels)     [m/s{x_b units}]
    3378             :       xam,                     & ! x_am (thermodynamic levels)     [{x_a units}]
    3379             :       xbm,                     & ! x_bm (thermodynamic levels)     [{x_b units}]
    3380             :       xapxbp,                  & ! x_a'x_b' (m-levs)          [{x_a un}{x_b un}]
    3381             :       xpyp_forcing,            & ! <x'y'> forcing (m-levs)      [{x un}{x un}/s]
    3382             :       invrs_tau_zm,            & ! Time-scale tau on momentum levels       [1/s]
    3383             :       Cn                         ! Coefficient C_n                           [-]
    3384             : 
    3385             :     real( kind = core_rknd ), intent(in) :: &
    3386             :       threshold    ! Smallest allowable mag. value for x_a'x_b'  [{x_am units}
    3387             :                    !                                              *{x_bm units}]
    3388             : 
    3389             :     type (stats_metadata_type), intent(in) :: &
    3390             :       stats_metadata
    3391             : 
    3392             :     !------------------- InOut Variables -------------------
    3393             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
    3394             :       stats_zm
    3395             : 
    3396             :     !------------------- Output Variables -------------------
    3397             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: & 
    3398             :       rhs     ! Explicit contributions to x variance/covariance terms
    3399             : 
    3400             :     !---------------- Local Variables -------------------
    3401             :     real( kind = core_rknd ) :: tmp
    3402             :     
    3403             :     real( kind = core_rknd ) :: &
    3404             :       turbulent_prod, & ! Turbulent production term  [{x_a units}*{x_b units}/s]
    3405             :       xp2_mc_limiter    ! Largest allowable (negative) mc effect
    3406             : 
    3407             :     logical :: &
    3408             :       l_clip_large_neg_mc = .false.  ! Flag to clip excessively large mc values.
    3409             : 
    3410             :     ! Fractional amount of xp2 that microphysics (mc) is allowed to deplete,
    3411             :     ! where 0 <= mc_xp2_deplete_frac <= 1.  When mc_xp2_deplete_frac has a value
    3412             :     ! of 0, microphysics is not allowed to deplete xp2 at all, and when
    3413             :     ! mc_xp2_deplete_frac has a value of 1, microphysics is allowed to deplete
    3414             :     ! xp2 down to the threshold value of x_tol^2.  This is used only when the
    3415             :     ! l_clip_large_neg_mc flag is enabled.
    3416             :     real( kind = core_rknd ), parameter :: &
    3417             :       mc_xp2_deplete_frac = 0.75_core_rknd
    3418             : 
    3419             :     ! Array indices
    3420             :     integer :: i, k, k_low, k_high
    3421             : 
    3422             :     integer :: & 
    3423             :       ixapxbp_ta, & 
    3424             :       ixapxbp_tp, & 
    3425             :       ixapxbp_tp1, & 
    3426             :       ixapxbp_tp2, &
    3427             :       ixapxbp_dp1, &
    3428             :       ixapxbp_f
    3429             : 
    3430             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: & 
    3431     2117664 :       rhs_term_tp, &
    3432     2117664 :       rhs_term_dp1, &
    3433     2117664 :       lhs_term_dp1
    3434             : 
    3435             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: & 
    3436     2117664 :       zeros_vector, &
    3437     2117664 :       stats_tp1, &
    3438     2117664 :       stats_tp2
    3439             : 
    3440             :     !------------------------------ Begin Code ---------------------------------
    3441             : 
    3442             :     !$acc enter data create( rhs_term_tp, rhs_term_dp1, lhs_term_dp1 )
    3443             : 
    3444     1411776 :     select case ( solve_type )
    3445             :     case ( xp2_xpyp_rtp2 )
    3446      352944 :       ixapxbp_ta  = stats_metadata%irtp2_ta
    3447      352944 :       ixapxbp_tp  = stats_metadata%irtp2_tp
    3448      352944 :       ixapxbp_tp1 = 0
    3449      352944 :       ixapxbp_tp2 = 0
    3450      352944 :       ixapxbp_dp1 = stats_metadata%irtp2_dp1
    3451      352944 :       ixapxbp_f   = stats_metadata%irtp2_forcing
    3452             :     case ( xp2_xpyp_thlp2 )
    3453      352944 :       ixapxbp_ta  = stats_metadata%ithlp2_ta
    3454      352944 :       ixapxbp_tp  = stats_metadata%ithlp2_tp
    3455      352944 :       ixapxbp_tp1 = 0
    3456      352944 :       ixapxbp_tp2 = 0
    3457      352944 :       ixapxbp_dp1 = stats_metadata%ithlp2_dp1
    3458      352944 :       ixapxbp_f   = stats_metadata%ithlp2_forcing
    3459             :     case ( xp2_xpyp_rtpthlp )
    3460      352944 :       ixapxbp_ta  = stats_metadata%irtpthlp_ta
    3461      352944 :       ixapxbp_tp  = 0
    3462      352944 :       ixapxbp_tp1 = stats_metadata%irtpthlp_tp1
    3463      352944 :       ixapxbp_tp2 = stats_metadata%irtpthlp_tp2
    3464      352944 :       ixapxbp_dp1 = stats_metadata%irtpthlp_dp1
    3465      352944 :       ixapxbp_f   = stats_metadata%irtpthlp_forcing
    3466             :     case default ! No budgets for passive scalars
    3467           0 :       ixapxbp_ta  = 0
    3468           0 :       ixapxbp_tp  = 0
    3469           0 :       ixapxbp_tp1 = 0
    3470           0 :       ixapxbp_tp2 = 0
    3471           0 :       ixapxbp_dp1 = 0
    3472     1058832 :       ixapxbp_f   = 0
    3473             :     end select
    3474             : 
    3475             :     ! RHS turbulent production (tp) term.
    3476             :     call term_tp_rhs( nz, ngrdcol, xam, xbm,  & 
    3477             :                       wpxbp, wpxap, gr%invrs_dzm, &
    3478     1058832 :                       rhs_term_tp )
    3479             : 
    3480             :     ! RHS dissipation term 1 (dp1)
    3481             :     call term_dp1_rhs( nz, ngrdcol, & 
    3482             :                        Cn, invrs_tau_zm, threshold, &
    3483     1058832 :                        rhs_term_dp1 )
    3484             : 
    3485             :     ! RHS contribution from "over-implicit" weighted time step
    3486             :     ! for LHS dissipation term 1 (dp1).
    3487             :     call term_dp1_lhs( nz, ngrdcol, &
    3488             :                        Cn, invrs_tau_zm, &
    3489     1058832 :                        lhs_term_dp1 )
    3490             : 
    3491             :     ! Finish RHS calc with vectorizable loop, functions are in source file and should
    3492             :     ! be inlined with an -O2 or above compiler optimization flag
    3493             :     !$acc parallel loop gang vector collapse(2) default(present)
    3494    88941888 :     do k = 2, nz-1
    3495  1468501488 :       do i = 1, ngrdcol
    3496  2759119200 :         rhs(i,k) = rhs_ta(i,k) + ( one - gamma_over_implicit_ts ) &
    3497  1379559600 :                              * ( - lhs_ta(1,i,k) * xapxbp(i,k+1) &
    3498             :                                  - lhs_ta(2,i,k) * xapxbp(i,k) &
    3499  5518238400 :                                  - lhs_ta(3,i,k) * xapxbp(i,k-1) )
    3500             : 
    3501             :         ! RHS turbulent production (tp) term.
    3502  1379559600 :         rhs(i,k) = rhs(i,k) + rhs_term_tp(i,k)
    3503             : 
    3504             :         ! RHS dissipation term 1 (dp1)
    3505  1379559600 :         rhs(i,k) = rhs(i,k) + rhs_term_dp1(i,k)
    3506             : 
    3507             :         ! RHS contribution from "over-implicit" weighted time step
    3508             :         ! for LHS dissipation term 1 (dp1).
    3509             :         rhs(i,k) = rhs(i,k)  + ( one - gamma_over_implicit_ts ) &
    3510  1467442656 :                                * ( - lhs_term_dp1(i,k) * xapxbp(i,k) )
    3511             :       end do
    3512             :     end do
    3513             :     !$acc end parallel loop
    3514             : 
    3515             :     ! RHS <x'y'> forcing.
    3516             :     ! Note: <x'y'> forcing includes the effects of microphysics on <x'y'>.
    3517             :     if ( l_clip_large_neg_mc &
    3518     1058832 :          .and. ( solve_type == xp2_xpyp_rtp2 .or. solve_type == xp2_xpyp_thlp2 ) ) then
    3519             :       !$acc parallel loop gang vector collapse(2) default(present)
    3520           0 :       do k = 2, nz-1
    3521           0 :         do i = 1, ngrdcol
    3522             : 
    3523             :           ! Limit the variance-depleting effects of excessively large
    3524             :           ! microphysics terms on rtp2 and thlp2 in order to reduce oscillations.
    3525           0 :           if ( rhs_term_tp(i,k) >= zero ) then
    3526             : 
    3527             :             ! Microphysics is allowed to deplete turbulent production and a
    3528             :             ! fraction of the variance, determined by mc_xp2_deplete_frac, down
    3529             :             ! to the threshold.
    3530             :             xp2_mc_limiter = - mc_xp2_deplete_frac &
    3531             :                            * ( xapxbp(i,k) - threshold ) / dt &
    3532           0 :                            - rhs_term_tp(i,k)
    3533             :           else
    3534             :           
    3535             :             ! Microphysics is allowed to deplete a fraction of the variance,
    3536             :             ! determined by mc_xp2_deplete_frac, down to the threshold.
    3537             :             xp2_mc_limiter = - mc_xp2_deplete_frac &
    3538           0 :                            * ( xapxbp(i,k) - threshold ) / dt
    3539             :           endif
    3540             : 
    3541             :           ! Note: the value of xp2_mc_limiter is always negative.
    3542           0 :           rhs(i,k) = rhs(i,k) + max( xpyp_forcing(i,k), xp2_mc_limiter )
    3543             :           
    3544             :         end do
    3545             :       end do
    3546             :       !$acc end parallel loop
    3547             :     else
    3548             :       !$acc parallel loop gang vector collapse(2) default(present)
    3549    88941888 :       do k = 2, nz-1
    3550  1468501488 :         do i = 1, ngrdcol
    3551  1467442656 :           rhs(i,k) = rhs(i,k) + xpyp_forcing(i,k)
    3552             :         end do
    3553             :       end do
    3554             :       !$acc end parallel loop
    3555             :     endif 
    3556             : 
    3557             :     !$acc parallel loop gang vector collapse(2) default(present)
    3558    88941888 :     do k = 2, nz-1, 1
    3559  1468501488 :       do i = 1, ngrdcol
    3560  1467442656 :         rhs(i,k) = rhs(i,k) + one/dt * xapxbp(i,k)
    3561             :       end do
    3562             :     end do
    3563             :     !$acc end parallel loop
    3564             : 
    3565     1058832 :     if ( stats_metadata%l_stats_samp ) then
    3566             : 
    3567             :       !$acc update host( rhs_ta, lhs_ta, xapxbp, Cn, invrs_tau_zm, xam, rhs_term_tp, &
    3568             :       !$acc              xbm, wpxbp, wpxap, xpyp_forcing, rhs_term_dp1, lhs_term_dp1 )
    3569             : 
    3570           0 :       zeros_vector = zero
    3571             : 
    3572             :       ! Note:  To find the contribution of x'y' term tp1, substitute 0 for all
    3573             :       !        the xam inputs and the wpxbp input to function term_tp.
    3574             :       call term_tp_rhs( nz, ngrdcol, zeros_vector, xbm,  & 
    3575             :                         zeros_vector, wpxap, gr%invrs_dzm, &
    3576           0 :                         stats_tp1 )
    3577             : 
    3578             :       ! Note:  To find the contribution of x'y' term tp2, substitute 0 for all
    3579             :       !        the xbm inputs and the wpxap input to function term_tp.
    3580             :       call term_tp_rhs( nz, ngrdcol, xam, zeros_vector,  & 
    3581             :                         wpxbp, zeros_vector, gr%invrs_dzm, &
    3582           0 :                         stats_tp2 )
    3583             : 
    3584           0 :       do k = 2, nz-1
    3585           0 :         do i = 1, ngrdcol
    3586             :           ! Statistics: explicit contributions for rtp2, thlp2, or rtpthlp.
    3587             : 
    3588             :           ! <x'y'> term ta has both implicit and explicit components; call
    3589             :           ! stat_begin_update_pt.  Since stat_begin_update_pt automatically
    3590             :           ! subtracts the value sent in, reverse the sign on term_ta_explicit_rhs.
    3591             :           call stat_begin_update_pt( ixapxbp_ta, k, & ! Intent(in)
    3592           0 :                                      -rhs_ta(i,k), &
    3593           0 :                                      stats_zm(i) )       ! Intent(inout)
    3594             : 
    3595             :           call stat_modify_pt( ixapxbp_ta, k, &             ! Intent(in)
    3596             :                                + ( one - gamma_over_implicit_ts ) & ! Intent(in)
    3597           0 :                                  * ( - lhs_ta(1,i,k) * xapxbp(i,k+1) &
    3598             :                                      - lhs_ta(2,i,k) * xapxbp(i,k) &
    3599           0 :                                      - lhs_ta(3,i,k) * xapxbp(i,k-1) ), &
    3600           0 :                                stats_zm(i) )                   ! Intent(inout)
    3601             : 
    3602             :           ! x'y' term dp1 has both implicit and explicit components; call
    3603             :           ! stat_begin_update_pt.  Since stat_begin_update_pt automatically
    3604             :           ! subtracts the value sent in, reverse the sign on term_dp1_rhs.
    3605             :           call stat_begin_update_pt( ixapxbp_dp1, k,      & ! Intent(in)
    3606           0 :                                      -rhs_term_dp1(i,k),  & ! Intent(in)
    3607           0 :                                      stats_zm(i) )          ! Intent(inout)
    3608             : 
    3609             :           ! Note:  An "over-implicit" weighted time step is applied to this term.
    3610             :           !        A weighting factor of greater than 1 may be used to make the
    3611             :           !        term more numerically stable (see note above for RHS turbulent
    3612             :           !        advection (ta) term).
    3613             :           call stat_modify_pt( ixapxbp_dp1, k,                            & ! Intent(in)
    3614             :                                + ( one - gamma_over_implicit_ts )         & 
    3615           0 :                                  * ( - lhs_term_dp1(i,k) * xapxbp(i,k) ), & ! Intent(in)
    3616           0 :                                stats_zm(i) )                                ! Intent(inout)
    3617             : 
    3618             :           ! rtp2/thlp2 case (1 turbulent production term)
    3619             :           ! x'y' term tp is completely explicit; call stat_update_var_pt.
    3620             :           call stat_update_var_pt( ixapxbp_tp, k,     & ! Intent(in)
    3621           0 :                                    rhs_term_tp(i,k),  & ! Intent(in)
    3622           0 :                                    stats_zm(i) )        ! Intent(inout)
    3623             : 
    3624             :           ! rtpthlp case (2 turbulent production terms)
    3625             :           ! x'y' term tp1 is completely explicit; call stat_update_var_pt.
    3626             :           ! Note:  To find the contribution of x'y' term tp1, substitute 0 for all
    3627             :           !        the xam inputs and the wpxbp input to function term_tp.
    3628             :           call stat_update_var_pt( ixapxbp_tp1, k,  & ! Intent(in)
    3629           0 :                                    stats_tp1(i,k),  & ! Intent(in)
    3630           0 :                                    stats_zm(i) )      ! Intent(inout)
    3631             : 
    3632             :           ! x'y' term tp2 is completely explicit; call stat_update_var_pt.
    3633             :           ! Note:  To find the contribution of x'y' term tp2, substitute 0 for all
    3634             :           !        the xbm inputs and the wpxap input to function term_tp.
    3635             :           call stat_update_var_pt( ixapxbp_tp2, k,  & ! Intent(in)
    3636           0 :                                    stats_tp2(i,k),  & ! Intent(in)
    3637           0 :                                    stats_zm(i) )      ! Intent(inout)
    3638             : 
    3639             :           ! x'y' forcing term is completely explicit; call stat_update_var_pt.
    3640             :           if ( l_clip_large_neg_mc &
    3641           0 :                .and. ( solve_type == xp2_xpyp_rtp2 &
    3642           0 :                        .or. solve_type == xp2_xpyp_thlp2 ) ) then
    3643             :              call stat_update_var_pt( ixapxbp_f, k, & ! intent(in)
    3644           0 :                                       max( xpyp_forcing(i,k), xp2_mc_limiter ), & ! intent(in)
    3645           0 :                                       stats_zm(i) ) ! intent(inout)
    3646             :           else
    3647           0 :              call stat_update_var_pt( ixapxbp_f, k, xpyp_forcing(i,k), & ! intent(in)
    3648           0 :                                       stats_zm(i) )                       ! intent(inout)
    3649             :           end if
    3650             :           
    3651             :         end do
    3652             :       end do ! k=2..gr%nz-1
    3653             :       
    3654             :     end if ! stats_metadata%l_stats_samp
    3655             : 
    3656             : 
    3657             :     ! Boundary Conditions
    3658             :     ! These are set so that the surface_varnce value of rtp2, thlp2, or rtpthlp
    3659             :     ! (or sclrp2, sclrprtp, or sclrpthlp) can be used at the lowest boundary and the
    3660             :     ! values of those variables can be set to their respective threshold minimum
    3661             :     ! values (which is 0 in the case of the covariances) at the top boundary.
    3662             :     ! Fixed-point boundary conditions are used for both the variances and the
    3663             :     ! covariances.
    3664             : 
    3665             :     ! The value of the field at the upper boundary will be set to it's threshold
    3666             :     ! minimum value, as contained in the variable 'threshold'.
    3667             :     !$acc parallel loop gang vector default(present)
    3668    17680032 :     do i = 1, ngrdcol
    3669    16621200 :       rhs(i,1) = xapxbp(i,1)
    3670    17680032 :       rhs(i,nz) = threshold
    3671             :     end do
    3672             :     !$acc end parallel loop
    3673             : 
    3674             :     !$acc exit data delete( rhs_term_tp, rhs_term_dp1, lhs_term_dp1 )
    3675             : 
    3676     1058832 :     return
    3677             : 
    3678             :   end subroutine xp2_xpyp_rhs
    3679             : 
    3680             :   !=============================================================================================
    3681      352944 :   subroutine calc_xp2_xpyp_ta_terms( nz, ngrdcol, gr, wprtp, wprtp2, wpthlp, wpthlp2, wprtpthlp, &
    3682      352944 :                                      rtp2, thlp2, rtpthlp, upwp, vpwp, up2, vp2, wp2, &
    3683      352944 :                                      wp2_zt, wpsclrp, wpsclrp2, wpsclrprtp, wpsclrpthlp, &
    3684      352944 :                                      sclrp2, sclrprtp, sclrpthlp, &
    3685      352944 :                                      rho_ds_zt, invrs_rho_ds_zm, rho_ds_zm, &
    3686      352944 :                                      wp3_on_wp2, wp3_on_wp2_zt, sigma_sqd_w, &
    3687             :                                      pdf_implicit_coefs_terms, l_scalar_calc, &
    3688             :                                      beta, iiPDF_type, l_upwind_xpyp_ta, &
    3689             :                                      l_godunov_upwind_xpyp_ta, & 
    3690             :                                      stats_metadata, &
    3691      352944 :                                      stats_zt, &
    3692      352944 :                                      lhs_ta_wprtp2, lhs_ta_wpthlp2, lhs_ta_wprtpthlp, &
    3693      352944 :                                      lhs_ta_wpup2, lhs_ta_wpvp2, lhs_ta_wpsclrp2, &
    3694      352944 :                                      lhs_ta_wprtpsclrp, lhs_ta_wpthlpsclrp, &
    3695      352944 :                                      rhs_ta_wprtp2, rhs_ta_wpthlp2, rhs_ta_wprtpthlp, &
    3696      352944 :                                      rhs_ta_wpup2, rhs_ta_wpvp2, rhs_ta_wpsclrp2, &
    3697      352944 :                                      rhs_ta_wprtpsclrp, rhs_ta_wpthlpsclrp )
    3698             :       
    3699             :       
    3700             :     ! Description:
    3701             :     !   This procedure calculates all the turbulent advection terms needed by the
    3702             :     !   various LHS and RHS matrices. In general, first the implicit coeficients are
    3703             :     !   calculated and used to calculate the LHS turbulent advection terms, then the 
    3704             :     !   explicit terms are calculated and used to calculate the RHS turbulent advection
    3705             :     !   terms.
    3706             :     !
    3707             :     !-------------------------------------------------------------------------------------------
    3708             :                                          
    3709             :     use grid_class, only: &
    3710             :         grid, & ! Type
    3711             :         zt2zm,  & ! Procedure(s)
    3712             :         zm2zt
    3713             :       
    3714             :     use clubb_precision, only: &
    3715             :         core_rknd  ! Variable(s)
    3716             :       
    3717             :     use constants_clubb, only: &
    3718             :         one, &
    3719             :         one_third, &
    3720             :         zero, &
    3721             :         zero_threshold
    3722             :       
    3723             :     use parameters_model, only: &
    3724             :         sclr_dim  ! Number of passive scalar variables
    3725             :       
    3726             :     use pdf_parameter_module, only: &
    3727             :         implicit_coefs_terms    ! Variable Type
    3728             : 
    3729             :     use turbulent_adv_pdf, only: &
    3730             :         xpyp_term_ta_pdf_lhs,         &  ! Procedures
    3731             :         xpyp_term_ta_pdf_lhs_godunov, &
    3732             :         xpyp_term_ta_pdf_rhs,         &
    3733             :         xpyp_term_ta_pdf_rhs_godunov
    3734             :       
    3735             :     use model_flags, only: &
    3736             :         iiPDF_ADG1,       & ! integer constants
    3737             :         iiPDF_new,        &
    3738             :         iiPDF_new_hybrid, &
    3739             :         l_explicit_turbulent_adv_xpyp     ! Logical constant
    3740             :       
    3741             :     use stats_variables, only: &
    3742             :         stats_metadata_type
    3743             :       
    3744             :     use stats_type_utilities, only: & 
    3745             :         stat_update_var   ! Procedure(s)
    3746             : 
    3747             :     use stats_type, only: stats ! Type
    3748             : 
    3749             :     implicit none    
    3750             : 
    3751             :     !------------------- Input Variables -------------------
    3752             :     integer, intent(in) :: &
    3753             :       nz, &
    3754             :       ngrdcol
    3755             :     
    3756             :     type (grid), target, intent(in) :: gr
    3757             :         
    3758             :     type(implicit_coefs_terms), intent(in) :: &
    3759             :       pdf_implicit_coefs_terms    ! Implicit coefs / explicit terms [units vary]
    3760             :     
    3761             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(in) :: &
    3762             :       wpsclrp,      & ! <w'sclr'> (momentum levels)        [m/s{sclr units}]
    3763             :       wpsclrp2,     & ! <w'sclr'^2> (thermodynamic levels) [m/s{sclr units}^2]
    3764             :       wpsclrprtp,   & ! <w'sclr'r_t'> (thermo. levels)     [m/s{sclr units)kg/kg]
    3765             :       wpsclrpthlp     ! <w'sclr'th_l'> (thermo. levels)    [m/s{sclr units}K]
    3766             :       
    3767             :     ! Passive scalar output
    3768             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(in) :: &
    3769             :       sclrp2,       & 
    3770             :       sclrprtp,     &
    3771             :       sclrpthlp
    3772             :     
    3773             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    3774             :       wp2,              & ! <w'^2> (momentum levels)              [m^2/s^2]
    3775             :       wp2_zt,           & ! <w'^2> interpolated to thermo. levels [m^2/s^2]
    3776             :       wprtp,            & ! <w'r_t'> (momentum levels)            [(m/s)(kg/kg)]
    3777             :       wprtp2,           & ! <w'r_t'^2> (thermodynamic levels)     [m/s (kg/kg)^2]
    3778             :       wpthlp,           & ! <w'th_l'> (momentum levels)           [(m K)/s]
    3779             :       wpthlp2,          & ! <w'th_l'^2> (thermodynamic levels)    [m/s K^2]
    3780             :       wprtpthlp,        & ! <w'r_t'th_l'> (thermodynamic levels)  [m/s (kg/kg) K]
    3781             :       rtp2,             & ! <r_t'^2>                              [(kg/kg)^2]
    3782             :       thlp2,            & ! <th_l'^2>                             [K^2]
    3783             :       rtpthlp,          & ! <r_t'th_l'>                           [(kg K)/kg]
    3784             :       upwp,             & ! <u'w'> (momentum levels)              [m^2/s^2]
    3785             :       vpwp,             & ! <v'w'> (momentum levels)              [m^2/s^2]
    3786             :       up2,              & ! <u'^2> (momentum levels)              [m^s/s^2]
    3787             :       vp2,              & ! <v'^2> (momentum levels)              [m^2/s^2]
    3788             :       rho_ds_zt,        & ! Dry, static density on thermo. levels [kg/m^3]
    3789             :       invrs_rho_ds_zm,  & ! Inv. dry, static density @ mom. levs. [m^3/kg]
    3790             :       rho_ds_zm,        & ! Dry, static density on momentum levs. [kg/m^3]
    3791             :       wp3_on_wp2,       & ! Smoothed version of <w'^3>/<w'^2> zm  [m/s]
    3792             :       wp3_on_wp2_zt,    & ! Smoothed version of <w'^3>/<w'^2> zt  [m/s]
    3793             :       sigma_sqd_w         ! sigma_sqd_w (momentum levels)         [-]
    3794             :     
    3795             :     logical, intent(in) :: &
    3796             :       l_scalar_calc
    3797             : 
    3798             :     real( kind = core_rknd ), intent(in) :: &
    3799             :       beta    ! CLUBB tunable parameter beta
    3800             : 
    3801             :     integer, intent(in) :: &
    3802             :       iiPDF_type    ! Selected option for the two-component normal (double
    3803             :                     ! Gaussian) PDF type to use for the w, rt, and theta-l (or
    3804             :                     ! w, chi, and eta) portion of CLUBB's multivariate,
    3805             :                     ! two-component PDF.
    3806             : 
    3807             :     logical, intent(in) :: &
    3808             :       l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind differencing
    3809             :                           ! approximation rather than a centered differencing for turbulent or
    3810             :                           ! mean advection terms. It affects rtp2, thlp2, up2, vp2, sclrp2,
    3811             :                           ! rtpthlp, sclrprtp, & sclrpthlp.
    3812             :       l_godunov_upwind_xpyp_ta ! This flag determines whether we want to use a Godunov-like upwind 
    3813             :                                ! approximation rather than a centered differencing for  turbulent 
    3814             :                                ! or mean advection terms. It affects rtp2, thlp2, up2, vp2, sclrp2,
    3815             :                                ! rtpthlp, sclrprtp, & sclrpthlp.
    3816             : 
    3817             :     type (stats_metadata_type), intent(in) :: &
    3818             :           stats_metadata
    3819             : 
    3820             :     !------------------- Inout Variables -------------------
    3821             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
    3822             :       stats_zt
    3823             : 
    3824             :     !------------------- Output Variables -------------------
    3825             :     
    3826             :     ! Implicit (LHS) turbulent advection terms
    3827             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(out) :: & 
    3828             :       lhs_ta_wprtp2,    & ! For <w'rt'^2>
    3829             :       lhs_ta_wpthlp2,   & ! For <w'thl'^2>
    3830             :       lhs_ta_wprtpthlp, & ! For <w'rt'thl'>
    3831             :       lhs_ta_wpup2,     & ! For <w'u'^2>
    3832             :       lhs_ta_wpvp2        ! For <w'v'^2>
    3833             :  
    3834             :     ! Explicit (RHS) turbulent advection terms
    3835             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    3836             :       rhs_ta_wprtp2,    & ! For <w'rt'^2>
    3837             :       rhs_ta_wpthlp2,   & ! For <w'thl'^2>
    3838             :       rhs_ta_wprtpthlp, & ! For <w'rt'thl'>
    3839             :       rhs_ta_wpup2,     & ! For <w'u'^2>
    3840             :       rhs_ta_wpvp2        ! For <w'v'^2>
    3841             : 
    3842             :     ! Implicit (LHS) turbulent advection terms for scalars
    3843             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz,sclr_dim), intent(out) :: & 
    3844             :       lhs_ta_wpsclrp2,    & ! For <w'sclr'^2>
    3845             :       lhs_ta_wprtpsclrp,  & ! For <w'rt'sclr'>
    3846             :       lhs_ta_wpthlpsclrp    ! For <w'thl'sclr'>
    3847             : 
    3848             :     ! Explicit (RHS) turbulent advection terms for scalars
    3849             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(out) :: &
    3850             :       rhs_ta_wpsclrp2,    & ! For <w'sclr'^2>
    3851             :       rhs_ta_wprtpsclrp,  & ! For <w'rt'sclr'>
    3852             :       rhs_ta_wpthlpsclrp    ! For <w'thl'sclr'>
    3853             : 
    3854             :     !------------------- Local Variable -------------------
    3855             :     ! Variables for turbulent advection of predictive variances and covariances.
    3856             : 
    3857             :     ! <w'rt'^2> = coef_wprtp2_implicit * <rt'^2> + term_wprtp2_explicit
    3858             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3859      705888 :       coef_wprtp2_implicit, & ! Coefficient that is multiplied by <rt'^2>  [m/s]
    3860      705888 :       term_wprtp2_explicit    ! Term that is on the RHS           [m/s(kg/kg)^2]
    3861             : 
    3862             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3863      705888 :       coef_wprtp2_implicit_zm, & ! coef_wprtp2_implicit interp. to m-levs  [m/s]
    3864      705888 :       term_wprtp2_explicit_zm    ! term_wprtp2_expl interp m-levs [m/s(kg/kg)^2]
    3865             : 
    3866             :     ! <w'thl'^2> = coef_wpthlp2_implicit * <thl'^2> + term_wpthlp2_explicit
    3867             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3868      705888 :       coef_wpthlp2_implicit, & ! Coef. that is multiplied by <thl'^2>      [m/s]
    3869      705888 :       term_wpthlp2_explicit    ! Term that is on the RHS               [m/s K^2]
    3870             : 
    3871             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3872      705888 :       coef_wpthlp2_implicit_zm, & ! coef_wpthlp2_implicit interp. m-levs   [m/s]
    3873      705888 :       term_wpthlp2_explicit_zm    ! term_wpthlp2_expl interp to m-levs [m/s K^2]
    3874             : 
    3875             :     ! <w'rt'thl'> = coef_wprtpthlp_implicit*<rt'thl'> + term_wprtpthlp_explicit
    3876             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3877      705888 :       coef_wprtpthlp_implicit, & ! Coef. that is multiplied by <rt'thl'>   [m/s]
    3878      705888 :       term_wprtpthlp_explicit    ! Term that is on the RHS         [m/s(kg/kg)K]
    3879             : 
    3880             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3881      705888 :       coef_wprtpthlp_implicit_zm, & ! coef_wprtpthlp_impl interp. m-levs   [m/s]
    3882      705888 :       term_wprtpthlp_explicit_zm    ! term_wprtpthlp_expl intrp zm [m/s(kg/kg)K]
    3883             : 
    3884             :     ! CLUBB does not produce a PDF for horizontal wind components u and v.
    3885             :     ! However, turbulent advection of the variances of the horizontal wind
    3886             :     ! components, <u'^2> and <v'^2>, is still handled by equations of the form:
    3887             :     ! <w'u'^2> = coef_wpup2_implicit * <u'^2> + term_wpup2_explicit; and
    3888             :     ! <w'v'^2> = coef_wpvp2_implicit * <v'^2> + term_wpvp2_explicit.
    3889             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3890      705888 :       coef_wpup2_implicit, & ! Coef. that is multiplied by <u'^2>  [m/s]
    3891      705888 :       term_wpup2_explicit, & ! Term that is on the RHS (<u'^2>)    [m^3/s^3]
    3892      705888 :       coef_wpvp2_implicit, & ! Coef. that is multiplied by <v'^2>  [m/s]
    3893      705888 :       term_wpvp2_explicit    ! Term that is on the RHS (<v'^2>)    [m^3/s^3]
    3894             : 
    3895             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3896      705888 :       coef_wpup2_implicit_zm, & ! coef_wpup2__impl intrp m-levs   [m/s]
    3897      705888 :       term_wpup2_explicit_zm, & ! term_wpup2_expl interp. m-levs  [m^3/s^3]
    3898      705888 :       coef_wpvp2_implicit_zm, & ! coef_wpvp2_impl intrp m-levs    [m/s]
    3899      705888 :       term_wpvp2_explicit_zm    ! term_wpvp2_expl interp. m-levs  [m^3/s^3]
    3900             : 
    3901             :     ! Sign of turbulent velocity (used for "upwind" turbulent advection)
    3902             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3903      705888 :       sgn_t_vel_rtp2,    & ! Sign of the turbulent velocity for <rt'^2>      [-]
    3904      705888 :       sgn_t_vel_thlp2,   & ! Sign of the turbulent velocity for <thl'^2>     [-]
    3905      705888 :       sgn_t_vel_rtpthlp, & ! Sign of the turbulent velocity for <rt'thl'>    [-]
    3906      705888 :       sgn_t_vel_up2,     & ! Sign of the turbulent vel. for <u'^2>           [-]
    3907      705888 :       sgn_t_vel_vp2        ! Sign of the turbulent vel. for <v'^2>           [-]
    3908             : 
    3909             :     ! <w'sclr'^2> = coef_wpsclrp2_implicit * <sclr'^2> + term_wpsclrp2_explicit
    3910             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3911      705888 :       coef_wpsclrp2_implicit, & ! Coef. that is multiplied by <sclr'^2>    [m/s]
    3912      705888 :       term_wpsclrp2_explicit    ! Term that is on the RHS    [m/s(units vary)^2]
    3913             : 
    3914             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3915      705888 :       coef_wpsclrp2_implicit_zm, & ! coef_wpsclrp2_impl interp zm   [m/s]
    3916      705888 :       term_wpsclrp2_explicit_zm    ! term_wpsclrp2_expl interp zm   [un vary]
    3917             : 
    3918             :     ! <w'rt'sclr'> = coef_wprtpsclrp_implicit * <sclr'rt'>
    3919             :     !                + term_wprtpsclrp_explicit
    3920             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3921      705888 :       coef_wprtpsclrp_implicit, & ! Coef. that is multiplied by <sclr'rt'> [m/s]
    3922      705888 :       term_wprtpsclrp_explicit    ! Term that is on the RHS [m/s(kg/kg)(un. v.)]
    3923             : 
    3924             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3925      705888 :       coef_wprtpsclrp_implicit_zm, & ! coef_wprtpsclrp_impl interp zm [m/s]
    3926      705888 :       term_wprtpsclrp_explicit_zm    ! term_wprtpsclrp_expl interp zm [un vary]
    3927             : 
    3928             :     ! <w'thl'sclr'> = coef_wpthlpsclrp_implicit * <sclr'thl'>
    3929             :     !                 + term_wpthlpsclrp_explicit
    3930             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3931      705888 :       coef_wpthlpsclrp_implicit, & ! Coef. that is mult. by <sclr'thl'>    [m/s]
    3932      705888 :       term_wpthlpsclrp_explicit    ! Term that is on the RHS  [(m/s)K(un. vary)]
    3933             : 
    3934             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3935      705888 :       coef_wpthlpsclrp_implicit_zm, & ! coef_wpsclrpthlp_impl intrp zm [m/s]
    3936      705888 :       term_wpthlpsclrp_explicit_zm    ! term_wpsclrpthlp_expl intrp zm [un vary]
    3937             : 
    3938             :     ! Sign of turbulent velocity (used for "upwind" turbulent advection)
    3939             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3940      705888 :       sgn_t_vel_sclrp2,    & ! Sign of the turbulent velocity for <sclr'^2>  [-]
    3941      705888 :       sgn_t_vel_sclrprtp,  & ! Sign of the turbulent velocity for <sclr'rt'> [-]
    3942      705888 :       sgn_t_vel_sclrpthlp    ! Sign of the turbulent vel. for <sclr'thl'>    [-]
    3943             :         
    3944             :     real ( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
    3945      705888 :       wpsclrp_zt  ! <w'sclr'> interp. to thermo. levels  [m/s {sclrm units}]
    3946             :       
    3947             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3948      705888 :       a1,       & ! a_1 (momentum levels); See eqn. 24 in `Equations for CLUBB' [-]
    3949      705888 :       a1_zt,    & ! a_1 interpolated to thermodynamic levels      [-]
    3950      705888 :       upwp_zt,  & ! <u'w'> interpolated to thermodynamic levels    [m^2/s^2]
    3951      705888 :       vpwp_zt,  & ! <v'w'> interpolated to thermodynamic levels    [m^2/s^2]
    3952      705888 :       wprtp_zt, & ! w'r_t' interpolated to thermodynamic levels   [(kg/kg) m/s]
    3953      705888 :       wpthlp_zt   ! w'th_l' interpolated to thermodyamnic levels  [K m/s]
    3954             :                     
    3955             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3956      705888 :       wp_coef, &
    3957      705888 :       wp_coef_zt
    3958             : 
    3959             :     integer :: &
    3960             :       sclr, i, b, k, l  ! Loop index
    3961             : 
    3962             :     !------------------- Begin Code -------------------
    3963             : 
    3964             :     !$acc enter data create( coef_wprtp2_implicit, term_wprtp2_explicit, &
    3965             :     !$acc                 coef_wprtp2_implicit_zm, term_wprtp2_explicit_zm, &
    3966             :     !$acc                 coef_wpthlp2_implicit, term_wpthlp2_explicit, &
    3967             :     !$acc                 term_wpthlp2_explicit_zm, &
    3968             :     !$acc                 coef_wprtpthlp_implicit, term_wprtpthlp_explicit, &
    3969             :     !$acc                 coef_wpvp2_implicit_zm, term_wprtpthlp_explicit_zm, &
    3970             :     !$acc                 coef_wpup2_implicit, term_wpup2_explicit, coef_wpvp2_implicit, &
    3971             :     !$acc                 term_wpvp2_explicit, coef_wpup2_implicit_zm, term_wpup2_explicit_zm, &
    3972             :     !$acc                 term_wpvp2_explicit_zm, sgn_t_vel_rtp2, &
    3973             :     !$acc                 sgn_t_vel_thlp2, sgn_t_vel_rtpthlp, sgn_t_vel_up2, sgn_t_vel_vp2, & 
    3974             :     !$acc                 a1, a1_zt, upwp_zt, vpwp_zt, wprtp_zt, wpthlp_zt, wp_coef, wp_coef_zt )
    3975             : 
    3976             :     !$acc enter data if( sclr_dim > 0 ) &
    3977             :     !$acc         create( coef_wpsclrp2_implicit, term_wpsclrp2_explicit, &
    3978             :     !$acc                 coef_wpsclrp2_implicit_zm, term_wpsclrp2_explicit_zm, &
    3979             :     !$acc                 coef_wprtpsclrp_implicit, term_wprtpsclrp_explicit, &
    3980             :     !$acc                 coef_wprtpsclrp_implicit_zm, term_wprtpsclrp_explicit_zm, &
    3981             :     !$acc                 coef_wpthlpsclrp_implicit, coef_wpthlpsclrp_implicit_zm, &
    3982             :     !$acc                 term_wpthlpsclrp_explicit_zm, sgn_t_vel_sclrp2, sgn_t_vel_sclrprtp, &
    3983             :     !$acc                 sgn_t_vel_sclrpthlp, wpsclrp_zt )
    3984             :     
    3985             :     ! Define a_1 (located on momentum levels).
    3986             :     ! It is a variable that is a function of sigma_sqd_w (where sigma_sqd_w is
    3987             :     ! located on the momentum levels).  This will be used for the turbulent
    3988             :     ! advection (ta) terms for the ADG1 PDF.  This will also be used for the
    3989             :     ! turbulent advection of <u'^2> and <v'^2>, regardless of which PDF type or
    3990             :     ! turbulent advection option is used.
    3991             :     !$acc parallel loop gang vector collapse(2) default(present)
    3992    30353184 :     do k = 1, nz
    3993   501287184 :       do i = 1, ngrdcol
    3994   500934240 :         a1(i,k) = one / ( one - sigma_sqd_w(i,k) )
    3995             :       end do
    3996             :     end do
    3997             :     !$acc end parallel loop
    3998             : 
    3999             :     ! Interpolate a_1 from the momentum levels to the thermodynamic levels.
    4000             :     ! Positive definite quantity
    4001      352944 :     a1_zt(:,:) = zm2zt( nz, ngrdcol, gr, a1(:,:) )
    4002             : 
    4003             :     !$acc parallel loop gang vector collapse(2) default(present)
    4004    30353184 :     do k = 1, nz
    4005   501287184 :       do i = 1, ngrdcol
    4006   500934240 :         a1_zt(i,k) = max( a1_zt(i,k), zero_threshold ) 
    4007             :       end do
    4008             :     end do
    4009             :     !$acc end parallel loop
    4010             : 
    4011             :     !$acc parallel loop gang vector collapse(2) default(present)
    4012    30353184 :     do k = 1, nz
    4013   501287184 :       do i = 1, ngrdcol
    4014   470934000 :         wp_coef(i,k)    = ( one - one_third * beta ) *    a1(i,k)**2 *    wp3_on_wp2(i,k) /    wp2(i,k)
    4015   500934240 :         wp_coef_zt(i,k) = ( one - one_third * beta ) * a1_zt(i,k)**2 * wp3_on_wp2_zt(i,k) / wp2_zt(i,k)
    4016             :       end do
    4017             :     end do
    4018             :     !$acc end parallel loop
    4019             : 
    4020             :     if ( l_explicit_turbulent_adv_xpyp ) then
    4021             :         
    4022             :       ! The turbulent advection of <x'y'> is handled explicitly, the
    4023             :       ! terms are calculated only for the RHS matrices. The 
    4024             :       ! term_wpxpyp_explicit terms are equal to <w'x'y'> as calculated using PDF
    4025             :       ! parameters, which are general for any PDF type. The values of
    4026             :       ! <w'x'y'> are calculated on thermodynamic levels.
    4027             :       
    4028             :       ! These coefficients only need to be set if stats output is on
    4029             :       if( stats_metadata%l_stats_samp ) then
    4030             :         !$acc parallel loop gang vector collapse(2) default(present)
    4031             :         do k = 1, nz
    4032             :           do i = 1, ngrdcol
    4033             :             coef_wprtp2_implicit(i,k) = zero
    4034             :             coef_wpthlp2_implicit(i,k) = zero
    4035             :             coef_wprtpthlp_implicit(i,k) = zero
    4036             :           end do
    4037             :         end do
    4038             :         !$acc end parallel loop
    4039             :       end if
    4040             :             
    4041             :       ! The turbulent advection terms are handled entirely explicitly. Thus the LHS
    4042             :       ! terms can be set to zero.
    4043             :       !$acc parallel loop gang vector collapse(3) default(present)
    4044             :       do k = 1, nz
    4045             :         do i = 1, ngrdcol
    4046             :           do b = 1, ndiags3
    4047             :             lhs_ta_wprtp2(b,i,k) = zero
    4048             :             lhs_ta_wpthlp2(b,i,k) = zero
    4049             :             lhs_ta_wprtpthlp(b,i,k) = zero
    4050             :           end do
    4051             :         end do
    4052             :       end do
    4053             :       !$acc end parallel loop
    4054             : 
    4055             :       if ( l_scalar_calc ) then
    4056             :         !$acc parallel loop gang vector collapse(4) default(present)
    4057             :         do sclr = 1, sclr_dim
    4058             :           do k = 1, nz
    4059             :             do i = 1, ngrdcol
    4060             :               do b = 1, ndiags3
    4061             :                   lhs_ta_wpsclrp2(b,i,k,sclr) = zero
    4062             :                   lhs_ta_wprtpsclrp(b,i,k,sclr) = zero
    4063             :                   lhs_ta_wpthlpsclrp(b,i,k,sclr) = zero
    4064             :               end do
    4065             :             end do
    4066             :           end do
    4067             :         end do
    4068             :         !$acc end parallel loop
    4069             :       end if
    4070             :         
    4071             :       ! The termo-level terms only need to be set if we're not using l_upwind_xpyp_ta,
    4072             :       ! or if stats output is on
    4073             :       if ( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4074             :         !$acc parallel loop gang vector collapse(2) default(present)
    4075             :         do k = 1, nz
    4076             :           do i = 1, ngrdcol
    4077             :             term_wprtp2_explicit(i,k) = wprtp2(i,k)
    4078             :             term_wpthlp2_explicit(i,k) = wpthlp2(i,k)
    4079             :             term_wprtpthlp_explicit(i,k) = wprtpthlp(i,k)
    4080             :           end do
    4081             :         end do
    4082             :         !$acc end parallel loop
    4083             :       end if
    4084             :         
    4085             :       ! Interpolate wprtp2 to momentum levels, and calculate the sign of vertical velocity
    4086             :       if ( l_upwind_xpyp_ta ) then
    4087             :         term_wprtp2_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, wprtp2(:,:) )
    4088             : 
    4089             :         !$acc parallel loop gang vector collapse(2) default(present)
    4090             :         do k = 1, nz
    4091             :           do i = 1, ngrdcol
    4092             :             sgn_t_vel_rtp2(i,k) = sign(one,term_wprtp2_explicit_zm(i,k)*rtp2(i,k))
    4093             :           end do
    4094             :         end do
    4095             :         !$acc end parallel loop
    4096             :       end if
    4097             :             
    4098             :       ! Calculate the RHS turbulent advection term for <w'rt'^2>
    4099             :       call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtp2_explicit, & ! Intent(in)
    4100             :                                  rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4101             :                                  invrs_rho_ds_zm,                       & ! Intent(in)
    4102             :                                  l_upwind_xpyp_ta,                      & ! Intent(in)
    4103             :                                  sgn_t_vel_rtp2,                        & ! Intent(in)
    4104             :                                  term_wprtp2_explicit_zm,               & ! Intent(in)
    4105             :                                  rhs_ta_wprtp2 )                          ! Intent(out)
    4106             :           
    4107             :       ! Interpolate wpthlp2 to momentum levels, and calculate the sign of vertical velocity
    4108             :       if ( l_upwind_xpyp_ta ) then
    4109             :         term_wpthlp2_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, wpthlp2(:,:) )
    4110             : 
    4111             :         !$acc parallel loop gang vector collapse(2) default(present)
    4112             :         do k = 1, nz
    4113             :           do i = 1, ngrdcol
    4114             :             sgn_t_vel_thlp2(i,k) = sign(one,term_wpthlp2_explicit_zm(i,k)*thlp2(i,k))
    4115             :           end do
    4116             :         end do
    4117             :         !$acc end parallel loop
    4118             :       end if
    4119             :     
    4120             :       ! Calculate the RHS turbulent advection term for <w'thl'^2>
    4121             :       call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpthlp2_explicit,  & ! Intent(in)
    4122             :                                  rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
    4123             :                                  invrs_rho_ds_zm,                         & ! Intent(in)
    4124             :                                  l_upwind_xpyp_ta,                        & ! Intent(in)
    4125             :                                  sgn_t_vel_thlp2,                         & ! Intent(in)
    4126             :                                  term_wpthlp2_explicit_zm,                & ! Intent(in)
    4127             :                                  rhs_ta_wpthlp2 )                           ! Intent(out)
    4128             :                                      
    4129             :       ! Interpolate wprtpthlp to momentum levels, and calculate the sign of vertical velocity
    4130             :       if ( l_upwind_xpyp_ta ) then
    4131             :         term_wprtpthlp_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, wprtpthlp(:,:) )
    4132             : 
    4133             :         !$acc parallel loop gang vector collapse(2) default(present)
    4134             :         do k = 1, nz
    4135             :           do i = 1, ngrdcol
    4136             :             sgn_t_vel_rtpthlp(i,k) = sign(one,term_wprtpthlp_explicit_zm(i,k)*rtpthlp(i,k))
    4137             :           end do
    4138             :         end do
    4139             :         !$acc end parallel loop
    4140             :       end if    
    4141             :     
    4142             :       ! Calculate the RHS turbulent advection term for <w'rt'thl'>
    4143             :       call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtpthlp_explicit,  & ! Intent(in)
    4144             :                                  rho_ds_zt, rho_ds_zm,                      & ! Intent(in)
    4145             :                                  invrs_rho_ds_zm,                           & ! Intent(in)
    4146             :                                  l_upwind_xpyp_ta,                          & ! Intent(in)
    4147             :                                  sgn_t_vel_rtpthlp,                         & ! Intent(in)
    4148             :                                  term_wprtpthlp_explicit_zm,                & ! Intent(in)
    4149             :                                  rhs_ta_wprtpthlp )                           ! Intent(out)
    4150             :     
    4151             :       if ( l_scalar_calc ) then
    4152             :     
    4153             :         do sclr = 1, sclr_dim
    4154             :             
    4155             :           ! Interpolate wpsclrp2 to momentum levels and calculate the sign of 
    4156             :           ! vertical velocityif l_upwind_xpyp_ta, otherwise just use wpsclrp2 
    4157             :           if ( l_upwind_xpyp_ta ) then
    4158             :             term_wpsclrp2_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, wpsclrp2(:,:,sclr) )
    4159             : 
    4160             :             !$acc parallel loop gang vector collapse(2) default(present)
    4161             :             do k = 1, nz
    4162             :               do i = 1, ngrdcol
    4163             :                 sgn_t_vel_sclrp2(i,k) = sign(one,term_wpsclrp2_explicit_zm(i,k)*sclrp2(i,k,sclr))
    4164             :               end do
    4165             :             end do
    4166             :             !$acc end parallel loop
    4167             :           else
    4168             :             !$acc parallel loop gang vector collapse(2) default(present)
    4169             :             do k = 1, nz
    4170             :               do i = 1, ngrdcol
    4171             :                 term_wpsclrp2_explicit(i,k) = wpsclrp2(i,k,sclr)
    4172             :               end do
    4173             :             end do
    4174             :             !$acc end parallel loop
    4175             :           end if
    4176             :         
    4177             :           ! Calculate the RHS turbulent advection term for <w'sclr'^2>
    4178             :           call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpsclrp2_explicit, & ! Intent(in)
    4179             :                                      rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
    4180             :                                      invrs_rho_ds_zm,                         & ! Intent(in)
    4181             :                                      l_upwind_xpyp_ta,                        & ! Intent(in)
    4182             :                                      sgn_t_vel_sclrp2,                        & ! Intent(in)
    4183             :                                      term_wpsclrp2_explicit_zm,               & ! Intent(in)
    4184             :                                      rhs_ta_wpsclrp2(:,:,sclr) )                ! Intent(out)
    4185             :         end do
    4186             :         
    4187             :         ! Interpolate wpsclrprtp to momentum levels and calculate the sign of 
    4188             :         ! vertical velocityif l_upwind_xpyp_ta, otherwise just use wpsclrprtp 
    4189             :         do sclr = 1, sclr_dim
    4190             :           if ( l_upwind_xpyp_ta ) then
    4191             :             term_wprtpsclrp_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, wpsclrprtp(:,:,sclr) )
    4192             :             
    4193             :             !$acc parallel loop gang vector collapse(2) default(present)
    4194             :             do k = 1, nz
    4195             :               do i = 1, ngrdcol
    4196             :                 sgn_t_vel_sclrprtp(i,k) = sign(one,term_wprtpsclrp_explicit_zm(i,k)*sclrprtp(i,k,sclr))
    4197             :               end do
    4198             :             end do
    4199             :             !$acc end parallel loop
    4200             :           else
    4201             :             !$acc parallel loop gang vector collapse(2) default(present)
    4202             :             do k = 1, nz
    4203             :               do i = 1, ngrdcol
    4204             :                 term_wprtpsclrp_explicit(i,k) = wpsclrprtp(i,k,sclr)
    4205             :               end do
    4206             :             end do
    4207             :             !$acc end parallel loop
    4208             :           end if
    4209             :             
    4210             :           ! Calculate the RHS turbulent advection term for <w'sclr'rt'>
    4211             :           call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtpsclrp_explicit, & ! Intent(in)
    4212             :                                      rho_ds_zt, rho_ds_zm,                      & ! Intent(in)
    4213             :                                      invrs_rho_ds_zm,                           & ! Intent(in)
    4214             :                                      l_upwind_xpyp_ta,                          & ! Intent(in)
    4215             :                                      sgn_t_vel_sclrprtp,                        & ! Intent(in)
    4216             :                                      term_wprtpsclrp_explicit_zm,               & ! Intent(in)
    4217             :                                      rhs_ta_wprtpsclrp(:,:,sclr) )                ! Intent(out)
    4218             :           
    4219             :         end do
    4220             :         
    4221             :         ! Interpolate wpsclrpthlp to momentum levels and calculate the sign of 
    4222             :         ! vertical velocityif l_upwind_xpyp_ta, otherwise just use wpsclrpthlp 
    4223             :         do sclr = 1, sclr_dim
    4224             :           if ( l_upwind_xpyp_ta ) then
    4225             :             term_wpthlpsclrp_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, wpsclrpthlp(:,:,sclr) )
    4226             :             
    4227             :             !$acc parallel loop gang vector collapse(2) default(present)
    4228             :             do k = 1, nz
    4229             :               do i = 1, ngrdcol
    4230             :                 sgn_t_vel_sclrpthlp(i,k) = sign(one,term_wpthlpsclrp_explicit_zm(i,k)*sclrpthlp(i,k,sclr))
    4231             :               end do
    4232             :             end do
    4233             :             !$acc end parallel loop
    4234             :           else
    4235             :             !$acc parallel loop gang vector collapse(2) default(present)
    4236             :             do k = 1, nz
    4237             :               do i = 1, ngrdcol
    4238             :                 term_wpthlpsclrp_explicit(i,k) = wpsclrpthlp(i,k,sclr)
    4239             :               end do
    4240             :             end do
    4241             :             !$acc end parallel loop
    4242             :           end if
    4243             :     
    4244             :           ! Calculate the RHS turbulent advection term for <w'sclr'thl'>
    4245             :           call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpthlpsclrp_explicit,  & ! Intent(in)
    4246             :                                      rho_ds_zt, rho_ds_zm,                        & ! Intent(in)
    4247             :                                      invrs_rho_ds_zm,                             & ! Intent(in)
    4248             :                                      l_upwind_xpyp_ta,                            & ! Intent(in)
    4249             :                                      sgn_t_vel_sclrpthlp,                         & ! Intent(in)
    4250             :                                      term_wpthlpsclrp_explicit_zm,                & ! Intent(in)
    4251             :                                      rhs_ta_wpthlpsclrp(:,:,sclr) )                 ! Intent(out)
    4252             :           
    4253             :         end do
    4254             :         
    4255             :       end if ! l_scalar_calc
    4256             : 
    4257             :     else ! .not. l_explicit_turbulent_adv_xpyp
    4258             :      
    4259             :       ! The turbulent advection of <x'y'> is handled implicitly or
    4260             :       ! semi-implicitly.
    4261             : 
    4262      352944 :       if ( iiPDF_type == iiPDF_ADG1 ) then  
    4263             :           
    4264             :         ! The ADG1 PDF is used.
    4265             :         
    4266             :         ! For ADG1, the sign of the turbulent velocity is the sign of
    4267             :         ! <w'^3> / <w'^2>.  For simplicity, the sign of turbulent
    4268             :         ! velocity is set to wp3_on_wp2 for all terms.
    4269             :     
    4270             :         ! The termodynamic grid level coefficients are only needed if l_upwind_xpyp_ta
    4271             :         ! is false, or if stats output is on
    4272      352944 :         if( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4273             :           !$acc parallel loop gang vector collapse(2) default(present)
    4274           0 :           do k = 1, nz
    4275           0 :             do i = 1, ngrdcol
    4276           0 :               coef_wprtp2_implicit(i,k) = one_third * beta * a1_zt(i,k) * wp3_on_wp2_zt(i,k)
    4277           0 :               coef_wpthlp2_implicit(i,k) = coef_wprtp2_implicit(i,k)
    4278           0 :               coef_wprtpthlp_implicit(i,k) = coef_wprtp2_implicit(i,k)
    4279             :             end do
    4280             :           end do
    4281             :           !$acc end parallel loop
    4282             :         end if
    4283             : 
    4284             :         ! Calculate the momentum level coefficients and sign of vertical velocity if
    4285             :         ! l_upwind_xpyp_ta is true
    4286      352944 :         if ( l_upwind_xpyp_ta ) then
    4287             :           !$acc parallel loop gang vector collapse(2) default(present)
    4288    30353184 :           do k = 1, nz
    4289   501287184 :             do i = 1, ngrdcol
    4290   470934000 :               coef_wprtp2_implicit_zm(i,k) = one_third * beta * a1(i,k) * wp3_on_wp2(i,k)
    4291   500934240 :               sgn_t_vel_rtp2(i,k) = wp3_on_wp2(i,k)
    4292             :             end do
    4293             :           end do
    4294             :           !$acc end parallel loop
    4295             :         end if
    4296             : 
    4297      352944 :         if ( .not. l_godunov_upwind_xpyp_ta ) then
    4298             : 
    4299             :           ! Calculate the LHS turbulent advection term for <w'rt'^2>
    4300             :           call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wprtp2_implicit, & ! Intent(in)
    4301             :                                      rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4302             :                                      invrs_rho_ds_zm,                       & ! Intent(in)
    4303             :                                      l_upwind_xpyp_ta,                      & ! Intent(in)
    4304             :                                      sgn_t_vel_rtp2,                        & ! Intent(in)
    4305             :                                      coef_wprtp2_implicit_zm,               & ! Intent(in)
    4306      352944 :                                      lhs_ta_wprtp2 )                          ! Intent(out)
    4307             : 
    4308             :         else
    4309             : 
    4310             :           ! Godunov-like method for the vertical discretization of ta term
    4311             :           !$acc parallel loop gang vector collapse(2) default(present)
    4312           0 :           do k = 1, nz
    4313           0 :             do i = 1, ngrdcol  
    4314           0 :               coef_wprtp2_implicit(i,k) = one_third * beta * a1_zt(i,k) * wp3_on_wp2_zt(i,k)
    4315           0 :               coef_wpthlp2_implicit(i,k) = coef_wprtp2_implicit(i,k)
    4316           0 :               coef_wprtpthlp_implicit(i,k) = coef_wprtp2_implicit(i,k)
    4317             :             end do
    4318             :           end do
    4319             :           !$acc end parallel loop
    4320             : 
    4321             :           call xpyp_term_ta_pdf_lhs_godunov( nz, ngrdcol, gr,             & ! Intent(in)
    4322             :                                              coef_wprtp2_implicit,        & ! Intent(in)
    4323             :                                              invrs_rho_ds_zm, rho_ds_zm,  & ! Intent(in)                             & ! Intent(in)
    4324           0 :                                              lhs_ta_wprtp2 )                ! Intent(out)
    4325             : 
    4326             :         endif
    4327             : 
    4328             :         ! For ADG1, the LHS turbulent advection terms for 
    4329             :         ! <w'rt'^2>, <w'thl'^2>, <w'rt'thl'>, and <w'sclr'x'> are all equal
    4330             :         !$acc parallel loop gang vector collapse(3) default(present)
    4331    30353184 :         do k = 1, nz
    4332   501287184 :           do i = 1, ngrdcol
    4333  1913736240 :             do b = 1, ndiags3
    4334  1412802000 :               lhs_ta_wpthlp2(b,i,k)  = lhs_ta_wprtp2(b,i,k) 
    4335  1883736000 :               lhs_ta_wprtpthlp(b,i,k)  = lhs_ta_wprtp2(b,i,k)
    4336             :             end do
    4337             :           end do
    4338             :         end do 
    4339             :         !$acc end parallel loop
    4340             : 
    4341      352944 :         if ( l_scalar_calc ) then
    4342             :           !$acc parallel loop gang vector collapse(4) default(present)
    4343           0 :           do sclr = 1, sclr_dim, 1
    4344           0 :             do k = 1, nz
    4345           0 :               do i = 1, ngrdcol
    4346           0 :                 do b = 1, ndiags3
    4347           0 :                   lhs_ta_wpsclrp2(b,i,k,sclr)  = lhs_ta_wprtp2(b,i,k) 
    4348           0 :                   lhs_ta_wprtpsclrp(b,i,k,sclr)  = lhs_ta_wprtp2(b,i,k) 
    4349           0 :                   lhs_ta_wpthlpsclrp(b,i,k,sclr)  = lhs_ta_wprtp2(b,i,k)
    4350             :                 end do
    4351             :               end do
    4352             :             end do 
    4353             :           enddo ! sclr = 1, sclr_dim, 1
    4354             :           !$acc end parallel loop
    4355             :         end if
    4356             :         
    4357             :         ! Explicit contributions
    4358             : 
    4359             :         ! The termodynamic grid level term are only needed if l_upwind_xpyp_ta
    4360             :         ! is false, or if stats output is on
    4361      352944 :         if( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4362             :             
    4363           0 :           wprtp_zt(:,:)  = zm2zt( nz, ngrdcol, gr, wprtp(:,:) )
    4364           0 :           wpthlp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wpthlp(:,:) )
    4365             : 
    4366             :           !$acc parallel loop gang vector collapse(2) default(present)
    4367           0 :           do k = 1, nz
    4368           0 :             do i = 1, ngrdcol          
    4369           0 :               term_wprtp2_explicit(i,k)    = wp_coef_zt(i,k) * wprtp_zt(i,k)**2
    4370           0 :               term_wpthlp2_explicit(i,k)   = wp_coef_zt(i,k) * wpthlp_zt(i,k)**2
    4371           0 :               term_wprtpthlp_explicit(i,k) = wp_coef_zt(i,k) * wprtp_zt(i,k) * wpthlp_zt(i,k)
    4372             :             end do
    4373             :           end do
    4374             :           !$acc end parallel loop
    4375             :         end if
    4376             : 
    4377             :         ! Calculate the momentum level terms and sign of vertical velocity if
    4378             :         ! l_upwind_xpyp_ta is true
    4379      352944 :         if ( l_upwind_xpyp_ta ) then
    4380             :           !$acc parallel loop gang vector collapse(2) default(present)
    4381    30353184 :           do k = 1, nz
    4382   501287184 :             do i = 1, ngrdcol            
    4383   470934000 :               term_wprtp2_explicit_zm(i,k) = wp_coef(i,k) * wprtp(i,k)**2
    4384   500934240 :               sgn_t_vel_rtp2(i,k)          = wp3_on_wp2(i,k)
    4385             :             end do
    4386             :           end do
    4387             :           !$acc end parallel loop
    4388             :         end if
    4389             : 
    4390      352944 :         if ( .not. l_godunov_upwind_xpyp_ta ) then
    4391             :             
    4392             :           ! Calculate the RHS turbulent advection term for <w'rt'^2>
    4393             :           call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtp2_explicit, & ! Intent(in)
    4394             :                                      rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4395             :                                      invrs_rho_ds_zm,                       & ! Intent(in)
    4396             :                                      l_upwind_xpyp_ta,                      & ! Intent(in)
    4397             :                                      sgn_t_vel_rtp2,                        & ! Intent(in)
    4398             :                                      term_wprtp2_explicit_zm,               & ! Intent(in)
    4399      352944 :                                      rhs_ta_wprtp2 )                          ! Intent(out)
    4400             :             
    4401             :         else
    4402             : 
    4403             :           ! Using the godunov upwind scheme for the calculation of RHS turbulent
    4404             :           ! advection term for <w'rt'^2>. Here, we define the "wind" for godunov
    4405             :           ! scheme as ( one - one_third * beta ) * a1_zt**2 * wp3_on_wp2_zt / wp2_zt,
    4406             :           ! and define the xpyp_term_ta_pdf_rhs_godunov subroutine in
    4407             :           ! turbulent_adv_pdf.F90 to process the calculation using godunov scheme
    4408             :           !$acc parallel loop gang vector collapse(2) default(present)
    4409           0 :           do k = 1, nz
    4410           0 :             do i = 1, ngrdcol 
    4411           0 :               term_wprtp2_explicit_zm(i,k) = wprtp(i,k)**2
    4412           0 :               sgn_t_vel_rtp2(i,k)          = wp_coef_zt(i,k)
    4413             :             end do
    4414             :           end do
    4415             :           !$acc end parallel loop
    4416             : 
    4417             :           call xpyp_term_ta_pdf_rhs_godunov( nz, ngrdcol, gr,         & ! Intent(in)
    4418             :                                              term_wprtp2_explicit_zm, & ! Intent(in)
    4419             :                                              invrs_rho_ds_zm,         & ! Intent(in)
    4420             :                                              sgn_t_vel_rtp2,          & ! Intent(in)
    4421             :                                              rho_ds_zm,               & ! Intent(in)
    4422           0 :                                              rhs_ta_wprtp2 )            ! Intent(out)
    4423             : 
    4424             :         endif
    4425             : 
    4426             :         ! Calculate the momentum level terms and sign of vertical velocity if
    4427             :         ! l_upwind_xpyp_ta is true
    4428      352944 :         if ( l_upwind_xpyp_ta ) then
    4429             :           !$acc parallel loop gang vector collapse(2) default(present)
    4430    30353184 :           do k = 1, nz
    4431   501287184 :             do i = 1, ngrdcol             
    4432   470934000 :               term_wpthlp2_explicit_zm(i,k) = wp_coef(i,k) * wpthlp(i,k)**2
    4433   500934240 :               sgn_t_vel_thlp2(i,k)          = wp3_on_wp2(i,k)
    4434             :             end do
    4435             :           end do
    4436             :           !$acc end parallel loop
    4437             :         end if
    4438             : 
    4439      352944 :         if ( .not. l_godunov_upwind_xpyp_ta ) then
    4440             : 
    4441             :           ! Calculate the RHS turbulent advection term for <w'thl'^2>
    4442             :           call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpthlp2_explicit,  & ! Intent(in)
    4443             :                                      rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
    4444             :                                      invrs_rho_ds_zm,                         & ! Intent(in)
    4445             :                                      l_upwind_xpyp_ta,                        & ! Intent(in)
    4446             :                                      sgn_t_vel_thlp2,                         & ! Intent(in)
    4447             :                                      term_wpthlp2_explicit_zm,                & ! Intent(in)
    4448      352944 :                                      rhs_ta_wpthlp2 )                           ! Intent(out)
    4449             : 
    4450             :         else
    4451             : 
    4452             :           ! Using the godunov upwind scheme for the calculation of RHS
    4453             :           ! turbulent advection term for <w'thl'^2>.
    4454             :           !$acc parallel loop gang vector collapse(2) default(present)
    4455           0 :           do k = 1, nz
    4456           0 :             do i = 1, ngrdcol 
    4457           0 :               term_wpthlp2_explicit_zm(i,k) = wpthlp(i,k)**2
    4458           0 :               sgn_t_vel_thlp2(i,k)          = wp_coef_zt(i,k)
    4459             :             end do
    4460             :           end do
    4461             :           !$acc end parallel loop
    4462             : 
    4463             :           call xpyp_term_ta_pdf_rhs_godunov( nz, ngrdcol, gr,           & ! Intent(in)
    4464             :                                              term_wpthlp2_explicit_zm,  & ! Intent(in)
    4465             :                                              invrs_rho_ds_zm,           & ! Intent(in)
    4466             :                                              sgn_t_vel_thlp2,           & ! Intent(in)
    4467             :                                              rho_ds_zm,                 & ! Intent(in)
    4468           0 :                                              rhs_ta_wpthlp2 )             ! Intent(out)
    4469             : 
    4470             :         end if
    4471             : 
    4472             :         ! Calculate the momentum level terms and sign of vertical velocity if
    4473             :         ! l_upwind_xpyp_ta is true
    4474      352944 :         if ( l_upwind_xpyp_ta ) then
    4475             :           !$acc parallel loop gang vector collapse(2) default(present)
    4476    30353184 :           do k = 1, nz
    4477   501287184 :             do i = 1, ngrdcol             
    4478   470934000 :               term_wprtpthlp_explicit_zm(i,k) = wp_coef(i,k) * wprtp(i,k) * wpthlp(i,k)
    4479   500934240 :               sgn_t_vel_rtpthlp(i,k)          = wp3_on_wp2(i,k)
    4480             :             end do
    4481             :           end do
    4482             :           !$acc end parallel loop
    4483             :         end if    
    4484             : 
    4485      352944 :         if ( .not. l_godunov_upwind_xpyp_ta ) then
    4486             :         
    4487             :           ! Calculate the RHS turbulent advection term for <w'rt'thl'>
    4488             :           call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtpthlp_explicit,  & ! Intent(in)
    4489             :                                      rho_ds_zt, rho_ds_zm,                      & ! Intent(in)
    4490             :                                      invrs_rho_ds_zm,                           & ! Intent(in)
    4491             :                                      l_upwind_xpyp_ta,                          & ! Intent(in)
    4492             :                                      sgn_t_vel_rtpthlp,                         & ! Intent(in)
    4493             :                                      term_wprtpthlp_explicit_zm,                & ! Intent(in)
    4494      352944 :                                      rhs_ta_wprtpthlp )                           ! Intent(out)
    4495             : 
    4496             :         else
    4497             : 
    4498             :           ! Using the godunov upwind scheme for the calculation of RHS
    4499             :           ! turbulent
    4500             :           ! advection term for <w'rt'thl'>.
    4501             :           !$acc parallel loop gang vector collapse(2) default(present)
    4502           0 :           do k = 1, nz
    4503           0 :             do i = 1, ngrdcol           
    4504           0 :               term_wprtpthlp_explicit_zm(i,k) = wprtp(i,k) * wpthlp(i,k)
    4505           0 :               sgn_t_vel_rtpthlp(i,k)          = wp_coef_zt(i,k)
    4506             :             end do
    4507             :           end do
    4508             :           !$acc end parallel loop
    4509             : 
    4510             :           call xpyp_term_ta_pdf_rhs_godunov( nz, ngrdcol, gr,             & ! Intent(in)
    4511             :                                              term_wprtpthlp_explicit_zm,  & ! Intent(in)
    4512             :                                              invrs_rho_ds_zm,             & ! Intent(in)
    4513             :                                              sgn_t_vel_rtpthlp,           & ! Intent(in)
    4514             :                                              rho_ds_zm,                   & ! Intent(in)
    4515           0 :                                              rhs_ta_wprtpthlp )             ! Intent(out)
    4516             :         end if
    4517             : 
    4518      352944 :         if ( l_scalar_calc ) then
    4519             :             
    4520             :           ! Explicit contributions to passive scalars
    4521             :             
    4522             :           ! Interpolate wpsclrp to thermo levels if not using l_upwind_xpyp_ta
    4523           0 :           if ( .not. l_upwind_xpyp_ta ) then
    4524           0 :             do sclr = 1, sclr_dim
    4525           0 :               wpsclrp_zt(:,:,sclr) = zm2zt( nz, ngrdcol, gr, wpsclrp(:,:,sclr) )
    4526             :             end do
    4527             :           end if
    4528             :             
    4529           0 :           do sclr = 1, sclr_dim
    4530             :               
    4531             :             ! Calculate the momentum level terms and sign of vertical velocity if
    4532             :             ! l_upwind_xpyp_ta is true, otherwise just calculate the thermo level terms
    4533           0 :             if ( l_upwind_xpyp_ta ) then
    4534             :               !$acc parallel loop gang vector collapse(2) default(present)
    4535           0 :               do k = 1, nz
    4536           0 :                 do i = 1, ngrdcol
    4537           0 :                   term_wpsclrp2_explicit_zm(i,k) = wp_coef(i,k) * wpsclrp(i,k,sclr)**2
    4538           0 :                   sgn_t_vel_sclrp2(i,k)          = wp3_on_wp2(i,k)
    4539             :                 end do
    4540             :               end do
    4541             :               !$acc end parallel loop
    4542             :             else
    4543             :               !$acc parallel loop gang vector collapse(2) default(present)
    4544           0 :               do k = 1, nz
    4545           0 :                 do i = 1, ngrdcol
    4546           0 :                   term_wpsclrp2_explicit(i,k) = wp_coef_zt(i,k) * wpsclrp_zt(i,k,sclr)**2
    4547             :                 end do
    4548             :               end do
    4549             :               !$acc end parallel loop
    4550             :             end if
    4551             : 
    4552           0 :             if ( .not. l_godunov_upwind_xpyp_ta ) then          
    4553             : 
    4554             :               ! Calculate the RHS turbulent advection term for <w'sclr'^2>
    4555             :               call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpsclrp2_explicit, & ! Intent(in)
    4556             :                                          rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
    4557             :                                          invrs_rho_ds_zm,                         & ! Intent(in)
    4558             :                                          l_upwind_xpyp_ta,                        & ! Intent(in)
    4559             :                                          sgn_t_vel_sclrp2,                        & ! Intent(in)
    4560             :                                          term_wpsclrp2_explicit_zm,               & ! Intent(in)
    4561           0 :                                          rhs_ta_wpsclrp2(:,:,sclr) )                ! Intent(out)
    4562             :            
    4563             :             else
    4564             : 
    4565             :               ! Using the godunov upwind scheme for the calculation of RHS
    4566             :               ! turbulent
    4567             :               ! advection term for <w'sclr'^2>.
    4568             :               !$acc parallel loop gang vector collapse(2) default(present)
    4569           0 :               do k = 1, nz
    4570           0 :                 do i = 1, ngrdcol 
    4571           0 :                   term_wpsclrp2_explicit_zm(i,k) = wpsclrp(i,k,sclr)**2
    4572           0 :                   sgn_t_vel_sclrp2(i,k)          = wp_coef_zt(i,k)
    4573             :                 end do
    4574             :               end do
    4575             :               !$acc end parallel loop
    4576             : 
    4577             :               call xpyp_term_ta_pdf_rhs_godunov( nz, ngrdcol, gr,           & ! Intent(in)
    4578             :                                                  term_wpsclrp2_explicit_zm, & ! Intent(in)
    4579             :                                                  invrs_rho_ds_zm,           & ! Intent(in)
    4580             :                                                  sgn_t_vel_sclrp2,          & ! Intent(in)
    4581             :                                                  rho_ds_zm,                 & ! Intent(in)
    4582           0 :                                                  rhs_ta_wpsclrp2(:,:,sclr) )  ! Intent(out)
    4583             :              end if
    4584             :  
    4585             :           end do
    4586             :         
    4587             :           ! Calculate the momentum level terms and sign of vertical velocity if
    4588             :           ! l_upwind_xpyp_ta is true, otherwise just calculate the thermo level terms
    4589           0 :           do sclr = 1, sclr_dim
    4590             :               
    4591           0 :             if ( l_upwind_xpyp_ta ) then
    4592             :               !$acc parallel loop gang vector collapse(2) default(present)
    4593           0 :               do k = 1, nz
    4594           0 :                 do i = 1, ngrdcol
    4595           0 :                   term_wprtpsclrp_explicit_zm(i,k) = wp_coef(i,k) * wpsclrp(i,k,sclr) * wprtp(i,k)
    4596           0 :                   sgn_t_vel_sclrprtp(i,k)          = wp3_on_wp2(i,k)
    4597             :                 end do
    4598             :               end do
    4599             :               !$acc end parallel loop
    4600             :             else
    4601             :               !$acc parallel loop gang vector collapse(2) default(present)
    4602           0 :               do k = 1, nz
    4603           0 :                 do i = 1, ngrdcol                
    4604           0 :                   term_wprtpsclrp_explicit(i,k) &
    4605           0 :                     = wp_coef_zt(i,k) * wpsclrp_zt(i,k,sclr) * wprtp_zt(i,k)
    4606             :                 end do
    4607             :               end do
    4608             :               !$acc end parallel loop
    4609             :             end if
    4610             :            
    4611           0 :             if ( .not. l_godunov_upwind_xpyp_ta ) then
    4612             :  
    4613             :               ! Calculate the RHS turbulent advection term for <w'sclr'rt'>
    4614             :               call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtpsclrp_explicit, & ! Intent(in)
    4615             :                                          rho_ds_zt, rho_ds_zm,                      & ! Intent(in)
    4616             :                                          invrs_rho_ds_zm,                           & ! Intent(in)
    4617             :                                          l_upwind_xpyp_ta,                          & ! Intent(in)
    4618             :                                          sgn_t_vel_sclrprtp,                        & ! Intent(in)
    4619             :                                          term_wprtpsclrp_explicit_zm,               & ! Intent(in)
    4620           0 :                                          rhs_ta_wprtpsclrp(:,:,sclr) )                ! Intent(out)
    4621             :             
    4622             :             else
    4623             : 
    4624             :               ! Using the godunov upwind scheme for the calculation of RHS
    4625             :               ! turbulent advection term for <w'sclr'rt'>.
    4626             :               !$acc parallel loop gang vector collapse(2) default(present)
    4627           0 :               do k = 1, nz
    4628           0 :                 do i = 1, ngrdcol 
    4629           0 :                   term_wprtpsclrp_explicit_zm(i,k) = wpsclrp(i,k,sclr) * wprtp(i,k) 
    4630           0 :                   sgn_t_vel_sclrprtp(i,k)          = wp_coef_zt(i,k)
    4631             :                 end do
    4632             :               end do
    4633             :               !$acc end parallel loop
    4634             : 
    4635             :               call xpyp_term_ta_pdf_rhs_godunov( nz, ngrdcol, gr,             & ! Intent(in)
    4636             :                                                  term_wprtpsclrp_explicit_zm, & ! Intent(in)
    4637             :                                                  invrs_rho_ds_zm,             & ! Intent(in)
    4638             :                                                  sgn_t_vel_sclrprtp,          & ! Intent(in)
    4639             :                                                  rho_ds_zm,                   & ! Intent(in)
    4640           0 :                                                  rhs_ta_wprtpsclrp(:,:,sclr) )  ! Intent(out)
    4641             :             endif
    4642             : 
    4643             :           end do
    4644             :           
    4645             :           ! Calculate the momentum level terms and sign of vertical velocity if
    4646             :           ! l_upwind_xpyp_ta is true, otherwise just calculate the thermo level terms
    4647           0 :           do sclr = 1, sclr_dim
    4648             :               
    4649           0 :             if ( l_upwind_xpyp_ta ) then
    4650             :               !$acc parallel loop gang vector collapse(2) default(present)
    4651           0 :               do k = 1, nz
    4652           0 :                 do i = 1, ngrdcol               
    4653           0 :                   term_wpthlpsclrp_explicit_zm(i,k) = wp_coef(i,k) * wpsclrp(i,k,sclr) * wpthlp(i,k)
    4654           0 :                   sgn_t_vel_sclrpthlp(i,k)          = wp3_on_wp2(i,k)
    4655             :                 end do
    4656             :               end do
    4657             :               !$acc end parallel loop
    4658             :             else
    4659             :               !$acc parallel loop gang vector collapse(2) default(present)
    4660           0 :               do k = 1, nz
    4661           0 :                 do i = 1, ngrdcol                 
    4662           0 :                   term_wpthlpsclrp_explicit(i,k) &
    4663           0 :                       = wp_coef_zt(i,k) * wpsclrp_zt(i,k,sclr) * wpthlp_zt(i,k)
    4664             :                 end do
    4665             :               end do
    4666             :               !$acc end parallel loop
    4667             :             end if
    4668             :          
    4669           0 :             if ( .not. l_godunov_upwind_xpyp_ta ) then
    4670             :  
    4671             :               ! Calculate the RHS turbulent advection term for <w'sclr'thl'>
    4672             :               call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpthlpsclrp_explicit, & ! Intent(in)
    4673             :                                          rho_ds_zt, rho_ds_zm,                       & ! Intent(in)
    4674             :                                          invrs_rho_ds_zm,                            & ! Intent(in)
    4675             :                                          l_upwind_xpyp_ta,                           & ! Intent(in)
    4676             :                                          sgn_t_vel_sclrpthlp,                        & ! Intent(in)
    4677             :                                          term_wpthlpsclrp_explicit_zm,               & ! Intent(in)
    4678           0 :                                          rhs_ta_wpthlpsclrp(:,:,sclr) )                ! Intent(out)
    4679             :             
    4680             :             else
    4681             : 
    4682             :               ! Using the godunov upwind scheme for the calculation of RHS
    4683             :               ! turbulent advection term for <w'sclr'thl'>.
    4684             :               !$acc parallel loop gang vector collapse(2) default(present)
    4685           0 :               do k = 1, nz
    4686           0 :                 do i = 1, ngrdcol               
    4687           0 :                   term_wpthlpsclrp_explicit_zm(i,k) = wpsclrp(i,k,sclr) * wpthlp(i,k)
    4688           0 :                   sgn_t_vel_sclrpthlp(i,k)          = wp_coef_zt(i,k)
    4689             :                 end do
    4690             :               end do
    4691             :               !$acc end parallel loop
    4692             : 
    4693             :               call xpyp_term_ta_pdf_rhs_godunov( nz, ngrdcol, gr,               & ! Intent(in)
    4694             :                                                  term_wpthlpsclrp_explicit_zm,  & ! Intent(in)
    4695             :                                                  invrs_rho_ds_zm,               & ! Intent(in)
    4696             :                                                  sgn_t_vel_sclrpthlp,           & ! Intent(in)
    4697             :                                                  rho_ds_zm,                     & ! Intent(in)
    4698           0 :                                                  rhs_ta_wpthlpsclrp(:,:,sclr) )   ! Intent(out)
    4699             :             endif
    4700             : 
    4701             :           end do
    4702             :             
    4703             :         end if ! l_scalar_calc
    4704             : 
    4705           0 :       elseif ( iiPDF_type == iiPDF_new ) then
    4706             :        
    4707             :         ! The new PDF is used.
    4708             :        
    4709             :         ! The termodynamic grid level coefficients are only needed if l_upwind_xpyp_ta
    4710             :         ! is false, or if stats output is on
    4711           0 :         if( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4712           0 :           coef_wprtp2_implicit(:,:) = pdf_implicit_coefs_terms%coef_wprtp2_implicit(:,:)
    4713           0 :           coef_wpthlp2_implicit(:,:) = pdf_implicit_coefs_terms%coef_wpthlp2_implicit(:,:)
    4714           0 :           coef_wprtpthlp_implicit(:,:) = pdf_implicit_coefs_terms%coef_wprtpthlp_implicit(:,:)
    4715             :         end if
    4716             :         
    4717             :         ! Calculate the momentum level terms and sign of vertical velocity if
    4718             :         ! l_upwind_xpyp_ta is true
    4719           0 :         if ( l_upwind_xpyp_ta ) then
    4720             :           coef_wprtp2_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4721           0 :                                                 pdf_implicit_coefs_terms%coef_wprtp2_implicit(:,:) )
    4722           0 :           sgn_t_vel_rtp2(:,:) = sign(one,coef_wprtp2_implicit_zm(:,:)*rtp2(:,:)*rtp2(:,:))
    4723             :         end if
    4724             : 
    4725             :         ! Calculate the LHS turbulent advection term for <w'rt'^2>
    4726             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wprtp2_implicit, & ! Intent(in)
    4727             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4728             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
    4729             :                                    l_upwind_xpyp_ta,                      & ! Intent(in)
    4730             :                                    sgn_t_vel_rtp2,                        & ! Intent(in)
    4731             :                                    coef_wprtp2_implicit_zm,               & ! Intent(in)
    4732           0 :                                    lhs_ta_wprtp2 )                          ! Intent(out)   
    4733             :     
    4734             :        ! Calculate the momentum level terms and sign of vertical velocity if
    4735             :        ! l_upwind_xpyp_ta is true
    4736           0 :         if ( l_upwind_xpyp_ta ) then
    4737             :           coef_wpthlp2_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4738           0 :                                              pdf_implicit_coefs_terms%coef_wpthlp2_implicit(:,:) )
    4739           0 :           sgn_t_vel_thlp2(:,:) = sign(one,coef_wpthlp2_implicit_zm(:,:)*thlp2(:,:)*thlp2(:,:))
    4740             :         end if
    4741             :         
    4742             :         ! Calculate the LHS turbulent advection term for <w'thl'^2>
    4743             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wpthlp2_implicit,  & ! Intent(in)
    4744             :                                    rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
    4745             :                                    invrs_rho_ds_zm,                         & ! Intent(in)
    4746             :                                    l_upwind_xpyp_ta,                        & ! Intent(in)
    4747             :                                    sgn_t_vel_thlp2,                         & ! Intent(in)
    4748             :                                    coef_wpthlp2_implicit_zm,                & ! Intent(in)
    4749           0 :                                    lhs_ta_wpthlp2 )                           ! Intent(out)   
    4750             :     
    4751             :         ! Calculate the momentum level terms and sign of vertical velocity if
    4752             :         ! l_upwind_xpyp_ta is true
    4753           0 :         if ( l_upwind_xpyp_ta ) then
    4754             :           coef_wprtpthlp_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4755           0 :                                             pdf_implicit_coefs_terms%coef_wprtpthlp_implicit(:,:) )
    4756             :           term_wprtpthlp_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4757           0 :                                             pdf_implicit_coefs_terms%term_wprtpthlp_explicit(:,:) )
    4758             :           sgn_t_vel_rtpthlp(:,:) = sign(one, ( coef_wprtpthlp_implicit_zm(:,:) * rtpthlp(:,:) &
    4759           0 :                                            + term_wprtpthlp_explicit_zm(:,:) ) * rtpthlp(:,:))
    4760             :         end if
    4761             :         
    4762             :         ! Calculate the LHS turbulent advection term for <w'rt'thl'>
    4763             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wprtpthlp_implicit,  & ! Intent(in)
    4764             :                                    rho_ds_zt, rho_ds_zm,                      & ! Intent(in)
    4765             :                                    invrs_rho_ds_zm,                           & ! Intent(in)
    4766             :                                    l_upwind_xpyp_ta,                          & ! Intent(in)
    4767             :                                    sgn_t_vel_rtpthlp,                         & ! Intent(in)
    4768             :                                    coef_wprtpthlp_implicit_zm,                & ! Intent(in)
    4769           0 :                                    lhs_ta_wprtpthlp )                           ! Intent(out) 
    4770             :     
    4771           0 :         if ( l_scalar_calc ) then
    4772             :           ! The code for the scalar variables will be set up later.
    4773           0 :           lhs_ta_wpsclrp2(:,:,:,:)  = zero
    4774           0 :           lhs_ta_wprtpsclrp(:,:,:,:)  = zero
    4775           0 :           lhs_ta_wpthlpsclrp(:,:,:,:)  = zero
    4776             :         end if
    4777             :     
    4778             :         ! The termodynamic grid level term are only needed if l_upwind_xpyp_ta
    4779             :         ! is false, or if stats output is on. The value of term_wprtp2_explicit_zm 
    4780             :         ! and term_wpthlp2_explicit are always 0.
    4781           0 :         if( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4782           0 :           term_wprtp2_explicit(:,:) = zero
    4783           0 :           term_wpthlp2_explicit(:,:) = zero
    4784           0 :           term_wprtpthlp_explicit(:,:) = pdf_implicit_coefs_terms%term_wprtpthlp_explicit(:,:)
    4785             :         end if
    4786             :     
    4787             :         ! Calculate the RHS turbulent advection term for <w'rt'thl'>
    4788             :         call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtpthlp_explicit,  & ! Intent(in)
    4789             :                                    rho_ds_zt, rho_ds_zm,                      & ! Intent(in)
    4790             :                                    invrs_rho_ds_zm,                           & ! Intent(in)
    4791             :                                    l_upwind_xpyp_ta,                          & ! Intent(in)
    4792             :                                    sgn_t_vel_rtpthlp,                         & ! Intent(in)
    4793             :                                    term_wprtpthlp_explicit_zm,                & ! Intent(in)
    4794           0 :                                    rhs_ta_wprtpthlp )                           ! Intent(out)
    4795             :     
    4796             :         ! The <rt'^2> and <thl'^2> turbulent advection terms are entirely implicit, as
    4797             :         ! <w'rt'^2> = coef_wprtp2_implicit * <rt'^2>, and 
    4798             :         ! <w'thl'^2> = coef_wpthlp2_implicit * <thl'^2>.  So the values of these RHS
    4799             :         ! turbulent advection terms are always zero
    4800           0 :         rhs_ta_wprtp2(:,:)       = zero
    4801           0 :         rhs_ta_wpthlp2(:,:)      = zero
    4802             :         
    4803             :         ! The code for the scalar variables will be set up later.
    4804           0 :         rhs_ta_wpsclrp2(:,:,:)     = zero
    4805           0 :         rhs_ta_wprtpsclrp(:,:,:)   = zero
    4806           0 :         rhs_ta_wpthlpsclrp(:,:,:)  = zero
    4807             :            
    4808           0 :       elseif ( iiPDF_type == iiPDF_new_hybrid ) then
    4809             : 
    4810             :         ! The new hybrid PDF is used.
    4811             : 
    4812           0 :         if ( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4813           0 :           coef_wprtp2_implicit(:,:) = pdf_implicit_coefs_terms%coef_wprtp2_implicit(:,:)
    4814           0 :           term_wprtp2_explicit(:,:) = pdf_implicit_coefs_terms%term_wprtp2_explicit(:,:)
    4815             :         endif
    4816             : 
    4817             :         ! Calculate the momentum level terms and sign of turbulent velocity if
    4818             :         ! l_upwind_xpyp_ta is true
    4819           0 :         if ( l_upwind_xpyp_ta ) then
    4820             :           coef_wprtp2_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4821           0 :                                             pdf_implicit_coefs_terms%coef_wprtp2_implicit(:,:) )
    4822             :           term_wprtp2_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4823           0 :                                             pdf_implicit_coefs_terms%term_wprtp2_explicit(:,:) )
    4824             :           sgn_t_vel_rtp2(:,:) = sign(one, ( coef_wprtp2_implicit_zm(:,:) * rtp2(:,:) &
    4825           0 :                                         + term_wprtpthlp_explicit_zm(:,:) ) * rtp2(:,:))
    4826             :         endif
    4827             : 
    4828             :         ! Calculate the LHS turbulent advection term for <w'rt'^2>
    4829             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wprtp2_implicit, & ! Intent(in)
    4830             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4831             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
    4832             :                                    l_upwind_xpyp_ta,                      & ! Intent(in)
    4833             :                                    sgn_t_vel_rtp2,                        & ! Intent(in)
    4834             :                                    coef_wprtp2_implicit_zm,               & ! Intent(in)
    4835           0 :                                    lhs_ta_wprtp2 )                          ! Intent(out)  
    4836             : 
    4837             :         ! Calculate the RHS turbulent advection term for <w'rt'^2>
    4838             :         call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtp2_explicit, & ! Intent(in)
    4839             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4840             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
    4841             :                                    l_upwind_xpyp_ta,                      & ! Intent(in)
    4842             :                                    sgn_t_vel_rtp2,                        & ! Intent(in)
    4843             :                                    term_wprtp2_explicit_zm,               & ! Intent(in)
    4844           0 :                                    rhs_ta_wprtp2 )                          ! Intent(out)
    4845             : 
    4846           0 :         if ( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4847           0 :           coef_wpthlp2_implicit(:,:) = pdf_implicit_coefs_terms%coef_wpthlp2_implicit(:,:)
    4848           0 :           term_wpthlp2_explicit(:,:) = pdf_implicit_coefs_terms%term_wpthlp2_explicit(:,:)
    4849             :         endif
    4850             : 
    4851             :         ! Calculate the momentum level terms and sign of turbulent velocity if
    4852             :         ! l_upwind_xpyp_ta is true
    4853           0 :         if ( l_upwind_xpyp_ta ) then
    4854             :           coef_wpthlp2_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4855           0 :                                             pdf_implicit_coefs_terms%coef_wpthlp2_implicit(:,:) )
    4856             :           term_wpthlp2_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4857           0 :                                             pdf_implicit_coefs_terms%term_wpthlp2_explicit(:,:) )
    4858             :           sgn_t_vel_thlp2(:,:) = sign(one, ( coef_wpthlp2_implicit_zm(:,:) * thlp2(:,:) &
    4859           0 :                                          + term_wpthlp2_explicit_zm(:,:) ) * thlp2(:,:))
    4860             :         endif
    4861             : 
    4862             :         ! Calculate the LHS turbulent advection term for <w'thl'^2>
    4863             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wpthlp2_implicit,  & ! Intent(in)
    4864             :                                    rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
    4865             :                                    invrs_rho_ds_zm,                         & ! Intent(in)
    4866             :                                    l_upwind_xpyp_ta,                        & ! Intent(in)
    4867             :                                    sgn_t_vel_thlp2,                         & ! Intent(in)
    4868             :                                    coef_wpthlp2_implicit_zm,                & ! Intent(in)
    4869           0 :                                    lhs_ta_wpthlp2 )                           ! Intent(out)   
    4870             : 
    4871             :         ! Calculate the RHS turbulent advection term for <w'thl'^2>
    4872             :         call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpthlp2_explicit,  & ! Intent(in)
    4873             :                                    rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
    4874             :                                    invrs_rho_ds_zm,                         & ! Intent(in)
    4875             :                                    l_upwind_xpyp_ta,                        & ! Intent(in)
    4876             :                                    sgn_t_vel_thlp2,                         & ! Intent(in)
    4877             :                                    term_wpthlp2_explicit_zm,                & ! Intent(in)
    4878           0 :                                    rhs_ta_wpthlp2 )                           ! Intent(out)
    4879             : 
    4880           0 :         if ( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4881           0 :           coef_wprtpthlp_implicit(:,:) = pdf_implicit_coefs_terms%coef_wprtpthlp_implicit(:,:)
    4882           0 :           term_wprtpthlp_explicit(:,:) = pdf_implicit_coefs_terms%term_wprtpthlp_explicit(:,:)
    4883             :         endif
    4884             : 
    4885             :         ! Calculate the momentum level terms and sign of turbulent velocity if
    4886             :         ! l_upwind_xpyp_ta is true
    4887           0 :         if ( l_upwind_xpyp_ta ) then
    4888             :           coef_wprtpthlp_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4889           0 :                                             pdf_implicit_coefs_terms%coef_wprtpthlp_implicit(:,:) )
    4890             :           term_wprtpthlp_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4891           0 :                                             pdf_implicit_coefs_terms%term_wprtpthlp_explicit(:,:) )
    4892             :           sgn_t_vel_rtpthlp(:,:) = sign(one, ( coef_wprtpthlp_implicit_zm(:,:) * rtpthlp(:,:) &
    4893           0 :                                            + term_wprtpthlp_explicit_zm(:,:) ) * rtpthlp(:,:))
    4894             :         endif
    4895             : 
    4896             :         ! Calculate the LHS turbulent advection term for <w'rt'thl'>
    4897             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wprtpthlp_implicit,  & ! Intent(in)
    4898             :                                    rho_ds_zt, rho_ds_zm,                      & ! Intent(in)
    4899             :                                    invrs_rho_ds_zm,                           & ! Intent(in)
    4900             :                                    l_upwind_xpyp_ta,                          & ! Intent(in)
    4901             :                                    sgn_t_vel_rtpthlp,                         & ! Intent(in)
    4902             :                                    coef_wprtpthlp_implicit_zm,                & ! Intent(in)
    4903           0 :                                    lhs_ta_wprtpthlp )                           ! Intent(out) 
    4904             : 
    4905             :         ! Calculate the RHS turbulent advection term for <w'rt'thl'>
    4906             :         call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtpthlp_explicit,  & ! Intent(in)
    4907             :                                    rho_ds_zt, rho_ds_zm,                      & ! Intent(in)
    4908             :                                    invrs_rho_ds_zm,                           & ! Intent(in)
    4909             :                                    l_upwind_xpyp_ta,                          & ! Intent(in)
    4910             :                                    sgn_t_vel_rtpthlp,                         & ! Intent(in)
    4911             :                                    term_wprtpthlp_explicit_zm,                & ! Intent(in)
    4912           0 :                                    rhs_ta_wprtpthlp )                           ! Intent(out)
    4913             : 
    4914           0 :         if ( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4915           0 :           coef_wpup2_implicit(:,:) = pdf_implicit_coefs_terms%coef_wpup2_implicit(:,:)
    4916           0 :           term_wpup2_explicit(:,:) = pdf_implicit_coefs_terms%term_wpup2_explicit(:,:)
    4917             :         endif
    4918             : 
    4919             :         ! Calculate the momentum level terms and sign of turbulent velocity if
    4920             :         ! l_upwind_xpyp_ta is true
    4921           0 :         if ( l_upwind_xpyp_ta ) then
    4922             :           coef_wpup2_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4923           0 :                                                pdf_implicit_coefs_terms%coef_wpup2_implicit(:,:) )
    4924             :           term_wpup2_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4925           0 :                                                pdf_implicit_coefs_terms%term_wpup2_explicit(:,:) )
    4926             :           sgn_t_vel_up2(:,:) = sign(one, ( coef_wpup2_implicit_zm(:,:) * up2(:,:) &
    4927           0 :                                        + term_wpup2_explicit_zm(:,:) ) * up2(:,:))
    4928             :         endif
    4929             : 
    4930             :         ! Calculate the LHS turbulent advection term for <w'u'^2>
    4931             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wpup2_implicit,  & ! Intent(in)
    4932             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4933             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
    4934             :                                    l_upwind_xpyp_ta,                      & ! Intent(in)
    4935             :                                    sgn_t_vel_up2,                         & ! Intent(in)
    4936             :                                    coef_wpup2_implicit_zm,                & ! Intent(in)
    4937           0 :                                    lhs_ta_wpup2 )                           ! Intent(out)
    4938             : 
    4939             :         ! Calculate the RHS turbulent advection term for <w'u'^2>
    4940             :         call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpup2_explicit,  & ! Intent(in)
    4941             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4942             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
    4943             :                                    l_upwind_xpyp_ta,                      & ! Intent(in)
    4944             :                                    sgn_t_vel_up2,                         & ! Intent(in)
    4945             :                                    term_wpup2_explicit_zm,                & ! Intent(in)
    4946           0 :                                    rhs_ta_wpup2 )                           ! Intent(out)
    4947             : 
    4948           0 :         if ( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4949           0 :           coef_wpvp2_implicit(:,:) = pdf_implicit_coefs_terms%coef_wpvp2_implicit(:,:)
    4950           0 :           term_wpvp2_explicit(:,:) = pdf_implicit_coefs_terms%term_wpvp2_explicit(:,:)
    4951             :         endif
    4952             : 
    4953             :         ! Calculate the momentum level terms and sign of turbulent velocity if
    4954             :         ! l_upwind_xpyp_ta is true
    4955           0 :         if ( l_upwind_xpyp_ta ) then
    4956             :           coef_wpvp2_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4957           0 :                                                pdf_implicit_coefs_terms%coef_wpvp2_implicit(:,:) )
    4958             :           term_wpvp2_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4959           0 :                                                pdf_implicit_coefs_terms%term_wpvp2_explicit(:,:) )
    4960             :           sgn_t_vel_vp2(:,:) = sign(one, ( coef_wpvp2_implicit_zm(:,:) * vp2(:,:) &
    4961           0 :                                        + term_wpvp2_explicit_zm(:,:) ) * vp2(:,:))
    4962             :         endif
    4963             : 
    4964             :         ! Calculate the LHS turbulent advection term for <w'v'^2>
    4965             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wpvp2_implicit,  & ! Intent(in)
    4966             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4967             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
    4968             :                                    l_upwind_xpyp_ta,                      & ! Intent(in)
    4969             :                                    sgn_t_vel_vp2,                         & ! Intent(in)
    4970             :                                    coef_wpvp2_implicit_zm,                & ! Intent(in)
    4971           0 :                                    lhs_ta_wpvp2 )                           ! Intent(out)   
    4972             : 
    4973             :         ! Calculate the RHS turbulent advection term for <w'v'^2>
    4974             :         call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpvp2_explicit,  & ! Intent(in)
    4975             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    4976             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
    4977             :                                    l_upwind_xpyp_ta,                      & ! Intent(in)
    4978             :                                    sgn_t_vel_vp2,                         & ! Intent(in)
    4979             :                                    term_wpvp2_explicit_zm,                & ! Intent(in)
    4980           0 :                                    rhs_ta_wpvp2 )                           ! Intent(out)
    4981             : 
    4982           0 :         if ( l_scalar_calc ) then
    4983             : 
    4984           0 :           do sclr = 1, sclr_dim, 1
    4985             : 
    4986           0 :             if ( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    4987           0 :               coef_wpsclrp2_implicit(:,:) =pdf_implicit_coefs_terms%coef_wpsclrp2_implicit(:,:,sclr)
    4988           0 :               term_wpsclrp2_explicit(:,:) =pdf_implicit_coefs_terms%term_wpsclrp2_explicit(:,:,sclr)
    4989             :             endif
    4990             : 
    4991             :             ! Calculate the momentum level terms and sign of turbulent velocity if
    4992             :             ! l_upwind_xpyp_ta is true
    4993           0 :             if ( l_upwind_xpyp_ta ) then
    4994             :               coef_wpsclrp2_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4995           0 :                                         pdf_implicit_coefs_terms%coef_wpsclrp2_implicit(:,:,sclr) )
    4996             :               term_wpsclrp2_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    4997           0 :                                         pdf_implicit_coefs_terms%term_wpsclrp2_explicit(:,:,sclr) )
    4998           0 :               sgn_t_vel_sclrp2(:,:) =sign(one, ( coef_wpsclrp2_implicit_zm(:,:) * sclrp2(:,:,sclr) &
    4999           0 :                                             + term_wpsclrp2_explicit_zm(:,:) ) * sclrp2(:,:,sclr))
    5000             :             endif
    5001             : 
    5002             :             ! Calculate the LHS turbulent advection term for <w'sclr'^2>
    5003             :             call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wpsclrp2_implicit, & ! In
    5004             :                                        rho_ds_zt, rho_ds_zm,                    & ! In
    5005             :                                        invrs_rho_ds_zm,                         & ! In
    5006             :                                        l_upwind_xpyp_ta,                        & ! In
    5007             :                                        sgn_t_vel_sclrp2,                        & ! In
    5008             :                                        coef_wpsclrp2_implicit_zm,               & ! In
    5009           0 :                                        lhs_ta_wpsclrp2(:,:,:,sclr) )              ! Out
    5010             : 
    5011             :             ! Calculate the RHS turbulent advection term for <w'sclr'^2>
    5012             :             call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpsclrp2_explicit, & ! In
    5013             :                                        rho_ds_zt, rho_ds_zm,                    & ! In
    5014             :                                        invrs_rho_ds_zm,                         & ! In
    5015             :                                        l_upwind_xpyp_ta,                        & ! In
    5016             :                                        sgn_t_vel_sclrp2,                        & ! In
    5017             :                                        term_wpsclrp2_explicit_zm,               & ! In
    5018           0 :                                        rhs_ta_wpsclrp2(:,:,sclr) )                ! Out
    5019             : 
    5020           0 :             if ( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    5021           0 :               coef_wprtpsclrp_implicit(:,:) &
    5022           0 :                       = pdf_implicit_coefs_terms%coef_wprtpsclrp_implicit(:,:,sclr)
    5023           0 :               term_wprtpsclrp_explicit(:,:) &
    5024           0 :                       = pdf_implicit_coefs_terms%term_wprtpsclrp_explicit(:,:,sclr)
    5025             :             endif
    5026             : 
    5027             :             ! Calculate the momentum level terms and sign of turbulent velocity if
    5028             :             ! l_upwind_xpyp_ta is true
    5029           0 :             if ( l_upwind_xpyp_ta ) then
    5030             :               coef_wprtpsclrp_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    5031           0 :                                       pdf_implicit_coefs_terms%coef_wprtpsclrp_implicit(:,:,sclr) )
    5032             :               term_wprtpsclrp_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    5033           0 :                                       pdf_implicit_coefs_terms%term_wprtpsclrp_explicit(:,:,sclr) )
    5034             :               sgn_t_vel_sclrprtp(:,:) &
    5035           0 :                         = sign(one, ( coef_wprtpsclrp_implicit_zm(:,:) * sclrprtp(:,:,sclr) &
    5036           0 :                                + term_wprtpsclrp_explicit_zm(:,:) ) * sclrprtp(:,:,sclr))
    5037             :             endif
    5038             : 
    5039             :             ! Calculate the LHS turbulent advection term for <w'rt'sclr'>
    5040             :             call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wprtpsclrp_implicit, & ! In
    5041             :                                        rho_ds_zt, rho_ds_zm,                      & ! In
    5042             :                                        invrs_rho_ds_zm,                           & ! In
    5043             :                                        l_upwind_xpyp_ta,                          & ! In
    5044             :                                        sgn_t_vel_sclrprtp,                        & ! In
    5045             :                                        coef_wprtpsclrp_implicit_zm,               & ! In
    5046           0 :                                        lhs_ta_wprtpsclrp(:,:,:,sclr) )              ! Out
    5047             : 
    5048             :             ! Calculate the RHS turbulent advection term for <w'rt'sclr'>
    5049             :             call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wprtpsclrp_explicit, & ! In
    5050             :                                        rho_ds_zt, rho_ds_zm,                      & ! In
    5051             :                                        invrs_rho_ds_zm,                           & ! In
    5052             :                                        l_upwind_xpyp_ta,                          & ! In
    5053             :                                        sgn_t_vel_sclrprtp,                        & ! In
    5054             :                                        term_wprtpsclrp_explicit_zm,               & ! In
    5055           0 :                                        rhs_ta_wprtpsclrp(:,:,sclr) )                ! In
    5056             : 
    5057           0 :             if ( .not. l_upwind_xpyp_ta .or. stats_metadata%l_stats_samp ) then
    5058           0 :               coef_wpthlpsclrp_implicit(:,:) &
    5059           0 :                     = pdf_implicit_coefs_terms%coef_wpthlpsclrp_implicit(:,:,sclr)
    5060           0 :               term_wpthlpsclrp_explicit(:,:) &
    5061           0 :                     = pdf_implicit_coefs_terms%term_wpthlpsclrp_explicit(:,:,sclr)
    5062             :             endif
    5063             : 
    5064             :             ! Calculate the momentum level terms and sign of turbulent velocity if
    5065             :             ! l_upwind_xpyp_ta is true
    5066           0 :             if ( l_upwind_xpyp_ta ) then
    5067             :               coef_wpthlpsclrp_implicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    5068           0 :                                     pdf_implicit_coefs_terms%coef_wpthlpsclrp_implicit(:,:,sclr) )
    5069             :               term_wpthlpsclrp_explicit_zm(:,:) = zt2zm( nz, ngrdcol, gr, &
    5070           0 :                                     pdf_implicit_coefs_terms%term_wpthlpsclrp_explicit(:,:,sclr) )
    5071             :               sgn_t_vel_sclrpthlp(:,:) &
    5072           0 :                     = sign(one, ( coef_wpthlpsclrp_implicit_zm(:,:) * sclrpthlp(:,:,sclr) &
    5073           0 :                            + term_wpthlpsclrp_explicit_zm(:,:) ) * sclrpthlp(:,:,sclr))
    5074             :             endif
    5075             : 
    5076             :             ! Calculate the LHS turbulent advection term for <w'thl'sclr'>
    5077             :               call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wpthlpsclrp_implicit,  & ! In
    5078             :                                          rho_ds_zt, rho_ds_zm,                        & ! In
    5079             :                                          invrs_rho_ds_zm,                             & ! In
    5080             :                                          l_upwind_xpyp_ta,                            & ! In
    5081             :                                          sgn_t_vel_sclrpthlp,                         & ! In
    5082             :                                          coef_wpthlpsclrp_implicit_zm,                & ! In
    5083           0 :                                          lhs_ta_wpthlpsclrp(:,:,:,sclr) )               ! Out
    5084             : 
    5085             :             ! Calculate the RHS turbulent advection term for <w'thl'sclr'>
    5086             :             call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpthlpsclrp_explicit,  & ! In
    5087             :                                        rho_ds_zt, rho_ds_zm,                        & ! In
    5088             :                                        invrs_rho_ds_zm,                             & ! In
    5089             :                                        l_upwind_xpyp_ta,                            & ! In
    5090             :                                        sgn_t_vel_sclrpthlp,                         & ! In
    5091             :                                        term_wpthlpsclrp_explicit_zm,                & ! In
    5092           0 :                                        rhs_ta_wpthlpsclrp(:,:,sclr) )                 ! Out
    5093             : 
    5094             :           enddo ! sclr = 1, sclr_dim, 1
    5095             : 
    5096             :         endif ! l_scalar_calc
    5097             : 
    5098             :       endif ! iiPDF_type
    5099             : 
    5100             :     endif ! l_explicit_turbulent_adv_xpyp
    5101             : 
    5102      352944 :     if ( iiPDF_type /= iiPDF_new_hybrid ) then
    5103             :         
    5104             :       ! Set up the implicit coefficients and explicit terms for turbulent
    5105             :       ! advection of <u'^2> and <v'^2> following ADG1, then calculate the
    5106             :       ! turbulent advection terms.
    5107             : 
    5108             :       ! CLUBB does not produce a PDF for horizontal wind components u and v.
    5109             :       ! However, the code for the ADG1 PDF is still used to handle the
    5110             :       ! turbulent advection for the variances of the horizontal wind
    5111             :       ! components, <u'^2> and <v'^2>.  The ADG1 code is used regardless of
    5112             :       ! which PDF type or turbulent advection option is used.  The implicit
    5113             :       ! coefficients and explicit terms are calculated on thermodynamic grid
    5114             :       ! levels.
    5115             :         
    5116      352944 :       if ( l_upwind_xpyp_ta ) then
    5117             :         ! Calculate coef_wpup2_wpvp2_implicit, term_wpup2_explicit, and
    5118             :         ! term_wpvp2_explicit on momentum levels as
    5119             :         ! coef_wpup2_wpvp2_implicit_zm(i,:), term_wpup2_explicit_zm, and
    5120             :         ! term_wpvp2_explicit_zm, respectively.
    5121             :         !$acc parallel loop gang vector collapse(2) default(present)
    5122    30353184 :         do k = 1, nz
    5123   501287184 :           do i = 1, ngrdcol              
    5124   470934000 :             coef_wpup2_implicit_zm(i,k) = one_third * beta * a1(i,k) * wp3_on_wp2(i,k)
    5125   470934000 :             coef_wpvp2_implicit_zm(i,k) = coef_wpup2_implicit_zm(i,k)
    5126   470934000 :             term_wpup2_explicit_zm(i,k) = wp_coef(i,k) * upwp(i,k)**2
    5127   500934240 :             term_wpvp2_explicit_zm(i,k) = wp_coef(i,k) * vpwp(i,k)**2
    5128             :           end do
    5129             :         end do
    5130             :         !$acc end parallel loop
    5131             : 
    5132             :         ! For ADG1, the sign of the turbulent velocity is the sign of
    5133             :         ! <w'^3> / <w'^2>.  For simplicity, the sign of turbulent velocity is
    5134             :         ! set to wp3_on_wp2.
    5135             :         !$acc parallel loop gang vector collapse(2) default(present)
    5136    30353184 :         do k = 1, nz
    5137   501287184 :           do i = 1, ngrdcol        
    5138   470934000 :             sgn_t_vel_up2(i,k) = wp3_on_wp2(i,k)
    5139   500934240 :             sgn_t_vel_vp2(i,k) = sgn_t_vel_up2(i,k)
    5140             :           end do
    5141             :         end do
    5142             :         !$acc end parallel loop
    5143             :       else
    5144             :         
    5145             :         ! Interpolate <u'w'> and <v'w'> from the momentum levels to the
    5146             :         ! thermodynamic levels.  These will be used for the turbulent
    5147             :         ! advection terms in each equation.
    5148           0 :         upwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, upwp(:,:) )
    5149           0 :         vpwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, vpwp(:,:) )
    5150             :       
    5151             :         ! Implicit coefficient on <u'^2> or <v'^2> in <w'u'^2> or <w'v'^2>
    5152             :         ! equation.
    5153             :         !$acc parallel loop gang vector collapse(2) default(present)
    5154           0 :         do k = 1, nz
    5155           0 :           do i = 1, ngrdcol        
    5156           0 :             coef_wpup2_implicit(i,k) = one_third * beta * a1_zt(i,k) * wp3_on_wp2_zt(i,k)
    5157           0 :             coef_wpvp2_implicit(i,k) = coef_wpup2_implicit(i,k)
    5158             :           end do
    5159             :         end do
    5160             :         !$acc end parallel loop
    5161             :     
    5162             :         ! Explicit (RHS) term in <w'u'^2> equation.
    5163             :         !$acc parallel loop gang vector collapse(2) default(present)
    5164           0 :         do k = 1, nz
    5165           0 :           do i = 1, ngrdcol
    5166           0 :             term_wpup2_explicit(i,k) = wp_coef_zt(i,k) * upwp_zt(i,k)**2
    5167             :         
    5168             :             ! Explicit (RHS) term in <w'v'^2> equation.
    5169           0 :             term_wpvp2_explicit(i,k) = wp_coef_zt(i,k) * vpwp_zt(i,k)**2
    5170             :           end do
    5171             :         end do
    5172             :         !$acc end parallel loop
    5173             :       end if
    5174             :         
    5175             :       ! Calculate the LHS turbulent advection term for <w'u'^2> and <w'v'^2>
    5176             :       call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wpup2_implicit,  & ! Intent(in)
    5177             :                                  rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    5178             :                                  invrs_rho_ds_zm,                       & ! Intent(in)
    5179             :                                  l_upwind_xpyp_ta,                      & ! Intent(in)
    5180             :                                  sgn_t_vel_up2,                         & ! Intent(in)
    5181             :                                  coef_wpup2_implicit_zm,                & ! Intent(in)
    5182      352944 :                                  lhs_ta_wpup2 )                           ! Intent(out)
    5183             : 
    5184             :       ! The same LHS is used for <w'u'^2> and <w'v'^2>
    5185             :       !$acc parallel loop gang vector collapse(3) default(present)
    5186    30353184 :       do k = 1, nz
    5187   501287184 :         do i = 1, ngrdcol
    5188  1913736240 :           do b = 1, ndiags3
    5189  1883736000 :             lhs_ta_wpvp2(b,i,k) = lhs_ta_wpup2(b,i,k)
    5190             :           end do
    5191             :         end do
    5192             :       end do
    5193             :       !$acc end parallel loop
    5194             :       
    5195             :       ! Calculate the RHS turbulent advection term for <w'u'^2>
    5196             :       call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpup2_explicit,  & ! Intent(in)
    5197             :                                  rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    5198             :                                  invrs_rho_ds_zm,                       & ! Intent(in)
    5199             :                                  l_upwind_xpyp_ta,                      & ! Intent(in)
    5200             :                                  sgn_t_vel_up2,                         & ! Intent(in)
    5201             :                                  term_wpup2_explicit_zm,                & ! Intent(in)
    5202      352944 :                                  rhs_ta_wpup2 )                           ! Intent(out)
    5203             :     
    5204             :       ! Calculate the RHS turbulent advection term for <w'v'^2>
    5205             :       call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wpvp2_explicit,  & ! Intent(in)
    5206             :                                  rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
    5207             :                                  invrs_rho_ds_zm,                       & ! Intent(in)
    5208             :                                  l_upwind_xpyp_ta,                      & ! Intent(in)
    5209             :                                  sgn_t_vel_vp2,                         & ! Intent(in)
    5210             :                                  term_wpvp2_explicit_zm,                & ! Intent(in)
    5211      352944 :                                  rhs_ta_wpvp2 )                           ! Intent(out)
    5212             :      
    5213             :     endif ! iiPDF_type /= iiPDF_new_hybrid
    5214             : 
    5215             :     ! Stats output for implicit coefficients and explicit terms of 
    5216             :     ! <w'rt'^2>, <w'thl'^2>, and <w'rt'thl'> used in the calcualtion of
    5217             :     ! the turbulent advection terms
    5218      352944 :     if ( stats_metadata%l_stats_samp ) then
    5219             :       !$acc update host( coef_wprtp2_implicit, term_wprtp2_explicit, &
    5220             :       !$acc              coef_wpthlp2_implicit, term_wpthlp2_explicit, &
    5221             :       !$acc              coef_wprtpthlp_implicit, term_wprtpthlp_explicit )
    5222           0 :       do i = 1, ngrdcol
    5223           0 :         call stat_update_var( stats_metadata%icoef_wprtp2_implicit, coef_wprtp2_implicit(i,:), & ! intent(in)
    5224           0 :                               stats_zt(i) )                                     ! intent(inout)
    5225             :         call stat_update_var( stats_metadata%iterm_wprtp2_explicit, term_wprtp2_explicit(i,:), & ! intent(in)
    5226           0 :                               stats_zt(i) )                                     ! intent(in)
    5227             :         call stat_update_var( stats_metadata%icoef_wpthlp2_implicit, coef_wpthlp2_implicit(i,:), & ! intent(in)
    5228           0 :                               stats_zt(i) ) ! intent(inout)
    5229             :         call stat_update_var( stats_metadata%iterm_wpthlp2_explicit, term_wpthlp2_explicit(i,:), & ! intent(in)
    5230           0 :                               stats_zt(i) ) ! intent(inout)
    5231             :         call stat_update_var( stats_metadata%icoef_wprtpthlp_implicit, coef_wprtpthlp_implicit(i,:), & ! intent(in)
    5232           0 :                               stats_zt(i) ) ! intent(inout)
    5233             :         call stat_update_var( stats_metadata%iterm_wprtpthlp_explicit, term_wprtpthlp_explicit(i,:), & ! intent(in)
    5234           0 :                               stats_zt(i) ) ! intent(inout)
    5235             :       end do
    5236             :     end if ! stats_metadata%l_stats_samp
    5237             : 
    5238             :     !$acc exit data delete( coef_wprtp2_implicit, term_wprtp2_explicit, &
    5239             :     !$acc                 coef_wprtp2_implicit_zm, term_wprtp2_explicit_zm, &
    5240             :     !$acc                 coef_wpthlp2_implicit, term_wpthlp2_explicit, &
    5241             :     !$acc                 term_wpthlp2_explicit_zm, &
    5242             :     !$acc                 coef_wprtpthlp_implicit, term_wprtpthlp_explicit, &
    5243             :     !$acc                 coef_wpvp2_implicit_zm, term_wprtpthlp_explicit_zm, &
    5244             :     !$acc                 coef_wpup2_implicit, term_wpup2_explicit, coef_wpvp2_implicit, &
    5245             :     !$acc                 term_wpvp2_explicit, coef_wpup2_implicit_zm, term_wpup2_explicit_zm, &
    5246             :     !$acc                 term_wpvp2_explicit_zm, sgn_t_vel_rtp2, &
    5247             :     !$acc                 sgn_t_vel_thlp2, sgn_t_vel_rtpthlp, sgn_t_vel_up2, sgn_t_vel_vp2, & 
    5248             :     !$acc                 a1, a1_zt, upwp_zt, vpwp_zt, wprtp_zt, wpthlp_zt, wp_coef, wp_coef_zt )
    5249             : 
    5250             :     !$acc exit data if( sclr_dim > 0 ) &
    5251             :     !$acc         delete( coef_wpsclrp2_implicit, term_wpsclrp2_explicit, &
    5252             :     !$acc                 coef_wpsclrp2_implicit_zm, term_wpsclrp2_explicit_zm, &
    5253             :     !$acc                 coef_wprtpsclrp_implicit, term_wprtpsclrp_explicit, &
    5254             :     !$acc                 coef_wprtpsclrp_implicit_zm, term_wprtpsclrp_explicit_zm, &
    5255             :     !$acc                 coef_wpthlpsclrp_implicit, coef_wpthlpsclrp_implicit_zm, &
    5256             :     !$acc                 term_wpthlpsclrp_explicit_zm, sgn_t_vel_sclrp2, sgn_t_vel_sclrprtp, &
    5257             :     !$acc                 sgn_t_vel_sclrpthlp, wpsclrp_zt )
    5258             :     
    5259      352944 :     return
    5260             :                                  
    5261             :   end subroutine calc_xp2_xpyp_ta_terms
    5262             : 
    5263             :   !=============================================================================
    5264     1764720 :   subroutine term_tp_rhs( nz, ngrdcol, xam, xbm,  & 
    5265     1764720 :                           wpxbp, wpxap, invrs_dzm, &
    5266     1764720 :                           rhs )
    5267             :     ! Description:
    5268             :     ! Turbulent production of x_a'x_b':  explicit portion of the code.
    5269             :     !
    5270             :     ! The d(x_a'x_b')/dt equation contains a turbulent production term:
    5271             :     !
    5272             :     ! - w'x_b' d(x_am)/dz - w'x_a' d(x_bm)/dz.
    5273             :     !
    5274             :     ! This term is solved for completely explicitly and is discretized as
    5275             :     ! follows:
    5276             :     !
    5277             :     ! The values of w'x_a' and w'x_b' are found on the momentum levels, whereas
    5278             :     ! the values of x_am and x_bm are found on the thermodynamic levels.  The
    5279             :     ! derivatives of both x_am and x_bm are taken over the intermediate
    5280             :     ! (central) momentum level.  All of the remaining mathematical operations
    5281             :     ! take place at the central momentum level, yielding the desired result.
    5282             :     !
    5283             :     ! ---------xamp1------------xbmp1-------------------------- t(k+1)
    5284             :     !
    5285             :     ! ===wpxap======d(xam)/dz=========d(xbm)/dz===wpxbp======== m(k)
    5286             :     !
    5287             :     ! ---------xam--------------xbm---------------------------- t(k)
    5288             :     !
    5289             :     ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes
    5290             :     ! zt(k+1), zm(k), and zt(k), respectively.  The letter "t" is used for
    5291             :     ! thermodynamic levels and the letter "m" is used for momentum levels.
    5292             :     !
    5293             :     ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) )
    5294             : 
    5295             :     ! References:
    5296             :     !-----------------------------------------------------------------------
    5297             : 
    5298             :     use clubb_precision, only: &
    5299             :         core_rknd ! Variable(s)
    5300             : 
    5301             :     implicit none
    5302             : 
    5303             :     !------------------------ Input variables ------------------------
    5304             :     integer, intent(in) :: &
    5305             :       nz, &
    5306             :       ngrdcol
    5307             : 
    5308             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: & 
    5309             :       xam,       & ! x_am(k)                     [{x_am units}]
    5310             :       xbm,       & ! x_bm(k)                     [{x_bm units}]
    5311             :       wpxbp,     & ! w'x_b'(k)                   [m/s {x_bm units}]
    5312             :       wpxap,     & ! w'x_a'(k)                   [m/s {x_am units}]
    5313             :       invrs_dzm    ! Inverse of grid spacing (k) [1/m]
    5314             : 
    5315             :     !------------------------ Return Variable ------------------------
    5316             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    5317             :       rhs
    5318             : 
    5319             :     !------------------------ Local Variables ------------------------
    5320             :     integer :: i, k
    5321             : 
    5322             :     !------------------------ Begin Code ------------------------
    5323             : 
    5324             :     !$acc data copyin( xam, xbm, wpxbp, wpxap, invrs_dzm ) &
    5325             :     !$acc     copyout( rhs )
    5326             : 
    5327             :     !$acc parallel loop gang vector collapse(2) default(present)
    5328   148236480 :     do k = 2, nz-1
    5329  2447502480 :       do i = 1, ngrdcol
    5330  6897798000 :         rhs(i,k) = - wpxbp(i,k) * invrs_dzm(i,k) * ( xam(i,k+1) - xam(i,k) ) & 
    5331  9343535760 :                    - wpxap(i,k) * invrs_dzm(i,k) * ( xbm(i,k+1) - xbm(i,k) )
    5332             :       end do
    5333             :     end do
    5334             :     !$acc end parallel loop
    5335             : 
    5336             :     !$acc end data
    5337             : 
    5338     1764720 :     return
    5339             : 
    5340             :   end subroutine term_tp_rhs
    5341             : 
    5342             :   !=============================================================================
    5343     2823552 :   subroutine term_dp1_lhs( nz, ngrdcol, &
    5344     2823552 :                            Cn, invrs_tau_zm, &
    5345     2823552 :                            lhs )
    5346             :     ! Description:
    5347             :     ! Dissipation term 1 for x_a'x_b':  implicit portion of the code.
    5348             :     !
    5349             :     ! The d(x_a'x_b')/dt equation contains dissipation term 1:
    5350             :     !
    5351             :     ! - ( C_n / tau_zm ) x_a'x_b'.
    5352             :     !
    5353             :     ! For cases where x_a'x_b' is a variance (in other words, where x_a and x_b
    5354             :     ! are the same variable), the term is damped to a certain positive
    5355             :     ! threshold, such that:
    5356             :     !
    5357             :     ! - ( C_n / tau_zm ) * ( x_a'x_b' - threshold ).
    5358             :     !
    5359             :     ! However, if x_a'x_b' is u'^2 or v'^2, damping to a minimum threshold value
    5360             :     ! is part of pressure term 1 and is handled as part of function 'term_pr1'.
    5361             :     ! Thus, for u'^2 and v'^2, function 'term_dp1_lhs' is called, but function
    5362             :     ! 'term_dp1_rhs' is not called, as function 'term_pr1' is called instead.
    5363             :     !
    5364             :     ! For cases where x_a'x_b' is a covariance (in other words, where x_a and
    5365             :     ! x_b are different variables), threshold is set to 0, and the expression
    5366             :     ! reverts to the form found in the first equation.
    5367             :     !
    5368             :     ! This term is broken into implicit and explicit portions.  The equations
    5369             :     ! for u'^2, v'^2, and any covariances only include the implicit portion.
    5370             :     ! The implicit portion of this term is:
    5371             :     !
    5372             :     ! - ( C_n / tau_zm ) x_a'x_b'(t+1).
    5373             :     !
    5374             :     ! Note:  When the implicit term is brought over to the left-hand side,
    5375             :     !        the sign is reversed and the leading "-" in front of the term
    5376             :     !        is changed to a "+".
    5377             :     !
    5378             :     ! The timestep index (t+1) means that the value of x_a'x_b' being used is
    5379             :     ! from the next timestep, which is being advanced to in solving the
    5380             :     ! d(x_a'x_b')/dt equation.
    5381             :     !
    5382             :     ! The values of x_a'x_b' are found on momentum levels.  The values of
    5383             :     ! time-scale tau_zm are also found on momentum levels.
    5384             :     !
    5385             :     ! Note:  For equations that use pressure term 1 (such as the equations for
    5386             :     !        u'^2 and v'^2), C_n = ( 2*C_4 + C_14 ) / 3; which combines the
    5387             :     !        implicit contributions for dissipation term 1 and pressure term 1
    5388             :     !        into one expression.  Otherwise, C_n = C_2.
    5389             : 
    5390             :     ! References:
    5391             :     !-----------------------------------------------------------------------
    5392             : 
    5393             :     use clubb_precision, only: &
    5394             :         core_rknd ! Variable(s)
    5395             : 
    5396             :     use constants_clubb, only: &
    5397             :         zero
    5398             : 
    5399             :     implicit none
    5400             : 
    5401             :     !--------------------------- Input Variables ---------------------------
    5402             :     integer, intent(in) :: &
    5403             :       nz, &
    5404             :       ngrdcol
    5405             : 
    5406             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: & 
    5407             :       Cn,          & ! Coefficient C_n                       [-]
    5408             :       invrs_tau_zm   ! Inverse time-scale tau at momentum levels (k) [1/s]
    5409             : 
    5410             :     !--------------------------- Return Variables ---------------------------
    5411             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    5412             :       lhs
    5413             : 
    5414             :     !--------------------------- Local Variables ---------------------------
    5415             :     integer :: i, k
    5416             : 
    5417             :     !--------------------------- Begin Code ---------------------------
    5418             :     
    5419             :     !$acc data copyin( Cn, invrs_tau_zm ) &
    5420             :     !$acc     copyout( lhs ) 
    5421             : 
    5422             :     !$acc parallel loop gang vector default(present)
    5423    47146752 :     do i = 1, ngrdcol
    5424             :       ! Zero boundary
    5425    44323200 :       lhs(i,1) = zero
    5426    47146752 :       lhs(i,nz) = zero
    5427             :     end do
    5428             :     !$acc end parallel loop
    5429             : 
    5430             :     !$acc parallel loop gang vector collapse(2) default(present)
    5431   237178368 :     do k = 2, nz-1
    5432  3916003968 :       do i = 1, ngrdcol
    5433             :         ! Momentum main diagonal: [ x xapxbp(k,<t+1>) ]
    5434  3913180416 :         lhs(i,k) = + Cn(i,k) * invrs_tau_zm(i,k)
    5435             :       end do
    5436             :     end do
    5437             :     !$acc end parallel loop
    5438             : 
    5439             :     !$acc end data
    5440             : 
    5441     2823552 :     return
    5442             : 
    5443             :   end subroutine term_dp1_lhs
    5444             : 
    5445             :   !=============================================================================
    5446     1058832 :   subroutine term_dp1_rhs( nz, ngrdcol, &
    5447     1058832 :                            Cn, invrs_tau_zm, threshold, &
    5448     1058832 :                            rhs ) 
    5449             :     ! Description:
    5450             :     ! Dissipation term 1 for x_a'x_b':  explicit portion of the code.
    5451             :     !
    5452             :     ! The d(x_a'x_b')/dt equation contains dissipation term 1:
    5453             :     !
    5454             :     ! - ( C_n / tau_zm ) x_a'x_b'.
    5455             :     !
    5456             :     ! For cases where x_a'x_b' is a variance (in other words, where x_a and x_b
    5457             :     ! are the same variable), the term is damped to a certain positive
    5458             :     ! threshold, such that:
    5459             :     !
    5460             :     ! - ( C_n / tau_zm ) * ( x_a'x_b' - threshold ).
    5461             :     !
    5462             :     ! However, if x_a'x_b' is u'^2 or v'^2, damping to a minimum threshold value
    5463             :     ! is part of pressure term 1 and is handled as part of function 'term_pr1'.
    5464             :     ! Thus, for u'^2 and v'^2, function 'term_dp1_lhs' is called, but function
    5465             :     ! 'term_dp1_rhs' is not called, as function 'term_pr1' is called instead.
    5466             :     !
    5467             :     ! For cases where x_a'x_b' is a covariance (in other words, where x_a and
    5468             :     ! x_b are different variables), threshold is set to 0, and the expression
    5469             :     ! reverts to the form found in the first equation.
    5470             :     !
    5471             :     ! This term is broken into implicit and explicit portions.  The equations
    5472             :     ! for u'^2, v'^2, and any covariances only include the implicit portion.
    5473             :     ! The explicit portion of this term is:
    5474             :     !
    5475             :     ! + ( C_n / tau_zm ) * threshold.
    5476             :     !
    5477             :     ! The values of time-scale tau_zm and the threshold are found on the
    5478             :     ! momentum levels.
    5479             :     !
    5480             :     ! Note:  The equations that use pressure term 1 (such as the equations for
    5481             :     !        u'^2 and v'^2) do not call this function.  Thus, within this
    5482             :     !        function, C_n = C_2.
    5483             : 
    5484             :     ! References:
    5485             :     !-----------------------------------------------------------------------
    5486             : 
    5487             :     use clubb_precision, only: &
    5488             :         core_rknd ! Variable(s)
    5489             : 
    5490             :     implicit none
    5491             : 
    5492             :     !--------------------------- Input Variables ---------------------------
    5493             :     integer, intent(in) :: &
    5494             :       nz, &
    5495             :       ngrdcol
    5496             : 
    5497             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    5498             :       Cn,             & ! Coefficient C_n                               [-]
    5499             :       invrs_tau_zm      ! Time-scale tau at momentum levels (k)         [1/s]
    5500             : 
    5501             :     real( kind = core_rknd ) :: &
    5502             :       threshold         ! Minimum allowable magnitude value of x_a'x_b' [units vary]
    5503             : 
    5504             :     !--------------------------- Return Variable ---------------------------
    5505             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    5506             :       rhs
    5507             : 
    5508             :     !--------------------------- Local Variables ---------------------------
    5509             :     integer :: i, k
    5510             : 
    5511             :     !--------------------------- Begin Code ---------------------------
    5512             : 
    5513             :     !$acc data copyin( Cn, invrs_tau_zm ) &
    5514             :     !$acc     copyout( rhs ) 
    5515             : 
    5516             :     !$acc parallel loop gang vector collapse(2) default(present)
    5517    91059552 :     do k = 1, nz
    5518  1503861552 :       do i = 1, ngrdcol
    5519  1502802720 :         rhs(i,k) = + Cn(i,k) * invrs_tau_zm(i,k) * threshold
    5520             :       end do
    5521             :     end do
    5522             :     !$acc end parallel loop
    5523             : 
    5524             :     !$acc end data
    5525             : 
    5526     1058832 :     return
    5527             : 
    5528             :   end subroutine term_dp1_rhs
    5529             : 
    5530             :   !=============================================================================
    5531      705888 :   subroutine term_pr1( nz, ngrdcol, C4, C14, xbp2, &
    5532      705888 :                        wp2, invrs_tau_C4_zm, invrs_tau_C14_zm, &
    5533      705888 :                        rhs )
    5534             :     ! Description:
    5535             :     ! Pressure term 1 for x_a'x_b':  explicit portion of the code.
    5536             :     !
    5537             :     ! Note:  Pressure term 1 is only used when x_a'x_b' is either u'^2 or v'^2.
    5538             :     !        For the following description, pressure term 2 for u'^2 is used as
    5539             :     !        the example.  Pressure term 2 for v'^2 is the same as pressure
    5540             :     !        term 2 for u'^2, except that the v'^2 and u'^2 variables are
    5541             :     !        switched.
    5542             :     !
    5543             :     ! The d(u'^2)/dt equation contains dissipation term 1:
    5544             :     !
    5545             :     ! - ( C_4 / tau_zm ) * ( u'^2 - (2/3)*em );
    5546             :     !
    5547             :     ! where em = (1/2) * ( u'^2 + v'^2 + w'^2 );
    5548             :     !
    5549             :     ! and with the substitution applied, dissipation term 1 becomes:
    5550             :     !
    5551             :     ! - ( C_4 / tau_zm ) * ( u'^2 - (1/3) * ( u'^2 + v'^2 + w'^2 ) ).
    5552             :     !
    5553             :     ! The d(u'^2)/dt equation also contains pressure term 1:
    5554             :     !
    5555             :     ! - (2/3) * epsilon;
    5556             :     !
    5557             :     ! where epsilon = C_14 * ( em / tau_zm ).
    5558             :     !
    5559             :     ! Additionally, since pressure term 1 is a damping term, em is damped only
    5560             :     ! to it's minimum threshold value, em_min, where:
    5561             :     !
    5562             :     ! em_min = (1/2) * ( u'^2|_min + v'^2|_min + w'^2|_min )
    5563             :     !      = (1/2) * ( w_tol^2 + w_tol^2 + w_tol^2 )
    5564             :     !      = (3/2) * w_tol^2.
    5565             :     !
    5566             :     ! With the damping threshold applied, epsilon becomes:
    5567             :     !
    5568             :     ! epsilon = C_14 * ( ( em - em_min ) / tau_zm );
    5569             :     !
    5570             :     ! and with all substitutions applied, pressure term 1 becomes:
    5571             :     !
    5572             :     ! - (2/3) * ( C_14 / tau_zm )
    5573             :     !         * [ (1/2) * ( u'^2 + v'^2 + w'^2 ) - (3/2) * w_tol^2 ].
    5574             :     !
    5575             :     ! Dissipation term 1 and pressure term 1 are combined and simplify to:
    5576             :     !
    5577             :     ! - [ ( 2*C_4 + C_14 ) / ( 3 * tau_zm ) ] * u'^2
    5578             :     !    + [ ( C_4 - C_14 ) / ( 3 * tau_zm ) ] * ( v'^2 + w'^2 )
    5579             :     !    + ( C_14 / tau_zm ) * w_tol^2.
    5580             :     !
    5581             :     ! The combined term has both implicit and explicit components.
    5582             :     ! The implicit component is:
    5583             :     !
    5584             :     ! - [ ( 2*C_4 + C_14 ) / ( 3 * tau_zm ) ] * u'^2(t+1).
    5585             :     !
    5586             :     ! Note:  When the implicit term is brought over to the left-hand side,
    5587             :     !        the sign is reversed and the leading "-" in front of the term
    5588             :     !        is changed to a "+".
    5589             :     !
    5590             :     ! Timestep index (t) stands for the index of the current timestep, while
    5591             :     ! timestep index (t+1) stands for the index of the next timestep, which is
    5592             :     ! being advanced to in solving the d(x_a'x_b')/dt equation.
    5593             :     !
    5594             :     ! The implicit component of the combined dp1 and pr1 term is solved in
    5595             :     ! function "term_dp1_lhs" above, where "( 2*C_4 + C_14 ) / 3" is sent in
    5596             :     ! as "C_n".
    5597             :     !
    5598             :     ! The explicit component of the combined dp1 and pr1 term is:
    5599             :     !
    5600             :     ! + [ ( C_4 - C_14 ) / ( 3 * tau_zm ) ] * ( v'^2(t) + w'^2(t) )
    5601             :     ! + ( C_14 / tau_zm ) * w_tol^2;
    5602             :     !
    5603             :     ! and is discretized as follows:
    5604             :     !
    5605             :     ! The values for v'^2 and w'^2, as well as for tau_zm, are found on the
    5606             :     ! momentum levels.  The mathematical operations all take place on the
    5607             :     ! momentum levels, yielding the desired result.
    5608             : 
    5609             :     ! References:
    5610             :     !-----------------------------------------------------------------------
    5611             : 
    5612             :     use constants_clubb, only: &
    5613             :         w_tol_sqd, & ! Constant(s)
    5614             :         one_third
    5615             : 
    5616             :     use clubb_precision, only: &
    5617             :         core_rknd ! Variable(s)
    5618             : 
    5619             :     implicit none
    5620             : 
    5621             :     !------------------------- Input Variables -------------------------
    5622             :     integer, intent(in) :: &
    5623             :       nz, &
    5624             :       ngrdcol
    5625             : 
    5626             :     real( kind = core_rknd ), intent(in) :: & 
    5627             :       C4,              & ! Model parameter C_4                                 [-]
    5628             :       C14                ! Model parameter C_14                                [-]
    5629             : 
    5630             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: & 
    5631             :       xbp2,            & ! v'^2(k) (if solving for u'^2) or vice versa         [m^2/s^2]
    5632             :       wp2,             & ! w'^2(k)                                             [m^2/s^2]
    5633             :       invrs_tau_C4_zm, & ! Time-scale tau for C4 terms at momentum levels (k)  [1/s]
    5634             :       invrs_tau_C14_zm   ! Time-scale tau for C14 terms at momentum levels (k) [1/s]
    5635             : 
    5636             :     ! Return Variable
    5637             :     !------------------------- Return Variables -------------------------
    5638             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    5639             :       rhs
    5640             : 
    5641             :     !------------------------- Local Variables -------------------------
    5642             :     integer :: i, k
    5643             : 
    5644             :     !------------------------- Begin Code -------------------------
    5645             : 
    5646             :     !$acc data copyin( xbp2, wp2, invrs_tau_C4_zm, invrs_tau_C14_zm ) &
    5647             :     !$acc     copyout( rhs )
    5648             : 
    5649             :     !$acc parallel loop gang vector collapse(2) default(present)
    5650    59294592 :     do k = 2, nz-1
    5651   979000992 :       do i = 1, ngrdcol
    5652  1839412800 :         rhs(i,k) = + one_third * C4 * ( xbp2(i,k) + wp2(i,k) ) * invrs_tau_C4_zm(i,k)  &
    5653             :                    - one_third * C14 * ( xbp2(i,k) + wp2(i,k) ) * invrs_tau_C14_zm(i,k)  &
    5654  2817707904 :                    + C14 * invrs_tau_C14_zm(i,k) * w_tol_sqd
    5655             :       end do
    5656             :     end do
    5657             :     !$acc end parallel loop
    5658             : 
    5659             :     !$acc end data
    5660             : 
    5661      705888 :     return
    5662             : 
    5663             :   end subroutine term_pr1
    5664             : 
    5665             :   !=============================================================================
    5666      705888 :   subroutine term_pr2( nz, ngrdcol, gr, &
    5667      705888 :                        C_uu_shr, C_uu_buoy, thv_ds_zm, wpthvp, upwp, & 
    5668      705888 :                        vpwp, um, vm, &
    5669      705888 :                        rhs_pr2 )
    5670             : 
    5671             :     ! Description:
    5672             :     ! Pressure term 2 for x_a'x_b':  explicit portion of the code.
    5673             :     !
    5674             :     ! Note:  Pressure term 2 is only used when x_a'x_b' is either u'^2 or v'^2.
    5675             :     !        For the following description, pressure term 2 for u'^2 is used as
    5676             :     !        the example.  Pressure term 2 for v'^2 is the exact same as
    5677             :     !        pressure term 2 for u'^2.
    5678             :     !
    5679             :     ! The d(u'^2)/dt equation contains pressure term 2:
    5680             :     !
    5681             :     ! + (2/3) C_5 [ (g/thv_ds) w'th_v' - u'w' du/dz - v'w' dv/dz ].
    5682             :     !
    5683             :     ! Note that below we have broken up C5 into C_uu_shr for shear terms and 
    5684             :     ! C_uu_buoy for buoyancy terms.
    5685             :     !
    5686             :     ! This term is solved for completely explicitly and is discretized as
    5687             :     ! follows:
    5688             :     !
    5689             :     ! The values of w'th_v', u'w', and v'w' are found on the momentum levels,
    5690             :     ! whereas the values of um and vm are found on the thermodynamic levels.
    5691             :     ! Additionally, the values of thv_ds_zm are found on the momentum levels.
    5692             :     ! The derivatives of both um and vm are taken over the intermediate
    5693             :     ! (central) momentum level.  All the remaining mathematical operations take
    5694             :     ! place at the central momentum level, yielding the desired result.
    5695             :     !
    5696             :     ! -----ump1------------vmp1-------------------------------------- t(k+1)
    5697             :     !
    5698             :     ! =upwp====d(um)/dz========d(vm)/dz==vpwp===thv_ds_zm==wpthvp==== m(k)
    5699             :     !
    5700             :     ! -----um--------------vm---------------------------------------- t(k)
    5701             :     !
    5702             :     ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes
    5703             :     ! zt(k+1), zm(k), and zt(k), respectively.  The letter "t" is used for
    5704             :     ! thermodynamic levels and the letter "m" is used for momentum levels.
    5705             :     !
    5706             :     ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) )
    5707             : 
    5708             :     ! References:
    5709             :     !-----------------------------------------------------------------------
    5710             : 
    5711             :     use constants_clubb, only: & ! Constants 
    5712             :         grav, & ! Gravitational acceleration [m/s^2]
    5713             :         two_thirds, &
    5714             :         zero_threshold
    5715             : 
    5716             :     use grid_class, only: &
    5717             :         grid ! Type
    5718             : 
    5719             :     use clubb_precision, only: &
    5720             :         core_rknd ! Variable(s)
    5721             : 
    5722             :     implicit none
    5723             : 
    5724             :     ! External
    5725             :     intrinsic :: abs, max
    5726             : 
    5727             :     ! ------------ Input Variables ------------
    5728             :     integer, intent(in) :: &
    5729             :       nz, &
    5730             :       ngrdcol
    5731             : 
    5732             :     type (grid), intent(in) :: gr
    5733             :       
    5734             :     real( kind = core_rknd ), intent(in) :: & 
    5735             :       C_uu_shr,  & ! Model parameter C_uu_shr                       [-]
    5736             :       C_uu_buoy    ! Model parameter C_uu_buoy                      [-]
    5737             :       
    5738             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    5739             :       thv_ds_zm, & ! Dry, base-state theta_v at momentum level (k)  [K]
    5740             :       wpthvp,    & ! w'th_v'(k)                                     [m/K/s]
    5741             :       upwp,      & ! u'w'(k)                                        [m^2/s^2]
    5742             :       vpwp         ! v'w'(k)                                        [m^2/s^2]
    5743             : 
    5744             :     ! Note: Entire arrays of um and vm are now required rather than um and vm
    5745             :     ! only at levels k and k+1.  The entire array is necessary when a vertical
    5746             :     ! average calculation of d(um)/dz and d(vm)/dz is used. --ldgrant March 2010
    5747             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    5748             :       um,  & ! mean zonal wind       [m/s]
    5749             :       vm     ! mean meridional wind  [m/s]
    5750             : 
    5751             :     ! ------------ Output Variable ------------
    5752             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    5753             :       rhs_pr2
    5754             :     
    5755             :     ! ------------ Local Variables ------------
    5756             :     integer :: i, k
    5757             :     
    5758             : 
    5759             :     ! calculation for d(um)/dz and d(vm)/dz
    5760             : 
    5761             :     ! ------------ Begin code ------------
    5762             : 
    5763             :     ! use original version of term_pr2
    5764             : 
    5765             :     ! As applied to w'2
    5766             :     !$acc parallel loop gang vector collapse(2) default(present)
    5767    59294592 :     do k = 2, nz-1
    5768   979000992 :       do i = 1, ngrdcol
    5769  1839412800 :         rhs_pr2(i,k) = + two_thirds &
    5770             :                        * ( C_uu_buoy &
    5771             :                           * ( grav / thv_ds_zm(i,k) ) * wpthvp(i,k) &
    5772             :                         + C_uu_shr &
    5773   919706400 :                           * ( - upwp(i,k) * gr%invrs_dzm(i,k) * ( um(i,k+1) - um(i,k) ) &
    5774             :                               - vpwp(i,k) * gr%invrs_dzm(i,k) * ( vm(i,k+1) - vm(i,k) ) &
    5775             :                             ) &
    5776  2759119200 :                         )
    5777             : 
    5778             :         ! Added by dschanen for ticket #36
    5779             :         ! We have found that when shear generation is zero this term will only be
    5780             :         ! offset by hole-filling (up2_pd/vp2_pd) and reduces turbulence 
    5781             :         ! unrealistically at lower altitudes to make up the difference.
    5782   978295104 :         rhs_pr2(i,k) = max( rhs_pr2(i,k), zero_threshold )
    5783             :       end do
    5784             :     end do
    5785             :     !$acc end parallel loop
    5786             : 
    5787      705888 :     return
    5788             : 
    5789             :   end subroutine term_pr2
    5790             : 
    5791             :   !=============================================================================
    5792     1411776 :   subroutine pos_definite_variances( nz, ngrdcol, gr, &
    5793             :                                      solve_type, dt, tolerance, &
    5794     1411776 :                                      rho_ds_zm, rho_ds_zt, &
    5795             :                                      stats_metadata, &
    5796     1411776 :                                      stats_zm, &
    5797     1411776 :                                      xp2_np1 )
    5798             : 
    5799             :     ! Description:
    5800             :     ! Use the hole filling code to make a variance term positive definite
    5801             :     !-----------------------------------------------------------------------
    5802             : 
    5803             :     use constants_clubb, only: num_hf_draw_points
    5804             :     use fill_holes, only: fill_holes_vertical
    5805             :     use grid_class, only: grid
    5806             :     use clubb_precision, only: core_rknd
    5807             : 
    5808             :     use stats_variables, only:  & 
    5809             :         stats_metadata_type
    5810             : 
    5811             :     use stats_type_utilities, only:  & 
    5812             :         stat_begin_update, stat_end_update ! subroutines
    5813             : 
    5814             : 
    5815             :     use stats_type, only: stats ! Type
    5816             : 
    5817             :     implicit none
    5818             : 
    5819             :     !------------------- Input variables ------------------
    5820             :     integer, intent(in) :: &
    5821             :       nz, &
    5822             :       ngrdcol
    5823             : 
    5824             :     type (grid), target, intent(in) :: &
    5825             :       gr
    5826             :     
    5827             :     integer, intent(in) :: & 
    5828             :       solve_type
    5829             : 
    5830             :     real( kind = core_rknd ), intent(in) :: & 
    5831             :       dt        ! Model timestep              [s]
    5832             : 
    5833             :     real( kind = core_rknd ), intent(in) :: & 
    5834             :       tolerance ! Threshold for xp2_np1       [units vary]
    5835             : 
    5836             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    5837             :       rho_ds_zm, & ! Dry, static density on momentum levels         [kg/m^3]
    5838             :       rho_ds_zt    ! Dry, static density on thermodynamic levels    [kg/m^3]
    5839             : 
    5840             :     type (stats_metadata_type), intent(in) :: &
    5841             :       stats_metadata
    5842             : 
    5843             :     !------------------- Input/Output variables ------------------
    5844             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
    5845             :       stats_zm
    5846             :       
    5847             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  & 
    5848             :       xp2_np1   ! Variance for <n+1>          [units vary]
    5849             : 
    5850             :     !------------------- Local variables ------------------
    5851             :     integer :: & 
    5852             :       ixp2_pd, i
    5853             : 
    5854             :     !------------------- Begin Code ------------------
    5855             : 
    5856     1764720 :     select case( solve_type )
    5857             :     case ( xp2_xpyp_rtp2 )
    5858      352944 :       ixp2_pd = stats_metadata%irtp2_pd
    5859             :     case ( xp2_xpyp_thlp2 )
    5860      352944 :       ixp2_pd = stats_metadata%ithlp2_pd
    5861             :     case ( xp2_xpyp_up2 )
    5862      352944 :       ixp2_pd = stats_metadata%iup2_pd
    5863             :     case ( xp2_xpyp_vp2 )
    5864      352944 :       ixp2_pd = stats_metadata%ivp2_pd
    5865             :     case default
    5866     1411776 :       ixp2_pd = 0 ! This includes the passive scalars
    5867             :     end select
    5868             : 
    5869     1411776 :     if ( stats_metadata%l_stats_samp ) then
    5870             : 
    5871             :       !$acc update host( xp2_np1 )
    5872             : 
    5873             :       ! Store previous value for effect of the positive definite scheme
    5874           0 :       do i = 1, ngrdcol
    5875           0 :         call stat_begin_update( nz, ixp2_pd, xp2_np1(i,:) / dt, &   ! Intent(in)
    5876           0 :                                 stats_zm(i) )                          ! Intent(inout)
    5877             :       end do
    5878             :     endif
    5879             : 
    5880             :     ! Call the hole-filling scheme.
    5881             :     ! The first pass-through should draw from only two levels on either side
    5882             :     ! of the hole.
    5883             :     ! upper_hf_level = nz-1 since we are filling the zm levels
    5884             :     call fill_holes_vertical( nz, ngrdcol, num_hf_draw_points, tolerance, nz-1, & ! In
    5885             :                               gr%dzm, rho_ds_zm,                                & ! In
    5886     1411776 :                               xp2_np1 )                                           ! InOut
    5887             : 
    5888     1411776 :     if ( stats_metadata%l_stats_samp ) then
    5889             : 
    5890             :       !$acc update host( xp2_np1 )
    5891             : 
    5892             :       ! Store previous value for effect of the positive definite scheme
    5893           0 :       do i = 1, ngrdcol
    5894           0 :         call stat_end_update( nz, ixp2_pd, xp2_np1(i,:) / dt, & ! Intent(in)
    5895           0 :                               stats_zm(i) )                        ! Intent(inout)
    5896             :       end do
    5897             :     endif
    5898             : 
    5899     1411776 :     return
    5900             : 
    5901             :   end subroutine pos_definite_variances
    5902             : 
    5903             :   !============================================================================
    5904           0 :   subroutine update_xp2_mc( gr, nz, ngrdcol, dt, cloud_frac, rcm, rvm, thlm, &
    5905           0 :                             wm, exner, rrm_evap, pdf_params,        &
    5906           0 :                             rtp2_mc, thlp2_mc, wprtp_mc, wpthlp_mc,    &
    5907           0 :                             rtpthlp_mc )
    5908             :     !Description:
    5909             :     !This subroutine is for use when l_morr_xp2_mc = .true.
    5910             :     !The effects of rain evaporation on rtp2 and thlp2 are included by
    5911             :     !assuming rain falls through the moist (cold) portion of the pdf.
    5912             :     !This is accomplished by defining a precip_fraction and assuming a double
    5913             :     !delta shaped pdf, such that the evaporation makes the moist component 
    5914             :     !moister and the colder component colder. Calculations are done using
    5915             :     !variables on the zt grid, and the outputs are on the zm grid --storer
    5916             : 
    5917             :     use pdf_parameter_module, only: pdf_parameter
    5918             : 
    5919             :     use grid_class, only: &
    5920             :         zt2zm, &   ! Procedure(s)
    5921             :         grid
    5922             : 
    5923             :     use constants_clubb, only: &
    5924             :         cloud_frac_min, &  !Variables
    5925             :         Cp, &
    5926             :         Lv
    5927             : 
    5928             :     use clubb_precision, only: &
    5929             :         core_rknd ! Variable(s)
    5930             :       
    5931             : 
    5932             :     implicit none
    5933             : 
    5934             :     ! -------------------- Input Variables --------------------
    5935             :     integer, intent(in) :: &
    5936             :       nz, & ! Points in the Vertical        [-]
    5937             :       ngrdcol
    5938             : 
    5939             :     type(grid), target, intent(in) :: gr
    5940             : 
    5941             :     real( kind = core_rknd ), intent(in) :: dt ! Model timestep        [s]
    5942             : 
    5943             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    5944             :       cloud_frac, &       !Cloud fraction                        [-]
    5945             :       rcm, &              !Cloud water mixing ratio              [kg/kg]
    5946             :       rvm, &              !Vapor water mixing ratio              [kg/kg]
    5947             :       thlm, &             !Liquid potential temperature          [K]
    5948             :       wm, &               !Mean vertical velocity                [m/s]
    5949             :       exner, &            !Exner function                        [-]
    5950             :       rrm_evap         !Evaporation of rain                   [kg/kg/s]
    5951             :                           !It is expected that this variable is negative, as
    5952             :                           !that is the convention in Morrison microphysics
    5953             : 
    5954             :     type(pdf_parameter), intent(in) :: &
    5955             :       pdf_params ! PDF parameters
    5956             : 
    5957             :     ! -------------------- Input/Output Variables --------------------
    5958             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
    5959             :       rtp2_mc, &    !Tendency of <rt'^2> due to evaporation   [(kg/kg)^2/s]
    5960             :       thlp2_mc, &   !Tendency of <thl'^2> due to evaporation  [K^2/s]
    5961             :       wprtp_mc, &   !Tendency of <w'rt'> due to evaporation   [m*(kg/kg)/s^2]
    5962             :       wpthlp_mc, &  !Tendency of <w'thl'> due to evaporation  [m*K/s^2] 
    5963             :       rtpthlp_mc    !Tendency of <rt'thl'> due to evaporation [K*(kg/kg)/s]
    5964             : 
    5965             :     ! -------------------- Local Variables --------------------
    5966             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    5967           0 :       temp_rtp2, &          !Used only to calculate rtp2_mc  [(kg/kg)^2]
    5968           0 :       temp_thlp2, &         !Used to calculate thlp2_mc      [K^2/s]
    5969           0 :       temp_wp2,  &          !Used to calculate wpxp_mc       [m^2/s^2]
    5970           0 :       rtp2_mc_zt, &   !Calculated on the zt grid             [(kg/kg)^2/s]
    5971           0 :       thlp2_mc_zt, &  !Calculated on the zt grid             [(kg/kg)^2/s]
    5972           0 :       wprtp_mc_zt, &  !Calculated on the zt grid             [m*(kg/kg)/s^2]
    5973           0 :       wpthlp_mc_zt, & !Calcualted on the zt grid             [m*K/s^2]
    5974           0 :       rtpthlp_mc_zt,& !Calculated on the zt grid             [K*(kg/kg)/s]
    5975           0 :       precip_frac_double_delta, &!Precipitation fraction for a double delta [-]
    5976           0 :       pf_const              ! ( 1 - pf )/( pf )                    [-]
    5977             : 
    5978             :     integer :: i, k
    5979             : 
    5980             :     ! -------------------- Begin Code --------------------
    5981             : 
    5982             :     ! Calculate precip_frac_double_delta
    5983           0 :     precip_frac_double_delta(:,nz) = 0.0_core_rknd
    5984           0 :     do k = nz-1, 1, -1
    5985           0 :       do i = 1, ngrdcol
    5986           0 :         if ( cloud_frac(i,k) > cloud_frac_min ) then
    5987           0 :           precip_frac_double_delta(i,k) = cloud_frac(i,k)
    5988             :         else
    5989           0 :           precip_frac_double_delta(i,k) = precip_frac_double_delta(i,k+1)
    5990             :         end if
    5991             :       end do
    5992             :     end do
    5993             : 
    5994             : 
    5995             :     !pf_const is calculated so that when precip_frac_double_delta = 0, rtp2_mc and 
    5996             :     !thlp2_mc will both be zero.  This also avoids a divide by zero error
    5997           0 :     do k = 1, nz
    5998           0 :       do i = 1, ngrdcol
    5999           0 :         if ( precip_frac_double_delta(i,k) > cloud_frac_min ) then
    6000             :           pf_const(i,k) = ( 1.0_core_rknd - precip_frac_double_delta(i,k) ) &
    6001           0 :                           / precip_frac_double_delta(i,k)
    6002             :         else
    6003           0 :           pf_const(i,k) = 0.0_core_rknd
    6004             :         end if
    6005             :       end do
    6006             :     end do
    6007             : 
    6008             :     ! Include effects of rain evaporation on rtp2
    6009           0 :     do k = 1, nz
    6010           0 :       do i = 1, ngrdcol
    6011           0 :         temp_rtp2(i,k) = pdf_params%mixt_frac(i,k) &
    6012           0 :                     * ( ( pdf_params%rt_1(i,k) - ( rcm(i,k) + rvm(i,k) ) )**2 &
    6013           0 :                         + pdf_params%varnce_rt_1(i,k) ) &
    6014             :                     + ( 1.0_core_rknd - pdf_params%mixt_frac(i,k) ) &
    6015           0 :                         * ( ( pdf_params%rt_2(i,k) - ( rcm(i,k) + rvm(i,k) ) )**2 &
    6016           0 :                             + pdf_params%varnce_rt_2(i,k) )
    6017             : 
    6018             :         rtp2_mc_zt(i,k) = rrm_evap(i,k)**2 * pf_const(i,k) * dt &
    6019             :                            + 2.0_core_rknd * abs(rrm_evap(i,k)) &
    6020           0 :                              * sqrt(temp_rtp2(i,k) * pf_const(i,k))
    6021             :                            !use absolute value of evaporation, as evaporation will add
    6022             :                            !to rt_1
    6023             :       end do
    6024             :     end do
    6025             :     
    6026           0 :     rtp2_mc = zt2zm( nz, ngrdcol, gr, rtp2_mc_zt )
    6027             : 
    6028             :     !Include the effects of rain evaporation on thlp2
    6029           0 :     do k = 1, nz
    6030           0 :       do i = 1, ngrdcol
    6031           0 :         temp_thlp2(i,k) = pdf_params%mixt_frac(i,k) &
    6032           0 :                         * ( ( pdf_params%thl_1(i,k) - thlm(i,k) )**2 &
    6033           0 :                             + pdf_params%varnce_thl_1(i,k) ) &
    6034             :                      + ( 1.0_core_rknd - pdf_params%mixt_frac(i,k) ) &
    6035           0 :                         * ( ( pdf_params%thl_2(i,k) - thlm(i,k) )**2 &
    6036           0 :                             + pdf_params%varnce_thl_2(i,k) )
    6037             : 
    6038             :         thlp2_mc_zt(i,k) = ( rrm_evap(i,k) * Lv / ( Cp * exner(i,k) ) )**2 &
    6039             :                            * pf_const(i,k) * dt &
    6040             :                            + 2.0_core_rknd * abs(rrm_evap(i,k)) * Lv / ( Cp * exner(i,k) ) &
    6041           0 :                            * sqrt(temp_thlp2(i,k) * pf_const(i,k))
    6042             :       end do
    6043             :     end do
    6044             :     
    6045           0 :     thlp2_mc = zt2zm( nz, ngrdcol, gr, thlp2_mc_zt )
    6046             : 
    6047             :     ! Include effects of rain evaporation on other moments (wprtp, wpthlp, and 
    6048             :     ! rtpthlp - added 07/13 rstorer
    6049           0 :     do k = 1, nz
    6050           0 :       do i = 1, ngrdcol
    6051           0 :         temp_wp2(i,k) = pdf_params%mixt_frac(i,k) &
    6052           0 :                       * ( ( pdf_params%w_1(i,k) - wm(i,k) )**2 + pdf_params%varnce_w_1(i,k) ) &
    6053             :                    + ( 1.0_core_rknd - pdf_params%mixt_frac(i,k) ) &
    6054           0 :                       * ( ( pdf_params%w_2(i,k) - wm(i,k) )**2 + pdf_params%varnce_w_2(i,k) )
    6055             : 
    6056           0 :         wprtp_mc_zt(i,k) = abs(rrm_evap(i,k)) * sqrt(pf_const(i,k)) * sqrt(temp_wp2(i,k))
    6057             : 
    6058             :         wpthlp_mc_zt(i,k) = -1.0_core_rknd * Lv / ( Cp * exner(i,k)) * abs(rrm_evap(i,k)) &
    6059           0 :                                     * sqrt(pf_const(i,k)) * sqrt(temp_wp2(i,k))
    6060             : 
    6061             :         rtpthlp_mc_zt(i,k) = -1.0_core_rknd * abs(rrm_evap(i,k)) * sqrt( pf_const(i,k) ) &
    6062             :                                   * ( ( Lv / (cp * exner(i,k) ) ) * sqrt( temp_rtp2(i,k) ) &
    6063             :                                     + sqrt( temp_thlp2(i,k) ) ) &
    6064             :                                 - ( Lv / (cp * exner(i,k) ) ) * pf_const(i,k) &
    6065           0 :                                     * ( rrm_evap(i,k) )**2 * dt
    6066             :       end do
    6067             :     end do
    6068             :     
    6069           0 :     wprtp_mc    = zt2zm( nz, ngrdcol, gr, wprtp_mc_zt )
    6070           0 :     wpthlp_mc   = zt2zm( nz, ngrdcol, gr, wpthlp_mc_zt )
    6071           0 :     rtpthlp_mc  = zt2zm( nz, ngrdcol, gr, rtpthlp_mc_zt )
    6072           0 :   end subroutine update_xp2_mc
    6073             : 
    6074             : !===============================================================================
    6075             : 
    6076             : end module advance_xp2_xpyp_module

Generated by: LCOV version 1.14