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