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

Generated by: LCOV version 1.14