LCOV - code coverage report
Current view: | top level - physics/clubb/src/CLUBB_core - advance_xm_wpxp_module.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 624 | 1454 | 42.9 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 15 | 17 | 88.2 %

              Line data    Source code
           1             : !-----------------------------------------------------------------------
           2             : ! $Id$
           3             : !===============================================================================
           4             : module advance_xm_wpxp_module
           5             :
           6             :   ! Description:
           7             :   ! Contains the CLUBB advance_xm_wpxp_module scheme.
           8             :
           9             :   ! References:
          10             :   ! None
          11             :   !-----------------------------------------------------------------------
          12             :
          13             :   implicit none
          14             :
          15             :   private ! Default scope
          16             :
          17             :   public  :: advance_xm_wpxp
          18             :
          19             :   private :: xm_wpxp_lhs, &
          20             :              xm_wpxp_rhs, &
          21             :              xm_wpxp_solve, &
          22             :              xm_wpxp_clipping_and_stats, &
          23             :              xm_term_ta_lhs, &
          24             :              wpxp_term_tp_lhs, &
          25             :              wpxp_terms_ac_pr2_lhs, &
          26             :              wpxp_term_pr1_lhs, &
          27             :              wpxp_terms_bp_pr3_rhs, &
          28             :              xm_correction_wpxp_cl, &
          29             :              damp_coefficient, &
          30             :              diagnose_upxp, &
          31             :              error_prints_xm_wpxp
          32             :
          33             :   ! Parameter Constants
          34             :   integer, parameter, private :: &
          35             :     nsub = 2, & ! Number of subdiagonals in the LHS matrix
          36             :     nsup = 2, & ! Number of superdiagonals in the LHS matrix
          37             :     xm_wpxp_thlm = 1,   & ! Named constant for thlm and wpthlp solving
          38             :     xm_wpxp_rtm = 2,    & ! Named constant for rtm and wprtp solving
          39             :     xm_wpxp_scalar = 3, & ! Named constant for sclrm and wpsclrp solving
          40             :     xm_wpxp_um = 4,     & ! Named constant for optional um and upwp solving
          41             :     xm_wpxp_vm = 5        ! Named constant for optional vm and vpwp solving
          42             :
          43             :   integer, parameter :: &
          44             :     ndiags2 = 2,  &
          45             :     ndiags3 = 3,  &
          46             :     ndiags5 = 5
          47             :
          48             :   contains
          49             :
          50             :   !=============================================================================
          51     8935056 :   subroutine advance_xm_wpxp( nz, ngrdcol, sclr_dim, sclr_tol, gr, dt, &
          52     8935056 :                               sigma_sqd_w, wm_zm, wm_zt, wp2, &
          53     8935056 :                               Lscale_zm, wp3_on_wp2, wp3_on_wp2_zt, Kh_zt, Kh_zm, &
          54     8935056 :                               invrs_tau_C6_zm, tau_max_zm, Skw_zm, wp2rtp, rtpthvp, &
          55     8935056 :                               rtm_forcing, wprtp_forcing, rtm_ref, wp2thlp, &
          56     8935056 :                               thlpthvp, thlm_forcing, wpthlp_forcing, thlm_ref, &
          57     8935056 :                               rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, &
          58     8935056 :                               invrs_rho_ds_zt, thv_ds_zm, rtp2, thlp2, &
          59     8935056 :                               w_1_zm, w_2_zm, varnce_w_1_zm, varnce_w_2_zm, &
          60     8935056 :                               mixt_frac_zm, l_implemented, em, wp2sclrp, &
          61     8935056 :                               sclrpthvp, sclrm_forcing, sclrp2, exner, rcm, &
          62     8935056 :                               p_in_Pa, thvm, Cx_fnc_Richardson, &
          63     8935056 :                               ice_supersat_frac, &
          64             :                               pdf_implicit_coefs_terms, &
          65     8935056 :                               um_forcing, vm_forcing, ug, vg, wpthvp, &
          66     8935056 :                               fcor, um_ref, vm_ref, up2, vp2, &
          67     8935056 :                               uprcp, vprcp, rc_coef_zm, &
          68     8935056 :                               clubb_params, nu_vert_res_dep, &
          69             :                               iiPDF_type, &
          70             :                               penta_solve_method, &
          71             :                               tridiag_solve_method, &
          72             :                               saturation_formula, &
          73             :                               l_predict_upwp_vpwp, &
          74             :                               l_diffuse_rtm_and_thlm, &
          75             :                               l_stability_correct_Kh_N2_zm, &
          76             :                               l_godunov_upwind_wpxp_ta, &
          77             :                               l_upwind_xm_ma, &
          78             :                               l_uv_nudge, &
          79             :                               l_tke_aniso, &
          80             :                               l_diag_Lscale_from_tau, &
          81             :                               l_use_C7_Richardson, &
          82             :                               l_brunt_vaisala_freq_moist, &
          83             :                               l_use_thvm_in_bv_freq, &
          84             :                               l_lmm_stepping, &
          85             :                               l_enable_relaxed_clipping, &
          86             :                               l_linearize_pbl_winds, &
          87             :                               l_mono_flux_lim_thlm, &
          88             :                               l_mono_flux_lim_rtm, &
          89             :                               l_mono_flux_lim_um, &
          90             :                               l_mono_flux_lim_vm, &
          91             :                               l_mono_flux_lim_spikefix, &
          92             :                               order_xm_wpxp, order_xp2_xpyp, order_wp2_wp3, &
          93             :                               stats_metadata, &
          94     8935056 :                               stats_zt, stats_zm, stats_sfc, &
          95     8935056 :                               rtm, wprtp, thlm, wpthlp, &
          96     8935056 :                               sclrm, wpsclrp, um, upwp, vm, vpwp, &
          97     8935056 :                               um_pert, vm_pert, upwp_pert, vpwp_pert )
          98             :
          99             :     ! Description:
         100             :     ! Advance the mean and flux terms by one timestep.
         101             :
         102             :     ! References:
         103             :     ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:wpxp_eqns
         104             :     !
         105             :     ! Eqn. 16 & 17 on p. 3546 of
         106             :     ! ``A PDF-Based Model for Boundary Layer Clouds. Part I:
         107             :     !   Method and Model Description'' Golaz, et al. (2002)
         108             :     !   JAS, Vol. 59, pp. 3540--3551.
         109             :
         110             :     ! See Also
         111             :     ! ``Equations for CLUBB'' Section 5:
         112             :     !   /Implicit solutions for the means and fluxes/
         113             :     !-----------------------------------------------------------------------
         114             :
         115             :     use parameter_indices, only: &
         116             :         nparams,             & ! Variable(s)
         117             :         iC6rt,               &
         118             :         iC6rtb,              &
         119             :         iC6rtc,              &
         120             :         iC6thl,              &
         121             :         iC6thlb,             &
         122             :         iC6thlc,             &
         123             :         iC6rt_Lscale0,       &
         124             :         iC6thl_Lscale0,      &
         125             :         iC7,                 &
         126             :         iC7b,                &
         127             :         iC7c,                &
         128             :         iC7_Lscale0,         &
         129             :         ic_K6,               &
         130             :         iwpxp_L_thresh,      &
         131             :         ialtitude_threshold, &
         132             :         iC_uu_shr
         133             :
         134             :     use parameters_tunable, only: &
         135             :         nu_vertical_res_dep    ! Type(s)
         136             :
         137             :     use constants_clubb, only:  &
         138             :         fstderr, &  ! Constant
         139             :         one, &
         140             :         one_half, &
         141             :         zero, &
         142             :         eps
         143             :
         144             :     use parameters_model, only: &
         145             :         ts_nudge
         146             :
         147             :     use grid_class, only: &
         148             :         grid, & ! Type
         149             :         ddzt    ! Procedure(s)
         150             :
         151             :     use model_flags, only: &
         152             :         iiPDF_new,                     & ! Variable(s)
         153             :         l_explicit_turbulent_adv_wpxp
         154             :
         155             :     use mono_flux_limiter, only: &
         156             :         calc_turb_adv_range ! Procedure(s)
         157             :
         158             :     use pdf_parameter_module, only: &
         159             :         implicit_coefs_terms    ! Variable Type
         160             :
         161             :     use clubb_precision, only:  &
         162             :         core_rknd ! Variable(s)
         163             :
         164             :     use error_code, only: &
         165             :         clubb_at_least_debug_level,  & ! Procedure
         166             :         err_code,                    & ! Error Indicator
         167             :         clubb_fatal_error              ! Constants
         168             :
         169             :     use stats_type_utilities, only: &
         170             :         stat_begin_update, & ! Procedure(s)
         171             :         stat_end_update, &
         172             :         stat_update_var
         173             :
         174             :     use stats_variables, only: &
         175             :         stats_metadata_type
         176             :
         177             :     use sponge_layer_damping, only: &
         178             :         rtm_sponge_damp_settings, &
         179             :         thlm_sponge_damp_settings, &
         180             :         uv_sponge_damp_settings, &
         181             :         rtm_sponge_damp_profile, &
         182             :         thlm_sponge_damp_profile, &
         183             :         uv_sponge_damp_profile, &
         184             :         sponge_damp_xm ! Procedure(s)
         185             :
         186             :     use stats_type, only: stats ! Type
         187             :
         188             :     implicit none
         189             :
         190             :     ! -------------------- Input Variables --------------------
         191             :     integer, intent(in) :: &
         192             :       nz,       & ! Number of vertical levels
         193             :       ngrdcol,  & ! Number of grid columns
         194             :       sclr_dim    ! Number of passive scalars
         195             :
         196             :     real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: &
         197             :       sclr_tol          ! Threshold(s) on the passive scalars  [units vary]
         198             :
         199             :     type (grid), target, intent(in) :: &
         200             :       gr
         201             :
         202             :     real( kind = core_rknd ), intent(in) ::  &
         203             :       dt                 ! Timestep                                 [s]
         204             :
         205             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
         206             :       sigma_sqd_w,     & ! sigma_sqd_w on momentum levels           [-]
         207             :       wm_zm,           & ! w wind component on momentum levels      [m/s]
         208             :       wm_zt,           & ! w wind component on thermodynamic levels [m/s]
         209             :       wp2,             & ! w'^2 (momentum levels)                   [m^2/s^2]
         210             :       Lscale_zm,       & ! Turbulent mixing length interp to m levs [m]
         211             :       em,              & ! Turbulent Kinetic Energy (TKE)           [m^2/s^2]
         212             :       wp3_on_wp2,      & ! Smoothed wp3 / wp2 on momentum levels    [m/s]
         213             :       wp3_on_wp2_zt,   & ! Smoothed wp3 / wp2 on thermo. levels     [m/s]
         214             :       Kh_zt,           & ! Eddy diffusivity on thermodynamic levels [m^2/s]
         215             :       Kh_zm,           & ! Eddy diffusivity on momentum levels
         216             :       invrs_tau_C6_zm, & ! Inverse time-scale on mom. levels applied to C6 term [1/s]
         217             :       tau_max_zm,      & ! Max. allowable eddy dissipation time scale on m-levs  [s]
         218             :       Skw_zm,          & ! Skewness of w on momentum levels         [-]
         219             :       wp2rtp,          & ! <w'^2 r_t'> (thermodynamic levels)    [m^2/s^2 kg/kg]
         220             :       rtpthvp,         & ! r_t'th_v' (momentum levels)              [(kg/kg) K]
         221             :       rtm_forcing,     & ! r_t forcing (thermodynamic levels)       [(kg/kg)/s]
         222             :       wprtp_forcing,   & ! <w'r_t'> forcing (momentum levels)       [(kg/kg)/s^2]
         223             :       rtm_ref,         & ! rtm for nudging                          [kg/kg]
         224             :       wp2thlp,         & ! <w'^2 th_l'> (thermodynamic levels)      [m^2/s^2 K]
         225             :       thlpthvp,        & ! th_l'th_v' (momentum levels)             [K^2]
         226             :       thlm_forcing,    & ! th_l forcing (thermodynamic levels)      [K/s]
         227             :       wpthlp_forcing,  & ! <w'th_l'> forcing (momentum levels)      [K/s^2]
         228             :       thlm_ref,        & ! thlm for nudging                         [K]
         229             :       rho_ds_zm,       & ! Dry, static density on momentum levels   [kg/m^3]
         230             :       rho_ds_zt,       & ! Dry, static density on thermo. levels    [kg/m^3]
         231             :       invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg]
         232             :       invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg]
         233             :       thv_ds_zm,       & ! Dry, base-state theta_v on moment. levs. [K]
         234             :       ! Added for clipping by Vince Larson 29 Sep 2007
         235             :       rtp2,            & ! r_t'^2 (momentum levels)                 [(kg/kg)^2]
         236             :       thlp2,           & ! th_l'^2 (momentum levels)                [K^2]
         237             :       ! End of Vince Larson's addition.
         238             :       w_1_zm,          & ! Mean w (1st PDF component)              [m/s]
         239             :       w_2_zm,          & ! Mean w (2nd PDF component)              [m/s]
         240             :       varnce_w_1_zm,   & ! Variance of w (1st PDF component)       [m^2/s^2]
         241             :       varnce_w_2_zm,   & ! Variance of w (2nd PDF component)       [m^2/s^2]
         242             :       mixt_frac_zm       ! Weight of 1st PDF component (Sk_w dependent) [-]
         243             :
         244             :     logical, intent(in) ::  &
         245             :       l_implemented      ! Flag for CLUBB being implemented in a larger model.
         246             :
         247             :     ! Additional variables for passive scalars
         248             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) :: &
         249             :       wp2sclrp,      & ! <w'^2 sclr'> (thermodynamic levels)   [Units vary]
         250             :       sclrpthvp,     & ! <sclr' th_v'> (momentum levels)       [Units vary]
         251             :       sclrm_forcing, & ! sclrm forcing (thermodynamic levels)  [Units vary]
         252             :       sclrp2           ! For clipping Vince Larson             [Units vary]
         253             :
         254             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) ::  &
         255             :       exner,            & ! Exner function                            [-]
         256             :       rcm,              & ! cloud water mixing ratio, r_c             [kg/kg]
         257             :       p_in_Pa,          & ! Air pressure                              [Pa]
         258             :       thvm,             & ! Virutal potential temperature             [K]
         259             :       Cx_fnc_Richardson,& ! Cx_fnc computed from Richardson_num       [-]
         260             :       ice_supersat_frac
         261             :
         262             :     type(implicit_coefs_terms), intent(in) :: &
         263             :       pdf_implicit_coefs_terms    ! Implicit coefs / explicit terms [units vary]
         264             :
         265             :     ! Variables used to predict <u> and <u'w'>, as well as <v> and <v'w'>.
         266             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
         267             :       um_forcing, & ! <u> forcing term (thermodynamic levels)      [m/s^2]
         268             :       vm_forcing, & ! <v> forcing term (thermodynamic levels)      [m/s^2]
         269             :       ug,         & ! <u> geostrophic wind (thermodynamic levels)  [m/s]
         270             :       vg,         & ! <v> geostrophic wind (thermodynamic levels)  [m/s]
         271             :       wpthvp        ! <w'thv'> (momentum levels)                   [m/s K]
         272             :
         273             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
         274             :       uprcp,        & ! < u' r_c' >                               [(m kg)/(s kg)]
         275             :       vprcp,        & ! < v' r_c' >                               [(m kg)/(s kg)]
         276             :       rc_coef_zm      ! Coefficient on X'r_c' in X'th_v' equation [K/(kg/kg)]
         277             :
         278             :      real( kind = core_rknd ), dimension(ngrdcol), intent(in) ::  &
         279             :       fcor          ! Coriolis parameter                           [s^-1]
         280             :
         281             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
         282             :       um_ref, & ! Reference u wind component for nudging       [m/s]
         283             :       vm_ref, & ! Reference v wind component for nudging       [m/s]
         284             :       up2,    & ! Variance of the u wind component             [m^2/s^2]
         285             :       vp2       ! Variance of the v wind component             [m^2/s^2]
         286             :
         287             :     real( kind = core_rknd ), dimension(ngrdcol,nparams), intent(in) :: &
         288             :       clubb_params    ! Array of CLUBB's tunable parameters    [units vary]
         289             :
         290             :     type(nu_vertical_res_dep), intent(in) :: &
         291             :       nu_vert_res_dep    ! Vertical resolution dependent nu values
         292             :
         293             :     integer, intent(in) :: &
         294             :       iiPDF_type,           & ! Selected option for the two-component normal (double
         295             :                               ! Gaussian) PDF type to use for the w, rt, and theta-l (or
         296             :                               ! w, chi, and eta) portion of CLUBB's multivariate,
         297             :                               ! two-component PDF.
         298             :       penta_solve_method,   & ! Method to solve then penta-diagonal system
         299             :       tridiag_solve_method, & ! Specifier for method to solve tridiagonal systems
         300             :       saturation_formula      ! Integer that stores the saturation formula to be used
         301             :
         302             :     logical, intent(in) :: &
         303             :       l_predict_upwp_vpwp,          & ! Flag to predict <u'w'> and <v'w'> along with <u> and <v>
         304             :                                       ! alongside the advancement of <rt>, <w'rt'>, <thl>,
         305             :                                       ! <wpthlp>, <sclr>, and <w'sclr'> in subroutine
         306             :                                       ! advance_xm_wpxp.  Otherwise, <u'w'> and <v'w'> are still
         307             :                                       ! approximated by eddy diffusivity when <u> and <v> are
         308             :                                       ! advanced in subroutine advance_windm_edsclrm.
         309             :       l_diffuse_rtm_and_thlm,       & ! This flag determines whether or not we want CLUBB to do
         310             :                                       ! diffusion on rtm and thlm
         311             :       l_stability_correct_Kh_N2_zm, & ! This flag determines whether or not we want CLUBB to apply
         312             :                                       ! a stability correction
         313             :       l_godunov_upwind_wpxp_ta,     & ! This flag determines whether we want to use an upwind
         314             :                                       ! differencing approximation rather than a centered
         315             :                                       ! differencing for turbulent advection terms.
         316             :                                       ! It affects  wpxp only.
         317             :       l_upwind_xm_ma,               & ! This flag determines whether we want to use an upwind
         318             :                                       ! differencing approximation rather than a centered
         319             :                                       ! differencing for turbulent or mean advection terms.
         320             :                                       ! It affects rtm, thlm, sclrm, um and vm.
         321             :       l_uv_nudge,                   & ! For wind speed nudging
         322             :       l_tke_aniso,                  & ! For anisotropic turbulent kinetic energy, i.e. TKE = 1/2
         323             :                                       ! (u'^2 + v'^2 + w'^2)
         324             :       l_diag_Lscale_from_tau,       & ! First diagnose dissipation time tau, and then diagnose the
         325             :                                       ! mixing length scale as Lscale = tau * tke
         326             :       l_use_C7_Richardson,          & ! Parameterize C7 based on Richardson number
         327             :       l_brunt_vaisala_freq_moist,   & ! Use a different formula for the Brunt-Vaisala frequency in
         328             :                                       ! saturated atmospheres (from Durran and Klemp, 1982)
         329             :       l_use_thvm_in_bv_freq,        & ! Use thvm in the calculation of Brunt-Vaisala frequency
         330             :       l_lmm_stepping,               & ! Apply Linear Multistep Method (LMM) Stepping
         331             :       l_enable_relaxed_clipping,    & ! Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats
         332             :       l_linearize_pbl_winds,        & ! Flag (used by E3SM) to linearize PBL winds
         333             :       l_mono_flux_lim_thlm,         & ! Flag to turn on monotonic flux limiter for thlm
         334             :       l_mono_flux_lim_rtm,          & ! Flag to turn on monotonic flux limiter for rtm
         335             :       l_mono_flux_lim_um,           & ! Flag to turn on monotonic flux limiter for um
         336             :       l_mono_flux_lim_vm,           & ! Flag to turn on monotonic flux limiter for vm
         337             :       l_mono_flux_lim_spikefix        ! Flag to implement monotonic flux limiter code that
         338             :                                       ! eliminates spurious drying tendencies at model top
         339             :
         340             :     integer, intent(in) :: &
         341             :       order_xm_wpxp, &
         342             :       order_xp2_xpyp, &
         343             :       order_wp2_wp3
         344             :
         345             :     type (stats_metadata_type), intent(in) :: &
         346             :       stats_metadata
         347             :
         348             :     ! -------------------- Input/Output Variables --------------------
         349             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
         350             :       stats_zt, &
         351             :       stats_zm, &
         352             :       stats_sfc
         353             :
         354             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  &
         355             :       rtm,       & ! r_t  (total water mixing ratio)           [kg/kg]
         356             :       wprtp,     & ! w'r_t'                                    [(kg/kg) m/s]
         357             :       thlm,      & ! th_l (liquid water potential temperature) [K]
         358             :       wpthlp       ! w'th_l'                                   [K m/s]
         359             :
         360             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) ::  &
         361             :       sclrm,  & !                                     [Units vary]
         362             :       wpsclrp   !                                     [Units vary]
         363             :
         364             :     ! Variables used to predict <u> and <u'w'>, as well as <v> and <v'w'>.
         365             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  &
         366             :       um,   & ! <u>:  mean west-east horiz. velocity (thermo. levs.)   [m/s]
         367             :       upwp, & ! <u'w'>:  momentum flux (momentum levels)               [m^2/s^2]
         368             :       vm,   & ! <v>:  mean south-north horiz. velocity (thermo. levs.) [m/s]
         369             :       vpwp    ! <v'w'>:  momentum flux (momentum levels)               [m^2/s^2]
         370             :
         371             :     ! Variables used to track perturbed version of winds.
         372             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
         373             :       um_pert,   & ! perturbed <u>    [m/s]
         374             :       vm_pert,   & ! perturbed <v>    [m/s]
         375             :       upwp_pert, & ! perturbed <u'w'> [m^2/s^2]
         376             :       vpwp_pert    ! perturbed <v'w'> [m^2/s^2]
         377             :
         378             :     ! -------------------- Local Variables --------------------
         379             :
         380             :     ! Parameter Constants
         381             :     logical, parameter :: &
         382             :       l_iter = .true. ! True when the means and fluxes are prognosed
         383             :
         384             :     real( kind = core_rknd ) ::  &
         385             :       C6rt,               & ! CLUBB tunable parameter C6rt
         386             :       C6rtb,              & ! CLUBB tunable parameter C6rtb
         387             :       C6rtc,              & ! CLUBB tunable parameter C6rtc
         388             :       C6thl,              & ! CLUBB tunable parameter C6thl
         389             :       C6thlb,             & ! CLUBB tunable parameter C6thlb
         390             :       C6thlc,             & ! CLUBB tunable parameter C6thlc
         391             :       C7,                 & ! CLUBB tunable parameter C7
         392             :       C7b,                & ! CLUBB tunable parameter C7b
         393             :       C7c                   ! CLUBB tunable parameter C7c
         394             :
         395             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  &
         396    17870112 :       C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc, C6_term
         397             :
         398             :     ! Eddy Diffusion for wpthlp and wprtp.
         399    17870112 :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: Kw6  ! wpxp eddy diff. [m^2/s]
         400             :
         401             :     ! Variables used as part of the monotonic turbulent advection scheme.
         402             :     ! Find the lowermost and uppermost grid levels that can have an effect
         403             :     ! on the central thermodynamic level during the course of a time step,
         404             :     ! due to the effects of turbulent advection only.
         405             :     integer, dimension(ngrdcol,nz) ::  &
         406    17870112 :       low_lev_effect, & ! Index of the lowest level that has an effect.
         407    17870112 :       high_lev_effect   ! Index of the highest level that has an effect.
         408             :
         409             :     ! Constant parameters as a function of Skw.
         410             :
         411             :     integer :: &
         412             :       nrhs         ! Number of RHS vectors
         413             :
         414             :     ! Saved values of predictive fields, prior to being advanced, for use in
         415             :     ! print statements in case of fatal error.
         416             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  &
         417    17870112 :       rtm_old,    & ! Saved value of r_t        [kg/kg]
         418    17870112 :       wprtp_old,  & ! Saved value of w'r_t'     [(kg/kg) m/s]
         419    17870112 :       thlm_old,   & ! Saved value of th_l       [K]
         420    17870112 :       wpthlp_old    ! Saved value of w'th_l'    [K m/s]
         421             :
         422             :     ! Input/Output Variables
         423             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) ::  &
         424    17870112 :       sclrm_old,   & ! Saved value of sclr      [units vary]
         425    17870112 :       wpsclrp_old    ! Saved value of wpsclrp   [units vary]
         426             :
         427             :     ! Variables used to predict <u> and <u'w'>, as well as <v> and <v'w'>.
         428             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  &
         429    17870112 :       um_old,   & ! Saved value of <u>       [m/s]
         430    17870112 :       upwp_old, & ! Saved value of <u'w'>    [m^2/s^2]
         431    17870112 :       vm_old,   & ! Saved value of <v>       [m/s]
         432    17870112 :       vpwp_old    ! Saved value of <v'w'>    [m^2/s^2]
         433             :
         434             :     ! LHS/RHS terms
         435             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz) :: &
         436    17870112 :       lhs_diff_zm,  & ! Diffusion term for w'x'
         437    17870112 :       lhs_diff_zt,  & ! Diffusion term for w'x'
         438    17870112 :       lhs_ma_zt,    & ! Mean advection contributions to lhs
         439    17870112 :       lhs_ma_zm       ! Mean advection contributions to lhs
         440             :
         441             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz) :: &
         442    17870112 :       lhs_ta_wprtp,  & ! w'r_t' turbulent advection contributions to lhs
         443    17870112 :       lhs_ta_wpthlp, & ! w'thl' turbulent advection contributions to lhs
         444    17870112 :       lhs_ta_wpup,   & ! w'u' turbulent advection contributions to lhs
         445    17870112 :       lhs_ta_wpvp      ! w'v' turbulent advection contributions to lhs
         446             :
         447             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz,sclr_dim) :: &
         448    17870112 :       lhs_ta_wpsclrp    ! w'sclr' turbulent advection contributions to lhs
         449             :
         450             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
         451    17870112 :       rhs_ta_wprtp,  & ! w'r_t' turbulent advection contributions to rhs
         452    17870112 :       rhs_ta_wpthlp, & ! w'thl' turbulent advection contributions to rhs
         453    17870112 :       rhs_ta_wpup,   & ! w'u' turbulent advection contributions to rhs
         454    17870112 :       rhs_ta_wpvp      ! w'v' turbulent advection contributions to rhs
         455             :
         456             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
         457    17870112 :       rhs_ta_wpsclrp    ! w'sclr' turbulent advection contributions to rhs
         458             :
         459             :     real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz) :: &
         460    17870112 :       lhs_tp,     & ! Turbulent production terms of w'x'
         461    17870112 :       lhs_ta_xm     ! Turbulent advection terms of xm
         462             :
         463             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
         464    17870112 :       lhs_ac_pr2,     & ! Accumulation of w'x' and w'x' pressure term 2
         465    17870112 :       lhs_pr1_wprtp,  & ! Pressure term 1 for w'r_t' for all grid levels
         466    17870112 :       lhs_pr1_wpthlp, & ! Pressure term 1 for w'thl' for all grid levels
         467    17870112 :       lhs_pr1_wpsclrp   ! Pressure term 1 for w'sclr' for all grid levels
         468             :
         469             :     logical :: &
         470             :       l_scalar_calc   ! True if sclr_dim > 0
         471             :
         472             :     integer :: i, j, k
         473             :
         474             :     ! Whether preturbed winds are being solved.
         475             :     logical :: l_perturbed_wind
         476             :
         477    17870112 :     real( kind = core_rknd ), dimension(nz) :: tmp_in
         478             :
         479             :     ! -------------------- Begin Code --------------------
         480             :
         481             :     !$acc enter data create( C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc, C6_term, Kw6, &
         482             :     !$acc                 low_lev_effect, high_lev_effect, rtm_old, wprtp_old, thlm_old, &
         483             :     !$acc                 wpthlp_old, um_old, upwp_old, vm_old, &
         484             :     !$acc                 vpwp_old, lhs_diff_zm, lhs_diff_zt, lhs_ma_zt, lhs_ma_zm, &
         485             :     !$acc                 lhs_ta_wprtp, lhs_ta_wpthlp, lhs_ta_wpup, lhs_ta_wpvp, &
         486             :     !$acc                 rhs_ta_wprtp, rhs_ta_wpthlp, rhs_ta_wpup, &
         487             :     !$acc                 rhs_ta_wpvp, lhs_tp, lhs_ta_xm, lhs_ac_pr2, &
         488             :     !$acc                 lhs_pr1_wprtp, lhs_pr1_wpthlp )
         489             :
         490             :     !$acc enter data if( sclr_dim > 0 ) &
         491             :     !$acc            create( sclrm_old, wpsclrp_old, lhs_ta_wpsclrp,  &
         492             :     !$acc                    rhs_ta_wpsclrp, lhs_pr1_wpsclrp )
         493             :
         494     8935056 :     l_perturbed_wind = l_predict_upwp_vpwp .and. l_linearize_pbl_winds
         495             :
         496             :     ! Check whether monotonic flux limiter flags are set appropriately
         497     8935056 :     if ( clubb_at_least_debug_level( 0 ) ) then
         498     8935056 :       if ( l_mono_flux_lim_rtm .and. .not. l_mono_flux_lim_spikefix ) then
         499           0 :         write(fstderr,*) "l_mono_flux_lim_rtm=T with l_mono_flux_lim_spikefix=F can lead to spikes aloft."
         500           0 :         err_code = clubb_fatal_error
         501           0 :         return
         502             :       end if
         503             :     end if
         504             :
         505             :     ! Check whether the passive scalars are present.
         506     8935056 :     if ( sclr_dim > 0 ) then
         507           0 :       l_scalar_calc = .true.
         508             :     else
         509     8935056 :       l_scalar_calc = .false.
         510             :     end if
         511             :
         512     8935056 :     if ( iiPDF_type == iiPDF_new .and. ( .not. l_explicit_turbulent_adv_wpxp ) ) then
         513           0 :        nrhs = 1
         514             :     else
         515     8935056 :        nrhs = 2 + sclr_dim
         516     8935056 :        if ( l_predict_upwp_vpwp ) then
         517     8935056 :           nrhs = nrhs + 2
         518     8935056 :           if ( l_perturbed_wind ) then
         519           0 :              nrhs = nrhs + 2
         520             :           endif ! l_perturbed_wind
         521             :        endif ! l_predict_upwp_vpwp
         522             :     endif
         523             :
         524             :     ! Save values of predictive fields to be printed in case of crash.
         525     8935056 :     if ( l_lmm_stepping ) then
         526             :
         527             :       !$acc parallel loop gang vector collapse(2) default(present)
         528           0 :       do k = 1, nz
         529           0 :         do i = 1, ngrdcol
         530           0 :           rtm_old(i,k)    = rtm(i,k)
         531           0 :           wprtp_old(i,k)  = wprtp(i,k)
         532           0 :           thlm_old(i,k)   = thlm(i,k)
         533           0 :           wpthlp_old(i,k) = wpthlp(i,k)
         534             :         end do
         535             :       end do
         536             :       !$acc end parallel loop
         537             :
         538           0 :       if ( sclr_dim > 0 ) then
         539             :         !$acc parallel loop gang vector collapse(3) default(present)
         540           0 :         do j = 1, sclr_dim
         541           0 :           do k = 1, nz
         542           0 :             do i = 1, ngrdcol
         543           0 :               sclrm_old(i,k,j)   = sclrm(i,k,j)
         544           0 :               wpsclrp_old(i,k,j) = wpsclrp(i,k,j)
         545             :             end do
         546             :           end do
         547             :         end do
         548             :         !$acc end parallel loop
         549             :       end if ! sclr_dim > 0
         550             :
         551           0 :       if ( l_predict_upwp_vpwp ) then
         552             :         !$acc parallel loop gang vector collapse(2) default(present)
         553           0 :         do k = 1, nz
         554           0 :           do i = 1, ngrdcol
         555           0 :             um_old(i,k)   = um(i,k)
         556           0 :             upwp_old(i,k) = upwp(i,k)
         557           0 :             vm_old(i,k)   = vm(i,k)
         558           0 :             vpwp_old(i,k) = vpwp(i,k)
         559             :           end do
         560             :         end do
         561             :         !$acc end parallel loop
         562             :       end if ! l_predict_upwp_vpwp
         563             :
         564             :     end if ! l_lmm_stepping
         565             :
         566     8935056 :     if ( .not. l_diag_Lscale_from_tau ) then
         567             :
         568             :       !$acc parallel loop gang vector collapse(2) default(present)
         569   768414816 :       do k = 1, nz
         570 12690480816 :         do i = 1, ngrdcol
         571             :
         572 11922066000 :           C6rt  = clubb_params(i,iC6rt)
         573 11922066000 :           C6rtb = clubb_params(i,iC6rtb)
         574 11922066000 :           C6rtc = clubb_params(i,iC6rtc)
         575             :
         576             :           ! Compute C6 as a function of Skw
         577             :           ! The if...then is just here to save compute time
         578 12681545760 :           if ( abs(C6rt-C6rtb) > abs(C6rt+C6rtb)*eps/2 ) then
         579 11922066000 :             C6rt_Skw_fnc(i,k) = C6rtb + ( C6rt - C6rtb ) &
         580 23844132000 :                                         * exp( -one_half * (Skw_zm(i,k)/C6rtc)**2 )
         581             :           else
         582           0 :             C6rt_Skw_fnc(i,k) = C6rtb
         583             :           end if
         584             :
         585             :         end do
         586             :       end do
         587             :       !$acc end parallel loop
         588             :
         589             :       !$acc parallel loop gang vector collapse(2) default(present)
         590   768414816 :       do k = 1, nz
         591 12690480816 :         do i = 1, ngrdcol
         592             :
         593 11922066000 :           C6thl  = clubb_params(i,iC6thl)
         594 11922066000 :           C6thlb = clubb_params(i,iC6thlb)
         595 11922066000 :           C6thlc = clubb_params(i,iC6thlc)
         596             :
         597 12681545760 :           if ( abs(C6thl-C6thlb) > abs(C6thl+C6thlb)*eps/2 ) then
         598 11922066000 :             C6thl_Skw_fnc(i,k) = C6thlb + ( C6thl - C6thlb ) &
         599 23844132000 :                                           * exp( -one_half * (Skw_zm(i,k)/C6thlc)**2 )
         600             :           else
         601           0 :             C6thl_Skw_fnc(i,k) = C6thlb
         602             :           end if
         603             :
         604             :           end do
         605             :       end do
         606             :       !$acc end parallel loop
         607             :
         608             :       ! Damp C6 as a function of Lscale in stably stratified regions
         609             :       call damp_coefficient( nz, ngrdcol, gr, clubb_params(:,iC6rt), C6rt_Skw_fnc, &
         610             :                              clubb_params(:,iC6rt_Lscale0), &
         611             :                              clubb_params(:,ialtitude_threshold), &
         612             :                              clubb_params(:,iwpxp_L_thresh), Lscale_zm, &
         613     8935056 :                              C6rt_Skw_fnc )
         614             :
         615             :       call damp_coefficient( nz, ngrdcol, gr, clubb_params(:,iC6thl), C6thl_Skw_fnc, &
         616             :                              clubb_params(:,iC6thl_Lscale0), &
         617             :                              clubb_params(:,ialtitude_threshold), &
         618             :                              clubb_params(:,iwpxp_L_thresh), Lscale_zm, &
         619     8935056 :                              C6thl_Skw_fnc )
         620             :
         621             :     else ! l_diag_Lscale_from_tau
         622             :       !$acc parallel loop gang vector collapse(2) default(present)
         623           0 :       do k = 1, nz
         624           0 :         do i = 1, ngrdcol
         625           0 :           C6rt_Skw_fnc(i,k)  = clubb_params(i,iC6rt)
         626           0 :           C6thl_Skw_fnc(i,k) = clubb_params(i,iC6thl)
         627             :         end do
         628             :       end do
         629             :       !$acc end parallel loop
         630             :     endif ! .not. l_diag_Lscale_from_tau
         631             :
         632             :     ! Compute C7_Skw_fnc
         633     8935056 :     if ( l_use_C7_Richardson ) then
         634             :
         635             :       ! New formulation based on Richardson number
         636             :       !$acc parallel loop gang vector collapse(2) default(present)
         637           0 :       do k = 1, nz
         638           0 :         do i = 1, ngrdcol
         639           0 :           C7_Skw_fnc(i,k) = Cx_fnc_Richardson(i,k)
         640             :         end do
         641             :       end do
         642             :       !$acc end parallel loop
         643             :
         644             :     else
         645             :
         646             :       !$acc parallel loop gang vector collapse(2) default(present)
         647   768414816 :       do k = 1, nz
         648 12690480816 :         do i = 1, ngrdcol
         649             :
         650 11922066000 :           C7  = clubb_params(i,iC7)
         651 11922066000 :           C7b = clubb_params(i,iC7b)
         652 11922066000 :           C7c = clubb_params(i,iC7c)
         653             :
         654             :           ! Compute C7 as a function of Skw
         655 12681545760 :           if ( abs(C7-C7b) > abs(C7+C7b)*eps/2 ) then
         656 11922066000 :             C7_Skw_fnc(i,k) = C7b + ( C7 - C7b ) &
         657 23844132000 :                                     * exp( -one_half * (Skw_zm(i,k)/C7c)**2 )
         658             :           else
         659           0 :             C7_Skw_fnc(i,k) = C7b
         660             :           endif
         661             :
         662             :         end do
         663             :       end do
         664             :       !$acc end parallel loop
         665             :
         666             :       ! Damp C7 as a function of Lscale in stably stratified regions
         667             :       call damp_coefficient( nz, ngrdcol, gr, clubb_params(:,iC7), C7_Skw_fnc, &
         668             :                              clubb_params(:,iC7_Lscale0), &
         669             :                              clubb_params(:,ialtitude_threshold), &
         670             :                              clubb_params(:,iwpxp_L_thresh), Lscale_zm, &
         671     8935056 :                              C7_Skw_fnc )
         672             :
         673             :     end if ! l_use_C7_Richardson
         674             :
         675             :
         676     8935056 :     if ( stats_metadata%l_stats_samp ) then
         677             :
         678             :       !$acc update host( C7_Skw_fnc, C6rt_Skw_fnc, C6thl_Skw_fnc )
         679             :
         680           0 :       do i = 1, ngrdcol
         681           0 :         call stat_update_var( stats_metadata%iC7_Skw_fnc, C7_Skw_fnc(i,:), & ! intent(in)
         682           0 :                               stats_zm(i) )                 ! intent(inout)
         683             :         call stat_update_var( stats_metadata%iC6rt_Skw_fnc, C6rt_Skw_fnc(i,:), & ! intent(in)
         684           0 :                               stats_zm(i) )                     ! intent(inout
         685             :         call stat_update_var( stats_metadata%iC6thl_Skw_fnc, C6thl_Skw_fnc(i,:), & ! intent(in)
         686           0 :                               stats_zm(i) )                       ! intent(inout)
         687             :       end do
         688             :
         689             :     end if
         690             :
         691     8935056 :     if ( clubb_at_least_debug_level( 0 ) ) then
         692             :       ! Assertion check for C7_Skw_fnc
         693             :       !$acc parallel loop gang vector collapse(2) default(present)  reduction(.or.:err_code)
         694   768414816 :       do k = 1, nz
         695 12690480816 :         do i = 1, ngrdcol
         696 12681545760 :           if ( C7_Skw_fnc(i,k) > one .or. C7_Skw_fnc(i,k) < zero ) then
         697           0 :             err_code = clubb_fatal_error
         698             :           end if
         699             :         end do
         700             :       end do
         701             :       !$acc end parallel loop
         702             :
         703     8935056 :       if ( err_code == clubb_fatal_error ) then
         704           0 :         write(fstderr,*) "The C7_Skw_fnc variable is outside the valid range"
         705           0 :         return
         706             :       end if
         707             :     end if
         708             :
         709             :     ! Define the Coefficent of Eddy Diffusivity for the wpthlp and wprtp.
         710             :     ! Kw6 is used for wpthlp and wprtp, which are located on momentum levels.
         711             :     ! Kw6 is located on thermodynamic levels.
         712             :     ! Kw6 = c_K6 * Kh_zt
         713             :     !$acc parallel loop gang vector collapse(2) default(present)
         714   768414816 :     do k = 1, nz
         715 12690480816 :       do i = 1, ngrdcol
         716 12681545760 :         Kw6(i,k) = clubb_params(i,ic_K6) * Kh_zt(i,k)
         717             :       end do
         718             :     end do
         719             :     !$acc end parallel loop
         720             :
         721             :     ! Find the number of grid levels, both upwards and downwards, that can
         722             :     ! have an effect on the central thermodynamic level during the course of
         723             :     ! one time step due to turbulent advection.  This is used as part of the
         724             :     ! monotonic turbulent advection scheme.
         725             :     call calc_turb_adv_range( nz, ngrdcol, gr, dt, &
         726             :                               w_1_zm, w_2_zm, varnce_w_1_zm, varnce_w_2_zm, & ! intent(in)
         727             :                               mixt_frac_zm, & ! intent(in)
         728             :                               stats_metadata, & ! intent(in)
         729             :                               stats_zm, & ! intent(inout)
         730     8935056 :                               low_lev_effect, high_lev_effect ) ! intent(out)
         731             :
         732             :
         733             :     ! Calculate 1st pressure terms for w'r_t', w'thl', and w'sclr'.
         734             :     call wpxp_term_pr1_lhs( nz, ngrdcol, C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc, & ! Intent(in)
         735             :                             invrs_tau_C6_zm, l_scalar_calc,                       & ! Intent(in)
         736     8935056 :                             lhs_pr1_wprtp, lhs_pr1_wpthlp, lhs_pr1_wpsclrp )        ! Intent(out)
         737             :
         738             :     !$acc parallel loop gang vector collapse(2) default(present)
         739   768414816 :     do k = 1, nz
         740 12690480816 :       do i = 1, ngrdcol
         741 12681545760 :         C6_term(i,k) = C6rt_Skw_fnc(i,k) * invrs_tau_C6_zm(i,k)
         742             :       end do
         743             :     end do
         744             :     !$acc end parallel loop
         745             :
         746     8935056 :     if ( stats_metadata%l_stats_samp ) then
         747             :       !$acc update host( C6_term )
         748           0 :       do i = 1, ngrdcol
         749           0 :         call stat_update_var( stats_metadata%iC6_term, C6_term(i,:), & ! intent(in)
         750           0 :                               stats_zm(i) )           ! intent(inout)
         751             :       end do
         752             :     end if
         753             :
         754             :     call  calc_xm_wpxp_ta_terms( nz, ngrdcol, sclr_dim, gr, wp2rtp, &  ! intent(in)
         755             :                                  wp2thlp, wp2sclrp, & ! intent(in)
         756             :                                  rho_ds_zt, invrs_rho_ds_zm, rho_ds_zm, & ! intent(in)
         757             :                                  sigma_sqd_w, wp3_on_wp2_zt, & ! intent(in)
         758             :                                  pdf_implicit_coefs_terms, & ! intent(in)
         759             :                                  iiPDF_type, & ! intent(in)
         760             :                                  l_explicit_turbulent_adv_wpxp, l_predict_upwp_vpwp, & ! intent(in)
         761             :                                  l_scalar_calc, & ! intent(in)
         762             :                                  l_godunov_upwind_wpxp_ta, & ! intent(in)
         763             :                                  stats_metadata, & ! intent(in)
         764             :                                  stats_zt, & ! intent(inout)
         765             :                                  lhs_ta_wprtp, lhs_ta_wpthlp, lhs_ta_wpup, & ! intent(out)
         766             :                                  lhs_ta_wpvp, lhs_ta_wpsclrp, & ! intent(out)
         767             :                                  rhs_ta_wprtp, rhs_ta_wpthlp, rhs_ta_wpup, & ! intent(out)
         768     8935056 :                                  rhs_ta_wpvp, rhs_ta_wpsclrp ) ! intent(out)
         769             :
         770             :     ! Calculate various terms that are the same between all LHS matricies
         771             :     call calc_xm_wpxp_lhs_terms( nz, ngrdcol, gr, Kh_zm, wm_zm, wm_zt, wp2,        & ! In
         772             :                                  Kw6, C7_Skw_fnc, invrs_rho_ds_zt,                 & ! In
         773             :                                  invrs_rho_ds_zm, rho_ds_zt,                       & ! In
         774             :                                  rho_ds_zm, l_implemented, em,                     & ! In
         775             :                                  Lscale_zm, thlm, exner, rtm, rcm, p_in_Pa, thvm,  & ! In
         776             :                                  ice_supersat_frac,                                & ! In
         777             :                                  clubb_params, nu_vert_res_dep,                    & ! In
         778             :                                  saturation_formula,                               & ! In
         779             :                                  l_diffuse_rtm_and_thlm,                           & ! In
         780             :                                  l_stability_correct_Kh_N2_zm,                     & ! In
         781             :                                  l_upwind_xm_ma,                                   & ! In
         782             :                                  l_brunt_vaisala_freq_moist,                       & ! In
         783             :                                  l_use_thvm_in_bv_freq,                            & ! In
         784             :                                  lhs_diff_zm, lhs_diff_zt, lhs_ma_zt, lhs_ma_zm,   & ! Out
         785     8935056 :                                  lhs_tp, lhs_ta_xm, lhs_ac_pr2 ) ! Out
         786             :
         787             :     ! Setup and decompose matrix for each variable.
         788             :
         789     8935056 :     if ( ( iiPDF_type == iiPDF_new ) .and. ( .not. l_explicit_turbulent_adv_wpxp ) ) then
         790             :
         791             :       ! LHS matrices are unique, multiple band solves required
         792             :       call solve_xm_wpxp_with_multiple_lhs( nz, ngrdcol, sclr_dim, sclr_tol, gr, dt,        & ! In
         793             :                                             l_iter, nrhs, wm_zt, wp2,                       & ! In
         794             :                                             rtpthvp, rtm_forcing, wprtp_forcing, thlpthvp,  & ! In
         795             :                                             thlm_forcing,   wpthlp_forcing, rho_ds_zm,      & ! In
         796             :                                             rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt,    & ! In
         797             :                                             thv_ds_zm, rtp2, thlp2, l_implemented,          & ! In
         798             :                                             sclrpthvp, sclrm_forcing, sclrp2,               & ! In
         799             :                                             low_lev_effect, high_lev_effect, C7_Skw_fnc,    & ! In
         800             :                                             lhs_diff_zm, lhs_diff_zt, lhs_ma_zt, lhs_ma_zm, & ! In
         801             :                                             lhs_ta_wprtp, lhs_ta_wpthlp, lhs_ta_wpsclrp,    & ! In
         802             :                                             rhs_ta_wprtp, rhs_ta_wpthlp, rhs_ta_wpsclrp,    & ! In
         803             :                                             lhs_tp, lhs_ta_xm, lhs_ac_pr2, lhs_pr1_wprtp,   & ! In
         804             :                                             lhs_pr1_wpthlp, lhs_pr1_wpsclrp,                & ! In
         805             :                                             penta_solve_method,                             & ! In
         806             :                                             tridiag_solve_method,                           & ! In
         807             :                                             l_predict_upwp_vpwp,                            & ! In
         808             :                                             l_diffuse_rtm_and_thlm,                         & ! In
         809             :                                             l_upwind_xm_ma,                                 & ! In
         810             :                                             l_tke_aniso,                                    & ! In
         811             :                                             l_enable_relaxed_clipping,                      & ! In
         812             :                                             l_mono_flux_lim_thlm,                           & ! In
         813             :                                             l_mono_flux_lim_rtm,                            & ! In
         814             :                                             l_mono_flux_lim_um,                             & ! In
         815             :                                             l_mono_flux_lim_vm,                             & ! In
         816             :                                             l_mono_flux_lim_spikefix,                       & ! In
         817             :                                             order_xm_wpxp, order_xp2_xpyp, order_wp2_wp3,   & ! In
         818             :                                             stats_metadata,                                 & ! In
         819             :                                             stats_zt, stats_zm, stats_sfc,                  & ! In
         820           0 :                                             rtm, wprtp, thlm, wpthlp, sclrm, wpsclrp )        ! Out
         821             :     else
         822             :
         823             :       ! LHS matrices are equivalent, only one solve required
         824             :       call solve_xm_wpxp_with_single_lhs( nz, ngrdcol, sclr_dim, sclr_tol, gr, dt, l_iter, nrhs, & ! In
         825             :                                           wm_zt, wp2, invrs_tau_C6_zm, tau_max_zm,         & ! In
         826             :                                           rtpthvp, rtm_forcing, wprtp_forcing, thlpthvp,   & ! In
         827             :                                           thlm_forcing, wpthlp_forcing, rho_ds_zm,         & ! In
         828             :                                           rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt,     & ! In
         829             :                                           thv_ds_zm, rtp2, thlp2, l_implemented,           & ! In
         830             :                                           sclrpthvp, sclrm_forcing, sclrp2, um_forcing,    & ! In
         831             :                                           vm_forcing, ug, vg, uprcp, vprcp, rc_coef_zm, fcor, & ! In
         832             :                                           up2, vp2,                                        & ! In
         833             :                                           low_lev_effect, high_lev_effect,                 & ! In
         834             :                                           C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc,         & ! In
         835             :                                           lhs_diff_zm, lhs_diff_zt, lhs_ma_zt, lhs_ma_zm,  & ! In
         836             :                                           lhs_ta_wprtp,                                    & ! In
         837             :                                           rhs_ta_wprtp, rhs_ta_wpthlp, rhs_ta_wpup,        & ! In
         838             :                                           rhs_ta_wpvp, rhs_ta_wpsclrp,                     & ! In
         839             :                                           lhs_tp, lhs_ta_xm, lhs_ac_pr2, lhs_pr1_wprtp,    & ! In
         840             :                                           lhs_pr1_wpthlp, lhs_pr1_wpsclrp,                 & ! In
         841             :                                           clubb_params(:,iC_uu_shr),                         & ! In
         842             :                                           penta_solve_method,                              & ! In
         843             :                                           tridiag_solve_method,                            & ! In
         844             :                                           l_predict_upwp_vpwp,                             & ! In
         845             :                                           l_diffuse_rtm_and_thlm,                          & ! In
         846             :                                           l_upwind_xm_ma,                                  & ! In
         847             :                                           l_tke_aniso,                                     & ! In
         848             :                                           l_enable_relaxed_clipping,                       & ! In
         849             :                                           l_perturbed_wind,                                & ! In
         850             :                                           l_mono_flux_lim_thlm,                            & ! In
         851             :                                           l_mono_flux_lim_rtm,                             & ! In
         852             :                                           l_mono_flux_lim_um,                              & ! In
         853             :                                           l_mono_flux_lim_vm,                              & ! In
         854             :                                           l_mono_flux_lim_spikefix,                        & ! In
         855             :                                           order_xm_wpxp, order_xp2_xpyp, order_wp2_wp3,    & ! In
         856             :                                           stats_metadata,                                  & ! In
         857             :                                           stats_zt, stats_zm, stats_sfc,                   & ! In
         858             :                                           rtm, wprtp, thlm, wpthlp,                        & ! Out
         859             :                                           sclrm, wpsclrp, um, upwp, vm, vpwp,              & ! Out
         860     8935056 :                                           um_pert, vm_pert, upwp_pert, vpwp_pert )           ! Out
         861             :     end if ! ( ( iiPDF_type == iiPDF_new ) .and. ( .not. l_explicit_turbulent_adv_wpxp ) )
         862             :
         863     8935056 :     if ( l_lmm_stepping ) then
         864             :
         865             :       !$acc parallel loop gang vector collapse(2) default(present)
         866           0 :       do k = 1, nz
         867           0 :         do i = 1, ngrdcol
         868           0 :           thlm(i,k)   = one_half * (   thlm_old(i,k) + thlm(i,k)   )
         869           0 :           rtm(i,k)    = one_half * (    rtm_old(i,k) + rtm(i,k)    )
         870           0 :           wpthlp(i,k) = one_half * ( wpthlp_old(i,k) + wpthlp(i,k) )
         871           0 :           wprtp(i,k)  = one_half * (  wprtp_old(i,k) + wprtp(i,k)  )
         872             :         end do
         873             :       end do
         874             :       !$acc end parallel loop
         875             :
         876           0 :       if ( sclr_dim > 0 ) then
         877             :         !$acc parallel loop gang vector collapse(3) default(present)
         878           0 :         do j = 1, sclr_dim
         879           0 :           do k = 1, nz
         880           0 :             do i = 1, ngrdcol
         881           0 :               sclrm(i,k,j)   = one_half * (   sclrm_old(i,k,j) +   sclrm(i,k,j) )
         882           0 :               wpsclrp(i,k,j) = one_half * ( wpsclrp_old(i,k,j) + wpsclrp(i,k,j) )
         883             :             end do
         884             :           end do
         885             :         end do
         886             :         !$acc end parallel loop
         887             :       endif ! sclr_dim > 0
         888             :
         889           0 :       if ( l_predict_upwp_vpwp ) then
         890             :         !$acc parallel loop gang vector collapse(2) default(present)
         891           0 :         do k = 1, nz
         892           0 :           do i = 1, ngrdcol
         893           0 :             um(i,k)   = one_half * (   um_old(i,k) +   um(i,k) )
         894           0 :             vm(i,k)   = one_half * (   vm_old(i,k) +   vm(i,k) )
         895           0 :             upwp(i,k) = one_half * ( upwp_old(i,k) + upwp(i,k) )
         896           0 :             vpwp(i,k) = one_half * ( vpwp_old(i,k) + vpwp(i,k) )
         897             :           end do
         898             :         end do
         899             :         !$acc end parallel loop
         900             :       end if ! l_predict_upwp_vpwp
         901             :
         902             :     end if ! l_lmm_stepping
         903             :
         904     8935056 :     if ( clubb_at_least_debug_level( 0 ) ) then
         905     8935056 :       if ( err_code == clubb_fatal_error ) then
         906             :
         907             :         !$acc update host( sigma_sqd_w, wm_zm, wm_zt, wp2, Lscale_zm, wp3_on_wp2, &
         908             :         !$acc              wp3_on_wp2_zt, Kh_zt, Kh_zm, invrs_tau_C6_zm, Skw_zm, &
         909             :         !$acc              wp2rtp, rtpthvp, rtm_forcing, wprtp_forcing, rtm_ref, wp2thlp, &
         910             :         !$acc              thlpthvp, thlm_forcing, wpthlp_forcing, thlm_ref, rho_ds_zm, &
         911             :         !$acc              rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, rtp2, &
         912             :         !$acc              thlp2, w_1_zm, w_2_zm, varnce_w_1_zm, varnce_w_2_zm, &
         913             :         !$acc              mixt_frac_zm, em, wp2sclrp, sclrpthvp, &
         914             :         !$acc              sclrm_forcing, sclrp2, exner, rcm, p_in_Pa, thvm, &
         915             :         !$acc              Cx_fnc_Richardson, um_forcing, vm_forcing, ug, vg, &
         916             :         !$acc              wpthvp, fcor, um_ref, vm_ref, up2, vp2, uprcp, vprcp, rc_coef_zm, &
         917             :         !$acc              rtm, wprtp, thlm, wpthlp, sclrm, wpsclrp, um, upwp, vm, vpwp, &
         918             :         !$acc              rtm_old,wprtp_old, thlm_old, wpthlp_old, sclrm_old, wpsclrp_old, &
         919             :         !$acc              um_old, upwp_old, vm_old, vpwp_old )
         920             :
         921           0 :         do i = 1, ngrdcol
         922           0 :           call error_prints_xm_wpxp( nz, sclr_dim, gr%zm(i,:), gr%zt(i,:), & ! intent(in)
         923           0 :                                      dt, sigma_sqd_w(i,:), wm_zm(i,:), wm_zt(i,:), wp2(i,:), & ! intent(in)
         924           0 :                                      Lscale_zm(i,:), wp3_on_wp2(i,:), wp3_on_wp2_zt(i,:), & ! intent(in)
         925           0 :                                      Kh_zt(i,:), Kh_zm(i,:), invrs_tau_C6_zm(i,:), Skw_zm(i,:), & ! intent(in)
         926           0 :                                      wp2rtp(i,:), rtpthvp(i,:), rtm_forcing(i,:), & ! intent(in)
         927           0 :                                      wprtp_forcing(i,:), rtm_ref(i,:), wp2thlp(i,:), & ! intent(in)
         928           0 :                                      thlpthvp(i,:), thlm_forcing(i,:), & ! intent(in)
         929           0 :                                      wpthlp_forcing(i,:), thlm_ref(i,:), rho_ds_zm(i,:), & ! intent(in)
         930           0 :                                      rho_ds_zt(i,:), invrs_rho_ds_zm(i,:), & ! intent(in)
         931           0 :                                      invrs_rho_ds_zt(i,:), thv_ds_zm(i,:), rtp2(i,:), & ! intent(in)
         932           0 :                                      thlp2(i,:), w_1_zm(i,:), w_2_zm(i,:), & ! intent(in)
         933           0 :                                      varnce_w_1_zm(i,:), varnce_w_2_zm(i,:), & ! intent(in)
         934           0 :                                      mixt_frac_zm(i,:), l_implemented, em(i,:), & ! intent(in)
         935           0 :                                      wp2sclrp(i,:,:), sclrpthvp(i,:,:), sclrm_forcing(i,:,:), & ! intent(in)
         936           0 :                                      sclrp2(i,:,:), exner(i,:), rcm(i,:), p_in_Pa(i,:), thvm(i,:), & ! intent(in)
         937           0 :                                      Cx_fnc_Richardson(i,:), & ! intent(in)
         938             :                                      pdf_implicit_coefs_terms, & ! intent(in)
         939           0 :                                      um_forcing(i,:), vm_forcing(i,:), ug(i,:), vg(i,:), & ! intent(in)
         940           0 :                                      wpthvp(i,:), fcor(i), um_ref(i,:), vm_ref(i,:), up2(i,:), & ! intent(in)
         941             :                                      vp2(i,:), uprcp(i,:), vprcp(i,:), rc_coef_zm(i,:), rtm(i,:), & ! intent(in)
         942             :                                      wprtp(i,:), thlm(i,:), wpthlp(i,:), sclrm(i,:,:), wpsclrp(i,:,:), & ! intent(in)
         943             :                                      um(i,:), upwp(i,:), vm(i,:), vpwp(i,:), rtm_old(i,:), & ! intent(in)
         944             :                                      wprtp_old(i,:), thlm_old(i,:), wpthlp_old(i,:), & ! intent(in)
         945             :                                      sclrm_old(i,:,:), wpsclrp_old(i,:,:), um_old(i,:), & ! intent(in)
         946             :                                      upwp_old(i,:), vm_old(i,:), vpwp_old(i,:), & ! intent(in)
         947           0 :                                      l_predict_upwp_vpwp, l_lmm_stepping ) ! intent(in)
         948             :         end do
         949             :       end if
         950             :     end if
         951             :
         952     8935056 :     if ( rtm_sponge_damp_settings%l_sponge_damping ) then
         953             :
         954             :       !$acc update host( rtm, rtm_ref )
         955             :
         956           0 :       if ( stats_metadata%l_stats_samp ) then
         957           0 :         do i = 1, ngrdcol
         958           0 :           tmp_in(1) = 0.0_core_rknd
         959           0 :           tmp_in(2:nz) = rtm(i,2:nz)
         960             :           call stat_begin_update( nz, stats_metadata%irtm_sdmp, tmp_in / dt, & ! intent(in)
         961           0 :                                   stats_zt(i) )             ! intent(inout)
         962             :         end do
         963             :       end if
         964             :
         965           0 :       do i = 1, ngrdcol
         966           0 :         rtm(i,:) = sponge_damp_xm( nz, dt, gr%zt(i,:), gr%zm(i,:), &
         967           0 :                                    rtm_ref(i,:), rtm(i,:), rtm_sponge_damp_profile )
         968             :       end do
         969             :
         970           0 :       if ( stats_metadata%l_stats_samp ) then
         971           0 :         do i = 1, ngrdcol
         972           0 :           tmp_in(1) = 0.0_core_rknd
         973           0 :           tmp_in(2:nz) = rtm(i,2:nz)
         974             :           call stat_end_update( nz, stats_metadata%irtm_sdmp, tmp_in / dt, & ! intent(in)
         975           0 :                                 stats_zt(i) )             ! intent(inout)
         976             :         end do
         977             :       end if
         978             :
         979             :       !$acc update device( rtm )
         980             :
         981             :     endif ! rtm_sponge_damp_settings%l_sponge_damping
         982             :
         983     8935056 :     if ( thlm_sponge_damp_settings%l_sponge_damping ) then
         984             :
         985             :       !$acc update host( thlm, thlm_ref )
         986             :
         987           0 :       if ( stats_metadata%l_stats_samp ) then
         988           0 :         do i = 1, ngrdcol
         989           0 :           tmp_in(1) = 0.0_core_rknd
         990           0 :           tmp_in(2:nz) = thlm(i,2:nz)
         991             :           call stat_begin_update( nz, stats_metadata%ithlm_sdmp, tmp_in / dt, & ! intent(in)
         992           0 :                                   stats_zt(i) )               ! intent(inout)
         993             :         end do
         994             :       end if
         995             :
         996           0 :       do i = 1, ngrdcol
         997           0 :         thlm(i,:) = sponge_damp_xm( nz, dt, gr%zt(i,:), gr%zm(i,:), &
         998           0 :                                     thlm_ref(i,:), thlm(i,:), thlm_sponge_damp_profile )
         999             :       end do
        1000             :
        1001           0 :       if ( stats_metadata%l_stats_samp ) then
        1002           0 :         do i = 1, ngrdcol
        1003           0 :           tmp_in(1) = 0.0_core_rknd
        1004           0 :           tmp_in(2:nz) = thlm(i,2:nz)
        1005             :           call stat_end_update( nz, stats_metadata%ithlm_sdmp, tmp_in / dt, & ! intent(in)
        1006           0 :                                 stats_zt(i) )               ! intent(inout)
        1007             :         end do
        1008             :       end if
        1009             :
        1010             :       !$acc update device( thlm )
        1011             :
        1012             :     end if ! thlm_sponge_damp_settings%l_sponge_damping
        1013             :
        1014     8935056 :     if ( l_predict_upwp_vpwp ) then
        1015             :
        1016     8935056 :       if ( uv_sponge_damp_settings%l_sponge_damping ) then
        1017             :
        1018             :         !$acc update host( um, vm, um_ref, vm_ref )
        1019             :
        1020           0 :         if ( stats_metadata%l_stats_samp ) then
        1021           0 :           do i = 1, ngrdcol
        1022           0 :              tmp_in(1) = 0.0_core_rknd
        1023           0 :              tmp_in(2:nz) = um(i,2:nz)
        1024             :              call stat_begin_update( nz, stats_metadata%ium_sdmp, tmp_in / dt, & ! intent(in)
        1025           0 :                                      stats_zt(i) )           ! intent(inout)
        1026           0 :              tmp_in(1) = 0.0_core_rknd
        1027           0 :              tmp_in(2:nz) = vm(i,2:nz)
        1028             :              call stat_begin_update( nz, stats_metadata%ivm_sdmp, tmp_in / dt, & ! intent(in)
        1029           0 :                                      stats_zt(i) )           ! intent(inout)
        1030             :           end do
        1031             :         end if
        1032             :
        1033           0 :         do i = 1, ngrdcol
        1034           0 :           um(i,:) = sponge_damp_xm( nz, dt, gr%zt(i,:), gr%zm(i,:), &
        1035           0 :                                     um_ref(i,:), um(i,:), uv_sponge_damp_profile )
        1036             :         end do
        1037             :
        1038           0 :         do i = 1, ngrdcol
        1039           0 :           vm(i,:) = sponge_damp_xm( nz, dt, gr%zt(i,:), gr%zm(i,:), &
        1040           0 :                                     vm_ref(i,:), vm(i,:), uv_sponge_damp_profile )
        1041             :         end do
        1042             :
        1043           0 :         if ( stats_metadata%l_stats_samp ) then
        1044           0 :           do i = 1, ngrdcol
        1045           0 :             tmp_in(1) = 0.0_core_rknd
        1046           0 :             tmp_in(2:nz) = um(i,2:nz)
        1047             :             call stat_end_update( nz, stats_metadata%ium_sdmp, tmp_in / dt, & ! intent(in)
        1048           0 :                                   stats_zt(i) )           ! intent(inout)
        1049           0 :             tmp_in(1) = 0.0_core_rknd
        1050           0 :             tmp_in(2:nz) = vm(i,2:nz)
        1051             :             call stat_end_update( nz, stats_metadata%ivm_sdmp, tmp_in / dt, & ! intent(in)
        1052           0 :                                   stats_zt(i) )           ! intent(inout)
        1053             :           end do
        1054             :         end if
        1055             :
        1056             :       !$acc update device( um, vm )
        1057             :
        1058             :       end if ! uv_sponge_damp_settings%l_sponge_damping
        1059             :
        1060             :       ! Adjust um and vm if nudging is turned on.
        1061     8935056 :       if ( l_uv_nudge ) then
        1062             :
        1063             :         ! Reflect nudging in budget
        1064           0 :         if ( stats_metadata%l_stats_samp ) then
        1065             :           !$acc update host( um, vm )
        1066           0 :           do i = 1, ngrdcol
        1067           0 :             tmp_in(1) = 0.0_core_rknd
        1068           0 :             tmp_in(2:nz) = um(i,2:nz)
        1069             :             call stat_begin_update( nz, stats_metadata%ium_ndg, tmp_in / dt, & ! intent(in)
        1070           0 :                                     stats_zt(i) )          ! intent(inout)
        1071           0 :             tmp_in(1) = 0.0_core_rknd
        1072           0 :             tmp_in(2:nz) = vm(i,2:nz)
        1073             :             call stat_begin_update( nz, stats_metadata%ivm_ndg, tmp_in / dt, & ! intent(in)
        1074           0 :                                     stats_zt(i) )          ! intent(inout)
        1075             :           end do
        1076             :         end if
        1077             :
        1078             :         !$acc parallel loop gang vector collapse(2) default(present)
        1079           0 :         do k = 1, nz
        1080           0 :           do i = 1, ngrdcol
        1081           0 :             um(i,k) = um(i,k) - ( ( um(i,k) - um_ref(i,k) ) * (dt/ts_nudge) )
        1082           0 :             vm(i,k) = vm(i,k) - ( ( vm(i,k) - vm_ref(i,k) ) * (dt/ts_nudge) )
        1083             :           end do
        1084             :         end do
        1085             :         !$acc end parallel loop
        1086             :
        1087             :         ! Reflect nudging in budget
        1088           0 :         if ( stats_metadata%l_stats_samp ) then
        1089             :           !$acc update host( um, vm )
        1090           0 :           do i = 1, ngrdcol
        1091           0 :             tmp_in(1) = 0.0_core_rknd
        1092           0 :             tmp_in(2:nz) = um(i,2:nz)
        1093             :             call stat_end_update( nz, stats_metadata%ium_ndg, tmp_in / dt, & ! intent(in)
        1094           0 :                                   stats_zt(i) )          ! intent(inout)
        1095           0 :             tmp_in(1) = 0.0_core_rknd
        1096           0 :             tmp_in(2:nz) = vm(i,2:nz)
        1097             :             call stat_end_update( nz, stats_metadata%ivm_ndg, tmp_in / dt, & ! intent(in)
        1098           0 :                                   stats_zt(i) )          ! intent(inout)
        1099             :           end do
        1100             :         end if
        1101             :
        1102             :       end if ! l_uv_nudge
        1103             :
        1104     8935056 :       if ( stats_metadata%l_stats_samp ) then
        1105             :         !$acc update host( um_ref, vm_ref )
        1106           0 :         do i = 1, ngrdcol
        1107           0 :           tmp_in(1) = 0.0_core_rknd
        1108           0 :           tmp_in(2:nz) = um_ref(i,2:nz)
        1109             :           call stat_update_var( stats_metadata%ium_ref, tmp_in, & ! intent(in)
        1110           0 :                                 stats_zt(i) )         ! intent(inout)
        1111           0 :           tmp_in(1) = 0.0_core_rknd
        1112           0 :           tmp_in(2:nz) = vm_ref(i,2:nz)
        1113             :           call stat_update_var( stats_metadata%ivm_ref, tmp_in, & ! intent(in)
        1114           0 :                                 stats_zt(i) )         ! intent(inout)
        1115             :         end do
        1116             :       end if
        1117             :
        1118             :     end if ! l_predict_upwp_vpwp
        1119             :
        1120             :     ! Lower boundary condition on xm
        1121             :
        1122             :     !$acc parallel loop gang vector default(present)
        1123   149194656 :     do i = 1, ngrdcol
        1124   140259600 :       rtm(i,1)  = rtm(i,2)
        1125   149194656 :       thlm(i,1) = thlm(i,2)
        1126             :     enddo
        1127             :     !$acc end parallel loop
        1128             :
        1129     8935056 :     if ( sclr_dim > 0 ) then
        1130             :       !$acc parallel loop gang vector collapse(2) default(present)
        1131           0 :       do j = 1, sclr_dim
        1132           0 :         do i = 1, ngrdcol
        1133           0 :           sclrm(i,1,j) = sclrm(i,2,j)
        1134             :         enddo
        1135             :       enddo
        1136             :       !$acc end parallel loop
        1137             :     endif
        1138             :
        1139     8935056 :     if ( l_predict_upwp_vpwp ) then
        1140             :       !$acc parallel loop gang vector default(present)
        1141   149194656 :       do i = 1, ngrdcol
        1142   140259600 :         um(i,1) = um(i,2)
        1143   140259600 :         vm(i,1) = vm(i,2)
        1144   149194656 :         if ( l_perturbed_wind ) then
        1145           0 :           um_pert(i,1) = um_pert(i,2)
        1146           0 :           vm_pert(i,1) = vm_pert(i,2)
        1147             :         endif ! l_perturbed_wind
        1148             :       end do
        1149             :       !$acc end parallel loop
        1150             :     endif ! l_predict_upwp_vpwp
        1151             :
        1152             :     !$acc exit data delete( C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc, C6_term, Kw6, &
        1153             :     !$acc                   low_lev_effect, high_lev_effect, rtm_old, wprtp_old, thlm_old, &
        1154             :     !$acc                   wpthlp_old, um_old, upwp_old, vm_old, &
        1155             :     !$acc                   vpwp_old, lhs_diff_zm, lhs_diff_zt, lhs_ma_zt, lhs_ma_zm, &
        1156             :     !$acc                   lhs_ta_wprtp, lhs_ta_wpthlp, lhs_ta_wpup, lhs_ta_wpvp, &
        1157             :     !$acc                   rhs_ta_wprtp, rhs_ta_wpthlp, rhs_ta_wpup, &
        1158             :     !$acc                   rhs_ta_wpvp, lhs_tp, lhs_ta_xm, lhs_ac_pr2, &
        1159             :     !$acc                   lhs_pr1_wprtp, lhs_pr1_wpthlp )
        1160             :
        1161             :     !$acc exit data if( sclr_dim > 0 ) &
        1162             :     !$acc           delete( sclrm_old, wpsclrp_old, lhs_ta_wpsclrp,  &
        1163             :     !$acc                   rhs_ta_wpsclrp, lhs_pr1_wpsclrp )
        1164             :
        1165             :     return
        1166             :
        1167             :   end subroutine advance_xm_wpxp
        1168             :
        1169             :   !======================================================================================
        1170     8935056 :   subroutine xm_wpxp_lhs( nz, ngrdcol, l_iter, dt, wpxp, wm_zt, C7_Skw_fnc,     & ! In
        1171             :                           wpxp_upper_lim, wpxp_lower_lim,                       & ! In
        1172     8935056 :                           l_implemented, lhs_diff_zm, lhs_diff_zt,              & ! In
        1173     8935056 :                           lhs_ma_zm, lhs_ma_zt, lhs_ta_wpxp, lhs_ta_xm,         & ! In
        1174     8935056 :                           lhs_tp, lhs_pr1, lhs_ac_pr2,                          & ! In
        1175             :                           l_diffuse_rtm_and_thlm,                               & ! In
        1176             :                           stats_metadata,                                       & ! In
        1177     8935056 :                           lhs )                                                   ! Out
        1178             :     ! Description:
        1179             :     !   Compute LHS band diagonal matrix for xm and w'x'.
        1180             :     !   This subroutine computes the implicit portion of
        1181             :     !   the xm and w'x' equations.
        1182             :     !
        1183             :     !
        1184             :     ! Notes:
        1185             :     !
        1186             :     !   Boundary conditions:
        1187             :     !       The turbulent flux (wpxp) use fixed-point boundary conditions at both the
        1188             :     !       upper and lower boundaries.  Therefore, anything set in the wpxp loop
        1189             :     !       at both the upper and lower boundaries would be overwritten here.
        1190             :     !       However, the wpxp loop does not extend to the boundary levels.  An array
        1191             :     !       with a value of 1 at the main diagonal on the left-hand side and with
        1192             :     !       values of 0 at all other diagonals on the left-hand side will preserve the
        1193             :     !       right-hand side value at that level.  The value of xm at level k = 1,
        1194             :     !       which is below the model surface, is preserved and then overwritten to
        1195             :     !       match the new value of xm at level k = 2.
        1196             :     !
        1197             :     !           xm(1)  wpxp(1) ... wpxp(nzmax)
        1198             :     !         [  0.0     0.0         0.0    ]
        1199             :     !         [  0.0     0.0         0.0    ]
        1200             :     !         [  1.0     1.0   ...   1.0    ]
        1201             :     !         [  0.0     0.0         0.0    ]
        1202             :     !         [  0.0     0.0         0.0    ]
        1203             :     !
        1204             :     !
        1205             :     !   LHS turbulent advection (ta) term:
        1206             :     !        An "over-implicit" weighted time step is applied to this term.
        1207             :     !        The weight of the implicit portion of this term is controlled by
        1208             :     !        the factor gamma_over_implicit_ts (abbreviated "gamma" in the
        1209             :     !        equation in order to balance a weight that is not equal to 1,
        1210             :     !        such that:
        1211             :     !             -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS;
        1212             :     !        where X is the variable that is being solved for in a predictive
        1213             :     !        equation (<w'x'> in this case), y(t) is the linearized portion of
        1214             :     !        the term that gets treated implicitly, and RHS is the portion of
        1215             :     !        the term that is always treated explicitly.  A weight of greater
        1216             :     !        than 1 can be applied to make the term more numerically stable.
        1217             :     !
        1218             :     !
        1219             :     !   xm: Left-hand side (implicit xm portion of the code).
        1220             :     !
        1221             :     !   Thermodynamic subdiagonal (lhs index: t_km1_tdiag)
        1222             :     !         [ x xm(k-1,<t+1>) ]
        1223             :     !   Momentum subdiagonal (lhs index: t_km1_mdiag)
        1224             :     !         [ x wpxp(k-1,<t+1>) ]
        1225             :     !   Thermodynamic main diagonal (lhs index: t_k_tdiag)
        1226             :     !         [ x xm(k,<t+1>) ]
        1227             :     !   Momentum superdiagonal (lhs index: t_k_mdiag)
        1228             :     !         [ x wpxp(k,<t+1>) ]
        1229             :     !   Thermodynamic superdiagonal (lhs index: t_kp1_tdiag)
        1230             :     !         [ x xm(k+1,<t+1>) ]
        1231             :     !
        1232             :     !
        1233             :     !   w'x': Left-hand side (implicit w'x' portion of the code).
        1234             :     !
        1235             :     !   Momentum subdiagonal (lhs index: m_km1_mdiag)
        1236             :     !         [ x wpxp(k-1,<t+1>) ]
        1237             :     !   Thermodynamic subdiagonal (lhs index: m_k_tdiag)
        1238             :     !         [ x xm(k,<t+1>) ]
        1239             :     !   Momentum main diagonal (lhs index: m_k_mdiag)
        1240             :     !         [ x wpxp(k,<t+1>) ]
        1241             :     !   Thermodynamic superdiagonal (lhs index: m_kp1_tdiag)
        1242             :     !         [ x xm(k+1,<t+1>) ]
        1243             :     !   Momentum superdiagonal (lhs index: m_kp1_mdiag)
        1244             :     !         [ x wpxp(k+1,<t+1>) ]
        1245             :     !
        1246             :     !----------------------------------------------------------------------------------
        1247             :
        1248             :     use constants_clubb, only: &
        1249             :         gamma_over_implicit_ts, & ! Constant(s)
        1250             :         one, &
        1251             :         zero
        1252             :
        1253             :     use clubb_precision, only:  &
        1254             :         core_rknd ! Variable(s)
        1255             :
        1256             :     use clip_semi_implicit, only: &
        1257             :         clip_semi_imp_lhs ! Procedure(s)
        1258             :
        1259             :     use stats_variables, only: &
        1260             :         stats_metadata_type
        1261             :
        1262             :     implicit none
        1263             :
        1264             :     !------------------- Input Variables -------------------
        1265             :     integer, intent(in) :: &
        1266             :       nz, &
        1267             :       ngrdcol
        1268             :
        1269             :     real( kind = core_rknd ), intent(in) ::  &
        1270             :       dt    ! Timestep                                  [s]
        1271             :
        1272             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
        1273             :       wpxp,                   & ! w'x' (momentum levs) at timestep (t) [un vary]
        1274             :       wm_zt,                  & ! w wind component on thermo. levels       [m/s]
        1275             :       C7_Skw_fnc,             & ! C_7 parameter with Sk_w applied            [-]
        1276             :       wpxp_upper_lim,         & ! Keeps corrs. from becoming > 1       [un vary]
        1277             :       wpxp_lower_lim            ! Keeps corrs. from becoming < -1      [un vary]
        1278             :
        1279             :     logical, intent(in) ::  &
        1280             :       l_implemented, & ! Flag for CLUBB being implemented in a larger model.
        1281             :       l_iter
        1282             :
        1283             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: &
        1284             :       lhs_diff_zm,  & ! Diffusion term for w'x'
        1285             :       lhs_diff_zt,  & ! Diffusion term for xm
        1286             :       lhs_ma_zt,    & ! Mean advection contributions to lhs
        1287             :       lhs_ma_zm,    & ! Mean advection contributions to lhs
        1288             :       lhs_ta_wpxp     ! Turbulent advection contributions to lhs
        1289             :
        1290             :     real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(in) :: &
        1291             :       lhs_tp,     & ! Turbulent production terms of w'x'
        1292             :       lhs_ta_xm     ! Turbulent advection terms of xm
        1293             :
        1294             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        1295             :       lhs_ac_pr2, & ! Accumulation of w'x' and w'x' pressure term 2
        1296             :       lhs_pr1       ! Pressure term 1 for w'x'
        1297             :
        1298             :     type (stats_metadata_type), intent(in) :: &
        1299             :       stats_metadata
        1300             :
        1301             :     !------------------- Output Variable -------------------
        1302             :     real( kind = core_rknd ), intent(out), dimension(nsup+nsub+1,ngrdcol,2*nz) ::  &
        1303             :       lhs ! Implicit contributions to wpxp/xm (band diag. matrix) (LAPACK)
        1304             :
        1305             :     !------------------- Local Variables -------------------
        1306             :     ! Indices
        1307             :     integer :: k
        1308             :     integer :: k_xm, k_wpxp
        1309             :
        1310             :     logical :: l_upper_thresh, l_lower_thresh ! flags for clip_semi_imp_lhs
        1311             :
        1312             :     logical, intent(in) :: &
        1313             :       l_diffuse_rtm_and_thlm ! This flag determines whether or not we want CLUBB to do diffusion
        1314             :                              ! on rtm and thlm
        1315             :
        1316             :     real (kind = core_rknd) :: &
        1317             :       invrs_dt
        1318             :
        1319             :     integer :: i
        1320             :
        1321             :     !------------------- Begin Code -------------------
        1322             :
        1323             :     ! Initializations/precalculations
        1324     8935056 :     invrs_dt = 1.0_core_rknd / dt
        1325             :
        1326             :     ! Lower boundary for xm, lhs(:,1)
        1327             :     !$acc parallel loop gang vector default(present)
        1328   149194656 :     do i = 1, ngrdcol
        1329   140259600 :       lhs(1,i,1) = 0.0_core_rknd
        1330   140259600 :       lhs(2,i,1) = 0.0_core_rknd
        1331   140259600 :       lhs(3,i,1) = 1.0_core_rknd
        1332   140259600 :       lhs(4,i,1) = 0.0_core_rknd
        1333   149194656 :       lhs(5,i,1) = 0.0_core_rknd
        1334             :     end do
        1335             :     !$acc end parallel loop
        1336             :
        1337             :     ! Lower boundary for w'x', lhs(:,2)
        1338             :     !$acc parallel loop gang vector default(present)
        1339   149194656 :     do i = 1, ngrdcol
        1340   140259600 :       lhs(1,i,2) = 0.0_core_rknd
        1341   140259600 :       lhs(2,i,2) = 0.0_core_rknd
        1342   140259600 :       lhs(3,i,2) = 1.0_core_rknd
        1343   140259600 :       lhs(4,i,2) = 0.0_core_rknd
        1344   149194656 :       lhs(5,i,2) = 0.0_core_rknd
        1345             :     end do
        1346             :     !$acc end parallel loop
        1347             :
        1348             :     ! Combine xm and w'x' terms into LHS
        1349             :     !$acc parallel loop gang vector collapse(2) default(present)
        1350   759479760 :     do k = 2, nz
        1351 12541286160 :       do i = 1, ngrdcol
        1352             :
        1353 11781806400 :         k_xm = 2*k - 1  ! xm at odd index values
        1354 11781806400 :         k_wpxp = 2*k    ! w'x' at even index values
        1355             :
        1356             :         ! ---- sum xm terms ----
        1357             :
        1358 11781806400 :         lhs(1,i,k_xm) = zero
        1359             :
        1360 11781806400 :         lhs(2,i,k_xm) = lhs_ta_xm(1,i,k)
        1361             :
        1362 11781806400 :         lhs(3,i,k_xm) = invrs_dt
        1363             :
        1364 11781806400 :         lhs(4,i,k_xm) = lhs_ta_xm(2,i,k)
        1365             :
        1366 11781806400 :         lhs(5,i,k_xm) = zero
        1367             :
        1368             :         ! ---- sum w'x' terms ----
        1369             :
        1370 11781806400 :         lhs(1,i,k_wpxp) = lhs_ma_zm(1,i,k) + lhs_diff_zm(1,i,k) &
        1371 11781806400 :                           + gamma_over_implicit_ts * lhs_ta_wpxp(1,i,k)
        1372             :
        1373 11781806400 :         lhs(2,i,k_wpxp) = lhs_tp(1,i,k)
        1374             :
        1375             :         lhs(3,i,k_wpxp) = lhs_ma_zm(2,i,k) + lhs_diff_zm(2,i,k) + lhs_ac_pr2(i,k) &
        1376 11781806400 :                           + gamma_over_implicit_ts * ( lhs_ta_wpxp(2,i,k) + lhs_pr1(i,k) )
        1377             :
        1378 11781806400 :         lhs(4,i,k_wpxp) = lhs_tp(2,i,k)
        1379             :
        1380             :         lhs(5,i,k_wpxp) = lhs_ma_zm(3,i,k) + lhs_diff_zm(3,i,k) &
        1381 12532351104 :                         + gamma_over_implicit_ts * lhs_ta_wpxp(3,i,k)
        1382             :
        1383             :       end do
        1384             :     end do
        1385             :     !$acc end parallel loop
        1386             :
        1387             :     ! Upper boundary for w'x', , lhs(:,2*gr%nz)
        1388             :     ! These were set in the loop above for simplicity, so they must be set properly here
        1389             :     !$acc parallel loop gang vector default(present)
        1390   149194656 :     do i = 1, ngrdcol
        1391   140259600 :       lhs(1,i,2*nz) = 0.0_core_rknd
        1392   140259600 :       lhs(2,i,2*nz) = 0.0_core_rknd
        1393   140259600 :       lhs(3,i,2*nz) = 1.0_core_rknd
        1394   140259600 :       lhs(4,i,2*nz) = 0.0_core_rknd
        1395   149194656 :       lhs(5,i,2*nz) = 0.0_core_rknd
        1396             :     end do
        1397             :     !$acc end parallel loop
        1398             :
        1399             :     ! LHS time tendency
        1400     8935056 :     if ( l_iter ) then
        1401             :       !$acc parallel loop gang vector collapse(2) default(present)
        1402   750544704 :       do k = 2, nz-1
        1403 12392091504 :         do i = 1, ngrdcol
        1404 11641546800 :           k_wpxp = 2*k
        1405 12383156448 :           lhs(3,i,k_wpxp) = lhs(3,i,k_wpxp) + invrs_dt
        1406             :         end do
        1407             :       end do
        1408             :       !$acc end parallel loop
        1409             :     end if
        1410             :
        1411             :     ! Calculate diffusion terms for all thermodynamic grid level
        1412     8935056 :     if ( l_diffuse_rtm_and_thlm ) then
        1413             :       !$acc parallel loop gang vector collapse(2) default(present)
        1414           0 :       do k = 2, nz
        1415           0 :         do i = 1, ngrdcol
        1416           0 :           k_xm = 2*k - 1
        1417           0 :           lhs(1,i,k_xm) = lhs(1,i,k_xm) + lhs_diff_zt(1,i,k)
        1418           0 :           lhs(3,i,k_xm) = lhs(3,i,k_xm) + lhs_diff_zt(2,i,k)
        1419           0 :           lhs(5,i,k_xm) = lhs(5,i,k_xm) + lhs_diff_zt(3,i,k)
        1420             :         end do
        1421             :       end do
        1422             :       !$acc end parallel loop
        1423             :     end if
        1424             :
        1425             :     ! Calculate mean advection terms for all momentum grid level
        1426     8935056 :     if ( .not. l_implemented ) then
        1427             :       !$acc parallel loop gang vector collapse(2) default(present)
        1428           0 :       do k = 2, nz
        1429           0 :         do i = 1, ngrdcol
        1430           0 :           k_xm = 2*k - 1
        1431           0 :           lhs(1,i,k_xm) = lhs(1,i,k_xm) + lhs_ma_zt(1,i,k)
        1432           0 :           lhs(3,i,k_xm) = lhs(3,i,k_xm) + lhs_ma_zt(2,i,k)
        1433           0 :           lhs(5,i,k_xm) = lhs(5,i,k_xm) + lhs_ma_zt(3,i,k)
        1434             :         end do
        1435             :       end do
        1436             :       !$acc end parallel loop
        1437             :     end if
        1438             :
        1439     8935056 :     return
        1440             :
        1441             :   end subroutine xm_wpxp_lhs
        1442             :
        1443             :   !=============================================================================================
        1444     8935056 :   subroutine calc_xm_wpxp_lhs_terms( nz, ngrdcol, gr, Kh_zm, wm_zm, wm_zt, wp2,         & ! In
        1445     8935056 :                                      Kw6, C7_Skw_fnc, invrs_rho_ds_zt,                  & ! In
        1446     8935056 :                                      invrs_rho_ds_zm, rho_ds_zt,                        & ! In
        1447     8935056 :                                      rho_ds_zm, l_implemented, em,                      & ! In
        1448     8935056 :                                      Lscale_zm, thlm, exner, rtm, rcm, p_in_Pa, thvm,   & ! In
        1449     8935056 :                                      ice_supersat_frac,                                 & ! In
        1450     8935056 :                                      clubb_params, nu_vert_res_dep,                     & ! In
        1451             :                                      saturation_formula,                                & ! In
        1452             :                                      l_diffuse_rtm_and_thlm,                            & ! In
        1453             :                                      l_stability_correct_Kh_N2_zm,                      & ! In
        1454             :                                      l_upwind_xm_ma,                                    & ! In
        1455             :                                      l_brunt_vaisala_freq_moist,                        & ! In
        1456             :                                      l_use_thvm_in_bv_freq,                             & ! In
        1457     8935056 :                                      lhs_diff_zm, lhs_diff_zt, lhs_ma_zt, lhs_ma_zm,    & ! Out
        1458     8935056 :                                      lhs_tp, lhs_ta_xm, lhs_ac_pr2 )                      ! Out
        1459             :     ! Description:
        1460             :     !   Calculate various xm and w'x' terms. These are general terms that are the same
        1461             :     !   for multiple LHS matrices, so we save computations by calculating them once
        1462             :     !   here, then reusing them where needed.
        1463             :     !
        1464             :     !-------------------------------------------------------------------------------------------
        1465             :
        1466             :     use grid_class, only:  &
        1467             :         grid, & ! Type
        1468             :         zm2zt, & ! Procedure(s)
        1469             :         zt2zm
        1470             :
        1471             :     use parameter_indices, only: &
        1472             :         nparams, & ! Variable(s)
        1473             :         ilambda0_stability_coef, &
        1474             :         ibv_efold
        1475             :
        1476             :     use parameters_tunable, only: &
        1477             :         nu_vertical_res_dep    ! Type(s)
        1478             :
        1479             :     use clubb_precision, only:  &
        1480             :         core_rknd ! Variable(s)
        1481             :
        1482             :     use advance_helper_module, only: &
        1483             :         calc_stability_correction
        1484             :
        1485             :     use mean_adv, only: &
        1486             :         term_ma_zt_lhs, &
        1487             :         term_ma_zm_lhs
        1488             :
        1489             :     use turbulent_adv_pdf, only: &
        1490             :         xpyp_term_ta_pdf_lhs
        1491             :
        1492             :     use diffusion, only:  &
        1493             :         diffusion_zt_lhs, &
        1494             :         diffusion_zm_lhs
        1495             :
        1496             :     use constants_clubb, only: &
        1497             :         zero_threshold, &
        1498             :         zero
        1499             :
        1500             :     implicit none
        1501             :
        1502             :     !------------------- Input Variables -------------------
        1503             :     integer, intent(in) :: &
        1504             :       nz, &
        1505             :       ngrdcol
        1506             :
        1507             :     type (grid), target, intent(in) :: gr
        1508             :
        1509             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
        1510             :       Kh_zm,                  & ! Eddy diffusivity on momentum levels    [m^2/s]
        1511             :       Lscale_zm,              & ! Turbulent mixing length interp to m levs   [m]
        1512             :       em,                     & ! Turbulent Kinetic Energy (TKE)       [m^2/s^2]
        1513             :       thlm,                   & ! th_l (thermo. levels)                      [K]
        1514             :       exner,                  & ! Exner function                             [-]
        1515             :       rtm,                    & ! total water mixing ratio, r_t              [-]
        1516             :       rcm,                    & ! cloud water mixing ratio, r_c          [kg/kg]
        1517             :       p_in_Pa,                & ! Air pressure                              [Pa]
        1518             :       thvm,                   & ! Virtual potential temperature              [K]
        1519             :       wm_zm,                  & ! w wind component on momentum levels      [m/s]
        1520             :       wm_zt,                  & ! w wind component on thermo. levels       [m/s]
        1521             :       wp2,                    & ! w'^2 (momentum levels)               [m^2/s^2]
        1522             :       Kw6,                    & ! Coef. of eddy diffusivity for w'x'     [m^2/s]
        1523             :       C7_Skw_fnc,             & ! C_7 parameter with Sk_w applied            [-]
        1524             :       rho_ds_zm,              & ! Dry, static density on momentum levs. [kg/m^3]
        1525             :       rho_ds_zt,              &
        1526             :       invrs_rho_ds_zm,        &
        1527             :       invrs_rho_ds_zt,        &  ! Inv. dry, static density at t-levs.   [m^3/kg]
        1528             :       ice_supersat_frac
        1529             :
        1530             :     logical, intent(in) ::  &
        1531             :       l_implemented   ! Flag for CLUBB being implemented in a larger model.
        1532             :
        1533             :     real( kind = core_rknd ), dimension(ngrdcol,nparams), intent(in) :: &
        1534             :       clubb_params    ! Array of CLUBB's tunable parameters    [units vary]
        1535             :
        1536             :     type(nu_vertical_res_dep), intent(in) :: &
        1537             :       nu_vert_res_dep    ! Vertical resolution dependent nu values
        1538             :
        1539             :     integer, intent(in) :: &
        1540             :       saturation_formula ! Integer that stores the saturation formula to be used
        1541             :
        1542             :     logical, intent(in) :: &
        1543             :       l_diffuse_rtm_and_thlm,       & ! This flag determines whether or not we want CLUBB to do
        1544             :                                       ! diffusion on rtm and thlm
        1545             :       l_stability_correct_Kh_N2_zm, & ! This flag determines whether or not we want CLUBB to apply
        1546             :                                       ! a stability correction
        1547             :       l_upwind_xm_ma,               & ! This flag determines whether we want to use an upwind
        1548             :                                       ! differencing approximation rather than a centered
        1549             :                                       ! differencing for turbulent or mean advection terms.
        1550             :                                       ! It affects rtm, thlm, sclrm, um and vm.
        1551             :       l_brunt_vaisala_freq_moist,   & ! Use a different formula for the Brunt-Vaisala frequency in
        1552             :                                       ! saturated atmospheres (from Durran and Klemp, 1982)
        1553             :       l_use_thvm_in_bv_freq           ! Use thvm in the calculation of Brunt-Vaisala frequency
        1554             :
        1555             :     !------------------- Output Variables -------------------
        1556             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(out) :: &
        1557             :       lhs_diff_zm,  & ! Diffusion term for w'x'
        1558             :       lhs_diff_zt,  & ! Diffusion term for xm
        1559             :       lhs_ma_zt,    & ! Mean advection contributions to lhs
        1560             :       lhs_ma_zm       ! Mean advection contributions to lhs
        1561             :
        1562             :     real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(out) :: &
        1563             :       lhs_tp,     & ! Turbulent production terms of w'x'
        1564             :       lhs_ta_xm     ! Turbulent advection terms of xm
        1565             :
        1566             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
        1567             :       lhs_ac_pr2    ! Accumulation of w'x' and w'x' pressure term 2
        1568             :
        1569             :
        1570             :     !------------------- Local Variables -------------------
        1571             :     real (kind = core_rknd), dimension(ngrdcol,nz) :: &
        1572    17870112 :       Kh_N2_zm, &
        1573    17870112 :       K_zm, &      ! Coef. of eddy diffusivity at momentum level (k)   [m^2/s]
        1574    17870112 :       K_zt, &      ! Eddy diffusivity coefficient, thermo. levels [m2/s]
        1575    17870112 :       Kw6_zm       ! Eddy diffusivity coefficient, momentum levels [m2/s]
        1576             :
        1577             :     real (kind = core_rknd) :: &
        1578             :       constant_nu ! controls the magnitude of diffusion
        1579             :
        1580             :     real (kind = core_rknd), dimension(ngrdcol) :: &
        1581    17870112 :       zeros_array
        1582             :
        1583             :     integer :: i, k, b
        1584             :
        1585             :     !------------------- Begin Code -------------------
        1586             :
        1587             :     !$acc enter data create( Kh_N2_zm, K_zm, K_zt, Kw6_zm, zeros_array )
        1588             :
        1589             :     ! Initializations/precalculations
        1590     8935056 :     constant_nu = 0.1_core_rknd
        1591     8935056 :     Kw6_zm      = zt2zm( nz, ngrdcol, gr, Kw6, zero_threshold )
        1592             :
        1593             :     ! Calculate turbulent advection terms of xm for all grid levels
        1594             :     call xm_term_ta_lhs( nz, ngrdcol, gr,            & ! Intent(in)
        1595             :                          rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in)
        1596     8935056 :                          lhs_ta_xm )                   ! Intent(out)
        1597             :
        1598             :
        1599             :     ! Calculate turbulent production terms of w'x' for all grid level
        1600             :     call wpxp_term_tp_lhs( nz, ngrdcol, gr, wp2, & ! Intent(in)
        1601     8935056 :                            lhs_tp )                ! Intent(out)
        1602             :
        1603             :     ! Calculate accumulation of w'x' and w'x' pressure term 2 of w'x' for all grid level
        1604             :     ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:wpxp_pr
        1605             :     call wpxp_terms_ac_pr2_lhs( nz, ngrdcol, C7_Skw_fnc,  & ! Intent(in)
        1606             :                                 wm_zt, gr%invrs_dzm,      & ! Intent(in)
        1607     8935056 :                                 lhs_ac_pr2 )                ! Intent(out)
        1608             :
        1609             :     ! Calculate diffusion terms for all momentum grid level
        1610             :     call diffusion_zm_lhs( nz, ngrdcol, gr, Kw6, Kw6_zm, nu_vert_res_dep%nu6, & ! Intent(in)
        1611             :                            invrs_rho_ds_zm, rho_ds_zt,                        & ! Intent(in)
        1612     8935056 :                            lhs_diff_zm )                                        ! Intent(out)
        1613             :
        1614             :     ! Calculate mean advection terms for all momentum grid level
        1615             :     call term_ma_zm_lhs( nz, ngrdcol, wm_zm,              & ! Intent(in)
        1616             :                          gr%invrs_dzm, gr%weights_zm2zt,  & ! In
        1617     8935056 :                          lhs_ma_zm )                        ! Intent(out)
        1618             :
        1619             :     ! Calculate diffusion terms for all thermodynamic grid level
        1620     8935056 :     if ( l_diffuse_rtm_and_thlm ) then
        1621             :
        1622           0 :         if ( l_stability_correct_Kh_N2_zm ) then
        1623             :
        1624             :           call calc_stability_correction( nz, ngrdcol, gr, &
        1625             :                                           thlm, Lscale_zm, em, &
        1626             :                                           exner, rtm, rcm, &
        1627             :                                           p_in_Pa, thvm, ice_supersat_frac, &
        1628             :                                           clubb_params(:,ilambda0_stability_coef), &
        1629             :                                           clubb_params(:,ibv_efold), &
        1630             :                                           saturation_formula, &
        1631             :                                           l_brunt_vaisala_freq_moist, &
        1632             :                                           l_use_thvm_in_bv_freq,&
        1633           0 :                                           Kh_N2_zm )
        1634             :
        1635             :           !$acc parallel loop gang vector collapse(2) default(present)
        1636           0 :           do k = 1, nz
        1637           0 :             do i = 1, ngrdcol
        1638           0 :               Kh_N2_zm(i,k) = Kh_zm(i,k) / Kh_N2_zm(i,k)
        1639             :             end do
        1640             :           end do
        1641             :           !$acc end parallel loop
        1642             :
        1643             :         else
        1644             :           !$acc parallel loop gang vector collapse(2) default(present)
        1645           0 :           do k = 1, nz
        1646           0 :             do i = 1, ngrdcol
        1647           0 :               Kh_N2_zm(i,k) = Kh_zm(i,k)
        1648             :             end do
        1649             :           end do
        1650             :           !$acc end parallel loop
        1651             :         end if
        1652             :
        1653             :         !$acc parallel loop gang vector collapse(2) default(present)
        1654           0 :         do k = 1, nz
        1655           0 :           do i = 1, ngrdcol
        1656           0 :             K_zm(i,k) = Kh_N2_zm(i,k) + constant_nu
        1657             :           end do
        1658             :         end do
        1659             :         !$acc end parallel loop
        1660             :
        1661           0 :         K_zt = zm2zt( nz, ngrdcol, gr, K_zm, zero_threshold )
        1662             :
        1663             :         !$acc parallel loop gang vector default(present)
        1664           0 :         do i = 1, ngrdcol
        1665           0 :           zeros_array(i) = zero
        1666             :         end do
        1667             :         !$acc end parallel loop
        1668             :
        1669             :         call diffusion_zt_lhs( nz, ngrdcol, gr, K_zm, K_zt, zeros_array,  & ! Intent(in)
        1670             :                                invrs_rho_ds_zt, rho_ds_zm,                & ! intent(in)
        1671           0 :                                lhs_diff_zt )                                ! Intent(out)
        1672             :
        1673             :     end if
        1674             :
        1675             :     ! Calculate mean advection terms for all thermodynamic grid level
        1676     8935056 :     if ( .not. l_implemented ) then
        1677             :       call term_ma_zt_lhs( nz, ngrdcol, wm_zt, gr%weights_zt2zm,  & ! intent(in)
        1678             :                            gr%invrs_dzt, gr%invrs_dzm,            & ! intent(in)
        1679             :                            l_upwind_xm_ma,                        & ! Intent(in)
        1680           0 :                            lhs_ma_zt )                              ! Intent(out)
        1681             :     end if
        1682             :
        1683             :     !$acc exit data delete( Kh_N2_zm, K_zm, K_zt, Kw6_zm, zeros_array )
        1684             :
        1685     8935056 :     return
        1686             :
        1687             :   end subroutine calc_xm_wpxp_lhs_terms
        1688             :
        1689             :   !=============================================================================
        1690    35740224 :   subroutine xm_wpxp_rhs( nz, ngrdcol, solve_type, l_iter, dt, xm, wpxp, & ! In
        1691    35740224 :                           xm_forcing, wpxp_forcing, C7_Skw_fnc, & ! In
        1692    35740224 :                           xpthvp, rhs_ta, thv_ds_zm, & ! In
        1693    35740224 :                           lhs_pr1, lhs_ta_wpxp, & ! In
        1694             :                           stats_metadata, & ! In
        1695    35740224 :                           stats_zt, stats_zm, & ! In
        1696    35740224 :                           rhs ) ! Out
        1697             :
        1698             :     ! Description:
        1699             :     ! Compute RHS vector for xm and w'x'.
        1700             :     ! This subroutine computes the explicit portion of
        1701             :     ! the xm and w'x' equations.
        1702             :     !
        1703             :     ! Notes:
        1704             :     !   For LHS turbulent advection (ta) term.
        1705             :     !       An "over-implicit" weighted time step is applied to this term.
        1706             :     !       The weight of the implicit portion of this term is controlled by
        1707             :     !       the factor gamma_over_implicit_ts (abbreviated "gamma" in the
        1708             :     !       expression below).  A factor is added to the right-hand side of
        1709             :     !       the equation in order to balance a weight that is not equal to 1,
        1710             :     !       such that:
        1711             :     !            -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS;
        1712             :     !       where X is the variable that is being solved for in a predictive
        1713             :     !       equation (<w'x'> in this case), y(t) is the linearized portion of
        1714             :     !       the term that gets treated implicitly, and RHS is the portion of
        1715             :     !       the term that is always treated explicitly.  A weight of greater
        1716             :     !       than 1 can be applied to make the term more numerically stable.
        1717             :     !
        1718             :     !   --- THIS SUBROUTINE HAS BEEN OPTIMIZED ---
        1719             :     !   Significant changes to this routine may adversely affect computational speed
        1720             :     !       - Gunther Huebler, Aug. 2018, clubb:ticket:834
        1721             :     !----------------------------------------------------------------------------------
        1722             :
        1723             :     use constants_clubb, only:  &
        1724             :         gamma_over_implicit_ts, & ! Constant(s)
        1725             :         one, &
        1726             :         zero
        1727             :
        1728             :     use turbulent_adv_pdf, only: &
        1729             :         xpyp_term_ta_pdf_lhs, & ! Procedure(s)
        1730             :         xpyp_term_ta_pdf_rhs
        1731             :
        1732             :     use clubb_precision, only:  &
        1733             :         core_rknd ! Variable(s)
        1734             :
        1735             :     use clip_semi_implicit, only: &
        1736             :         clip_semi_imp_rhs ! Procedure(s)
        1737             :
        1738             :     use stats_type_utilities, only: &
        1739             :         stat_update_var,      & ! Procedure(s)
        1740             :         stat_update_var_pt,   &
        1741             :         stat_begin_update_pt, &
        1742             :         stat_modify_pt
        1743             :
        1744             :     use stats_variables, only: &
        1745             :         stats_metadata_type
        1746             :
        1747             :     use advance_helper_module, only: &
        1748             :         set_boundary_conditions_rhs    ! Procedure(s)
        1749             :
        1750             :     use stats_type, only: stats ! Type
        1751             :
        1752             :     implicit none
        1753             :
        1754             :     !------------------- Input Variables -------------------
        1755             :     integer, intent(in) :: &
        1756             :       nz, &
        1757             :       ngrdcol
        1758             :
        1759             :     integer, intent(in) :: &
        1760             :       solve_type  ! Variables being solved for.
        1761             :
        1762             :     logical, intent(in) :: l_iter
        1763             :
        1764             :     real( kind = core_rknd ), intent(in) ::  &
        1765             :       dt                 ! Timestep                                  [s]
        1766             :
        1767             :     ! For "over-implicit" weighted time step.
        1768             :     ! This vector holds output from the LHS (implicit) portion of a term at a
        1769             :     ! given vertical level.  This output is weighted and applied to the RHS.
        1770             :     ! This is used if the implicit portion of the term is "over-implicit", which
        1771             :     ! means that the LHS contribution is given extra weight (>1) in order to
        1772             :     ! increase numerical stability.  A weighted factor must then be applied to
        1773             :     ! the RHS in order to balance the weight.
        1774             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: &
        1775             :       lhs_ta_wpxp   ! Turbulent advection terms of w'x'
        1776             :
        1777             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        1778             :       xm,                     & ! xm (thermodynamic levels)               [x un]
        1779             :       wpxp,                   & ! <w'x'> (momentum levels)          [{x un} m/s]
        1780             :       xm_forcing,             & ! xm forcings (thermodynamic levels)  [{x un}/s]
        1781             :       wpxp_forcing,           & ! <w'x'> forcing (momentum levs)  [{x un} m/s^2]
        1782             :       C7_Skw_fnc,             & ! C_7 parameter with Sk_w applied            [-]
        1783             :       xpthvp,                 & ! x'th_v' (momentum levels)           [{x un} K]
        1784             :       thv_ds_zm,              & ! Dry, base-state theta_v on mom. levs.      [K]
        1785             :       lhs_pr1,                & ! Pressure term 1 for w'x'
        1786             :       rhs_ta
        1787             :
        1788             :     type (stats_metadata_type), intent(in) :: &
        1789             :       stats_metadata
        1790             :
        1791             :     !------------------- InOut Variables -------------------
        1792             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
        1793             :       stats_zt, &
        1794             :       stats_zm
        1795             :
        1796             :     !------------------- Output Variable -------------------
        1797             :     real( kind = core_rknd ), intent(out), dimension(ngrdcol,2*nz) ::  &
        1798             :       rhs  ! Right-hand side of band diag. matrix. (LAPACK)
        1799             :
        1800             :     !------------------- Local Variables -------------------
        1801             :
        1802             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        1803    71480448 :         rhs_bp_pr3, & ! Buoyancy production of w'x' and w'x' pressure term 3
        1804    71480448 :         rhs_bp,     & ! Buoyancy production of w'x' (stats only)
        1805    71480448 :         rhs_pr3       ! w'x' pressure term 3 (stats only)
        1806             :
        1807             :     real( kind = core_rknd ) :: &
        1808             :         invrs_dt
        1809             :
        1810             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        1811    71480448 :       zero_vector    ! Vector of 0s
        1812             :
        1813             :     ! Indices
        1814             :     integer :: k, k_xm, k_wpxp
        1815             :
        1816             :     integer :: &
        1817             :       ixm_f, &
        1818             :       iwpxp_bp, &
        1819             :       iwpxp_pr3, &
        1820             :       iwpxp_f, &
        1821             :       iwpxp_sicl, &
        1822             :       iwpxp_ta, &
        1823             :       iwpxp_pr1
        1824             :
        1825             :     integer :: i
        1826             :
        1827             :     !------------------- Begin Code -------------------
        1828             :
        1829             :     !$acc enter data create( rhs_bp_pr3 )
        1830             :
        1831             :     ! Initialize output array and precalculate the reciprocal of dt
        1832    35740224 :     invrs_dt = 1.0_core_rknd / dt
        1833             :
        1834             :     ! Calculate buoyancy production of w'x' and w'x' pressure term 3
        1835             :     call wpxp_terms_bp_pr3_rhs( nz, ngrdcol, C7_Skw_fnc, thv_ds_zm, xpthvp, & ! intent(in)
        1836    35740224 :                                 rhs_bp_pr3 )                                  ! intent(out)
        1837             :
        1838             :     !$acc parallel loop gang vector default(present)
        1839   596778624 :     do i = 1, ngrdcol
        1840             :       ! Set lower boundary for xm
        1841   561038400 :       rhs(i,1) = xm(i,1)
        1842             :
        1843             :       ! Set lower boundary for w'x'
        1844   596778624 :       rhs(i,2) = wpxp(i,1)
        1845             :     end do
        1846             :     !$acc end parallel loop
        1847             :
        1848             :     ! Combine terms to calculate other values, rhs(3) to rhs(gr%nz-2)
        1849             :     !$acc parallel loop gang vector collapse(2) default(present)
        1850  3002178816 :     do k = 2, nz-1
        1851 49568366016 :       do i = 1, ngrdcol
        1852             :
        1853 46566187200 :         k_xm   = 2*k - 1
        1854 46566187200 :         k_wpxp = 2*k
        1855             :
        1856             :         ! RHS time tendency and forcings for xm
        1857             :         ! Note: xm forcings include the effects of microphysics,
        1858             :         !       cloud water sedimentation, radiation, and any
        1859             :         !       imposed forcings on xm.
        1860 46566187200 :         rhs(i,k_xm) =  xm(i,k) * invrs_dt + xm_forcing(i,k)
        1861             :
        1862             :
        1863             :         ! Calculate rhs values for w'x' using precalculated terms
        1864 46566187200 :         rhs(i,k_wpxp) =  rhs_bp_pr3(i,k) + wpxp_forcing(i,k) + rhs_ta(i,k) &
        1865             :                                   + ( one - gamma_over_implicit_ts ) &
        1866 46566187200 :                                   * ( - lhs_ta_wpxp(1,i,k) * wpxp(i,k+1) &
        1867             :                                       - lhs_ta_wpxp(2,i,k) * wpxp(i,k) &
        1868 46566187200 :                                       - lhs_ta_wpxp(3,i,k) * wpxp(i,k-1) &
        1869 >18923*10^7 :                                       - lhs_pr1(i,k) * wpxp(i,k) )
        1870             :       end do
        1871             :     end do
        1872             :     !$acc end parallel loop
        1873             :
        1874             :     !$acc parallel loop gang vector default(present)
        1875   596778624 :     do i = 1, ngrdcol
        1876             :       ! Upper boundary for xm
        1877   561038400 :       rhs(i,2*nz-1) = xm(i,nz) * invrs_dt + xm_forcing(i,nz)
        1878             :
        1879             :       ! Upper boundary for w'x', rhs(2*gr%nz)
        1880   596778624 :       rhs(i,2*nz) = 0.0_core_rknd
        1881             :     end do
        1882             :     !$acc end parallel loop
        1883             :
        1884             :     ! RHS time tendency.
        1885    35740224 :     if ( l_iter ) then
        1886             :       !$acc parallel loop gang vector collapse(2) default(present)
        1887  3002178816 :       do k = 2, nz-1
        1888 49568366016 :         do i = 1, ngrdcol
        1889 46566187200 :           k_wpxp = 2*k
        1890 49532625792 :           rhs(i,k_wpxp) = rhs(i,k_wpxp) + wpxp(i,k) * invrs_dt
        1891             :         end do
        1892             :       end do
        1893             :       !$acc end parallel loop
        1894             :     end if
        1895             :
        1896             :
        1897    35740224 :     if ( stats_metadata%l_stats_samp ) then
        1898             :
        1899             :       !$acc update host( lhs_ta_wpxp, xm, wpxp, xm_forcing, wpxp_forcing, &
        1900             :       !$acc              C7_Skw_fnc, xpthvp, thv_ds_zm, lhs_pr1, rhs_ta, rhs )
        1901             :
        1902           0 :       zero_vector = zero
        1903             :
        1904           0 :       select case ( solve_type )
        1905             :           case ( xm_wpxp_rtm )  ! rtm/wprtp budget terms
        1906           0 :             ixm_f      = stats_metadata%irtm_forcing
        1907           0 :             iwpxp_bp   = stats_metadata%iwprtp_bp
        1908           0 :             iwpxp_pr3  = stats_metadata%iwprtp_pr3
        1909           0 :             iwpxp_f    = stats_metadata%iwprtp_forcing
        1910           0 :             iwpxp_sicl = stats_metadata%iwprtp_sicl
        1911           0 :             iwpxp_ta   = stats_metadata%iwprtp_ta
        1912           0 :             iwpxp_pr1  = stats_metadata%iwprtp_pr1
        1913             :           case ( xm_wpxp_thlm ) ! thlm/wpthlp budget terms
        1914           0 :             ixm_f      = stats_metadata%ithlm_forcing
        1915           0 :             iwpxp_bp   = stats_metadata%iwpthlp_bp
        1916           0 :             iwpxp_pr3  = stats_metadata%iwpthlp_pr3
        1917           0 :             iwpxp_f    = stats_metadata%iwpthlp_forcing
        1918           0 :             iwpxp_sicl = stats_metadata%iwpthlp_sicl
        1919           0 :             iwpxp_ta   = stats_metadata%iwpthlp_ta
        1920           0 :             iwpxp_pr1  = stats_metadata%iwpthlp_pr1
        1921             :           case ( xm_wpxp_um )  ! um/upwp budget terms
        1922           0 :             ixm_f      = 0
        1923           0 :             iwpxp_bp   = stats_metadata%iupwp_bp
        1924           0 :             iwpxp_pr3  = stats_metadata%iupwp_pr3
        1925           0 :             iwpxp_f    = 0
        1926           0 :             iwpxp_sicl = 0
        1927           0 :             iwpxp_ta   = stats_metadata%iupwp_ta
        1928           0 :             iwpxp_pr1  = stats_metadata%iupwp_pr1
        1929             :           case ( xm_wpxp_vm )  ! vm/vpwp budget terms
        1930           0 :             ixm_f      = 0
        1931           0 :             iwpxp_bp   = stats_metadata%ivpwp_bp
        1932           0 :             iwpxp_pr3  = stats_metadata%ivpwp_pr3
        1933           0 :             iwpxp_f    = 0
        1934           0 :             iwpxp_sicl = 0
        1935           0 :             iwpxp_ta   = stats_metadata%ivpwp_ta
        1936           0 :             iwpxp_pr1  = stats_metadata%ivpwp_pr1
        1937             :           case default    ! this includes the sclrm case
        1938           0 :             ixm_f      = 0
        1939           0 :             iwpxp_bp   = 0
        1940           0 :             iwpxp_pr3  = 0
        1941           0 :             iwpxp_f    = 0
        1942           0 :             iwpxp_sicl = 0
        1943           0 :             iwpxp_ta   = 0
        1944           0 :             iwpxp_pr1  = 0
        1945             :       end select
        1946             :
        1947             :       ! Statistics: explicit contributions for wpxp.
        1948             :
        1949             :       ! w'x' term bp is completely explicit; call stat_update_var.
        1950             :       ! Note:  To find the contribution of w'x' term bp, substitute 0 for the
        1951             :       !        C_7 skewness function input to function wpxp_terms_bp_pr3_rhs.
        1952             :       call wpxp_terms_bp_pr3_rhs( nz, ngrdcol, zero_vector, thv_ds_zm, xpthvp, & ! intent(in)
        1953           0 :                                   rhs_bp )                                       ! intent(out)
        1954             :
        1955           0 :       do i = 1, ngrdcol
        1956           0 :         call stat_update_var( iwpxp_bp, rhs_bp(i,:), & ! intent(in)
        1957           0 :                               stats_zm(i) )          ! intent(inout)
        1958             :       end do
        1959             :
        1960             :       ! w'x' term pr3 is completely explicit; call stat_update_var.
        1961             :       ! Note:  To find the contribution of w'x' term pr3, add 1 to the
        1962             :       !        C_7 skewness function input to function wpxp_terms_bp_pr2_rhs.
        1963             :       call wpxp_terms_bp_pr3_rhs( nz, ngrdcol, (one+C7_Skw_fnc), thv_ds_zm, xpthvp, & ! intent(in)
        1964           0 :                                   rhs_pr3 )                                           ! intent(out)
        1965             :
        1966           0 :       do i = 1, ngrdcol
        1967           0 :         call stat_update_var( iwpxp_pr3, rhs_pr3(i,:), & ! intent(in)
        1968           0 :                               stats_zm(i) )            ! intent(inout)
        1969             :       end do
        1970             :
        1971           0 :       do k = 2, nz-1
        1972           0 :         do i = 1, ngrdcol
        1973             :
        1974             :           ! w'x' forcing term is completely explicit; call stat_update_var_pt.
        1975           0 :           call stat_update_var_pt( iwpxp_f, k, wpxp_forcing(i,k), & ! intent(in)
        1976           0 :                                    stats_zm(i) )                     ! intent(inout)
        1977             :
        1978             :
        1979             :           ! <w'x'> term ta has both implicit and explicit components; call
        1980             :           ! stat_begin_update_pt.  Since stat_begin_update_pt automatically
        1981             :           ! subtracts the value sent in, reverse the sign on
        1982             :           ! xpyp_term_ta_pdf_rhs.
        1983           0 :           call stat_begin_update_pt( iwpxp_ta, k, -rhs_ta(i,k), & ! intent(in)
        1984           0 :                                      stats_zm(i) )                 ! intent(inout)
        1985             :
        1986             :           ! Note:  An "over-implicit" weighted time step is applied to this term.
        1987             :           !        A weighting factor of greater than 1 may be used to make the
        1988             :           !        term more numerically stable (see note above for RHS
        1989             :           !        contribution from "over-implicit" weighted time step for LHS
        1990             :           !        turbulent advection (ta) term).
        1991             :           call stat_modify_pt( iwpxp_ta, k, & ! intent(in)
        1992             :                                + ( one - gamma_over_implicit_ts ) &
        1993           0 :                                  * ( - lhs_ta_wpxp(1,i,k) * wpxp(i,k+1) &
        1994             :                                      - lhs_ta_wpxp(2,i,k) * wpxp(i,k) &
        1995           0 :                                      - lhs_ta_wpxp(3,i,k) * wpxp(i,k-1) ), & ! intent(in)
        1996           0 :                                stats_zm(i) ) ! intent(inout)
        1997             :
        1998             :           ! w'x' term pr1 is normally completely implicit.  However, there is a
        1999             :           ! RHS contribution from the "over-implicit" weighted time step.  A
        2000             :           ! weighting factor of greater than 1 may be used to make the term more
        2001             :           ! numerically stable (see note above for RHS contribution from
        2002             :           ! "over-implicit" weighted time step for LHS turbulent advection (ta)
        2003             :           ! term).  Therefore, w'x' term pr1 has both implicit and explicit
        2004             :           ! components; call stat_begin_update_pt.  Since stat_begin_update_pt
        2005             :           ! automatically subtracts the value sent in, reverse the sign on the
        2006             :           ! input value.
        2007             :           call stat_begin_update_pt( iwpxp_pr1, k, & ! intent(in)
        2008             :                                     - ( one - gamma_over_implicit_ts )  &
        2009           0 :                                     * ( - lhs_pr1(i,k) * wpxp(i,k) ), & ! intent(in)
        2010           0 :                                      stats_zm(i) ) ! intent(inout)
        2011             :         end do
        2012             :       end do
        2013             :
        2014             :
        2015             :       ! Statistics: explicit contributions for xm
        2016             :       !             (including microphysics/radiation).
        2017             :
        2018             :       ! xm forcings term is completely explicit; call stat_update_var_pt.
        2019           0 :       do k = 2, nz
        2020           0 :         do i = 1, ngrdcol
        2021           0 :           call stat_update_var_pt( ixm_f, k, xm_forcing(i,k), & ! intent(in)
        2022           0 :                                    stats_zt(i) )                ! intent(inout)
        2023             :         end do
        2024             :       end do
        2025             :
        2026             :     endif ! stats_metadata%l_stats_samp
        2027             :
        2028             :     !$acc exit data delete( rhs_bp_pr3 )
        2029             :
        2030    35740224 :     return
        2031             :
        2032             :   end subroutine xm_wpxp_rhs
        2033             :
        2034             :   !=============================================================================================
        2035     8935056 :   subroutine calc_xm_wpxp_ta_terms( nz, ngrdcol, sclr_dim, gr, wp2rtp, &
        2036     8935056 :                                     wp2thlp, wp2sclrp, &
        2037     8935056 :                                     rho_ds_zt, invrs_rho_ds_zm, rho_ds_zm, &
        2038     8935056 :                                     sigma_sqd_w, wp3_on_wp2_zt, &
        2039             :                                     pdf_implicit_coefs_terms, &
        2040             :                                     iiPDF_type, &
        2041             :                                     l_explicit_turbulent_adv_wpxp, l_predict_upwp_vpwp, &
        2042             :                                     l_scalar_calc, &
        2043             :                                     l_godunov_upwind_wpxp_ta, &
        2044             :                                     stats_metadata, &
        2045     8935056 :                                     stats_zt, &
        2046     8935056 :                                     lhs_ta_wprtp, lhs_ta_wpthlp, lhs_ta_wpup, &
        2047     8935056 :                                     lhs_ta_wpvp, lhs_ta_wpsclrp, &
        2048     8935056 :                                     rhs_ta_wprtp, rhs_ta_wpthlp, rhs_ta_wpup, &
        2049     8935056 :                                     rhs_ta_wpvp, rhs_ta_wpsclrp )
        2050             :   !
        2051             :   ! Description: This subroutine calculates the turbulent advection terms for
        2052             :   !              the left and right hand side matrices. Solutions may be entirely
        2053             :   !              explicit, entirely implicit, or mixed between, depending on
        2054             :   !              various flags and the PDF type.
        2055             :   !---------------------------------------------------------------------------------------------
        2056             :
        2057             :     use grid_class, only: &
        2058             :         grid, & ! Type
        2059             :         zt2zm,  & ! Procedure(s)
        2060             :         zm2zt
        2061             :
        2062             :     use clubb_precision, only: &
        2063             :         core_rknd  ! Variable(s)
        2064             :
        2065             :     use constants_clubb, only: &
        2066             :         one, &
        2067             :         zero, &
        2068             :         zero_threshold
        2069             :
        2070             :     use pdf_parameter_module, only: &
        2071             :         implicit_coefs_terms    ! Variable Type
        2072             :
        2073             :     use turbulent_adv_pdf, only: &
        2074             :         xpyp_term_ta_pdf_lhs, &  ! Procedures
        2075             :         xpyp_term_ta_pdf_lhs_godunov, &
        2076             :         xpyp_term_ta_pdf_rhs
        2077             :
        2078             :     use model_flags, only: &
        2079             :         iiPDF_ADG1,       & ! Integer constants
        2080             :         iiPDF_new,        &
        2081             :         iiPDF_new_hybrid
        2082             :
        2083             :     use stats_variables, only: &
        2084             :         stats_metadata_type
        2085             :
        2086             :     use stats_type_utilities, only: &
        2087             :         stat_update_var   ! Procedure(s)
        2088             :
        2089             :     use stats_type, only: &
        2090             :       stats ! Type
        2091             :
        2092             :     implicit none
        2093             :
        2094             :     !------------------- Input Variables -------------------
        2095             :     integer, intent(in) :: &
        2096             :       nz, &
        2097             :       ngrdcol, &
        2098             :       sclr_dim
        2099             :
        2100             :     type (grid), target, intent(in) :: gr
        2101             :
        2102             :     type(implicit_coefs_terms), intent(in) :: &
        2103             :       pdf_implicit_coefs_terms    ! Implicit coefs / explicit terms [units vary]
        2104             :
        2105             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        2106             :       wp2rtp, &
        2107             :       wp2thlp, &
        2108             :       rho_ds_zt, &
        2109             :       invrs_rho_ds_zm, &
        2110             :       rho_ds_zm, &
        2111             :       sigma_sqd_w, &
        2112             :       wp3_on_wp2_zt
        2113             :
        2114             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(in) :: &
        2115             :       wp2sclrp
        2116             :
        2117             :     integer, intent(in) :: &
        2118             :       iiPDF_type    ! Selected option for the two-component normal (double
        2119             :                     ! Gaussian) PDF type to use for the w, rt, and theta-l (or
        2120             :                     ! w, chi, and eta) portion of CLUBB's multivariate,
        2121             :                     ! two-component PDF.
        2122             :
        2123             :     logical, intent(in) :: &
        2124             :       l_explicit_turbulent_adv_wpxp, &
        2125             :       l_scalar_calc, &
        2126             :       l_predict_upwp_vpwp
        2127             :
        2128             :     logical, intent(in) :: &
        2129             :       l_godunov_upwind_wpxp_ta    ! This flag determines whether we want to use an upwind
        2130             :                                   ! differencing approximation rather than a centered
        2131             :                                   ! differencing for turbulent advection terms.
        2132             :                                   ! It affects  wpxp only.
        2133             :
        2134             :     logical, parameter :: &
        2135             :       l_dummy_false = .false. ! This flag is set to false in order to replace the flag
        2136             :                               ! passed into the xpyp_term_ta_pdf_rhs subroutine.
        2137             :                               ! This stems from removing the l_upwind_wpxp_ta flag.
        2138             :                               ! More information on this can be found on issue #926
        2139             :                               ! on the clubb repository.
        2140             :
        2141             :     type (stats_metadata_type), intent(in) :: &
        2142             :       stats_metadata
        2143             :
        2144             :     !------------------- Inout Variables -------------------
        2145             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
        2146             :       stats_zt
        2147             :
        2148             :     !------------------- Output Variables -------------------
        2149             :
        2150             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(out) :: &
        2151             :       lhs_ta_wprtp, &
        2152             :       lhs_ta_wpthlp, &
        2153             :       lhs_ta_wpup, &
        2154             :       lhs_ta_wpvp
        2155             :
        2156             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz,sclr_dim), intent(out) :: &
        2157             :       lhs_ta_wpsclrp
        2158             :
        2159             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
        2160             :       rhs_ta_wprtp, &
        2161             :       rhs_ta_wpthlp, &
        2162             :       rhs_ta_wpup, &
        2163             :       rhs_ta_wpvp
        2164             :
        2165             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(out) :: &
        2166             :       rhs_ta_wpsclrp
        2167             :
        2168             :     !------------------- Local Variables -------------------
        2169             :
        2170             :     ! Variables for turbulent advection of predictive variances and covariances.
        2171             :
        2172             :     ! <w'^2 rt'> = coef_wp2rtp_implicit * <w'rt'> + term_wp2rtp_explicit
        2173             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2174    17870112 :       coef_wp2rtp_implicit, & ! Coefficient that is multiplied by <w'rt'>  [m/s]
        2175    17870112 :       term_wp2rtp_explicit    ! Term that is on the RHS          [m^2/s^2 kg/kg]
        2176             :
        2177             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2178    17870112 :       coef_wp2rtp_implicit_zm, & ! coef_wp2rtp_implicit interp. to m-levs. [m/s]
        2179    17870112 :       term_wp2rtp_explicit_zm    ! term_wp2rtp_expl intrp m-levs [m^2/s^2 kg/kg]
        2180             :
        2181             :     ! <w'^2 thl'> = coef_wp2thlp_implicit * <w'thl'> + term_wp2thlp_explicit
        2182             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2183    17870112 :       coef_wp2thlp_implicit, & ! Coef. that is multiplied by <w'thl'>      [m/s]
        2184    17870112 :       term_wp2thlp_explicit    ! Term that is on the RHS             [m^2/s^2 K]
        2185             :
        2186             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2187    17870112 :       coef_wp2thlp_implicit_zm, & ! coef_wp2thlp_implicit interp. m-levs.  [m/s]
        2188    17870112 :       term_wp2thlp_explicit_zm    ! term_wp2thlp_expl interp. m-levs [m^2/s^2 K]
        2189             :
        2190             :     ! <w'^2 sclr'> = coef_wp2sclrp_implicit * <w'sclr'> + term_wp2sclrp_explicit
        2191             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2192    17870112 :       term_wp2sclrp_explicit    ! Term that is on the RHS    [m^2/s^2(un. vary)]
        2193             :
        2194             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2195    17870112 :       term_wp2sclrp_explicit_zm    ! term_wp2sclrp_expl intrp zm [m^2/s^2(un v)]
        2196             :
        2197             :     ! Sign of turbulent velocity (used for "upwind" turbulent advection)
        2198             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2199    17870112 :       sgn_t_vel_wprtp,  & ! Sign of the turbulent velocity for <w'rt'>       [-]
        2200    17870112 :       sgn_t_vel_wpthlp    ! Sign of the turbulent velocity for <w'thl'>      [-]
        2201             :
        2202             :     real ( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2203    17870112 :       sgn_t_vel_wpsclrp    ! Sign of the turbulent velocity for <w'sclr'>    [-]
        2204             :
        2205             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2206    17870112 :       a1, &
        2207    17870112 :       a1_zt
        2208             :
        2209             :     integer :: i, k, b, sclr
        2210             :
        2211    17870112 :     real( kind = core_rknd ), dimension(nz) :: tmp_in
        2212             :
        2213             :     !------------------- Begin Code -------------------
        2214             :
        2215             :     !$acc enter data create( coef_wp2rtp_implicit, term_wp2rtp_explicit, coef_wp2rtp_implicit_zm, &
        2216             :     !$acc                 term_wp2rtp_explicit_zm, coef_wp2thlp_implicit, term_wp2thlp_explicit, &
        2217             :     !$acc                 coef_wp2thlp_implicit_zm, term_wp2thlp_explicit_zm, &
        2218             :     !$acc                 sgn_t_vel_wprtp, sgn_t_vel_wpthlp, &
        2219             :     !$acc                 a1, a1_zt )
        2220             :
        2221             :     !$acc enter data if( sclr_dim > 0 ) &
        2222             :     !$acc            create( term_wp2sclrp_explicit, term_wp2sclrp_explicit_zm, sgn_t_vel_wpsclrp )
        2223             :
        2224             :     ! Set up the implicit coefficients and explicit terms for turbulent
        2225             :     ! advection of <w'rt'>, <w'thl'>, and <w'sclr'>.
        2226     8935056 :     if ( l_explicit_turbulent_adv_wpxp ) then
        2227             :
        2228             :       ! The turbulent advection of <w'x'> is handled explicitly
        2229             :
        2230             :       ! The turbulent advection of <w'x'> is handled explicitly, the
        2231             :       ! terms are calculated only for the RHS matrices. The
        2232             :       ! term_wp2xp_explicit terms are equal to <w'x'> as calculated using PDF
        2233             :       ! parameters, which are general for any PDF type. The values of
        2234             :       ! <w'x'> are calculated on thermodynamic levels.
        2235             :
        2236             :       ! These coefficients only need to be set if stats output is on
        2237           0 :       if ( stats_metadata%l_stats_samp ) then
        2238           0 :         coef_wp2rtp_implicit(:,:)  = zero
        2239           0 :         coef_wp2thlp_implicit(:,:) = zero
        2240             :       end if
        2241             :
        2242             :       ! The turbulent advection terms are handled entirely explicitly. Thus the LHS
        2243             :       ! terms can be set to zero.
        2244             :       !$acc parallel loop gang vector collapse(3) default(present)
        2245           0 :       do k = 1, nz
        2246           0 :         do i = 1, ngrdcol
        2247           0 :           do b = 1, ndiags3
        2248           0 :             lhs_ta_wprtp(b,i,k) = zero
        2249           0 :             lhs_ta_wpthlp(b,i,k) = zero
        2250             :           end do
        2251             :         end do
        2252             :       end do
        2253             :       !$acc end parallel loop
        2254             :
        2255           0 :       if ( l_scalar_calc ) then
        2256             :         !$acc parallel loop gang vector default(present) collapse(4)
        2257           0 :         do sclr = 1, sclr_dim
        2258           0 :           do k = 1, nz
        2259           0 :             do i = 1, ngrdcol
        2260           0 :               do b = 1, ndiags3
        2261           0 :                 lhs_ta_wpsclrp(b,i,k,sclr_dim) = zero
        2262             :               end do
        2263             :             end do
        2264             :           end do
        2265             :         end do
        2266             :         !$acc end parallel loop
        2267             :       end if
        2268             :
        2269             :       !$acc parallel loop gang vector collapse(2) default(present)
        2270           0 :       do k = 1, nz
        2271           0 :         do i = 1, ngrdcol
        2272           0 :           term_wp2rtp_explicit(i,k)  = wp2rtp(i,k)
        2273           0 :           term_wp2thlp_explicit(i,k) = wp2thlp(i,k)
        2274             :         end do
        2275             :       end do
        2276             :       !$acc end parallel loop
        2277             :
        2278             :       ! Calculate the RHS turbulent advection term for <w'r_t'>
        2279             :       call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wp2rtp_explicit, & ! Intent(in)
        2280             :                                  rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
        2281             :                                  invrs_rho_ds_zm,                       & ! Intent(in)
        2282             :                                  l_dummy_false,                         & ! Intent(in)
        2283             :                                  sgn_t_vel_wprtp,                       & ! Intent(in)
        2284             :                                  term_wp2rtp_explicit_zm,               & ! Intent(in)
        2285           0 :                                  rhs_ta_wprtp )                           ! Intent(out)
        2286             :
        2287             :       ! Calculate the RHS turbulent advection term for <w'thl'>
        2288             :       call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wp2thlp_explicit,  & ! Intent(in)
        2289             :                                  rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
        2290             :                                  invrs_rho_ds_zm,                         & ! Intent(in)
        2291             :                                  l_dummy_false,                           & ! Intent(in)
        2292             :                                  sgn_t_vel_wpthlp,                        & ! Intent(in)
        2293             :                                  term_wp2thlp_explicit_zm,                & ! Intent(in)
        2294           0 :                                  rhs_ta_wpthlp )                            ! Intent(out)
        2295             :
        2296           0 :       do sclr = 1, sclr_dim, 1
        2297             :
        2298             :         !$acc parallel loop gang vector collapse(2) default(present)
        2299           0 :         do k = 1, nz
        2300           0 :           do i = 1, ngrdcol
        2301           0 :             term_wp2sclrp_explicit(i,k) = wp2sclrp(i,k,sclr)
        2302             :           end do
        2303             :         end do
        2304             :         !$acc end parallel loop
        2305             :
        2306             :         ! Calculate the RHS turbulent advection term for <w'thl'>
        2307             :         call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wp2sclrp_explicit, & ! Intent(in)
        2308             :                                    rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
        2309             :                                    invrs_rho_ds_zm,                         & ! Intent(in)
        2310             :                                    l_dummy_false,                           & ! Intent(in)
        2311             :                                    sgn_t_vel_wpsclrp,                       & ! Intent(in)
        2312             :                                    term_wp2sclrp_explicit_zm,               & ! Intent(in)
        2313           0 :                                    lhs_ta_wpsclrp(:,:,:,sclr) )                  ! Intent(out)
        2314             :
        2315             :       end do ! i = 1, sclr_dim, 1
        2316             :
        2317             :     else ! .not. l_explicit_turbulent_adv_xpyp
        2318             :
        2319             :       ! The turbulent advection of <w'x'> is handled implicitly or
        2320             :       ! semi-implicitly.
        2321             :
        2322     8935056 :       if ( iiPDF_type == iiPDF_ADG1 ) then
        2323             :
        2324             :         ! The ADG1 PDF is used.
        2325             :
        2326             :         ! Calculate the implicit coefficients and explicit terms on
        2327             :         ! thermodynamic grid levels.
        2328             :
        2329             :         ! Calculate a_1.
        2330             :         ! It is a variable that is a function of sigma_sqd_w (where
        2331             :         ! sigma_sqd_w is located on momentum levels).
        2332             :         !$acc parallel loop gang vector collapse(2) default(present)
        2333   768414816 :         do k = 1, nz
        2334 12690480816 :           do i = 1, ngrdcol
        2335 12681545760 :             a1(i,k) = one / ( one - sigma_sqd_w(i,k) )
        2336             :           end do
        2337             :         end do
        2338             :         !$acc end parallel loop
        2339             :
        2340             :         ! Interpolate a_1 from momentum levels to thermodynamic levels.  This
        2341             :         ! will be used for the <w'x'> turbulent advection (ta) term.
        2342     8935056 :         a1_zt(:,:) = zm2zt( nz, ngrdcol, gr, a1, zero_threshold )   ! Positive def. quantity
        2343             :
        2344             :         !$acc parallel loop gang vector collapse(2) default(present)
        2345   768414816 :         do k = 1, nz
        2346 12690480816 :           do i = 1, ngrdcol
        2347 11922066000 :             coef_wp2rtp_implicit(i,k) = a1_zt(i,k) * wp3_on_wp2_zt(i,k)
        2348 12681545760 :             coef_wp2thlp_implicit(i,k) = coef_wp2rtp_implicit(i,k)
        2349             :           end do
        2350             :         end do
        2351             :         !$acc end parallel loop
        2352             :
        2353     8935056 :         if ( .not. l_godunov_upwind_wpxp_ta ) then
        2354             :
        2355             :           ! Calculate the LHS turbulent advection term for <w'r_t'>
        2356             :           call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wp2rtp_implicit, & ! Intent(in)
        2357             :                                      rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
        2358             :                                      invrs_rho_ds_zm,                       & ! Intent(in)
        2359             :                                      l_dummy_false,                         & ! Intent(in)
        2360             :                                      sgn_t_vel_wprtp,                       & ! Intent(in)
        2361             :                                      coef_wp2rtp_implicit_zm,               & ! Intent(in)
        2362     8935056 :                                      lhs_ta_wprtp )                           ! Intent(out)
        2363             :
        2364             :         else
        2365             :
        2366             :           ! Godunov-like method for the vertical discretization of ta term
        2367             :           !$acc parallel loop gang vector default(present) collapse(2)
        2368           0 :           do k = 1, nz
        2369           0 :             do i = 1, ngrdcol
        2370           0 :               coef_wp2rtp_implicit(i,k) = a1_zt(i,k) * wp3_on_wp2_zt(i,k)
        2371           0 :               coef_wp2thlp_implicit(i,k) = coef_wp2rtp_implicit(i,k)
        2372             :             end do
        2373             :           end do
        2374             :           !$acc end parallel loop
        2375             :
        2376             :           call xpyp_term_ta_pdf_lhs_godunov( nz, ngrdcol, gr,             & ! Intent(in)
        2377             :                                              coef_wp2rtp_implicit,        & ! Intent(in)
        2378             :                                              invrs_rho_ds_zm, rho_ds_zm,  & ! Intent(in)
        2379           0 :                                              lhs_ta_wprtp )                 ! Intent(out)
        2380             :
        2381             :         end if
        2382             :
        2383             :         ! For ADG1, the LHS turbulent advection terms for
        2384             :         ! <w'r_t'>, <w'thl'>, <w'sclr'> are all equal
        2385             :         !$acc parallel loop gang vector default(present) collapse(3)
        2386   768414816 :         do k = 1, nz
        2387 12690480816 :           do i = 1, ngrdcol
        2388 48447743760 :             do b = 1, ndiags3
        2389 47688264000 :               lhs_ta_wpthlp(b,i,k) = lhs_ta_wprtp(b,i,k)
        2390             :             end do
        2391             :           end do
        2392             :         end do
        2393             :         !$acc end parallel loop
        2394             :
        2395     8935056 :         if ( l_scalar_calc ) then
        2396             :           !$acc parallel loop gang vector default(present) collapse(4)
        2397           0 :           do sclr = 1, sclr_dim
        2398           0 :             do k = 1, nz
        2399           0 :               do i = 1, ngrdcol
        2400           0 :                 do b = 1, ndiags3
        2401           0 :                   lhs_ta_wpsclrp(b,i,k,sclr) = lhs_ta_wprtp(b,i,k)
        2402             :                 end do
        2403             :               end do
        2404             :             end do
        2405             :           end do
        2406             :           !$acc end parallel loop
        2407             :         end if
        2408             :
        2409     8935056 :         if ( stats_metadata%l_stats_samp ) then
        2410             :           !$acc parallel loop gang vector collapse(2) default(present)
        2411           0 :           do k = 1, nz
        2412           0 :             do i = 1, ngrdcol
        2413           0 :               term_wp2rtp_explicit(i,k) = zero
        2414           0 :               term_wp2thlp_explicit(i,k) = zero
        2415             :             end do
        2416             :           end do
        2417             :           !$acc end parallel loop
        2418             :         end if
        2419             :
        2420             :         ! The <w'r_t'>, <w'thl'>, <w'sclr'> turbulent advection terms are entirely implicit.
        2421             :         ! Set the RHS turbulent advection terms to 0
        2422             :         !$acc parallel loop gang vector collapse(2) default(present)
        2423   768414816 :         do k = 1, nz
        2424 12690480816 :           do i = 1, ngrdcol
        2425 11922066000 :             rhs_ta_wprtp(i,k) = zero
        2426 12681545760 :             rhs_ta_wpthlp(i,k) = zero
        2427             :           end do
        2428             :         end do
        2429             :         !$acc end parallel loop
        2430             :
        2431     8935056 :         if ( l_scalar_calc ) then
        2432             :           !$acc parallel loop gang vector default(present) collapse(3)
        2433           0 :           do sclr = 1, sclr_dim
        2434           0 :             do k = 1, nz
        2435           0 :               do i = 1, ngrdcol
        2436           0 :                 rhs_ta_wpsclrp(i,k,sclr) = zero
        2437             :               end do
        2438             :             end do
        2439             :           end do
        2440             :           !$acc end parallel loop
        2441             :         end if
        2442             :
        2443     8935056 :         if ( l_predict_upwp_vpwp ) then
        2444             :
        2445             :           ! Predict <u> and <u'w'>, as well as <v> and <v'w'>.
        2446             :           ! These terms are equal to the <w'r_t'> terms as well in this case
        2447             :           !$acc parallel loop gang vector default(present) collapse(3)
        2448   768414816 :           do k = 1, nz
        2449 12690480816 :             do i = 1, ngrdcol
        2450 48447743760 :               do b = 1, ndiags3
        2451 35766198000 :                 lhs_ta_wpup(b,i,k) = lhs_ta_wprtp(b,i,k)
        2452 47688264000 :                 lhs_ta_wpvp(b,i,k) = lhs_ta_wprtp(b,i,k)
        2453             :               end do
        2454             :             end do
        2455             :           end do
        2456             :           !$acc end parallel loop
        2457             :
        2458             :           ! The <w'u'> and <w'v'> turbulent advection terms are entirely implicit.
        2459             :           ! Set the RHS turbulent advection terms to 0
        2460             :           !$acc parallel loop gang vector collapse(2) default(present)
        2461   768414816 :           do k = 1, nz
        2462 12690480816 :             do i = 1, ngrdcol
        2463 11922066000 :               rhs_ta_wpup(i,k) = zero
        2464 12681545760 :               rhs_ta_wpvp(i,k) = zero
        2465             :             end do
        2466             :           end do
        2467             :           !$acc end parallel loop
        2468             :
        2469             :         endif
        2470             :
        2471           0 :       elseif ( iiPDF_type == iiPDF_new ) then
        2472             :
        2473             :         ! The new PDF is used.
        2474             :
        2475             :         ! Unpack the variables coef_wp2rtp_implicit, term_wp2rtp_explicit,
        2476             :         ! coef_wp2thlp_implicit, and term_wp2thlp_explicit from
        2477             :         ! pdf_implicit_coefs_terms.  The PDF parameters and the resulting
        2478             :         ! implicit coefficients and explicit terms are calculated on
        2479             :         ! thermodynamic levels.
        2480           0 :         do i = 1, ngrdcol
        2481           0 :           coef_wp2rtp_implicit(i,:)  = pdf_implicit_coefs_terms%coef_wp2rtp_implicit(i,:)
        2482           0 :           coef_wp2thlp_implicit(i,:) = pdf_implicit_coefs_terms%coef_wp2thlp_implicit(i,:)
        2483           0 :           term_wp2rtp_explicit(i,:)  = pdf_implicit_coefs_terms%term_wp2rtp_explicit(i,:)
        2484           0 :           term_wp2thlp_explicit(i,:) = pdf_implicit_coefs_terms%term_wp2thlp_explicit(i,:)
        2485             :         end do
        2486             :
        2487             :
        2488             :         ! Calculate the LHS turbulent advection term for <w'rt'>
        2489             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wp2rtp_implicit, & ! Intent(in)
        2490             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
        2491             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
        2492             :                                    l_dummy_false,                         & ! Intent(in)
        2493             :                                    sgn_t_vel_wprtp,                       & ! Intent(in)
        2494             :                                    coef_wp2rtp_implicit_zm,               & ! Intent(in)
        2495           0 :                                    lhs_ta_wprtp )                           ! Intent(out)
        2496             :
        2497             :         ! Calculate the RHS turbulent advection term for <w'rt'>
        2498             :         call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wp2rtp_explicit, & ! Intent(in)
        2499             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
        2500             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
        2501             :                                    l_dummy_false,                         & ! Intent(in)
        2502             :                                    sgn_t_vel_wprtp,                       & ! Intent(in)
        2503             :                                    term_wp2rtp_explicit_zm,               & ! Intent(in)
        2504           0 :                                    rhs_ta_wprtp )                           ! Intent(out)
        2505             :
        2506             :
        2507             :         ! Calculate the LHS turbulent advection term for <w'thl'>
        2508             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wp2thlp_implicit,  & ! Intent(in)
        2509             :                                    rho_ds_zt, rho_ds_zm,                    & ! Intent(in)
        2510             :                                    invrs_rho_ds_zm,                         & ! Intent(in)
        2511             :                                    l_dummy_false,                           & ! Intent(in)
        2512             :                                    sgn_t_vel_wpthlp,                        & ! Intent(in)
        2513             :                                    coef_wp2thlp_implicit_zm,                & ! Intent(in)
        2514           0 :                                    lhs_ta_wpthlp )                            ! Intent(out)
        2515             :
        2516             :         ! Calculate the RHS turbulent advection term for <w'thl'>
        2517             :         call xpyp_term_ta_pdf_rhs( nz, ngrdcol, gr, term_wp2thlp_explicit,      & ! Intent(in)
        2518             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
        2519             :                                    invrs_rho_ds_zm,            & ! Intent(in)
        2520             :                                    l_dummy_false,                 & ! Intent(in)
        2521             :                                    sgn_t_vel_wpthlp,           & ! Intent(in)
        2522             :                                    term_wp2thlp_explicit_zm,   & ! Intent(in)
        2523           0 :                                    rhs_ta_wpthlp               ) ! Intent(out)
        2524             :
        2525             :         ! The code for the scalar variables will be set up later.
        2526           0 :         lhs_ta_wpsclrp(:,:,:,:) = zero
        2527           0 :         rhs_ta_wpsclrp(:,:,:) = zero
        2528             :
        2529           0 :       elseif ( iiPDF_type == iiPDF_new_hybrid ) then
        2530             :
        2531             :         ! The new hybrid PDF is used.
        2532             :
        2533             :         ! Unpack the variable coef_wp2rtp_implicit from the structure
        2534             :         ! pdf_implicit_coefs_terms.  The values of coef_wp2thlp_implicit,
        2535             :         ! coef_wp2up_implicit, coef_wp2vp_implict, and coef_wp2sclrp_implicit
        2536             :         ! are all equal to coef_wp2rtp_implicit.  The PDF parameters and the
        2537             :         ! resulting implicit coefficients are calculated on thermodynamic
        2538             :         ! levels.
        2539           0 :         do i = 1, ngrdcol
        2540           0 :           coef_wp2rtp_implicit(i,:) = pdf_implicit_coefs_terms%coef_wp2rtp_implicit(i,:)
        2541           0 :           coef_wp2thlp_implicit(i,:) = coef_wp2rtp_implicit(i,:)
        2542             :         end do
        2543             :
        2544             :
        2545             :         ! Calculate the LHS turbulent advection term for <w'rt'>
        2546             :         call xpyp_term_ta_pdf_lhs( nz, ngrdcol, gr, coef_wp2rtp_implicit, & ! Intent(in)
        2547             :                                    rho_ds_zt, rho_ds_zm,                  & ! Intent(in)
        2548             :                                    invrs_rho_ds_zm,                       & ! Intent(in)
        2549             :                                    l_dummy_false,                         & ! Intent(in)
        2550             :                                    sgn_t_vel_wprtp,                       & ! Intent(in)
        2551             :                                    coef_wp2rtp_implicit_zm,               & ! Intent(in)
        2552           0 :                                    lhs_ta_wprtp )                           ! Intent(out)
        2553             :
        2554             :         ! For the new hybrid PDF, the LHS turbulent advection terms for
        2555             :         ! <w'r_t'>, <w'thl'>, and <w'sclr'> are all the same.
        2556           0 :         lhs_ta_wpthlp(:,:,:) = lhs_ta_wprtp(:,:,:)
        2557             :
        2558           0 :         if ( l_scalar_calc ) then
        2559           0 :           do sclr = 1, sclr_dim
        2560           0 :             lhs_ta_wpsclrp(:,:,:,sclr) = lhs_ta_wprtp(:,:,:)
        2561             :           end do
        2562             :         end if
        2563             :
        2564           0 :         if ( stats_metadata%l_stats_samp ) then
        2565           0 :           term_wp2rtp_explicit(:,:) = zero
        2566           0 :           term_wp2thlp_explicit(:,:) = zero
        2567             :         end if
        2568             :
        2569             :         ! The <w'r_t'>, <w'thl'>, <w'sclr'> turbulent advection terms are
        2570             :         ! entirely implicit.  Set the RHS turbulent advection terms to 0
        2571           0 :         rhs_ta_wprtp(:,:) = zero
        2572           0 :         rhs_ta_wpthlp(:,:) = zero
        2573           0 :         rhs_ta_wpsclrp(:,:,:) = zero
        2574             :
        2575           0 :         if ( l_predict_upwp_vpwp ) then
        2576             :
        2577             :           ! Predict <u> and <u'w'>, as well as <v> and <v'w'>.
        2578             :           ! These terms are equal to the <w'r_t'> terms as well in this case
        2579           0 :           lhs_ta_wpup(:,:,:) = lhs_ta_wprtp(:,:,:)
        2580           0 :           lhs_ta_wpvp(:,:,:) = lhs_ta_wprtp(:,:,:)
        2581             :
        2582             :           ! The <w'u'> and <w'v'> turbulent advection terms are entirely
        2583             :           ! implicit.  Set the RHS turbulent advection terms to 0
        2584           0 :           rhs_ta_wpup(:,:) = zero
        2585           0 :           rhs_ta_wpvp(:,:) = zero
        2586             :
        2587             :         endif
        2588             :
        2589             :       endif ! iiPDF_type
        2590             :
        2591             :     endif ! l_explicit_turbulent_adv_xpyp
        2592             :
        2593     8935056 :     if ( stats_metadata%l_stats_samp ) then
        2594             :       !$acc update host( coef_wp2rtp_implicit, term_wp2rtp_explicit, &
        2595             :       !$acc              coef_wp2thlp_implicit, term_wp2thlp_explicit )
        2596           0 :       do i = 1, ngrdcol
        2597           0 :         tmp_in(1) = 0.0_core_rknd
        2598           0 :         tmp_in(2:nz) = coef_wp2rtp_implicit(i,2:nz)
        2599             :         call stat_update_var( stats_metadata%icoef_wp2rtp_implicit, tmp_in, & ! intent(in)
        2600           0 :                               stats_zt(i) )                                     ! intent(inout)
        2601           0 :         tmp_in(2:nz) = term_wp2rtp_explicit(i,2:nz)
        2602             :         call stat_update_var( stats_metadata%iterm_wp2rtp_explicit, tmp_in, & ! intent(in)
        2603             :                               stats_zt(i) )                                     ! intent(inout)
        2604           0 :         tmp_in(2:nz) = coef_wp2thlp_implicit(i,2:nz)
        2605             :         call stat_update_var( stats_metadata%icoef_wp2thlp_implicit, tmp_in, & ! intent(in)
        2606             :                               stats_zt(i) )                                       ! intent(inout)
        2607           0 :         tmp_in(2:nz) = term_wp2thlp_explicit(i,2:nz)
        2608             :         call stat_update_var( stats_metadata%iterm_wp2thlp_explicit, tmp_in, & ! intent(in)
        2609           0 :                               stats_zt(i) )                                       ! intent(inout)
        2610             :       end do
        2611             :     endif
        2612             :
        2613             :     !$acc exit data delete( coef_wp2rtp_implicit, term_wp2rtp_explicit, coef_wp2rtp_implicit_zm, &
        2614             :     !$acc                 term_wp2rtp_explicit_zm, coef_wp2thlp_implicit, term_wp2thlp_explicit, &
        2615             :     !$acc                 coef_wp2thlp_implicit_zm, term_wp2thlp_explicit_zm, &
        2616             :     !$acc                 sgn_t_vel_wprtp, sgn_t_vel_wpthlp, &
        2617             :     !$acc                 a1, a1_zt )
        2618             :
        2619             :     !$acc exit data if( sclr_dim > 0 ) &
        2620             :     !$acc            delete( term_wp2sclrp_explicit, term_wp2sclrp_explicit_zm, sgn_t_vel_wpsclrp )
        2621             :
        2622     8935056 :   end subroutine calc_xm_wpxp_ta_terms
        2623             :
        2624             :   !==========================================================================================
        2625     8935056 :   subroutine solve_xm_wpxp_with_single_lhs( nz, ngrdcol, sclr_dim, sclr_tol, gr, dt, l_iter, nrhs, &
        2626     8935056 :                                             wm_zt, wp2, invrs_tau_C6_zm, tau_max_zm, &
        2627     8935056 :                                             rtpthvp, rtm_forcing, wprtp_forcing, thlpthvp, &
        2628     8935056 :                                             thlm_forcing, wpthlp_forcing, rho_ds_zm, &
        2629     8935056 :                                             rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt, &
        2630     8935056 :                                             thv_ds_zm, rtp2, thlp2, l_implemented, &
        2631     8935056 :                                             sclrpthvp, sclrm_forcing, sclrp2, um_forcing, &
        2632     8935056 :                                             vm_forcing, ug, vg, uprcp, vprcp, rc_coef_zm, fcor, &
        2633     8935056 :                                             up2, vp2, &
        2634     8935056 :                                             low_lev_effect, high_lev_effect, &
        2635     8935056 :                                             C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc, &
        2636     8935056 :                                             lhs_diff_zm, lhs_diff_zt, lhs_ma_zt, lhs_ma_zm, &
        2637     8935056 :                                             lhs_ta_wpxp, &
        2638     8935056 :                                             rhs_ta_wprtp, rhs_ta_wpthlp, rhs_ta_wpup, &
        2639     8935056 :                                             rhs_ta_wpvp, rhs_ta_wpsclrp, &
        2640     8935056 :                                             lhs_tp, lhs_ta_xm, lhs_ac_pr2, lhs_pr1_wprtp, &
        2641     8935056 :                                             lhs_pr1_wpthlp, lhs_pr1_wpsclrp, &
        2642     8935056 :                                             C_uu_shr, &
        2643             :                                             penta_solve_method, &
        2644             :                                             tridiag_solve_method, &
        2645             :                                             l_predict_upwp_vpwp, &
        2646             :                                             l_diffuse_rtm_and_thlm, &
        2647             :                                             l_upwind_xm_ma, &
        2648             :                                             l_tke_aniso, &
        2649             :                                             l_enable_relaxed_clipping, &
        2650             :                                             l_perturbed_wind, &
        2651             :                                             l_mono_flux_lim_thlm, &
        2652             :                                             l_mono_flux_lim_rtm, &
        2653             :                                             l_mono_flux_lim_um, &
        2654             :                                             l_mono_flux_lim_vm, &
        2655             :                                             l_mono_flux_lim_spikefix, &
        2656             :                                             order_xm_wpxp, order_xp2_xpyp, order_wp2_wp3, &
        2657             :                                             stats_metadata, &
        2658     8935056 :                                             stats_zt, stats_zm, stats_sfc, &
        2659     8935056 :                                             rtm, wprtp, thlm, wpthlp, &
        2660     8935056 :                                             sclrm, wpsclrp, um, upwp, vm, vpwp, &
        2661     8935056 :                                             um_pert, vm_pert, upwp_pert, vpwp_pert )
        2662             :     !
        2663             :     ! Description: This subroutine solves all xm_wpxp when all the LHS matrices are equal.
        2664             :     !              The LHS matrices being equivalent allows for only a single solve, rather
        2665             :     !              than a seperate solve for each field.
        2666             :     !----------------------------------------------------------------------------------------
        2667             :
        2668             :     use grid_class, only: &
        2669             :         grid, & ! Type
        2670             :         ddzt    ! Procedure(s)
        2671             :
        2672             :     use error_code, only: &
        2673             :         clubb_at_least_debug_level,  & ! Procedure
        2674             :         err_code,                    & ! Error Indicator
        2675             :         clubb_fatal_error              ! Constants
        2676             :
        2677             :     use stats_type_utilities, only: &
        2678             :         stat_update_var   ! Procedure(s)
        2679             :
        2680             :     use stats_variables, only: &
        2681             :         stats_metadata_type
        2682             :
        2683             :     use clubb_precision, only:  &
        2684             :         core_rknd ! Variable(s)
        2685             :
        2686             :     use constants_clubb, only:  &
        2687             :         fstderr, &  ! Constant
        2688             :         rt_tol, &
        2689             :         thl_tol, &
        2690             :         w_tol, &
        2691             :         w_tol_sqd, &
        2692             :         thl_tol_mfl, &
        2693             :         rt_tol_mfl, &
        2694             :         zero, &
        2695             :         one, &
        2696             :         ep1
        2697             :
        2698             :     use stats_type, only: stats ! Type
        2699             :
        2700             :     use model_flags, only: &
        2701             :         penta_bicgstab
        2702             :
        2703             :     implicit none
        2704             :
        2705             :     ! ------------------- Input Variables -------------------
        2706             :     integer, intent(in) :: &
        2707             :       nz,       & ! Number of vertical levels
        2708             :       ngrdcol,  & ! Number of grid columns
        2709             :       sclr_dim    ! Number of passive scalars
        2710             :
        2711             :     real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: &
        2712             :       sclr_tol          ! Threshold(s) on the passive scalars  [units vary]
        2713             :
        2714             :     type (grid), target, intent(in) :: &
        2715             :       gr
        2716             :
        2717             :     real( kind = core_rknd ), intent(in) ::  &
        2718             :       dt                 ! Timestep                                 [s]
        2719             :
        2720             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
        2721             :       wm_zt,           & ! w wind component on thermodynamic levels [m/s]
        2722             :       wp2,             & ! w'^2 (momentum levels)                   [m^2/s^2]
        2723             :       invrs_tau_C6_zm, & ! Inverse tau on momentum levels applied to C6 term [1/s]
        2724             :       tau_max_zm,      & ! Max. allowable eddy dissipation time scale on m-levs [s]
        2725             :       rtpthvp,         & ! r_t'th_v' (momentum levels)              [(kg/kg) K]
        2726             :       rtm_forcing,     & ! r_t forcing (thermodynamic levels)       [(kg/kg)/s]
        2727             :       wprtp_forcing,   & ! <w'r_t'> forcing (momentum levels)       [(kg/kg)/s^2]
        2728             :       thlpthvp,        & ! th_l'th_v' (momentum levels)             [K^2]
        2729             :       thlm_forcing,    & ! th_l forcing (thermodynamic levels)      [K/s]
        2730             :       wpthlp_forcing,  & ! <w'th_l'> forcing (momentum levels)      [K/s^2]
        2731             :       rho_ds_zm,       & ! Dry, static density on momentum levels   [kg/m^3]
        2732             :       rho_ds_zt,       & ! Dry, static density on thermo. levels    [kg/m^3]
        2733             :       invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg]
        2734             :       invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg]
        2735             :       thv_ds_zm,       & ! Dry, base-state theta_v on moment. levs. [K]
        2736             :       rtp2,            & ! r_t'^2 (momentum levels)                 [(kg/kg)^2]
        2737             :       thlp2              ! th_l'^2 (momentum levels)                [K^2]
        2738             :
        2739             :     logical, intent(in) ::  &
        2740             :       l_implemented, &      ! Flag for CLUBB being implemented in a larger model.
        2741             :       l_iter
        2742             :
        2743             :     ! Additional variables for passive scalars
        2744             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) :: &
        2745             :       sclrpthvp,     & ! <sclr' th_v'> (momentum levels)       [Units vary]
        2746             :       sclrm_forcing, & ! sclrm forcing (thermodynamic levels)  [Units vary]
        2747             :       sclrp2           ! For clipping Vince Larson             [Units vary]
        2748             :
        2749             :     ! Variables used to predict <u> and <u'w'>, as well as <v> and <v'w'>.
        2750             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        2751             :       um_forcing, & ! <u> forcing term (thermodynamic levels)      [m/s^2]
        2752             :       vm_forcing, & ! <v> forcing term (thermodynamic levels)      [m/s^2]
        2753             :       ug,         & ! <u> geostrophic wind (thermodynamic levels)  [m/s]
        2754             :       vg            ! <v> geostrophic wind (thermodynamic levels)  [m/s]
        2755             :
        2756             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
        2757             :       uprcp,       & ! < u' r_c' >                               [(m kg)/(s kg)]
        2758             :       vprcp,       & ! < v' r_c' >                               [(m kg)/(s kg)]
        2759             :       rc_coef_zm     ! Coefficient on X'r_c' in X'th_v' equation [K/(kg/kg)]
        2760             :
        2761             :     real( kind = core_rknd ), dimension(ngrdcol), intent(in) ::  &
        2762             :       fcor          ! Coriolis parameter                           [s^-1]
        2763             :
        2764             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        2765             :       up2,    & ! Variance of the u wind component             [m^2/s^2]
        2766             :       vp2       ! Variance of the v wind component             [m^2/s^2]
        2767             :
        2768             :     ! LHS/RHS terms
        2769             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: &
        2770             :       lhs_diff_zm,  & ! Diffusion term for w'x'
        2771             :       lhs_diff_zt,  & ! Diffusion term for w'x'
        2772             :       lhs_ma_zt,    & ! Mean advection contributions to lhs
        2773             :       lhs_ma_zm       ! Mean advection contributions to lhs
        2774             :
        2775             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: &
        2776             :       lhs_ta_wpxp    ! w'r_t' turbulent advection contributions to lhs
        2777             :
        2778             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        2779             :       rhs_ta_wprtp,  & ! w'r_t' turbulent advection contributions to rhs
        2780             :       rhs_ta_wpthlp, & ! w'thl' turbulent advection contributions to rhs
        2781             :       rhs_ta_wpup,   & ! w'u' turbulent advection contributions to rhs
        2782             :       rhs_ta_wpvp      ! w'v' turbulent advection contributions to rhs
        2783             :
        2784             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(in) :: &
        2785             :       rhs_ta_wpsclrp    ! w'sclr' turbulent advection contributions to rhs
        2786             :
        2787             :     real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(in) :: &
        2788             :       lhs_tp,     & ! Turbulent production terms of w'x'
        2789             :       lhs_ta_xm     ! Turbulent advection terms of xm
        2790             :
        2791             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        2792             :       lhs_ac_pr2,     & ! Accumulation of w'x' and w'x' pressure term 2
        2793             :       lhs_pr1_wprtp,  & ! Pressure term 1 for w'r_t' for all grid levels
        2794             :       lhs_pr1_wpthlp, & ! Pressure term 1 for w'thl' for all grid levels
        2795             :       lhs_pr1_wpsclrp   ! Pressure term 1 for w'sclr' for all grid levels
        2796             :
        2797             :     ! Variables used as part of the monotonic turbulent advection scheme.
        2798             :     ! Find the lowermost and uppermost grid levels that can have an effect
        2799             :     ! on the central thermodynamic level during the course of a time step,
        2800             :     ! due to the effects of turbulent advection only.
        2801             :     integer, dimension(ngrdcol,nz), intent(in) ::  &
        2802             :       low_lev_effect, & ! Index of the lowest level that has an effect.
        2803             :       high_lev_effect   ! Index of the highest level that has an effect.
        2804             :
        2805             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
        2806             :       C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc
        2807             :
        2808             :     integer, intent(in) :: &
        2809             :       nrhs         ! Number of RHS vectors
        2810             :
        2811             :     real( kind = core_rknd ), dimension(ngrdcol), intent(in) ::  &
        2812             :       C_uu_shr    ! CLUBB tunable parameter C_uu_shr
        2813             :
        2814             :     integer, intent(in) :: &
        2815             :       penta_solve_method, & ! Method to solve then penta-diagonal system
        2816             :       tridiag_solve_method  ! Specifier for method to solve tridiagonal systems,
        2817             :                             ! used for monotonic flux limiter
        2818             :
        2819             :     logical, intent(in) :: &
        2820             :       l_predict_upwp_vpwp,       & ! Flag to predict <u'w'> and <v'w'> along
        2821             :                                    ! with <u> and <v> alongside the advancement
        2822             :                                    ! of <rt>, <w'rt'>, <thl>, <wpthlp>, <sclr>,
        2823             :                                    ! and <w'sclr'> in subroutine advance_xm_wpxp.
        2824             :                                    ! Otherwise, <u'w'> and <v'w'> are still
        2825             :                                    ! approximated by eddy diffusivity when <u>
        2826             :                                    ! and <v> are advanced in subroutine
        2827             :                                    ! advance_windm_edsclrm.
        2828             :       l_diffuse_rtm_and_thlm,    & ! This flag determines whether or not we want
        2829             :                                    ! CLUBB to do diffusion on rtm and thlm
        2830             :       l_upwind_xm_ma,            & ! This flag determines whether we want to use
        2831             :                                    ! an upwind differencing approximation rather
        2832             :                                    ! than a centered differencing for turbulent
        2833             :                                    ! or mean advection terms. It affects rtm,
        2834             :                                    ! thlm, sclrm, um and vm.
        2835             :       l_tke_aniso,               & ! For anisotropic turbulent kinetic energy,
        2836             :                                    ! i.e. TKE = 1/2 (u'^2 + v'^2 + w'^2)
        2837             :       l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in
        2838             :                                    ! xm_wpxp_clipping_and_stats
        2839             :       l_perturbed_wind,          & ! Whether perturbed winds are being solved
        2840             :       l_mono_flux_lim_thlm,      & ! Flag to turn on monotonic flux limiter for thlm
        2841             :       l_mono_flux_lim_rtm,       & ! Flag to turn on monotonic flux limiter for rtm
        2842             :       l_mono_flux_lim_um,        & ! Flag to turn on monotonic flux limiter for um
        2843             :       l_mono_flux_lim_vm,        & ! Flag to turn on monotonic flux limiter for vm
        2844             :       l_mono_flux_lim_spikefix     ! Flag to implement monotonic flux limiter code that
        2845             :                                    ! eliminates spurious drying tendencies at model top
        2846             :
        2847             :     integer, intent(in) :: &
        2848             :       order_xm_wpxp, &
        2849             :       order_xp2_xpyp, &
        2850             :       order_wp2_wp3
        2851             :
        2852             :     type (stats_metadata_type), intent(in) :: &
        2853             :       stats_metadata
        2854             :
        2855             :     ! ------------------- Input/Output Variables -------------------
        2856             :
        2857             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  &
        2858             :       rtm,       & ! r_t  (total water mixing ratio)           [kg/kg]
        2859             :       wprtp,     & ! w'r_t'                                    [(kg/kg) m/s]
        2860             :       thlm,      & ! th_l (liquid water potential temperature) [K]
        2861             :       wpthlp       ! w'th_l'                                   [K m/s]
        2862             :
        2863             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) ::  &
        2864             :       sclrm, wpsclrp !                                     [Units vary]
        2865             :
        2866             :     ! Variables used to predict <u> and <u'w'>, as well as <v> and <v'w'>.
        2867             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  &
        2868             :       um,   & ! <u>:  mean west-east horiz. velocity (thermo. levs.)   [m/s]
        2869             :       upwp, & ! <u'w'>:  momentum flux (momentum levels)               [m^2/s^2]
        2870             :       vm,   & ! <v>:  mean south-north horiz. velocity (thermo. levs.) [m/s]
        2871             :       vpwp    ! <v'w'>:  momentum flux (momentum levels)               [m^2/s^2]
        2872             :
        2873             :     ! Variables used to track perturbed version of winds.
        2874             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
        2875             :       um_pert,   & ! perturbed <u>    [m/s]
        2876             :       vm_pert,   & ! perturbed <v>    [m/s]
        2877             :       upwp_pert, & ! perturbed <u'w'> [m^2/s^2]
        2878             :       vpwp_pert    ! perturbed <v'w'> [m^2/s^2]
        2879             :
        2880             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
        2881             :       stats_zt, &
        2882             :       stats_zm, &
        2883             :       stats_sfc
        2884             :
        2885             :     ! ------------------- Local Variables -------------------
        2886             :
        2887             :     real( kind = core_rknd ), dimension(nsup+nsub+1,ngrdcol,2*nz) :: &
        2888    17870112 :       lhs  ! Implicit contributions to wpxp/xm (band diag. matrix) (LAPACK)
        2889             :
        2890             :     ! Additional variables for passive scalars
        2891             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
        2892    17870112 :       wpsclrp_forcing    ! <w'sclr'> forcing (momentum levels)  [m/s{un vary}]
        2893             :
        2894             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2895    17870112 :       um_tndcy,     & ! <u> forcing term + coriolis (thermo levs)        [m/s^2]
        2896    17870112 :       vm_tndcy,     & ! <v> forcing term + coriolis (thermo levs)        [m/s^2]
        2897    17870112 :       upwp_forcing, & ! <u'w'> extra RHS pressure term (mom levs)        [m^2/s^3]
        2898    17870112 :       vpwp_forcing, & ! <v'w'> extra RHS pressure term (mom levs)        [m^2/s^3]
        2899    17870112 :       upthvp,       & ! <u'thv'> (momentum levels)                       [m/s K]
        2900    17870112 :       vpthvp,       & ! <v'thv'> (momentum levels)                       [m/s K]
        2901    17870112 :       upthlp,       & ! eastward horz turb flux of theta_l (mom levs)    [m/s K]
        2902    17870112 :       vpthlp,       & ! northward horz turb flux of theta_l (mom levs)   [m/s K]
        2903    17870112 :       uprtp,        & ! eastward horz turb flux of tot water (mom levs)  [m/s kg/kg]
        2904    17870112 :       vprtp,        & ! northward horz turb flux of tot water (mom levs) [m/s kg/kg]
        2905    17870112 :       tau_C6_zm       ! Time-scale tau on momentum levels applied to C6 term [s]
        2906             :
        2907             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2908    17870112 :       upwp_forcing_pert, & ! perturbed extra RHS term (mom levs)         [m^2/s^3]
        2909    17870112 :       vpwp_forcing_pert, & ! perturbed extra RHS term (mom levs)         [m^2/s^3]
        2910    17870112 :       upthvp_pert,       & ! perturbed <u'thv'> (momentum levels)        [m/s K]
        2911    17870112 :       vpthvp_pert,       & ! perturbed <v'thv'> (momentum levels)        [m/s K]
        2912    17870112 :       upthlp_pert,       & ! perturbed horz flux of theta_l (mom levs)   [m/s K]
        2913    17870112 :       vpthlp_pert,       & ! perturbed horz flux of theta_l (mom levs)   [m/s K]
        2914    17870112 :       uprtp_pert,        & ! perturbed horz flux of tot water (mom levs) [m/s kg/kg]
        2915    17870112 :       vprtp_pert           ! perturbed horz flux of tot water (mom levs) [m/s kg/kg]
        2916             :
        2917             :     real( kind = core_rknd ), dimension(ngrdcol,2*nz,nrhs) :: &
        2918    17870112 :       rhs,        & ! Right-hand sides of band diag. matrix. (LAPACK)
        2919    17870112 :       rhs_save,   & ! Saved Right-hand sides of band diag. matrix. (LAPACK)
        2920    17870112 :       solution,   & ! solution vectors of band diag. matrix. (LAPACK)
        2921    17870112 :       old_solution  ! previous solutions
        2922             :
        2923             :     ! Constant parameters as a function of Skw.
        2924             :
        2925    17870112 :     real( kind = core_rknd ), dimension(ngrdcol) :: rcond
        2926             :
        2927             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        2928    17870112 :       zeros_vector, &
        2929    17870112 :       ddzt_um, &
        2930    17870112 :       ddzt_vm, &
        2931    17870112 :       ddzt_um_pert, &
        2932    17870112 :       ddzt_vm_pert
        2933             :
        2934             :     integer :: i, k, j, n
        2935             :
        2936     8935056 :     real( kind = core_rknd ), dimension(nz) :: tmp_in
        2937             :
        2938             :     ! ------------------- Begin Code -------------------
        2939             :
        2940             :     !$acc enter data create( lhs, um_tndcy, vm_tndcy, upwp_forcing, &
        2941             :     !$acc                 vpwp_forcing, upthvp, vpthvp, upthlp, vpthlp, uprtp, vprtp, &
        2942             :     !$acc                 tau_C6_zm, upwp_forcing_pert, vpwp_forcing_pert, upthvp_pert, &
        2943             :     !$acc                 vpthvp_pert, upthlp_pert, vpthlp_pert, uprtp_pert, vprtp_pert, &
        2944             :     !$acc                 rhs, rhs_save, solution, old_solution, rcond, zeros_vector, &
        2945             :     !$acc                 ddzt_um, ddzt_vm, ddzt_um_pert, ddzt_vm_pert )
        2946             :
        2947             :     !$acc enter data if( sclr_dim > 0 ) create( wpsclrp_forcing )
        2948             :
        2949             :     ! This is initialized solely for the purpose of avoiding a compiler
        2950             :     ! warning about uninitialized variables.
        2951             :     !$acc parallel loop gang vector collapse(2) default(present)
        2952   768414816 :     do k = 1, nz
        2953 12690480816 :       do i = 1, ngrdcol
        2954 12681545760 :         zeros_vector(i,k) = zero
        2955             :       end do
        2956             :     end do
        2957             :     !$acc end parallel loop
        2958             :
        2959             :     ! Simple case, where the new PDF is
        2960             :     ! used, l_explicit_turbulent_adv_wpxp is enabled.
        2961             :
        2962             :     ! Create the lhs once
        2963             :     call xm_wpxp_lhs( nz, ngrdcol, l_iter, dt, zeros_vector, wm_zt, C7_Skw_fnc,     & ! In
        2964             :                       zeros_vector, zeros_vector,                                   & ! In
        2965             :                       l_implemented, lhs_diff_zm, lhs_diff_zt,                      & ! In
        2966             :                       lhs_ma_zm, lhs_ma_zt, lhs_ta_wpxp, lhs_ta_xm,                 & ! In
        2967             :                       lhs_tp, lhs_pr1_wprtp, lhs_ac_pr2,                            & ! In
        2968             :                       l_diffuse_rtm_and_thlm,                                       & ! In
        2969             :                       stats_metadata,                                               & ! In
        2970     8935056 :                       lhs )                                                           ! Out
        2971             :
        2972             :     ! Compute the explicit portion of the r_t and w'r_t' equations.
        2973             :     ! Build the right-hand side vector.
        2974             :     call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_rtm, l_iter, dt, rtm, wprtp,      & ! In
        2975             :                       rtm_forcing, wprtp_forcing, C7_Skw_fnc,                & ! In
        2976             :                       rtpthvp, rhs_ta_wprtp, thv_ds_zm,                      & ! In
        2977             :                       lhs_pr1_wprtp, lhs_ta_wpxp,                            & ! In
        2978             :                       stats_metadata,                                        & ! In
        2979             :                       stats_zt, stats_zm,                                    & ! Inout
        2980     8935056 :                       rhs(:,:,1) )                                             ! Out
        2981             :
        2982             :     ! Compute the explicit portion of the th_l and w'th_l' equations.
        2983             :     ! Build the right-hand side vector.
        2984             :     call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_thlm, l_iter, dt, thlm, wpthlp,      & ! In
        2985             :                       thlm_forcing, wpthlp_forcing, C7_Skw_fnc,                 & ! In
        2986             :                       thlpthvp, rhs_ta_wpthlp, thv_ds_zm,                       & ! In
        2987             :                       lhs_pr1_wpthlp, lhs_ta_wpxp,                              & ! In
        2988             :                       stats_metadata,                                           & ! In
        2989             :                       stats_zt, stats_zm,                                       & ! Inout
        2990     8935056 :                       rhs(:,:,2) )                                                ! Out
        2991             :
        2992             : ! ---> h1g, 2010-06-15
        2993             : ! scalar transport, e.g, droplet and ice number concentration
        2994             : ! are handled in  " advance_sclrm_Nd_module.F90 "
        2995             : #ifdef GFDL
        2996             :     do j = 1, 0, 1
        2997             : #else
        2998     8935056 :     do j = 1, sclr_dim, 1
        2999             : #endif
        3000             : ! <--- h1g, 2010-06-15
        3001             :
        3002             :       ! Set <w'sclr'> forcing to 0 unless unless testing the wpsclrp code
        3003             :       ! using wprtp or wpthlp (then use wprtp_forcing or wpthlp_forcing).
        3004             :       !$acc parallel loop gang vector collapse(2) default(present)
        3005           0 :       do k = 1, nz
        3006           0 :         do i = 1, ngrdcol
        3007           0 :           wpsclrp_forcing(i,k,j) = zero
        3008             :         end do
        3009             :       end do
        3010             :       !$acc end parallel loop
        3011             :
        3012             :       call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_scalar, l_iter, dt, sclrm(:,:,j), wpsclrp(:,:,j), & ! In
        3013             :                         sclrm_forcing(:,:,j),                                             & ! In
        3014             :                         wpsclrp_forcing(:,:,j), C7_Skw_fnc,                               & ! In
        3015             :                         sclrpthvp(:,:,j), rhs_ta_wpsclrp(:,:,j), thv_ds_zm,               & ! In
        3016             :                         lhs_pr1_wpsclrp, lhs_ta_wpxp,                                     & ! In
        3017             :                         stats_metadata,                                                   & ! In
        3018             :                         stats_zt, stats_zm,                                               & ! Inout
        3019     8935056 :                         rhs(:,:,2+j) )                                                      ! Out
        3020             :     end do
        3021             :
        3022     8935056 :     if ( l_predict_upwp_vpwp ) then
        3023             :
        3024             :       ! Predict <u> and <u'w'>, as well as <v> and <v'w'>.
        3025             :       ! Currently, this requires the ADG1 PDF with implicit turbulent advection.
        3026             :       ! l_explicit_turbulent_adv_wpxp = false
        3027             :       ! and ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_new_hybrid )
        3028             :
        3029             :       ! Coriolis term for <u> and <v>
        3030     8935056 :       if ( .not. l_implemented ) then
        3031             :
        3032             :         ! Only compute the Coriolis term if the model is running on its own,
        3033             :         ! and is not part of a larger, host model.
        3034             :         !$acc parallel loop gang vector collapse(2) default(present)
        3035           0 :         do k = 1, nz
        3036           0 :           do i = 1, ngrdcol
        3037           0 :             um_tndcy(i,k) = um_forcing(i,k) - fcor(i) * ( vg(i,k) - vm(i,k) )
        3038           0 :             vm_tndcy(i,k) = vm_forcing(i,k) + fcor(i) * ( ug(i,k) - um(i,k) )
        3039             :           end do
        3040             :         end do
        3041             :         !$acc end parallel loop
        3042             :
        3043           0 :         if ( stats_metadata%l_stats_samp ) then
        3044             :
        3045             :           !$acc update host( fcor, um_forcing, vm_forcing, vg, ug, vm, um )
        3046             :
        3047           0 :           do i = 1, ngrdcol
        3048             :             ! um or vm term gf is completely explicit; call stat_update_var.
        3049           0 :             tmp_in(1) = 0.0_core_rknd
        3050           0 :             tmp_in(2:nz) = - fcor(i) * vg(i,2:nz)
        3051             :             call stat_update_var( stats_metadata%ium_gf, tmp_in, & ! intent(in)
        3052             :                                   stats_zt(i) )             ! intent(inout)
        3053           0 :             tmp_in(1) = 0.0_core_rknd
        3054           0 :             tmp_in(2:nz) = fcor(i) * ug(i,2:nz)
        3055             :             call stat_update_var( stats_metadata%ivm_gf, tmp_in, & ! intent(in)
        3056             :                                   stats_zt(i) )           ! intent(inout)
        3057             :
        3058             :             ! um or vm term cf is completely explicit; call stat_update_var.
        3059           0 :             tmp_in(1) = 0.0_core_rknd
        3060           0 :             tmp_in(2:nz) = fcor(i) * vm(i,2:nz)
        3061             :             call stat_update_var( stats_metadata%ium_cf, tmp_in, & ! intent(in)
        3062             :                                   stats_zt(i) )           ! intent(inout)
        3063           0 :             tmp_in(1) = 0.0_core_rknd
        3064           0 :             tmp_in(2:nz) = -fcor(i) * um(i,2:nz)
        3065             :             call stat_update_var( stats_metadata%ivm_cf, tmp_in, & ! intent(in)
        3066             :                                   stats_zt(i) )             ! intent(inout)
        3067             :
        3068             :             ! um or vm forcing term
        3069           0 :             tmp_in(1) = 0.0_core_rknd
        3070           0 :             tmp_in(2:nz) = um_forcing(i,2:nz)
        3071             :             call stat_update_var( stats_metadata%ium_f, tmp_in, & ! intent(in)
        3072           0 :                                   stats_zt(i) )           ! intent(inout)
        3073           0 :             tmp_in(1) = 0.0_core_rknd
        3074           0 :             tmp_in(2:nz) = vm_forcing(i,2:nz)
        3075             :             call stat_update_var( stats_metadata%ivm_f, tmp_in, & ! intent(in)
        3076           0 :                                   stats_zt(i) )           ! intent(inout)
        3077             :           end do
        3078             :         endif ! stats_metadata%l_stats_samp
        3079             :
        3080             :       else ! implemented in a host model
        3081             :
        3082             :         !$acc parallel loop gang vector collapse(2) default(present)
        3083   768414816 :         do k = 1, nz
        3084 12690480816 :           do i = 1, ngrdcol
        3085 11922066000 :             um_tndcy(i,k) = zero
        3086 12681545760 :             vm_tndcy(i,k) = zero
        3087             :           end do
        3088             :         end do
        3089             :         !$acc end parallel loop
        3090             :
        3091             :       end if ! .not. l_implemented
        3092             :
        3093     8935056 :       ddzt_um = ddzt( nz, ngrdcol, gr, um )
        3094     8935056 :       ddzt_vm = ddzt( nz, ngrdcol, gr, vm )
        3095             :
        3096             :       ! Add "extra term" and optional Coriolis term for <u'w'> and <v'w'>.
        3097             :       !$acc parallel loop gang vector collapse(2) default(present)
        3098   768414816 :       do k = 1, nz
        3099 12690480816 :         do i = 1, ngrdcol
        3100 11922066000 :           upwp_forcing(i,k) = C_uu_shr(i) * wp2(i,k) * ddzt_um(i,k)
        3101 12681545760 :           vpwp_forcing(i,k) = C_uu_shr(i) * wp2(i,k) * ddzt_vm(i,k)
        3102             :         end do
        3103             :       end do
        3104             :       !$acc end parallel loop
        3105             :
        3106     8935056 :       if ( l_perturbed_wind ) then
        3107             :
        3108           0 :         ddzt_um_pert = ddzt( nz, ngrdcol, gr, um_pert )
        3109           0 :         ddzt_vm_pert = ddzt( nz, ngrdcol, gr, vm_pert )
        3110             :
        3111             :         !$acc parallel loop gang vector collapse(2) default(present)
        3112           0 :         do k = 1, nz
        3113           0 :           do i = 1, ngrdcol
        3114           0 :             upwp_forcing_pert(i,k) = C_uu_shr(i) * wp2(i,k) * ddzt_um_pert(i,k)
        3115           0 :             vpwp_forcing_pert(i,k) = C_uu_shr(i) * wp2(i,k) * ddzt_vm_pert(i,k)
        3116             :           end do
        3117             :         end do
        3118             :         !$acc end parallel loop
        3119             :
        3120             :       endif ! l_perturbed_wind
        3121             :
        3122     8935056 :       if ( stats_metadata%l_stats_samp ) then
        3123             :
        3124             :         !$acc update host( wp2, ddzt_um, ddzt_vm, C_uu_shr )
        3125             :
        3126           0 :         do i = 1, ngrdcol
        3127           0 :           call stat_update_var( stats_metadata%iupwp_pr4, C_uu_shr(i) * wp2(i,:) * ddzt_um(i,:), & ! intent(in)
        3128           0 :                                 stats_zm(i) )                                    ! intent(inout)
        3129           0 :           call stat_update_var( stats_metadata%ivpwp_pr4, C_uu_shr(i) * wp2(i,:) * ddzt_vm(i,:), & ! intent(in)
        3130           0 :                                 stats_zm(i) )                                    ! intent(inout)
        3131             :         end do
        3132             :       end if ! stats_metadata%l_stats_samp
        3133             :
        3134             :       ! need tau_C6_zm for these calls
        3135             :       !$acc parallel loop gang vector collapse(2) default(present)
        3136   768414816 :       do k = 1, nz
        3137 12690480816 :         do i = 1, ngrdcol
        3138 12681545760 :           tau_C6_zm(i,k) = min ( one / invrs_tau_C6_zm(i,k), tau_max_zm(i,k) )
        3139             :         end do
        3140             :       end do
        3141             :       !$acc end parallel loop
        3142             :
        3143             :       call diagnose_upxp( nz, ngrdcol, gr, upwp, thlm, wpthlp, um,  & ! Intent(in)
        3144             :                           C6thl_Skw_fnc, tau_C6_zm, C7_Skw_fnc,     & ! Intent(in)
        3145     8935056 :                           upthlp )                                    ! Intent(out)
        3146             :
        3147             :       call diagnose_upxp( nz, ngrdcol, gr, upwp, rtm, wprtp, um,  & ! Intent(in)
        3148             :                           C6rt_Skw_fnc, tau_C6_zm, C7_Skw_fnc,    & ! Intent(in)
        3149     8935056 :                           uprtp )                                   ! Intent(out)
        3150             :
        3151             :       call diagnose_upxp( nz, ngrdcol, gr, vpwp, thlm, wpthlp, vm,  & ! Intent(in)
        3152             :                           C6thl_Skw_fnc, tau_C6_zm, C7_Skw_fnc,     & ! Intent(in)
        3153     8935056 :                           vpthlp )                                    ! Intent(out)
        3154             :
        3155             :       call diagnose_upxp( nz, ngrdcol, gr, vpwp, rtm, wprtp, vm,  & ! Intent(in)
        3156             :                           C6rt_Skw_fnc, tau_C6_zm, C7_Skw_fnc,    & ! Intent(in)
        3157     8935056 :                           vprtp )                                   ! Intent(out)
        3158             :
        3159     8935056 :       if ( l_perturbed_wind ) then
        3160             :
        3161             :          call diagnose_upxp( nz, ngrdcol, gr, upwp_pert, thlm, wpthlp, um_pert, & ! Intent(in)
        3162             :                              C6thl_Skw_fnc, tau_C6_zm, C7_Skw_fnc,              & ! Intent(in)
        3163           0 :                              upthlp_pert )                                        ! Intent(out)
        3164             :
        3165             :          call diagnose_upxp( nz, ngrdcol, gr, upwp_pert, rtm, wprtp, um_pert, & ! Intent(in)
        3166             :                              C6rt_Skw_fnc, tau_C6_zm, C7_Skw_fnc,             & ! Intent(in)
        3167           0 :                              uprtp_pert )                                       ! Intent(out)
        3168             :
        3169             :          call diagnose_upxp( nz, ngrdcol, gr, vpwp_pert, thlm, wpthlp, vm_pert, & ! Intent(in)
        3170             :                              C6thl_Skw_fnc, tau_C6_zm, C7_Skw_fnc,              & ! Intent(in)
        3171           0 :                              vpthlp_pert )                                        ! Intent(out)
        3172             :
        3173             :          call diagnose_upxp( nz, ngrdcol, gr, vpwp_pert, rtm, wprtp, vm_pert, & ! Intent(in)
        3174             :                              C6rt_Skw_fnc, tau_C6_zm, C7_Skw_fnc,             & ! Intent(in)
        3175           0 :                              vprtp_pert )                                       ! Intent(out)
        3176             :
        3177             :       endif ! l_perturbed_wind
        3178             :
        3179             :       ! Use a crude approximation for buoyancy terms <u'thv'> and <v'thv'>.
        3180             :       !upthvp = upwp * wpthvp / max( wp2, w_tol_sqd )
        3181             :       !vpthvp = vpwp * wpthvp / max( wp2, w_tol_sqd )
        3182             :       !upthvp = 0.3_core_rknd * ( upthlp + 200.0_core_rknd * uprtp ) &
        3183             :       !         + 200._core_rknd * sign( one, upwp) * sqrt( up2 * rcm**2 )
        3184             :       !vpthvp = 0.3_core_rknd * ( vpthlp + 200.0_core_rknd * vprtp ) &
        3185             :       !         + 200._core_rknd * sign( one, vpwp ) * sqrt( vp2 * rcm**2 )
        3186             :       !$acc parallel loop gang vector collapse(2) default(present)
        3187   768414816 :       do k = 1, nz
        3188 12690480816 :         do i = 1, ngrdcol
        3189 23844132000 :           upthvp(i,k) = upthlp(i,k) + ep1 * thv_ds_zm(i,k) * uprtp(i,k) &
        3190 23844132000 :                         + rc_coef_zm(i,k) * uprcp(i,k)
        3191             :
        3192             :           vpthvp(i,k) = vpthlp(i,k) + ep1 * thv_ds_zm(i,k) * vprtp(i,k) &
        3193 12681545760 :                         + rc_coef_zm(i,k) * vprcp(i,k)
        3194             :         end do
        3195             :       end do
        3196             :       !$acc end parallel loop
        3197             :
        3198     8935056 :       if ( l_perturbed_wind ) then
        3199             :
        3200             :         !$acc parallel loop gang vector collapse(2) default(present)
        3201           0 :         do k = 1, nz
        3202           0 :           do i = 1, ngrdcol
        3203           0 :             upthvp_pert(i,k) = upthlp_pert(i,k) &
        3204             :                                + ep1 * thv_ds_zm(i,k) * uprtp_pert(i,k) &
        3205           0 :                                + rc_coef_zm(i,k) * uprcp(i,k)
        3206             :             vpthvp_pert(i,k) = vpthlp_pert(i,k) &
        3207             :                                + ep1 * thv_ds_zm(i,k) * vprtp_pert(i,k) &
        3208           0 :                                + rc_coef_zm(i,k) * vprcp(i,k)
        3209             :           end do
        3210             :         end do
        3211             :         !$acc end parallel loop
        3212             :
        3213             :       endif ! l_perturbed_wind
        3214             :
        3215     8935056 :       if ( stats_metadata%l_stats_samp ) then
        3216             :
        3217             :         !$acc update host( upthlp, uprtp, vpthlp, vprtp, upthvp, vpthvp )
        3218             :
        3219           0 :         do i = 1, ngrdcol
        3220           0 :           call stat_update_var( stats_metadata%iupthlp, upthlp(i,:), & ! intent(in)
        3221           0 :                                 stats_zm(i) )         ! intent(inout)
        3222           0 :           call stat_update_var( stats_metadata%iuprtp,  uprtp(i,:),  & ! intent(in)
        3223           0 :                                 stats_zm(i) )         ! intent(inout)
        3224           0 :           call stat_update_var( stats_metadata%ivpthlp, vpthlp(i,:), & ! intent(in)
        3225           0 :                                 stats_zm(i) )         ! intent(inout)
        3226           0 :           call stat_update_var( stats_metadata%ivprtp,  vprtp(i,:),  & ! intent(in)
        3227           0 :                                 stats_zm(i) )         ! intent(inout)
        3228           0 :           call stat_update_var( stats_metadata%iupthvp, upthvp(i,:), & ! intent(in)
        3229           0 :                                 stats_zm(i) )         ! intent(inout)
        3230           0 :           call stat_update_var( stats_metadata%ivpthvp, vpthvp(i,:), & ! intent(in)
        3231           0 :                                 stats_zm(i) )         ! intent(inout)
        3232             :         end do
        3233             :       end if ! stats_metadata%l_stats_samp
        3234             :
        3235             :       call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_um, l_iter, dt, um, upwp,      & ! In
        3236             :                         um_tndcy, upwp_forcing, C7_Skw_fnc,                 & ! In
        3237             :                         upthvp, rhs_ta_wpup, thv_ds_zm,                     & ! In
        3238             :                         lhs_pr1_wprtp, lhs_ta_wpxp,                         & ! In
        3239             :                         stats_metadata,                                     & ! In
        3240             :                         stats_zt, stats_zm,                                 & ! Inout
        3241     8935056 :                         rhs(:,:,3+sclr_dim) )                                 ! Out
        3242             :
        3243             :       call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_vm, l_iter, dt, vm, vpwp,      & ! In
        3244             :                         vm_tndcy, vpwp_forcing, C7_Skw_fnc,                 & ! In
        3245             :                         vpthvp, rhs_ta_wpvp, thv_ds_zm,                     & ! In
        3246             :                         lhs_pr1_wprtp, lhs_ta_wpxp,                         & ! In
        3247             :                         stats_metadata,                                     & ! In
        3248             :                         stats_zt, stats_zm,                                 & ! Inout
        3249     8935056 :                         rhs(:,:,4+sclr_dim) )                                 ! Out
        3250             :
        3251     8935056 :       if ( l_perturbed_wind ) then
        3252             :
        3253             :         call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_um, l_iter, dt, um_pert,       & ! In
        3254             :                           upwp_pert, um_tndcy, upwp_forcing_pert, C7_Skw_fnc, & ! In
        3255             :                           upthvp_pert, rhs_ta_wpup, thv_ds_zm,                & ! In
        3256             :                           lhs_pr1_wprtp, lhs_ta_wpxp,                         & ! In
        3257             :                           stats_metadata,                                     & ! In
        3258             :                           stats_zt, stats_zm,                                 & ! Inout
        3259           0 :                           rhs(:,:,5+sclr_dim) )                                 ! Out
        3260             :
        3261             :         call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_vm, l_iter, dt, vm_pert,       & ! In
        3262             :                           vpwp_pert, vm_tndcy, vpwp_forcing_pert, C7_Skw_fnc, & ! In
        3263             :                           vpthvp_pert, rhs_ta_wpvp, thv_ds_zm,                & ! In
        3264             :                           lhs_pr1_wprtp, lhs_ta_wpxp,                         & ! In
        3265             :                           stats_metadata,                                     & ! In
        3266             :                           stats_zt, stats_zm,                                 & ! Inout
        3267           0 :                           rhs(:,:,6+sclr_dim) )                                 ! Out
        3268             :
        3269             :       endif ! l_perturbed_wind
        3270             :
        3271             :     endif ! l_predict_upwp_vpwp
        3272             :
        3273             :     ! Save the value of rhs, which will be overwritten with the solution as
        3274             :     ! part of the solving routine.
        3275             :     !$acc parallel loop gang vector collapse(3) default(present)
        3276    44675280 :     do n = 1, nrhs
        3277  6120513360 :       do k = 1, 2*nz
        3278 >10148*10^7 :         do i = 1, ngrdcol
        3279 >10145*10^7 :           rhs_save(i,k,n) = rhs(i,k,n)
        3280             :         end do
        3281             :       end do
        3282             :     end do
        3283             :     !$acc end parallel loop
        3284             :
        3285             :     ! Use the previous solution as an initial guess for the bicgstab method
        3286     8935056 :     if ( penta_solve_method == penta_bicgstab ) then
        3287             :
        3288             :       !$acc parallel loop gang vector collapse(2) default(present)
        3289           0 :       do k = 1, nz
        3290           0 :         do i = 1, ngrdcol
        3291           0 :           old_solution(i,2*k-1,1) = rtm(i,k)
        3292           0 :           old_solution(i,2*k  ,1) = wprtp(i,k)
        3293           0 :           old_solution(i,2*k-1,2) = thlm(i,k)
        3294           0 :           old_solution(i,2*k  ,2) = wpthlp(i,k)
        3295             :         end do
        3296             :       end do
        3297             :       !$acc end parallel loop
        3298             :
        3299             :       !$acc parallel loop gang vector collapse(3) default(present)
        3300           0 :       do j = 1, sclr_dim
        3301           0 :         do k = 1, nz
        3302           0 :           do i = 1, ngrdcol
        3303           0 :             old_solution(i,2*k-1,2+j) = sclrm(i,k,j)
        3304           0 :             old_solution(i,2*k  ,2+j) = wpsclrp(i,k,j)
        3305             :           end do
        3306             :         end do
        3307             :       end do
        3308             :       !$acc end parallel loop
        3309             :
        3310           0 :       if ( l_predict_upwp_vpwp ) then
        3311             :         !$acc parallel loop gang vector collapse(2) default(present)
        3312           0 :         do k = 1, nz
        3313           0 :           do i = 1, ngrdcol
        3314           0 :             old_solution(i,2*k-1,3+sclr_dim) = um(i,k)
        3315           0 :             old_solution(i,2*k  ,3+sclr_dim) = upwp(i,k)
        3316           0 :             old_solution(i,2*k-1,4+sclr_dim) = vm(i,k)
        3317           0 :             old_solution(i,2*k  ,4+sclr_dim) = vpwp(i,k)
        3318             :           end do
        3319             :         end do
        3320             :         !$acc end parallel loop
        3321             :       end if
        3322             :
        3323             :     end if
        3324             :
        3325             :     ! Solve for all fields
        3326     8935056 :     if ( stats_metadata%l_stats_samp .and. stats_metadata%ithlm_matrix_condt_num + stats_metadata%irtm_matrix_condt_num > 0 ) then
        3327             :        call xm_wpxp_solve( nz, ngrdcol, gr, nrhs, & ! Intent(in)
        3328             :                            old_solution,          & ! Intent(in)
        3329             :                            penta_solve_method,    & ! Intent(in)
        3330             :                            lhs, rhs,              & ! Intent(inout)
        3331           0 :                            solution, rcond )        ! Intent(out)
        3332             :     else
        3333             :       call xm_wpxp_solve( nz, ngrdcol, gr, nrhs,  & ! Intent(in)
        3334             :                           old_solution,           & ! Intent(in)
        3335             :                           penta_solve_method,     & ! Intent(in)
        3336             :                           lhs, rhs,               & ! Intent(inout)
        3337     8935056 :                           solution )                ! Intent(out)
        3338             :     end if
        3339             :
        3340             :
        3341     8935056 :     if ( clubb_at_least_debug_level( 0 ) ) then
        3342     8935056 :       if ( err_code == clubb_fatal_error ) then
        3343             :
        3344             :         !$acc update host( gr%zm, gr%zt, lhs, rhs_save )
        3345             :
        3346           0 :         write(fstderr,*) "xm & wpxp LU decomp. failed"
        3347           0 :         write(fstderr,*) "General xm and wpxp LHS"
        3348             :
        3349           0 :         do k = 1, nz
        3350           0 :           do i = 1, ngrdcol
        3351           0 :             write(fstderr,*) "grid col = ",i,"zt level = ", k, "height [m] = ", gr%zt(i,k), &
        3352           0 :                              "LHS = ", lhs(1:nsup+nsub+1,i,2*k-1)
        3353           0 :             write(fstderr,*) "grid col = ",i,"zm level = ", k, "height [m] = ", gr%zm(i,k), &
        3354           0 :                              "LHS = ", lhs(1:nsup+nsub+1,i,2*k)
        3355             :           end do
        3356             :         end do ! k = 1, nz
        3357             :
        3358           0 :         do j = 1, nrhs
        3359           0 :           if ( j == 1 ) then
        3360           0 :             write(fstderr,*) "rtm and wprtp RHS"
        3361           0 :           elseif ( j == 2 ) then
        3362           0 :             write(fstderr,*) "thlm and wpthlp RHS"
        3363             :           else ! j > 2
        3364           0 :             if ( sclr_dim > 0 ) then
        3365           0 :               if ( j <= 2+sclr_dim ) then
        3366           0 :                 write(fstderr,*) "sclrm and wpsclrp RHS for sclr", j-2
        3367             :               end if ! j <= 2+sclr_dim )
        3368             :             end if ! sclr_dim > 0
        3369           0 :             if ( l_predict_upwp_vpwp ) then
        3370           0 :               if ( j == 3+sclr_dim ) then
        3371           0 :                 write(fstderr,*) "um and upwp RHS"
        3372           0 :               elseif ( j == 4+sclr_dim ) then
        3373           0 :                 write(fstderr,*) "vm and vpwp RHS"
        3374             :               end if
        3375             :             end if ! l_predict_upwp_vpwp
        3376             :           end if
        3377           0 :           do k = 1, nz
        3378           0 :             do i = 1, ngrdcol
        3379           0 :               write(fstderr,*) "grid col = ",i,"zt level = ", k, &
        3380           0 :                                "height [m] = ", gr%zt(i,k), &
        3381           0 :                                "RHS = ", rhs_save(i,2*k-1,j)
        3382           0 :               write(fstderr,*) "grid col = ",i,"zm level = ", k, &
        3383           0 :                                "height [m] = ", gr%zm(i,k), &
        3384           0 :                                "RHS = ", rhs_save(i,2*k,j)
        3385             :             end do
        3386             :           end do ! k = 1, nz
        3387             :         end do ! j = 1, nrhs
        3388             :         return
        3389             :       end if
        3390             :     end if
        3391             :
        3392             :     call xm_wpxp_clipping_and_stats( nz, ngrdcol, &   ! Intent(in)
        3393             :            gr, xm_wpxp_rtm, dt, wp2, rtp2, wm_zt,  &  ! Intent(in)
        3394             :            rtm_forcing, rho_ds_zm, rho_ds_zt, &       ! Intent(in)
        3395             :            invrs_rho_ds_zm, invrs_rho_ds_zt, &        ! Intent(in)
        3396             :            rt_tol**2, rt_tol, rcond, &                ! Intent(in)
        3397             :            low_lev_effect, high_lev_effect, &         ! Intent(in)
        3398             :            lhs_ma_zt, lhs_ma_zm, lhs_ta_wpxp, &       ! Intent(in)
        3399             :            lhs_diff_zm, C7_Skw_fnc, &                 ! Intent(in)
        3400             :            lhs_tp, lhs_ta_xm, lhs_pr1_wprtp, &        ! Intent(in)
        3401             :            l_implemented, solution(:,:,1),  &         ! Intent(in)
        3402             :            tridiag_solve_method, &                    ! Intent(in)
        3403             :            l_predict_upwp_vpwp, &                     ! Intent(in)
        3404             :            l_upwind_xm_ma, &                          ! Intent(in)
        3405             :            l_tke_aniso, &                             ! Intent(in)
        3406             :            l_enable_relaxed_clipping, &               ! Intent(in)
        3407             :            l_mono_flux_lim_thlm, &
        3408             :            l_mono_flux_lim_rtm, &
        3409             :            l_mono_flux_lim_um, &
        3410             :            l_mono_flux_lim_vm, &
        3411             :            l_mono_flux_lim_spikefix, &
        3412             :            order_xm_wpxp, order_xp2_xpyp, &           ! Intent(in)
        3413             :            order_wp2_wp3, &                           ! Intent(in)
        3414             :            stats_metadata, &                          ! Intent(in)
        3415             :            stats_zt, stats_zm, stats_sfc, &           ! intent(inout)
        3416     8935056 :            rtm, rt_tol_mfl, wprtp )                   ! Intent(inout)
        3417             :
        3418     8935056 :     if ( clubb_at_least_debug_level( 0 ) ) then
        3419     8935056 :        if ( err_code == clubb_fatal_error ) then
        3420           0 :           write(fstderr,*) "rtm monotonic flux limiter:  tridiag failed"
        3421           0 :           return
        3422             :        end if
        3423             :     end if
        3424             :
        3425             :     call xm_wpxp_clipping_and_stats( nz, ngrdcol, &   ! Intent(in)
        3426             :            gr, xm_wpxp_thlm, dt, wp2, thlp2, wm_zt, & ! Intent(in)
        3427             :            thlm_forcing, rho_ds_zm, rho_ds_zt, &      ! Intent(in)
        3428             :            invrs_rho_ds_zm, invrs_rho_ds_zt, &        ! Intent(in)
        3429             :            thl_tol**2, thl_tol, rcond, &              ! Intent(in)
        3430             :            low_lev_effect, high_lev_effect, &         ! Intent(in)
        3431             :            lhs_ma_zt, lhs_ma_zm, lhs_ta_wpxp, &       ! Intent(in)
        3432             :            lhs_diff_zm, C7_Skw_fnc, &                 ! Intent(in)
        3433             :            lhs_tp, lhs_ta_xm, lhs_pr1_wprtp, &        ! Intent(in)
        3434             :            l_implemented, solution(:,:,2),  &         ! Intent(in)
        3435             :            tridiag_solve_method, &                    ! Intent(in)
        3436             :            l_predict_upwp_vpwp, &                     ! Intent(in)
        3437             :            l_upwind_xm_ma, &                          ! Intent(in)
        3438             :            l_tke_aniso, &                             ! Intent(in)
        3439             :            l_enable_relaxed_clipping, &               ! Intent(in)
        3440             :            l_mono_flux_lim_thlm, &
        3441             :            l_mono_flux_lim_rtm, &
        3442             :            l_mono_flux_lim_um, &
        3443             :            l_mono_flux_lim_vm, &
        3444             :            l_mono_flux_lim_spikefix, &
        3445             :            order_xm_wpxp, order_xp2_xpyp, &           ! Intent(in)
        3446             :            order_wp2_wp3, &                           ! Intent(in)
        3447             :            stats_metadata, &                          ! Intent(in)
        3448             :            stats_zt, stats_zm, stats_sfc, &           ! intent(inout)
        3449     8935056 :            thlm, thl_tol_mfl, wpthlp )                ! Intent(inout)
        3450             :
        3451     8935056 :     if ( clubb_at_least_debug_level( 0 ) ) then
        3452     8935056 :        if ( err_code == clubb_fatal_error ) then
        3453           0 :           write(fstderr,*) "thlm monotonic flux limiter:  tridiag failed"
        3454           0 :           return
        3455             :        end if
        3456             :     end if
        3457             :
        3458             : ! ---> h1g, 2010-06-15
        3459             : ! scalar transport, e.g, droplet and ice number concentration
        3460             : ! are handled in  " advance_sclrm_Nd_module.F90 "
        3461             : #ifdef GFDL
        3462             :     do j = 1, 0, 1
        3463             : #else
        3464     8935056 :     do j = 1, sclr_dim, 1
        3465             : #endif
        3466             : ! <--- h1g, 2010-06-15
        3467             :       call xm_wpxp_clipping_and_stats( nz, ngrdcol, &               ! Intent(in)
        3468             :              gr, xm_wpxp_scalar, dt, wp2, sclrp2(:,:,j), wm_zt, &   ! Intent(in)
        3469             :              sclrm_forcing(:,:,j), &                                ! Intent(in)
        3470             :              rho_ds_zm, rho_ds_zt, &                                ! Intent(in)
        3471             :              invrs_rho_ds_zm, invrs_rho_ds_zt, &                    ! Intent(in)
        3472           0 :              sclr_tol(j)**2, sclr_tol(j), rcond, &                  ! Intent(in)
        3473             :              low_lev_effect, high_lev_effect, &                     ! Intent(in)
        3474             :              lhs_ma_zt, lhs_ma_zm, lhs_ta_wpxp, &                   ! Intent(in)
        3475             :              lhs_diff_zm, C7_Skw_fnc, &                             ! Intent(in)
        3476             :              lhs_tp, lhs_ta_xm, lhs_pr1_wprtp, &                    ! Intent(in)
        3477             :              l_implemented, solution(:,:,2+j),  &                   ! Intent(in)
        3478             :              tridiag_solve_method, &                                ! Intent(in)
        3479             :              l_predict_upwp_vpwp, &                                 ! Intent(in)
        3480             :              l_upwind_xm_ma, &                                      ! Intent(in)
        3481             :              l_tke_aniso, &                                         ! Intent(in)
        3482             :              l_enable_relaxed_clipping, &                           ! Intent(in)
        3483             :              l_mono_flux_lim_thlm, &
        3484             :              l_mono_flux_lim_rtm, &
        3485             :              l_mono_flux_lim_um, &
        3486             :              l_mono_flux_lim_vm, &
        3487             :              l_mono_flux_lim_spikefix, &
        3488             :              order_xm_wpxp, order_xp2_xpyp, &                       ! Intent(in)
        3489             :              order_wp2_wp3, &                                       ! Intent(in)
        3490             :              stats_metadata, &                                      ! Intent(in)
        3491             :              stats_zt, stats_zm, stats_sfc, &                       ! intent(inout)
        3492           0 :              sclrm(:,:,j), sclr_tol(j), wpsclrp(:,:,j) )            ! Intent(inout)
        3493             :
        3494     8935056 :       if ( clubb_at_least_debug_level( 0 ) ) then
        3495           0 :          if ( err_code == clubb_fatal_error ) then
        3496           0 :             write(fstderr,*) "sclrm # ", j, "monotonic flux limiter: tridiag failed"
        3497           0 :             return
        3498             :          end if
        3499             :       end if
        3500             :
        3501             :     end do ! 1..sclr_dim
        3502             :
        3503     8935056 :     if ( l_predict_upwp_vpwp ) then
        3504             :
        3505             :       ! Predict <u> and <u'w'>, as well as <v> and <v'w'>.
        3506             :       call xm_wpxp_clipping_and_stats( nz, ngrdcol,   & ! Intent(in)
        3507             :             gr, xm_wpxp_um, dt, wp2, up2, wm_zt,      & ! Intent(in)
        3508             :             um_tndcy, rho_ds_zm, rho_ds_zt,           & ! Intent(in)
        3509             :             invrs_rho_ds_zm, invrs_rho_ds_zt,         & ! Intent(in)
        3510             :             w_tol_sqd, w_tol, rcond,                  & ! Intent(in)
        3511             :             low_lev_effect, high_lev_effect,          & ! Intent(in)
        3512             :             lhs_ma_zt, lhs_ma_zm, lhs_ta_wpxp,        & ! Intent(in)
        3513             :             lhs_diff_zm, C7_Skw_fnc,                  & ! Intent(in)
        3514             :             lhs_tp, lhs_ta_xm, lhs_pr1_wprtp,         & ! Intent(in)
        3515             :             l_implemented, solution(:,:,3+sclr_dim),  & ! Intent(in)
        3516             :             tridiag_solve_method,                     & ! Intent(in)
        3517             :             l_predict_upwp_vpwp,                      & ! Intent(in)
        3518             :             l_upwind_xm_ma,                           & ! Intent(in)
        3519             :             l_tke_aniso,                              & ! Intent(in)
        3520             :             l_enable_relaxed_clipping,                & ! Intent(in)
        3521             :             l_mono_flux_lim_thlm, &
        3522             :             l_mono_flux_lim_rtm, &
        3523             :             l_mono_flux_lim_um, &
        3524             :             l_mono_flux_lim_vm, &
        3525             :             l_mono_flux_lim_spikefix, &
        3526             :             order_xm_wpxp, order_xp2_xpyp,            & ! Intent(in)
        3527             :             order_wp2_wp3,                            & ! Intent(in)
        3528             :             stats_metadata,                           & ! Intent(in)
        3529             :             stats_zt, stats_zm, stats_sfc,            & ! intent(inout)
        3530     8935056 :             um, w_tol, upwp                           ) ! Intent(inout)
        3531             :
        3532     8935056 :       if ( clubb_at_least_debug_level( 0 ) ) then
        3533     8935056 :         if ( err_code == clubb_fatal_error ) then
        3534           0 :           write(fstderr,*) "um monotonic flux limiter:  tridiag failed"
        3535           0 :           return
        3536             :         end if
        3537             :       end if
        3538             :
        3539             :       call xm_wpxp_clipping_and_stats( nz, ngrdcol,   & ! Intent(in)
        3540             :             gr, xm_wpxp_vm, dt, wp2, vp2, wm_zt,      & ! Intent(in)
        3541             :             vm_tndcy, rho_ds_zm, rho_ds_zt,           & ! Intent(in)
        3542             :             invrs_rho_ds_zm, invrs_rho_ds_zt,         & ! Intent(in)
        3543             :             w_tol_sqd, w_tol, rcond,                  & ! Intent(in)
        3544             :             low_lev_effect, high_lev_effect,          & ! Intent(in)
        3545             :             lhs_ma_zt, lhs_ma_zm, lhs_ta_wpxp,        & ! Intent(in)
        3546             :             lhs_diff_zm, C7_Skw_fnc,                  & ! Intent(in)
        3547             :             lhs_tp, lhs_ta_xm, lhs_pr1_wprtp,         & ! Intent(in)
        3548             :             l_implemented, solution(:,:,4+sclr_dim),  & ! Intent(in)
        3549             :             tridiag_solve_method,                     & ! Intent(in)
        3550             :             l_predict_upwp_vpwp,                      & ! Intent(in)
        3551             :             l_upwind_xm_ma,                           & ! Intent(in)
        3552             :             l_tke_aniso,                              & ! Intent(in)
        3553             :             l_enable_relaxed_clipping,                & ! Intent(in)
        3554             :             l_mono_flux_lim_thlm, &
        3555             :             l_mono_flux_lim_rtm, &
        3556             :             l_mono_flux_lim_um, &
        3557             :             l_mono_flux_lim_vm, &
        3558             :             l_mono_flux_lim_spikefix, &
        3559             :             order_xm_wpxp, order_xp2_xpyp,            & ! Intent(in)
        3560             :             order_wp2_wp3,                            & ! Intent(in)
        3561             :             stats_metadata,                           & ! Intent(in)
        3562             :             stats_zt, stats_zm, stats_sfc,            & ! intent(inout)
        3563     8935056 :             vm, w_tol, vpwp )                           ! Intent(inout)
        3564             :
        3565     8935056 :       if ( clubb_at_least_debug_level( 0 ) ) then
        3566     8935056 :         if ( err_code == clubb_fatal_error ) then
        3567           0 :           write(fstderr,*) "vm monotonic flux limiter:  tridiag failed"
        3568           0 :           return
        3569             :         end if
        3570             :       end if
        3571             :
        3572     8935056 :       if ( l_perturbed_wind ) then
        3573             :
        3574             :          call xm_wpxp_clipping_and_stats( nz, ngrdcol,   & ! Intent(in)
        3575             :                gr, xm_wpxp_um, dt, wp2, up2, wm_zt,      & ! Intent(in)
        3576             :                um_tndcy, rho_ds_zm, rho_ds_zt,           & ! Intent(in)
        3577             :                invrs_rho_ds_zm, invrs_rho_ds_zt,         & ! Intent(in)
        3578             :                w_tol_sqd, w_tol, rcond,                  & ! Intent(in)
        3579             :                low_lev_effect, high_lev_effect,          & ! Intent(in)
        3580             :                lhs_ma_zt, lhs_ma_zm, lhs_ta_wpxp,        & ! Intent(in)
        3581             :                lhs_diff_zm, C7_Skw_fnc,                  & ! Intent(in)
        3582             :                lhs_tp, lhs_ta_xm, lhs_pr1_wprtp,         & ! Intent(in)
        3583             :                l_implemented, solution(:,:,5+sclr_dim),  & ! Intent(in)
        3584             :                tridiag_solve_method,                     & ! Intent(in)
        3585             :                l_predict_upwp_vpwp,                      & ! Intent(in)
        3586             :                l_upwind_xm_ma,                           & ! Intent(in)
        3587             :                l_tke_aniso,                              & ! Intent(in)
        3588             :                l_enable_relaxed_clipping,                & ! Intent(in)
        3589             :                l_mono_flux_lim_thlm, &
        3590             :                l_mono_flux_lim_rtm, &
        3591             :                l_mono_flux_lim_um, &
        3592             :                l_mono_flux_lim_vm, &
        3593             :                l_mono_flux_lim_spikefix, &
        3594             :                order_xm_wpxp, order_xp2_xpyp,            & ! Intent(in)
        3595             :                order_wp2_wp3,                            & ! Intent(in)
        3596             :                stats_metadata,                           & ! Intent(in)
        3597             :                stats_zt, stats_zm, stats_sfc,            & ! intent(inout)
        3598           0 :                um_pert, w_tol, upwp_pert                 ) ! Intent(inout)
        3599             :
        3600           0 :          if ( clubb_at_least_debug_level( 0 ) ) then
        3601           0 :            if ( err_code == clubb_fatal_error ) then
        3602           0 :              write(fstderr,*) "um_pert monotonic flux limiter:  tridiag failed"
        3603           0 :              return
        3604             :            end if
        3605             :          end if
        3606             :
        3607             :          call xm_wpxp_clipping_and_stats( nz, ngrdcol,   & ! Intent(in)
        3608             :                gr, xm_wpxp_vm, dt, wp2, vp2, wm_zt,      & ! Intent(in)
        3609             :                vm_tndcy, rho_ds_zm, rho_ds_zt,           & ! Intent(in)
        3610             :                invrs_rho_ds_zm, invrs_rho_ds_zt,         & ! Intent(in)
        3611             :                w_tol_sqd, w_tol, rcond,                  & ! Intent(in)
        3612             :                low_lev_effect, high_lev_effect,          & ! Intent(in)
        3613             :                lhs_ma_zt, lhs_ma_zm, lhs_ta_wpxp,        & ! Intent(in)
        3614             :                lhs_diff_zm, C7_Skw_fnc,                  & ! Intent(in)
        3615             :                lhs_tp, lhs_ta_xm, lhs_pr1_wprtp,         & ! Intent(in)
        3616             :                l_implemented, solution(:,:,6+sclr_dim),  & ! Intent(in)
        3617             :                tridiag_solve_method,                     & ! Intent(in)
        3618             :                l_predict_upwp_vpwp,                      & ! Intent(in)
        3619             :                l_upwind_xm_ma,                           & ! Intent(in)
        3620             :                l_tke_aniso,                              & ! Intent(in)
        3621             :                l_enable_relaxed_clipping,                & ! Intent(in)
        3622             :                l_mono_flux_lim_thlm, &
        3623             :                l_mono_flux_lim_rtm, &
        3624             :                l_mono_flux_lim_um, &
        3625             :                l_mono_flux_lim_vm, &
        3626             :                l_mono_flux_lim_spikefix, &
        3627             :                order_xm_wpxp, order_xp2_xpyp,            & ! Intent(in)
        3628             :                order_wp2_wp3,                            & ! Intent(in)
        3629             :                stats_metadata,                           & ! Intent(in)
        3630             :                stats_zt, stats_zm, stats_sfc,            & ! intent(inout)
        3631           0 :                vm_pert, w_tol, vpwp_pert )                 ! Intent(inout)
        3632             :
        3633           0 :          if ( clubb_at_least_debug_level( 0 ) ) then
        3634           0 :            if ( err_code == clubb_fatal_error ) then
        3635           0 :              write(fstderr,*) "vm_pert monotonic flux limiter:  tridiag failed"
        3636           0 :              return
        3637             :            end if
        3638             :          end if
        3639             :
        3640             :       endif ! l_perturbed_wind
        3641             :
        3642             :     end if ! l_predict_upwp_vpwp
        3643             :
        3644             :     !$acc exit data delete( lhs, um_tndcy, vm_tndcy, upwp_forcing, &
        3645             :     !$acc                 vpwp_forcing, upthvp, vpthvp, upthlp, vpthlp, uprtp, vprtp, &
        3646             :     !$acc                 tau_C6_zm, upwp_forcing_pert, vpwp_forcing_pert, upthvp_pert, &
        3647             :     !$acc                 vpthvp_pert, upthlp_pert, vpthlp_pert, uprtp_pert, vprtp_pert, &
        3648             :     !$acc                 rhs, rhs_save, solution, old_solution, rcond, zeros_vector, &
        3649             :     !$acc                 ddzt_um, ddzt_vm, ddzt_um_pert, ddzt_vm_pert )
        3650             :
        3651             :     !$acc exit data if( sclr_dim > 0 ) delete( wpsclrp_forcing )
        3652             :
        3653             :   end subroutine solve_xm_wpxp_with_single_lhs
        3654             :
        3655             :   !==========================================================================================
        3656             :
        3657           0 :   subroutine solve_xm_wpxp_with_multiple_lhs( nz, ngrdcol, sclr_dim, sclr_tol, gr, dt, &
        3658           0 :                                               l_iter, nrhs, wm_zt, wp2, &
        3659           0 :                                               rtpthvp, rtm_forcing, wprtp_forcing, thlpthvp, &
        3660           0 :                                               thlm_forcing,   wpthlp_forcing, rho_ds_zm, &
        3661           0 :                                               rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt, &
        3662           0 :                                               thv_ds_zm, rtp2, thlp2, l_implemented, &
        3663           0 :                                               sclrpthvp, sclrm_forcing, sclrp2, &
        3664           0 :                                               low_lev_effect, high_lev_effect, C7_Skw_fnc, &
        3665           0 :                                               lhs_diff_zm, lhs_diff_zt, lhs_ma_zt, lhs_ma_zm, &
        3666           0 :                                               lhs_ta_wprtp, lhs_ta_wpthlp, lhs_ta_wpsclrp, &
        3667           0 :                                               rhs_ta_wprtp, rhs_ta_wpthlp, rhs_ta_wpsclrp, &
        3668           0 :                                               lhs_tp, lhs_ta_xm, lhs_ac_pr2, lhs_pr1_wprtp, &
        3669           0 :                                               lhs_pr1_wpthlp, lhs_pr1_wpsclrp, &
        3670             :                                               penta_solve_method, &
        3671             :                                               tridiag_solve_method, &
        3672             :                                               l_predict_upwp_vpwp, &
        3673             :                                               l_diffuse_rtm_and_thlm, &
        3674             :                                               l_upwind_xm_ma, &
        3675             :                                               l_tke_aniso, &
        3676             :                                               l_enable_relaxed_clipping, &
        3677             :                                               l_mono_flux_lim_thlm, &
        3678             :                                               l_mono_flux_lim_rtm, &
        3679             :                                               l_mono_flux_lim_um, &
        3680             :                                               l_mono_flux_lim_vm, &
        3681             :                                               l_mono_flux_lim_spikefix, &
        3682             :                                               order_xm_wpxp, order_xp2_xpyp, order_wp2_wp3, &
        3683             :                                               stats_metadata, &
        3684           0 :                                               stats_zt, stats_zm, stats_sfc, &
        3685           0 :                                               rtm, wprtp, thlm, wpthlp, sclrm, wpsclrp )
        3686             :     !
        3687             :     ! Description: This subroutine solves all xm_wpxp when all the LHS matrices are NOT equal.
        3688             :     !              This means multiple solves are required, one for each unique LHS.
        3689             :     !
        3690             :     !----------------------------------------------------------------------------------------
        3691             :
        3692             :     use grid_class, only: &
        3693             :         grid, & ! Type
        3694             :         ddzt    ! Procedure(s)
        3695             :
        3696             :     use error_code, only: &
        3697             :         clubb_at_least_debug_level,  & ! Procedure
        3698             :         err_code,                    & ! Error Indicator
        3699             :         clubb_fatal_error              ! Constants
        3700             :
        3701             :     use stats_type_utilities, only: &
        3702             :         stat_update_var   ! Procedure(s)
        3703             :
        3704             :     use stats_variables, only: &
        3705             :         stats_metadata_type
        3706             :
        3707             :     use clubb_precision, only:  &
        3708             :         core_rknd ! Variable(s)
        3709             :
        3710             :     use constants_clubb, only:  &
        3711             :         fstderr, &  ! Constant
        3712             :         rt_tol, &
        3713             :         thl_tol, &
        3714             :         thl_tol_mfl, &
        3715             :         rt_tol_mfl, &
        3716             :         zero
        3717             :
        3718             :     use model_flags, only: &
        3719             :         penta_bicgstab
        3720             :
        3721             :     use stats_type, only: stats ! Type
        3722             :
        3723             :     implicit none
        3724             :
        3725             :     ! ------------------- Input Variables -------------------
        3726             :     integer, intent(in) :: &
        3727             :       nz,       & ! Number of vertical levels
        3728             :       ngrdcol,  & ! Number of grid columns
        3729             :       sclr_dim    ! Number of passive scalars
        3730             :
        3731             :     real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: &
        3732             :       sclr_tol          ! Threshold(s) on the passive scalars  [units vary]
        3733             :
        3734             :     type (grid), target, intent(in) :: &
        3735             :       gr
        3736             :
        3737             :     real( kind = core_rknd ), intent(in) ::  &
        3738             :       dt                 ! Timestep                                 [s]
        3739             :
        3740             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
        3741             :       wm_zt,           & ! w wind component on thermodynamic levels [m/s]
        3742             :       wp2,             & ! w'^2 (momentum levels)                   [m^2/s^2]
        3743             :       rtpthvp,         & ! r_t'th_v' (momentum levels)              [(kg/kg) K]
        3744             :       rtm_forcing,     & ! r_t forcing (thermodynamic levels)       [(kg/kg)/s]
        3745             :       wprtp_forcing,   & ! <w'r_t'> forcing (momentum levels)       [(kg/kg)/s^2]
        3746             :       thlpthvp,        & ! th_l'th_v' (momentum levels)             [K^2]
        3747             :       thlm_forcing,    & ! th_l forcing (thermodynamic levels)      [K/s]
        3748             :       wpthlp_forcing,  & ! <w'th_l'> forcing (momentum levels)      [K/s^2]
        3749             :       rho_ds_zm,       & ! Dry, static density on momentum levels   [kg/m^3]
        3750             :       rho_ds_zt,       & ! Dry, static density on thermo. levels    [kg/m^3]
        3751             :       invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg]
        3752             :       invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg]
        3753             :       thv_ds_zm,       & ! Dry, base-state theta_v on moment. levs. [K]
        3754             :       rtp2,            & ! r_t'^2 (momentum levels)                 [(kg/kg)^2]
        3755             :       thlp2              ! th_l'^2 (momentum levels)                [K^2]
        3756             :
        3757             :     logical, intent(in) ::  &
        3758             :       l_implemented, &      ! Flag for CLUBB being implemented in a larger model.
        3759             :       l_iter
        3760             :
        3761             :     ! Additional variables for passive scalars
        3762             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) :: &
        3763             :       sclrpthvp,     & ! <sclr' th_v'> (momentum levels)       [Units vary]
        3764             :       sclrm_forcing, & ! sclrm forcing (thermodynamic levels)  [Units vary]
        3765             :       sclrp2           ! For clipping Vince Larson             [Units vary]
        3766             :
        3767             :     ! LHS/RHS terms
        3768             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: &
        3769             :       lhs_diff_zm,  & ! Diffusion term for w'x'
        3770             :       lhs_diff_zt,  & ! Diffusion term for w'x'
        3771             :       lhs_ma_zt,    & ! Mean advection contributions to lhs
        3772             :       lhs_ma_zm       ! Mean advection contributions to lhs
        3773             :
        3774             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: &
        3775             :       lhs_ta_wprtp,   & ! w'r_t' turbulent advection contributions to lhs
        3776             :       lhs_ta_wpthlp     ! w'thl' turbulent advection contributions to lhs
        3777             :
        3778             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz,sclr_dim), intent(in) :: &
        3779             :       lhs_ta_wpsclrp    ! w'sclr' turbulent advection contributions to lhs
        3780             :
        3781             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        3782             :       rhs_ta_wprtp,  & ! w'r_t' turbulent advection contributions to rhs
        3783             :       rhs_ta_wpthlp    ! w'thl' turbulent advection contributions to rhs
        3784             :
        3785             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(in) :: &
        3786             :       rhs_ta_wpsclrp    ! w'sclr' turbulent advection contributions to rhs
        3787             :
        3788             :     real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(in) :: &
        3789             :       lhs_tp,     & ! Turbulent production terms of w'x'
        3790             :       lhs_ta_xm     ! Turbulent advection terms of xm
        3791             :
        3792             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        3793             :       lhs_ac_pr2,     & ! Accumulation of w'x' and w'x' pressure term 2
        3794             :       lhs_pr1_wprtp,  & ! Pressure term 1 for w'r_t' for all grid levels
        3795             :       lhs_pr1_wpthlp, & ! Pressure term 1 for w'thl' for all grid levels
        3796             :       lhs_pr1_wpsclrp   ! Pressure term 1 for w'sclr' for all grid levels
        3797             :
        3798             :     ! Variables used as part of the monotonic turbulent advection scheme.
        3799             :     ! Find the lowermost and uppermost grid levels that can have an effect
        3800             :     ! on the central thermodynamic level during the course of a time step,
        3801             :     ! due to the effects of turbulent advection only.
        3802             :     integer, dimension(ngrdcol,nz), intent(in) ::  &
        3803             :       low_lev_effect, & ! Index of the lowest level that has an effect.
        3804             :       high_lev_effect   ! Index of the highest level that has an effect.
        3805             :
        3806             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
        3807             :       C7_Skw_fnc
        3808             :
        3809             :     integer, intent(in) :: &
        3810             :       nrhs         ! Number of RHS vectors
        3811             :
        3812             :     integer, intent(in) :: &
        3813             :       tridiag_solve_method  ! Specifier for method to solve tridiagonal systems
        3814             :
        3815             :     logical, intent(in) :: &
        3816             :       l_predict_upwp_vpwp,       & ! Flag to predict <u'w'> and <v'w'> along
        3817             :                                    ! with <u> and <v> alongside the advancement
        3818             :                                    ! of <rt>, <w'rt'>, <thl>, <wpthlp>, <sclr>,
        3819             :                                    ! and <w'sclr'> in subroutine advance_xm_wpxp.
        3820             :                                    ! Otherwise, <u'w'> and <v'w'> are still
        3821             :                                    ! approximated by eddy diffusivity when <u>
        3822             :                                    ! and <v> are advanced in subroutine
        3823             :                                    ! advance_windm_edsclrm.
        3824             :       l_diffuse_rtm_and_thlm,    & ! This flag determines whether or not we want
        3825             :                                    ! CLUBB to do diffusion on rtm and thlm
        3826             :       l_upwind_xm_ma,            & ! This flag determines whether we want to use
        3827             :                                    ! an upwind differencing approximation rather
        3828             :                                    ! than a centered differencing for turbulent
        3829             :                                    ! or mean advection terms. It affects rtm,
        3830             :                                    ! thlm, sclrm, um and vm.
        3831             :       l_tke_aniso,               & ! For anisotropic turbulent kinetic energy,
        3832             :                                    ! i.e. TKE = 1/2 (u'^2 + v'^2 + w'^2)
        3833             :       l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in
        3834             :                                    ! xm_wpxp_clipping_and_stats
        3835             :       l_mono_flux_lim_thlm,      & ! Flag to turn on monotonic flux limiter for thlm
        3836             :       l_mono_flux_lim_rtm,       & ! Flag to turn on monotonic flux limiter for rtm
        3837             :       l_mono_flux_lim_um,        & ! Flag to turn on monotonic flux limiter for um
        3838             :       l_mono_flux_lim_vm,        & ! Flag to turn on monotonic flux limiter for vm
        3839             :       l_mono_flux_lim_spikefix     ! Flag to implement monotonic flux limiter code that
        3840             :                                    ! eliminates spurious drying tendencies at model top
        3841             :
        3842             :     integer, intent(in) :: &
        3843             :       penta_solve_method ! Method to solve then penta-diagonal system
        3844             :
        3845             :     integer, intent(in) :: &
        3846             :       order_xm_wpxp, &
        3847             :       order_xp2_xpyp, &
        3848             :       order_wp2_wp3
        3849             :
        3850             :     type (stats_metadata_type), intent(in) :: &
        3851             :       stats_metadata
        3852             :
        3853             :     ! ------------------- Input/Output Variables -------------------
        3854             :
        3855             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
        3856             :       stats_zt, &
        3857             :       stats_zm, &
        3858             :       stats_sfc
        3859             :
        3860             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  &
        3861             :       rtm,       & ! r_t  (total water mixing ratio)           [kg/kg]
        3862             :       wprtp,     & ! w'r_t'                                    [(kg/kg) m/s]
        3863             :       thlm,      & ! th_l (liquid water potential temperature) [K]
        3864             :       wpthlp       ! w'th_l'                                   [K m/s]
        3865             :
        3866             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) ::  &
        3867             :       sclrm, wpsclrp !                                     [Units vary]
        3868             :
        3869             :     ! ------------------- Local Variables -------------------
        3870             :
        3871             :     real( kind = core_rknd ), dimension(nsup+nsub+1,ngrdcol,2*nz) :: &
        3872           0 :       lhs  ! Implicit contributions to wpxp/xm (band diag. matrix) (LAPACK)
        3873             :
        3874             :     real( kind = core_rknd ), dimension(ngrdcol,2*nz,nrhs) :: &
        3875           0 :       rhs,        & ! Right-hand sides of band diag. matrix. (LAPACK)
        3876           0 :       rhs_save,   & ! Saved Right-hand sides of band diag. matrix. (LAPACK)
        3877           0 :       solution,   & ! solution vectors of band diag. matrix. (LAPACK)
        3878           0 :       old_solution  ! previous solutions
        3879             :
        3880             :     ! Additional variables for passive scalars
        3881             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
        3882           0 :       wpsclrp_forcing    ! <w'sclr'> forcing (momentum levels)  [m/s{un vary}]
        3883             :
        3884             :     ! Variables used for clipping of w'x' due to correlation
        3885             :     ! of w with x, such that:
        3886             :     ! corr_(w,x) = w'x' / [ sqrt(w'^2) * sqrt(x'^2) ];
        3887             :     ! -1 <= corr_(w,x) <= 1.
        3888             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        3889           0 :       wpxp_upper_lim, & ! Keeps correlations from becoming greater than 1.
        3890           0 :       wpxp_lower_lim    ! Keeps correlations from becoming less than -1.
        3891             :
        3892             :     ! Constant parameters as a function of Skw.
        3893             :
        3894           0 :     real( kind = core_rknd ), dimension(ngrdcol) :: rcond
        3895             :
        3896             :     integer :: i, j, k
        3897             :
        3898             :     ! ------------------- Begin Code -------------------
        3899             :
        3900             :     ! Compute the implicit portion of the r_t and w'r_t' equations.
        3901             :     ! Build the left-hand side matrix.
        3902             :     call xm_wpxp_lhs( nz, ngrdcol, l_iter, dt, wprtp, wm_zt, C7_Skw_fnc,      & ! In
        3903             :                       wpxp_upper_lim, wpxp_lower_lim,                         & ! In
        3904             :                       l_implemented, lhs_diff_zm, lhs_diff_zt,                & ! In
        3905             :                       lhs_ma_zm, lhs_ma_zt, lhs_ta_wprtp, lhs_ta_xm,          & ! In
        3906             :                       lhs_tp, lhs_pr1_wprtp, lhs_ac_pr2,                      & ! In
        3907             :                       l_diffuse_rtm_and_thlm,                                 & ! In
        3908             :                       stats_metadata,                                         & ! In
        3909           0 :                       lhs )                                                     ! Out
        3910             :
        3911             :     ! Compute the explicit portion of the r_t and w'r_t' equations.
        3912             :     ! Build the right-hand side vector.
        3913             :     call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_rtm, l_iter, dt, rtm, wprtp,       & ! In
        3914             :                       rtm_forcing, wprtp_forcing, C7_Skw_fnc,                 & ! In
        3915             :                       rtpthvp, rhs_ta_wprtp, thv_ds_zm,                       & ! In
        3916             :                       lhs_pr1_wprtp, lhs_ta_wprtp,                            & ! In
        3917             :                       stats_metadata,                                         & ! In
        3918             :                       stats_zt, stats_zm,                                     & ! Inout
        3919           0 :                       rhs(:,:,1) )                                              ! Out
        3920             :
        3921             :     ! Save the value of rhs, which will be overwritten with the solution as
        3922             :     ! part of the solving routine.
        3923           0 :     rhs_save = rhs
        3924             :
        3925             :     ! Use the previous solution as an initial guess for the bicgstab method
        3926           0 :     if ( penta_solve_method == penta_bicgstab ) then
        3927           0 :       do k = 1, nz
        3928           0 :         old_solution(:,2*k-1,1) = rtm(:,k)
        3929           0 :         old_solution(:,2*k  ,1) = wprtp(:,k)
        3930             :       end do
        3931             :     end if
        3932             :
        3933             :     ! Solve r_t / w'r_t'
        3934           0 :     if ( stats_metadata%l_stats_samp .and. stats_metadata%irtm_matrix_condt_num > 0 ) then
        3935             :       call xm_wpxp_solve( nz, ngrdcol, gr, nrhs,  & ! Intent(in)
        3936             :                           old_solution,           & ! Intent(in)
        3937             :                           penta_solve_method,     & ! Intent(in)
        3938             :                           lhs, rhs,               & ! Intent(inout)
        3939           0 :                           solution, rcond )         ! Intent(out)
        3940             :     else
        3941             :       call xm_wpxp_solve( nz, ngrdcol, gr, nrhs,  & ! Intent(in)
        3942             :                           old_solution,           & ! Intent(in)
        3943             :                           penta_solve_method,     & ! Intent(in)
        3944             :                           lhs, rhs,               & ! Intent(inout)
        3945           0 :                           solution )                ! Intent(out)
        3946             :     end if
        3947             :
        3948           0 :     if ( clubb_at_least_debug_level( 0 ) ) then
        3949           0 :       if ( err_code == clubb_fatal_error ) then
        3950           0 :         do i = 1, ngrdcol
        3951           0 :           write(fstderr,*) "Mean total water & total water flux LU decomp. failed"
        3952           0 :           write(fstderr,*) "rtm and wprtp LHS"
        3953           0 :           do k = 1, nz
        3954           0 :             write(fstderr,*) "grid col = ",i,"zt level = ", k, "height [m] = ", gr%zt(i,k), &
        3955           0 :                              "LHS = ", lhs(1:nsup+nsub+1,i,2*k-1)
        3956           0 :             write(fstderr,*) "grid col = ",i,"zm level = ", k, "height [m] = ", gr%zm(i,k), &
        3957           0 :                              "LHS = ", lhs(1:nsup+nsub+1,i,2*k)
        3958             :           end do ! k = 1, nz
        3959           0 :           write(fstderr,*) "rtm and wprtp RHS"
        3960           0 :           do k = 1, nz
        3961           0 :             write(fstderr,*) "grid col = ",i,"zt level = ", k, "height [m] = ", gr%zt(i,k), &
        3962           0 :                              "RHS = ", rhs_save(i,2*k-1,1)
        3963           0 :             write(fstderr,*) "grid col = ",i,"zm level = ", k, "height [m] = ", gr%zm(i,k), &
        3964           0 :                              "RHS = ", rhs_save(i,2*k,1)
        3965             :           end do ! k = 1, nz
        3966             :         end do
        3967             :         return
        3968             :       end if
        3969             :     end if
        3970             :
        3971             :     call xm_wpxp_clipping_and_stats( nz, ngrdcol, &   ! Intent(in)
        3972             :            gr, xm_wpxp_rtm, dt, wp2, rtp2, wm_zt,  &  ! Intent(in)
        3973             :            rtm_forcing, rho_ds_zm, rho_ds_zt, &       ! Intent(in)
        3974             :            invrs_rho_ds_zm, invrs_rho_ds_zt, &        ! Intent(in)
        3975             :            rt_tol**2, rt_tol, rcond, &                ! Intent(in)
        3976             :            low_lev_effect, high_lev_effect, &         ! Intent(in)
        3977             :            lhs_ma_zt, lhs_ma_zm, lhs_ta_wprtp, &      ! Intent(in)
        3978             :            lhs_diff_zm, C7_Skw_fnc, &                 ! Intent(in)
        3979             :            lhs_tp, lhs_ta_xm, lhs_pr1_wprtp, &        ! Intent(in)
        3980             :            l_implemented, solution(:,:,1), &          ! Intent(in)
        3981             :            tridiag_solve_method, &                      ! Intent(in)
        3982             :            l_predict_upwp_vpwp, &                     ! Intent(in)
        3983             :            l_upwind_xm_ma, &                          ! Intent(in)
        3984             :            l_tke_aniso, &                             ! Intent(in)
        3985             :            l_enable_relaxed_clipping, &               ! Intent(in)
        3986             :            l_mono_flux_lim_thlm, &
        3987             :            l_mono_flux_lim_rtm, &
        3988             :            l_mono_flux_lim_um, &
        3989             :            l_mono_flux_lim_vm, &
        3990             :            l_mono_flux_lim_spikefix, &
        3991             :            order_xm_wpxp, order_xp2_xpyp, &           ! Intent(in)
        3992             :            order_wp2_wp3, &                           ! Intent(in)
        3993             :            stats_metadata, &                          ! Intent(in)
        3994             :            stats_zt, stats_zm, stats_sfc, &           ! intent(inout)
        3995           0 :            rtm, rt_tol_mfl, wprtp )                   ! Intent(inout)
        3996             :
        3997           0 :     if ( clubb_at_least_debug_level( 0 ) ) then
        3998           0 :       if ( err_code == clubb_fatal_error ) then
        3999           0 :         write(fstderr,*) "rtm monotonic flux limiter:  tridiag failed"
        4000           0 :         return
        4001             :       end if
        4002             :     end if
        4003             :
        4004             :     ! Compute the implicit portion of the th_l and w'th_l' equations.
        4005             :     ! Build the left-hand side matrix.
        4006             :     call xm_wpxp_lhs( nz, ngrdcol, l_iter, dt, wpthlp, wm_zt, C7_Skw_fnc,       & ! In
        4007             :                       wpxp_upper_lim, wpxp_lower_lim,                           & ! In
        4008             :                       l_implemented, lhs_diff_zm, lhs_diff_zt,                  & ! In
        4009             :                       lhs_ma_zm, lhs_ma_zt, lhs_ta_wpthlp, lhs_ta_xm,           & ! In
        4010             :                       lhs_tp, lhs_pr1_wpthlp, lhs_ac_pr2,                       & ! In
        4011             :                       l_diffuse_rtm_and_thlm,                                   & ! In
        4012             :                       stats_metadata,                                           & ! In
        4013           0 :                       lhs )                                                       ! Out
        4014             :
        4015             :     ! Compute the explicit portion of the th_l and w'th_l' equations.
        4016             :     ! Build the right-hand side vector.
        4017             :     call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_thlm, l_iter, dt, thlm, wpthlp,      & ! In
        4018             :                       thlm_forcing, wpthlp_forcing, C7_Skw_fnc,                 & ! In
        4019             :                       thlpthvp, rhs_ta_wpthlp, thv_ds_zm,                       & ! In
        4020             :                       lhs_pr1_wpthlp, lhs_ta_wpthlp,                            & ! In
        4021             :                       stats_metadata,                                           & ! In
        4022             :                       stats_zt, stats_zm,                                       & ! Inout
        4023           0 :                       rhs(:,:,1) )                                                ! Out
        4024             :
        4025             :     ! Save the value of rhs, which will be overwritten with the solution as
        4026             :     ! part of the solving routine.
        4027           0 :     rhs_save = rhs
        4028             :
        4029             :     ! Use the previous solution as an initial guess for the bicgstab method
        4030           0 :     if ( penta_solve_method == penta_bicgstab ) then
        4031           0 :       do k = 1, nz
        4032           0 :         old_solution(:,2*k-1,1) = thlm(:,k)
        4033           0 :         old_solution(:,2*k  ,1) = wpthlp(:,k)
        4034             :       end do
        4035             :     end if
        4036             :
        4037             :     ! Solve for th_l / w'th_l'
        4038           0 :     if ( stats_metadata%l_stats_samp .and. stats_metadata%ithlm_matrix_condt_num > 0 ) then
        4039             :       call xm_wpxp_solve( nz, ngrdcol, gr, nrhs,  & ! Intent(in)
        4040             :                           old_solution,           & ! Intent(in)
        4041             :                           penta_solve_method,     & ! Intent(in)
        4042             :                           lhs, rhs,               & ! Intent(inout)
        4043           0 :                           solution, rcond )         ! Intent(out)
        4044             :     else
        4045             :       call xm_wpxp_solve( nz, ngrdcol, gr, nrhs,  & ! Intent(in)
        4046             :                           old_solution,           & ! Intent(in)
        4047             :                           penta_solve_method,     & ! Intent(in)
        4048             :                           lhs, rhs,               & ! Intent(inout)
        4049           0 :                           solution )                ! Intent(out)
        4050             :     end if
        4051             :
        4052           0 :     if ( clubb_at_least_debug_level( 0 ) ) then
        4053           0 :       if ( err_code == clubb_fatal_error ) then
        4054           0 :         do i = 1, ngrdcol
        4055           0 :           write(fstderr,*) "Liquid pot. temp & thetal flux LU decomp. failed"
        4056           0 :           write(fstderr,*) "thlm and wpthlp LHS"
        4057           0 :           do k = 1, nz
        4058           0 :              write(fstderr,*) "grid col = ",i,"zt level = ", k, "height [m] = ", gr%zt(i,k), &
        4059           0 :                               "LHS = ", lhs(1:nsup+nsub+1,i,2*k-1)
        4060           0 :              write(fstderr,*) "grid col = ",i,"zm level = ", k, "height [m] = ", gr%zm(i,k), &
        4061           0 :                               "LHS = ", lhs(1:nsup+nsub+1,i,2*k)
        4062             :           end do ! k = 1, nz
        4063           0 :           write(fstderr,*) "thlm and wpthlp RHS"
        4064           0 :           do k = 1, nz
        4065           0 :              write(fstderr,*) "grid col = ",i,"zt level = ", k, "height [m] = ", gr%zt(i,k), &
        4066           0 :                               "RHS = ", rhs_save(i,2*k-1,1)
        4067           0 :              write(fstderr,*) "grid col = ",i,"zm level = ", k, "height [m] = ", gr%zm(i,k), &
        4068           0 :                               "RHS = ", rhs_save(i,2*k,1)
        4069             :           end do ! k = 1, nz
        4070             :         end do
        4071             :         return
        4072             :       end if
        4073             :     end if
        4074             :
        4075             :     call xm_wpxp_clipping_and_stats( nz, ngrdcol, &     ! Intent(in)
        4076             :            gr, xm_wpxp_thlm, dt, wp2, thlp2, wm_zt,  &  ! Intent(in)
        4077             :            thlm_forcing, rho_ds_zm, rho_ds_zt, &        ! Intent(in)
        4078             :            invrs_rho_ds_zm, invrs_rho_ds_zt, &          ! Intent(in)
        4079             :            thl_tol**2, thl_tol, rcond, &                ! Intent(in)
        4080             :            low_lev_effect, high_lev_effect, &           ! Intent(in)
        4081             :            lhs_ma_zt, lhs_ma_zm, lhs_ta_wpthlp, &       ! Intent(in)
        4082             :            lhs_diff_zm, C7_Skw_fnc, &                   ! Intent(in)
        4083             :            lhs_tp, lhs_ta_xm, lhs_pr1_wpthlp, &         ! Intent(in)
        4084             :            l_implemented, solution(:,:,1),  &           ! Intent(in)
        4085             :            tridiag_solve_method, &                      ! Intent(in)
        4086             :            l_predict_upwp_vpwp, &                       ! Intent(in)
        4087             :            l_upwind_xm_ma, &                            ! Intent(in)
        4088             :            l_tke_aniso, &                               ! Intent(in)
        4089             :            l_enable_relaxed_clipping, &                 ! Intent(in)
        4090             :            l_mono_flux_lim_thlm, &
        4091             :            l_mono_flux_lim_rtm, &
        4092             :            l_mono_flux_lim_um, &
        4093             :            l_mono_flux_lim_vm, &
        4094             :            l_mono_flux_lim_spikefix, &
        4095             :            order_xm_wpxp, order_xp2_xpyp, &             ! Intent(in)
        4096             :            order_wp2_wp3, &                             ! Intent(in)
        4097             :            stats_metadata, &                            ! Intent(in)
        4098             :            stats_zt, stats_zm, stats_sfc, &             ! intent(inout)
        4099           0 :            thlm, thl_tol_mfl, wpthlp )                  ! Intent(inout)
        4100             :
        4101           0 :     if ( clubb_at_least_debug_level( 0 ) ) then
        4102           0 :       if ( err_code == clubb_fatal_error ) then
        4103           0 :         write(fstderr,*) "thlm monotonic flux limiter:  tridiag failed"
        4104           0 :         return
        4105             :       end if
        4106             :     end if
        4107             :
        4108             :     ! Solve sclrm / wpsclrp
        4109             :     ! If sclr_dim is 0, then this loop will execute 0 times.
        4110             : ! ---> h1g, 2010-06-15
        4111             : ! scalar transport, e.g, droplet and ice number concentration
        4112             : ! are handled in  " advance_sclrm_Nd_module.F90 "
        4113             : #ifdef GFDL
        4114             :     do j = 1, 0, 1
        4115             : #else
        4116           0 :     do j = 1, sclr_dim, 1
        4117             : #endif
        4118             : ! <--- h1g, 2010-06-15
        4119             :
        4120             :       ! Set <w'sclr'> forcing to 0 unless unless testing the wpsclrp code
        4121             :       ! using wprtp or wpthlp (then use wprtp_forcing or wpthlp_forcing).
        4122           0 :       wpsclrp_forcing(:,:,j) = zero
        4123             :
        4124             :       ! Compute the implicit portion of the sclr and w'sclr' equations.
        4125             :       ! Build the left-hand side matrix.
        4126             :       call xm_wpxp_lhs( nz, ngrdcol, l_iter, dt, wpsclrp(:,:,j), wm_zt, C7_Skw_fnc,       & ! In
        4127             :                         wpxp_upper_lim, wpxp_lower_lim,                                   & ! In
        4128             :                         l_implemented, lhs_diff_zm, lhs_diff_zt,                          & ! In
        4129             :                         lhs_ma_zm, lhs_ma_zt, lhs_ta_wpsclrp(:,:,:,j), lhs_ta_xm,         & ! In
        4130             :                         lhs_tp, lhs_pr1_wpsclrp, lhs_ac_pr2,                              & ! In
        4131             :                         l_diffuse_rtm_and_thlm,                                           & ! In
        4132             :                         stats_metadata,                                                   & ! In
        4133           0 :                         lhs )                                                               ! Out
        4134             :
        4135             :       ! Compute the explicit portion of the sclrm and w'sclr' equations.
        4136             :       ! Build the right-hand side vector.
        4137             :       call xm_wpxp_rhs( nz, ngrdcol, xm_wpxp_scalar, l_iter, dt, sclrm(:,:,j), wpsclrp(:,:,j),            & ! In
        4138             :                         sclrm_forcing(:,:,j),                                             & ! In
        4139             :                         wpsclrp_forcing(:,:,j), C7_Skw_fnc,                               & ! In
        4140             :                         sclrpthvp(:,:,j), rhs_ta_wpsclrp(:,:,j), thv_ds_zm,               & ! In
        4141             :                         lhs_pr1_wpsclrp, lhs_ta_wpsclrp(:,:,:,j),                         & ! In
        4142             :                         stats_metadata,                                                   & ! In
        4143             :                         stats_zt, stats_zm,                                               & ! Inout
        4144           0 :                         rhs(:,:,1) )                                                        ! Out
        4145             :
        4146             :       ! Save the value of rhs, which will be overwritten with the solution as
        4147             :       ! part of the solving routine.
        4148           0 :       rhs_save = rhs
        4149             :
        4150             :       ! Use the previous solution as an initial guess for the bicgstab method
        4151           0 :       if ( penta_solve_method == penta_bicgstab ) then
        4152           0 :         do k = 1, nz
        4153           0 :           old_solution(:,2*k-1,1) = sclrm(:,k,j)
        4154           0 :           old_solution(:,2*k  ,1) = wpsclrp(:,k,j)
        4155             :         end do
        4156             :       end if
        4157             :
        4158             :       ! Solve for sclrm / w'sclr'
        4159             :       call xm_wpxp_solve( nz, ngrdcol, gr, nrhs,  & ! Intent(in)
        4160             :                           old_solution,           & ! Intent(in)
        4161             :                           penta_solve_method,     & ! Intent(in)
        4162             :                           lhs, rhs,               & ! Intent(inout)
        4163           0 :                           solution )                ! Intent(out)
        4164             :
        4165           0 :       if ( clubb_at_least_debug_level( 0 ) ) then
        4166           0 :         if ( err_code == clubb_fatal_error ) then
        4167           0 :           do i = 1, ngrdcol
        4168           0 :             write(fstderr,*) "Passive scalar # ", j, " LU decomp. failed."
        4169           0 :             write(fstderr,*) "sclrm and wpsclrp LHS"
        4170           0 :             do k = 1, nz
        4171           0 :                write(fstderr,*) "grid col = ",i,"zt level = ", k, "height [m] = ", gr%zt(i,k), &
        4172           0 :                                 "LHS = ", lhs(1:nsup+nsub+1,i,2*k-1)
        4173           0 :                write(fstderr,*) "grid col = ",i,"zm level = ", k, "height [m] = ", gr%zm(i,k), &
        4174           0 :                                 "LHS = ", lhs(1:nsup+nsub+1,i,2*k)
        4175             :             end do ! k = 1, nz
        4176           0 :             write(fstderr,*) "sclrm and wpsclrp RHS"
        4177           0 :             do k = 1, nz
        4178           0 :                write(fstderr,*) "grid col = ",i,"zt level = ", k, "height [m] = ", gr%zt(i,k), &
        4179           0 :                                 "RHS = ", rhs_save(i,2*k-1,1)
        4180           0 :                write(fstderr,*) "grid col = ",i,"zm level = ", k, "height [m] = ", gr%zm(i,k), &
        4181           0 :                                 "RHS = ", rhs_save(i,2*k,1)
        4182             :             end do ! k = 1, nz
        4183             :           end do
        4184             :           return
        4185             :         end if
        4186             :       end if
        4187             :
        4188             :       call xm_wpxp_clipping_and_stats( nz, ngrdcol, &               ! Intent(in)
        4189             :              gr, xm_wpxp_scalar, dt, wp2, sclrp2(:,:,j), wm_zt,   & ! Intent(in)
        4190             :              sclrm_forcing(:,:,j),  &                               ! Intent(in)
        4191             :              rho_ds_zm, rho_ds_zt, &                                ! Intent(in)
        4192             :              invrs_rho_ds_zm, invrs_rho_ds_zt, &                    ! Intent(in)
        4193           0 :              sclr_tol(j)**2, sclr_tol(j), rcond, &                  ! Intent(in)
        4194             :              low_lev_effect, high_lev_effect, &                     ! Intent(in)
        4195             :              lhs_ma_zt, lhs_ma_zm, lhs_ta_wpsclrp(:,:,:,j), &       ! Intent(in)
        4196             :              lhs_diff_zm, C7_Skw_fnc, &                             ! Intent(in)
        4197             :              lhs_tp, lhs_ta_xm, lhs_pr1_wpsclrp, &                  ! Intent(in)
        4198             :              l_implemented, solution(:,:,1),  &                     ! Intent(in)
        4199             :              tridiag_solve_method, &                                ! Intent(in)
        4200             :              l_predict_upwp_vpwp, &                                 ! Intent(in)
        4201             :              l_upwind_xm_ma, &                                      ! Intent(in)
        4202             :              l_tke_aniso, &                                         ! Intent(in)
        4203             :              l_enable_relaxed_clipping, &                           ! Intent(in)
        4204             :              l_mono_flux_lim_thlm, &
        4205             :              l_mono_flux_lim_rtm, &
        4206             :              l_mono_flux_lim_um, &
        4207             :              l_mono_flux_lim_vm, &
        4208             :              l_mono_flux_lim_spikefix, &
        4209             :              order_xm_wpxp, order_xp2_xpyp, &                       ! Intent(in)
        4210             :              order_wp2_wp3, &                                       ! Intent(in)
        4211             :              stats_metadata, &                                      ! Intent(in)
        4212             :              stats_zt, stats_zm, stats_sfc, &                       ! intent(inout)
        4213           0 :              sclrm(:,:,j), sclr_tol(j), wpsclrp(:,:,j) )            ! Intent(inout)
        4214             :
        4215           0 :       if ( clubb_at_least_debug_level( 0 ) ) then
        4216           0 :         if ( err_code == clubb_fatal_error ) then
        4217           0 :           write(fstderr,*) "sclrm # ", j, "monotonic flux limiter: tridiag failed"
        4218           0 :           return
        4219             :         end if
        4220             :       end if
        4221             :
        4222             :     end do ! passive scalars
        4223             :
        4224             :   end subroutine solve_xm_wpxp_with_multiple_lhs
        4225             :
        4226             :   !=============================================================================
        4227     8935056 :   subroutine xm_wpxp_solve( nz, ngrdcol, gr, nrhs, &
        4228     8935056 :                             old_solution, &
        4229             :                             penta_solve_method, &
        4230     8935056 :                             lhs, rhs, &
        4231     8935056 :                             solution, rcond )
        4232             :
        4233             :     ! Description:
        4234             :     !   Solve for xm / w'x' using the band diagonal solver.
        4235             :
        4236             :     ! References:
        4237             :     !   None
        4238             :     !------------------------------------------------------------------------
        4239             :
        4240             :     use grid_class, only: &
        4241             :         grid ! Type
        4242             :
        4243             :     use matrix_solver_wrapper, only:  &
        4244             :         band_solve ! Procedure(s)
        4245             :
        4246             :     use clubb_precision, only: &
        4247             :         core_rknd ! Variable(s)
        4248             :
        4249             :     use constants_clubb, only: &
        4250             :         fstderr     ! Constant(s)
        4251             :
        4252             :     use error_code, only: &
        4253             :         clubb_at_least_debug_level,     & ! Procedure
        4254             :         err_code,                       & ! Error indicator
        4255             :         clubb_no_error                    ! Constant
        4256             :
        4257             :     implicit none
        4258             :
        4259             :     integer, intent(in) :: &
        4260             :       nz, &
        4261             :       ngrdcol
        4262             :
        4263             :     type (grid), target, intent(in) :: gr
        4264             :
        4265             :     !------------------------- Input Variables -------------------------
        4266             :     integer, intent(in) :: &
        4267             :       nrhs ! Number of rhs vectors
        4268             :
        4269             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,2*nz,nrhs) ::  &
        4270             :       old_solution ! Old solution, used as an initial guess in the bicgstab method
        4271             :
        4272             :     integer, intent(in) :: &
        4273             :       penta_solve_method ! Method to solve then penta-diagonal system
        4274             :
        4275             :     !------------------------- Input/Output Variables -------------------------
        4276             :     real( kind = core_rknd ), intent(inout), dimension(nsup+nsub+1,ngrdcol,2*nz) :: &
        4277             :       lhs  ! Implicit contributions to wpxp/xm (band diag. matrix in LAPACK storage)
        4278             :
        4279             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,2*nz,nrhs) ::  &
        4280             :       rhs      ! Right-hand side of band diag. matrix. (LAPACK storage)
        4281             :
        4282             :     !------------------------- Output Variables -------------------------
        4283             :     real( kind = core_rknd ), intent(out), dimension(ngrdcol,2*nz,nrhs) ::  &
        4284             :       solution ! Solution to band diagonal system (LAPACK storage)
        4285             :
        4286             :     real( kind = core_rknd ), optional, dimension(ngrdcol), intent(out) :: &
        4287             :       rcond ! Est. of the reciprocal of the condition #
        4288             :
        4289             :     !------------------------- Begin Code -------------------------
        4290             :
        4291             :     ! Solve the system
        4292             :     call band_solve( "xm_wpxp", penta_solve_method,     & ! Intent(in)
        4293             :                       ngrdcol, nsup, nsub, 2*nz, nrhs,  & ! Intent(in)
        4294             :                       old_solution,                     & ! Intent(in)
        4295             :                       lhs, rhs,                         & ! Intent(inout)
        4296     8935056 :                       solution, rcond )                   ! Intent(out)
        4297             :
        4298     8935056 :     if ( clubb_at_least_debug_level( 0 ) ) then
        4299     8935056 :       if ( err_code /= clubb_no_error ) then
        4300           0 :         write(fstderr,*) "Error in xm_wpxp_solve"
        4301           0 :         return
        4302             :       end if
        4303             :     end if
        4304             :
        4305             :     return
        4306             :
        4307             :   end subroutine xm_wpxp_solve
        4308             :
        4309             : !===============================================================================
        4310    35740224 :   subroutine xm_wpxp_clipping_and_stats( &
        4311    35740224 :                nz, ngrdcol, gr, solve_type, dt, wp2, xp2, wm_zt, &
        4312    35740224 :                xm_forcing, rho_ds_zm, rho_ds_zt, &
        4313    35740224 :                invrs_rho_ds_zm, invrs_rho_ds_zt, &
        4314    35740224 :                xp2_threshold, xm_threshold, rcond, &
        4315    35740224 :                low_lev_effect, high_lev_effect, &
        4316    35740224 :                lhs_ma_zt, lhs_ma_zm, lhs_ta_wpxp, &
        4317    35740224 :                lhs_diff_zm, C7_Skw_fnc, &
        4318    35740224 :                lhs_tp, lhs_ta_xm, lhs_pr1, &
        4319    35740224 :                l_implemented, solution, &
        4320             :                tridiag_solve_method, &
        4321             :                l_predict_upwp_vpwp, &
        4322             :                l_upwind_xm_ma, &
        4323             :                l_tke_aniso, &
        4324             :                l_enable_relaxed_clipping, &
        4325             :                l_mono_flux_lim_thlm, &
        4326             :                l_mono_flux_lim_rtm, &
        4327             :                l_mono_flux_lim_um, &
        4328             :                l_mono_flux_lim_vm, &
        4329             :                l_mono_flux_lim_spikefix, &
        4330             :                order_xm_wpxp, order_xp2_xpyp, &
        4331             :                order_wp2_wp3, &
        4332             :                stats_metadata, &
        4333    35740224 :                stats_zt, stats_zm, stats_sfc, &
        4334    35740224 :                xm, xm_tol, wpxp )
        4335             :
        4336             :     ! Description:
        4337             :     ! Clips and computes implicit stats for an artitrary xm and wpxp
        4338             :     !
        4339             :     ! References:
        4340             :     !   None
        4341             :     !-----------------------------------------------------------------------
        4342             :
        4343             :     use grid_class, only: &
        4344             :         grid ! Type
        4345             :
        4346             :     use clubb_precision, only:  &
        4347             :         core_rknd ! Variable(s)
        4348             :
        4349             :     use mono_flux_limiter, only: &
        4350             :         monotonic_turbulent_flux_limit ! Procedure(s)
        4351             :
        4352             :     use pos_definite_module, only:  &
        4353             :         pos_definite_adj ! Procedure(s)
        4354             :
        4355             :     use clip_explicit, only: &
        4356             :         clip_covar,   & ! Procedure(s)
        4357             :         clip_wprtp,   & ! Variable(s)
        4358             :         clip_wpthlp,  &
        4359             :         clip_upwp,    &
        4360             :         clip_vpwp,    &
        4361             :         clip_wpsclrp
        4362             :
        4363             :     use model_flags, only: &
        4364             :         l_pos_def, &     ! Logical for whether to apply the positive definite scheme to rtm
        4365             :         l_hole_fill, &   ! Logical for whether to apply the hole filling scheme to thlm/rtm
        4366             :         l_clip_turb_adv  ! Logical for whether to clip xm when wpxp is clipped
        4367             :
        4368             :     use constants_clubb, only: &
        4369             :         fstderr, & ! Constant(s)
        4370             :         one, &
        4371             :         zero, &
        4372             :         eps, &
        4373             :         gamma_over_implicit_ts, &
        4374             :         num_hf_draw_points
        4375             :
        4376             :     use fill_holes, only: &
        4377             :         fill_holes_vertical ! Procedure
        4378             :
        4379             :     use error_code, only: &
        4380             :         clubb_at_least_debug_level  ! Procedure
        4381             :
        4382             :     use stats_type_utilities, only: &
        4383             :         stat_begin_update,  & ! Procedure(s)
        4384             :         stat_update_var_pt, &
        4385             :         stat_end_update_pt, &
        4386             :         stat_end_update,  &
        4387             :         stat_update_var, &
        4388             :         stat_modify
        4389             :
        4390             :     use stats_variables, only: &
        4391             :         stats_metadata_type
        4392             :
        4393             :     use stats_type, only: stats ! Type
        4394             :
        4395             :     implicit none
        4396             :
        4397             :     !--------------------------- Input Variables ---------------------------
        4398             :     integer, intent(in) :: &
        4399             :       nz, &
        4400             :       ngrdcol
        4401             :
        4402             :     type (grid), target, intent(in) :: gr
        4403             :
        4404             :     logical :: &
        4405             :       l_first_clip_ts, &
        4406             :       l_last_clip_ts
        4407             :
        4408             :     integer, intent(in) ::  &
        4409             :       solve_type  ! Variables being solved for.
        4410             :
        4411             :     real( kind = core_rknd ), intent(in) ::  &
        4412             :       dt  ! Timestep   [s]
        4413             :
        4414             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) ::  &
        4415             :       wp2,             & ! w'^2 (momentum levels)                   [m^2/s^2]
        4416             :       xp2,             & ! x'^2 (momentum levels)                   [{xm units}^2]
        4417             :       wm_zt,           & ! w wind component on thermodynamic levels [m/s]
        4418             :       xm_forcing,      & ! xm forcings (thermodynamic levels)       [units vary]
        4419             :       rho_ds_zm,       & ! Dry, static density on momentum levels   [kg/m^3]
        4420             :       rho_ds_zt,       & ! Dry, static density on thermo. levels    [kg/m^3]
        4421             :       invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg]
        4422             :       invrs_rho_ds_zt    ! Inv. dry, static density @ thermo. levs. [m^3/kg]
        4423             :
        4424             :     real( kind = core_rknd ), intent(in) :: &
        4425             :       xp2_threshold, & ! Minimum allowable value of x'^2   [units vary]
        4426             :       xm_threshold,  & ! Minimum allowable value of xm     [units vary]
        4427             :       xm_tol           ! Minimum allowable deviation of xm [units vary]
        4428             :
        4429             :     real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
        4430             :       rcond ! Reciprocal of the estimated condition number (from computing A^-1)
        4431             :
        4432             :     ! Variables used as part of the monotonic turbulent advection scheme.
        4433             :     ! Find the lowermost and uppermost grid levels that can have an effect
        4434             :     ! on the central thermodynamic level during the course of a time step,
        4435             :     ! due to the effects of turbulent advection only.
        4436             :     integer, dimension(ngrdcol,nz), intent(in) ::  &
        4437             :       low_lev_effect, & ! Index of the lowest level that has an effect.
        4438             :       high_lev_effect   ! Index of the highest level that has an effect.
        4439             :
        4440             :     real( kind = core_rknd ), dimension(ndiags3,ngrdcol,nz), intent(in) :: &
        4441             :       lhs_diff_zm,  & ! Diffusion term for w'x'
        4442             :       lhs_ma_zt,    & ! Mean advection contributions to lhs
        4443             :       lhs_ma_zm,    & ! Mean advection contributions to lhs
        4444             :       lhs_ta_wpxp     ! Turbulent advection contributions to lhs
        4445             :
        4446             :     real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(in) :: &
        4447             :       lhs_tp,     & ! Turbulent production terms of w'x'
        4448             :       lhs_ta_xm     ! Turbulent advection terms of xm
        4449             :
        4450             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        4451             :       lhs_pr1       ! Pressure term 1 for w'x'
        4452             :
        4453             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
        4454             :       C7_Skw_fnc
        4455             :
        4456             :     logical, intent(in) :: &
        4457             :       l_implemented   ! Flag for CLUBB being implemented in a larger model.
        4458             :
        4459             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,2*nz) :: &
        4460             :       solution ! The <t+1> value of xm and wpxp   [units vary]
        4461             :
        4462             :     integer, intent(in) :: &
        4463             :       tridiag_solve_method  ! Specifier for method to solve tridiagonal systems
        4464             :
        4465             :     logical, intent(in) :: &
        4466             :       l_predict_upwp_vpwp,       & ! Flag to predict <u'w'> and <v'w'> along
        4467             :                                    ! with <u> and <v> alongside the advancement
        4468             :                                    ! of <rt>, <w'rt'>, <thl>, <wpthlp>, <sclr>,
        4469             :                                    ! and <w'sclr'> in subroutine advance_xm_wpxp.
        4470             :                                    ! Otherwise, <u'w'> and <v'w'> are still
        4471             :                                    ! approximated by eddy diffusivity when <u>
        4472             :                                    ! and <v> are advanced in subroutine
        4473             :                                    ! advance_windm_edsclrm.
        4474             :       l_upwind_xm_ma,            & ! This flag determines whether we want to use
        4475             :                                    ! an upwind differencing approximation rather
        4476             :                                    ! than a centered differencing for turbulent
        4477             :                                    ! or mean advection terms. It affects rtm,
        4478             :                                    ! thlm, sclrm, um and vm.
        4479             :       l_tke_aniso,               & ! For anisotropic turbulent kinetic energy,
        4480             :                                    ! i.e. TKE = 1/2 (u'^2 + v'^2 + w'^2)
        4481             :       l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in
        4482             :                                    ! xm_wpxp_clipping_and_stats
        4483             :       l_mono_flux_lim_thlm,      & ! Flag to turn on monotonic flux limiter for thlm
        4484             :       l_mono_flux_lim_rtm,       & ! Flag to turn on monotonic flux limiter for rtm
        4485             :       l_mono_flux_lim_um,        & ! Flag to turn on monotonic flux limiter for um
        4486             :       l_mono_flux_lim_vm,        & ! Flag to turn on monotonic flux limiter for vm
        4487             :       l_mono_flux_lim_spikefix     ! Flag to implement monotonic flux limiter code that
        4488             :                                    ! eliminates spurious drying tendencies at model top
        4489             :
        4490             :     integer, intent(in) :: &
        4491             :       order_xm_wpxp, &
        4492             :       order_xp2_xpyp, &
        4493             :       order_wp2_wp3
        4494             :
        4495             :     type (stats_metadata_type), intent(in) :: &
        4496             :       stats_metadata
        4497             :
        4498             :     !--------------------------- Input/Output Variables ---------------------------
        4499             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) :: &
        4500             :       xm, &     ! The mean x field  [units vary]
        4501             :       wpxp      ! The flux of x     [units vary m/s]
        4502             :
        4503             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
        4504             :       stats_zt, &
        4505             :       stats_zm, &
        4506             :       stats_sfc
        4507             :
        4508             :     !--------------------------- Local Variables ---------------------------
        4509             :     integer :: &
        4510             :       solve_type_cl ! solve_type used for clipping statistics.
        4511             :
        4512             :     character(len=10) :: &
        4513             :       solve_type_str ! solve_type as a string for debug output purposes
        4514             :
        4515             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        4516    71480448 :       xm_old ! Old value of xm for positive definite scheme     [units vary]
        4517             :
        4518             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        4519    71480448 :       wpxp_pd, xm_pd ! Change in xm and wpxp due to the pos. def. scheme
        4520             :
        4521             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        4522    71480448 :       wpxp_chnge, &  ! Net change in w'x' due to clipping       [units vary]
        4523    71480448 :       xp2_relaxed    ! Value of x'^2 * clip_factor               [units vary]
        4524             :
        4525             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        4526    71480448 :       zero_vector, &
        4527    71480448 :       wpxp_ac, &
        4528    71480448 :       wpxp_pr2
        4529             :
        4530             :     ! Indices
        4531             :     integer :: &
        4532             :       k, i, km1, kp1, &
        4533             :       k_xm, k_wpxp
        4534             :
        4535             :     integer :: &
        4536             :       ixm_ta, &
        4537             :       ixm_ma, &
        4538             :       ixm_matrix_condt_num, &
        4539             :       ixm_pd, &
        4540             :       ixm_cl, &
        4541             :       iwpxp_ma, &
        4542             :       iwpxp_ta, &
        4543             :       iwpxp_tp, &
        4544             :       iwpxp_ac, &
        4545             :       iwpxp_pr1, &
        4546             :       iwpxp_pr2, &
        4547             :       iwpxp_dp1, &
        4548             :       iwpxp_pd, &
        4549             :       iwpxp_sicl
        4550             :
        4551             :     ! --------------------------- Begin code ---------------------------
        4552             :
        4553             :     !$acc enter data create( xm_old, wpxp_pd, xm_pd, wpxp_chnge, xp2_relaxed )
        4554             :
        4555    44675280 :     select case ( solve_type )
        4556             :
        4557             :     case ( xm_wpxp_rtm ) ! rtm/wprtp budget terms
        4558     8935056 :       ixm_ta     = stats_metadata%irtm_ta
        4559     8935056 :       ixm_ma     = stats_metadata%irtm_ma
        4560     8935056 :       ixm_pd     = stats_metadata%irtm_pd
        4561     8935056 :       ixm_cl     = stats_metadata%irtm_cl
        4562     8935056 :       iwpxp_ma   = stats_metadata%iwprtp_ma
        4563     8935056 :       iwpxp_ta   = stats_metadata%iwprtp_ta
        4564     8935056 :       iwpxp_tp   = stats_metadata%iwprtp_tp
        4565     8935056 :       iwpxp_ac   = stats_metadata%iwprtp_ac
        4566     8935056 :       iwpxp_pr1  = stats_metadata%iwprtp_pr1
        4567     8935056 :       iwpxp_pr2  = stats_metadata%iwprtp_pr2
        4568     8935056 :       iwpxp_dp1  = stats_metadata%iwprtp_dp1
        4569     8935056 :       iwpxp_pd   = stats_metadata%iwprtp_pd
        4570     8935056 :       iwpxp_sicl = stats_metadata%iwprtp_sicl
        4571             :
        4572             :       ! This is a diagnostic from inverting the matrix, not a budget
        4573     8935056 :       ixm_matrix_condt_num = stats_metadata%irtm_matrix_condt_num
        4574             :
        4575             :     case ( xm_wpxp_thlm ) ! thlm/wpthlp budget terms
        4576     8935056 :       ixm_ta     = stats_metadata%ithlm_ta
        4577     8935056 :       ixm_ma     = stats_metadata%ithlm_ma
        4578     8935056 :       ixm_pd     = 0
        4579     8935056 :       ixm_cl     = stats_metadata%ithlm_cl
        4580     8935056 :       iwpxp_ma   = stats_metadata%iwpthlp_ma
        4581     8935056 :       iwpxp_ta   = stats_metadata%iwpthlp_ta
        4582     8935056 :       iwpxp_tp   = stats_metadata%iwpthlp_tp
        4583     8935056 :       iwpxp_ac   = stats_metadata%iwpthlp_ac
        4584     8935056 :       iwpxp_pr1  = stats_metadata%iwpthlp_pr1
        4585     8935056 :       iwpxp_pr2  = stats_metadata%iwpthlp_pr2
        4586     8935056 :       iwpxp_dp1  = stats_metadata%iwpthlp_dp1
        4587     8935056 :       iwpxp_pd   = 0
        4588     8935056 :       iwpxp_sicl = stats_metadata%iwpthlp_sicl
        4589             :
        4590             :       ! This is a diagnostic from inverting the matrix, not a budget
        4591     8935056 :       ixm_matrix_condt_num = stats_metadata%ithlm_matrix_condt_num
        4592             :
        4593             :     case ( xm_wpxp_um ) ! um/upwp budget terms
        4594     8935056 :       ixm_ta     = stats_metadata%ium_ta
        4595     8935056 :       ixm_ma     = stats_metadata%ium_ma
        4596     8935056 :       ixm_pd     = 0
        4597     8935056 :       ixm_cl     = 0
        4598     8935056 :       iwpxp_ma   = stats_metadata%iupwp_ma
        4599     8935056 :       iwpxp_ta   = stats_metadata%iupwp_ta
        4600     8935056 :       iwpxp_tp   = stats_metadata%iupwp_tp
        4601     8935056 :       iwpxp_ac   = stats_metadata%iupwp_ac
        4602     8935056 :       iwpxp_pr1  = stats_metadata%iupwp_pr1
        4603     8935056 :       iwpxp_pr2  = stats_metadata%iupwp_pr2
        4604     8935056 :       iwpxp_dp1  = stats_metadata%iupwp_dp1
        4605     8935056 :       iwpxp_pd   = 0
        4606     8935056 :       iwpxp_sicl = 0
        4607             :
        4608             :       ! This is a diagnostic from inverting the matrix, not a budget
        4609     8935056 :       ixm_matrix_condt_num = 0
        4610             :
        4611             :     case ( xm_wpxp_vm ) ! vm/vpwp budget terms
        4612     8935056 :       ixm_ta     = stats_metadata%ivm_ta
        4613     8935056 :       ixm_ma     = stats_metadata%ivm_ma
        4614     8935056 :       ixm_pd     = 0
        4615     8935056 :       ixm_cl     = 0
        4616     8935056 :       iwpxp_ma   = stats_metadata%ivpwp_ma
        4617     8935056 :       iwpxp_ta   = stats_metadata%ivpwp_ta
        4618     8935056 :       iwpxp_tp   = stats_metadata%ivpwp_tp
        4619     8935056 :       iwpxp_ac   = stats_metadata%ivpwp_ac
        4620     8935056 :       iwpxp_pr1  = stats_metadata%ivpwp_pr1
        4621     8935056 :       iwpxp_pr2  = stats_metadata%ivpwp_pr2
        4622     8935056 :       iwpxp_dp1  = stats_metadata%ivpwp_dp1
        4623     8935056 :       iwpxp_pd   = 0
        4624     8935056 :       iwpxp_sicl = 0
        4625             :
        4626             :       ! This is a diagnostic from inverting the matrix, not a budget
        4627     8935056 :       ixm_matrix_condt_num = 0
        4628             :
        4629             :     case default  ! this includes the sclrm case
        4630           0 :       ixm_ta     = 0
        4631           0 :       ixm_ma     = 0
        4632           0 :       ixm_pd     = 0
        4633           0 :       ixm_cl     = 0
        4634           0 :       iwpxp_ma   = 0
        4635           0 :       iwpxp_ta   = 0
        4636           0 :       iwpxp_tp   = 0
        4637           0 :       iwpxp_ac   = 0
        4638           0 :       iwpxp_pr1  = 0
        4639           0 :       iwpxp_pr2  = 0
        4640           0 :       iwpxp_dp1  = 0
        4641           0 :       iwpxp_pd   = 0
        4642           0 :       iwpxp_sicl = 0
        4643             :
        4644    35740224 :       ixm_matrix_condt_num = 0
        4645             :
        4646             :     end select
        4647             :
        4648             :     ! Copy result into output arrays
        4649             :     !$acc parallel loop gang vector collapse(2) default(present)
        4650  3073659264 :     do k=1, nz
        4651 50761923264 :       do i = 1, ngrdcol
        4652             :
        4653 47688264000 :         k_xm   = 2 * k - 1
        4654 47688264000 :         k_wpxp = 2 * k
        4655             :
        4656 47688264000 :         xm_old(i,k) = xm(i,k)
        4657             :
        4658 47688264000 :         xm(i,k)   = solution(i,k_xm)
        4659 50726183040 :         wpxp(i,k) = solution(i,k_wpxp)
        4660             :
        4661             :       end do
        4662             :     end do ! k=1..nz
        4663             :     !$acc end parallel loop
        4664             :
        4665             :
        4666    35740224 :     if ( stats_metadata%l_stats_samp ) then
        4667             :
        4668             :       !$acc update host( wm_zt, rcond, &
        4669             :       !$acc              lhs_diff_zm, lhs_ma_zt, lhs_ma_zm, &
        4670             :       !$acc              lhs_ta_wpxp, lhs_tp, lhs_ta_xm, &
        4671             :       !$acc              lhs_pr1, C7_Skw_fnc, xm, wpxp )
        4672             :
        4673           0 :       zero_vector(:,:) = 0.0_core_rknd
        4674             :
        4675             :       ! Note:  To find the contribution of w'x' term ac,
        4676             :       !        substitute 0 for the C_7 skewness function input
        4677             :       !        to function wpxp_terms_ac_pr2_lhs.
        4678             :       call wpxp_terms_ac_pr2_lhs( nz, ngrdcol, zero_vector, & ! intent(in)
        4679             :                                   wm_zt, gr%invrs_dzm,      & ! intent(in)
        4680           0 :                                   wpxp_ac )                   ! intent(out)
        4681             :
        4682             :       ! Note:  To find the contribution of w'x' term pr2,
        4683             :       !        add 1 to the C_7 skewness function input
        4684             :       !        to function wpxp_terms_ac_pr2_lhs.
        4685             :       call wpxp_terms_ac_pr2_lhs( nz, ngrdcol, (one+C7_Skw_fnc), & ! intent(in)
        4686             :                                   wm_zt, gr%invrs_dzm,           & ! intent(in)
        4687           0 :                                   wpxp_pr2 )                       ! intent(out)
        4688             :
        4689           0 :       do i = 1, ngrdcol
        4690             :
        4691           0 :         if ( ixm_matrix_condt_num > 0 ) then
        4692             :           ! Est. of the condition number of the mean/flux LHS matrix
        4693           0 :           call stat_update_var_pt( ixm_matrix_condt_num, 1, one / rcond(i), & ! intent(in)
        4694           0 :                                    stats_sfc(i) )                             ! intent(inout)
        4695             :         end if
        4696             :
        4697             :         ! The xm loop runs between k = 2 and k = nz.  The value of xm at
        4698             :         ! level k = 1, which is below the model surface, is simply set equal to
        4699             :         ! the value of xm at level k = 2 after the solve has been completed.
        4700             :         ! Thus, the statistical code will run from levels 2 through nz.
        4701             :
        4702           0 :         do k = 2, nz
        4703             :
        4704           0 :           km1 = max( k-1, 1 )
        4705           0 :           kp1 = min( k+1, nz )
        4706             :
        4707             :           ! Finalize implicit contributions for xm
        4708             :
        4709             :           ! xm term ma is completely implicit; call stat_update_var_pt.
        4710           0 :           if ( .not. l_implemented ) then
        4711             :             call stat_update_var_pt( ixm_ma, k, & ! intent(in)
        4712           0 :                 (-lhs_ma_zt(3,i,k)) * xm(i,km1) &
        4713             :               + (-lhs_ma_zt(2,i,k)) * xm(i,k) &
        4714           0 :               + (-lhs_ma_zt(1,i,k)) * xm(i,kp1), & ! intent(in)
        4715           0 :                 stats_zt(i) ) ! intent(inout)
        4716             :           end if
        4717             :
        4718             :           ! xm term ta is completely implicit; call stat_update_var_pt.
        4719             :           call stat_update_var_pt( ixm_ta, k, & ! intent(in)
        4720           0 :               (-lhs_ta_xm(2,i,k)) * wpxp(i,km1) &
        4721             :             + (-lhs_ta_xm(1,i,k)) * wpxp(i,k), & ! intent(in)
        4722           0 :               stats_zt(i) ) ! intent(inout)
        4723             :
        4724             :         enddo ! xm loop: 2..nz
        4725             :
        4726             :         ! The wpxp loop runs between k = 2 and k = nz-1.  The value of wpxp
        4727             :         ! is set to specified values at both the lowest level, k = 1, and the
        4728             :         ! highest level, k = nz.  Thus, the statistical code will run from
        4729             :         ! levels 2 through nz-1.
        4730             :
        4731           0 :         do k = 2, nz-1
        4732             :
        4733           0 :           km1 = max( k-1, 1 )
        4734           0 :           kp1 = min( k+1, nz )
        4735             :
        4736             :           ! Finalize implicit contributions for wpxp
        4737             :
        4738             :           ! w'x' term ma is completely implicit; call stat_update_var_pt.
        4739             :           call stat_update_var_pt( iwpxp_ma, k, & ! intent(in)
        4740           0 :               (-lhs_ma_zm(3,i,k)) * wpxp(i,km1) &
        4741             :             + (-lhs_ma_zm(2,i,k)) * wpxp(i,k) &
        4742           0 :             + (-lhs_ma_zm(1,i,k)) * wpxp(i,kp1), & ! intent(in)
        4743           0 :               stats_zm(i) ) ! intent(inout)
        4744             :
        4745             :
        4746             :             call stat_end_update_pt( iwpxp_ta, k, & ! intent(in)
        4747           0 :                 (-gamma_over_implicit_ts*lhs_ta_wpxp(3,i,k)) * wpxp(i,km1) &
        4748             :               + (-gamma_over_implicit_ts*lhs_ta_wpxp(2,i,k)) * wpxp(i,k) &
        4749             :               + (-gamma_over_implicit_ts*lhs_ta_wpxp(1,i,k)) * wpxp(i,kp1), & ! intent(in)
        4750           0 :                 stats_zm(i) ) ! intent(inout)
        4751             :
        4752             :           ! w'x' term tp is completely implicit; call stat_update_var_pt.
        4753             :           call stat_update_var_pt( iwpxp_tp, k, & ! intent(in)
        4754           0 :               (-lhs_tp(2,i,k)) * xm(i,k) &
        4755             :             + (-lhs_tp(1,i,k)) * xm(i,kp1), & ! intent(in)
        4756           0 :               stats_zm(i) ) ! intent(inout)
        4757             :
        4758             :           ! w'x' term ac is completely implicit; call stat_update_var_pt.
        4759             :           call stat_update_var_pt( iwpxp_ac, k, & ! intent(in)
        4760           0 :                                    -wpxp_ac(i,k) * wpxp(i,k), & ! intent(in)
        4761           0 :                                    stats_zm(i) ) ! intent(inout)
        4762             :
        4763             :           ! w'x' term pr1 is normally completely implicit.  However, due to the
        4764             :           ! RHS contribution from the "over-implicit" weighted time step,
        4765             :           ! w'x' term pr1 has both implicit and explicit components;
        4766             :           ! call stat_end_update_pt.
        4767             :           ! Note:  An "over-implicit" weighted time step is applied to this term.
        4768             :           !        A weighting factor of greater than 1 may be used to make the
        4769             :           !        term more numerically stable (see note above for LHS turbulent
        4770             :           !        advection (ta) term).
        4771             :           call stat_end_update_pt( iwpxp_pr1, k, & ! intent(in)
        4772           0 :               (-gamma_over_implicit_ts*lhs_pr1(i,k)) * wpxp(i,k), & ! intent(in)
        4773           0 :               stats_zm(i) ) ! intent(inout)
        4774             :
        4775             :           call stat_update_var_pt( iwpxp_pr2, k, & ! intent(in)
        4776           0 :                                   -wpxp_pr2(i,k) * wpxp(i,k), & ! intent(in)
        4777           0 :                                    stats_zm(i) ) ! intent(inout)
        4778             :
        4779             :           ! w'x' term dp1 is completely implicit; call stat_update_var_pt.
        4780             :           call stat_update_var_pt( iwpxp_dp1, k, & ! intent(in)
        4781           0 :               (-lhs_diff_zm(3,i,k)) * wpxp(i,km1) &
        4782             :             + (-lhs_diff_zm(2,i,k)) * wpxp(i,k) &
        4783             :             + (-lhs_diff_zm(1,i,k)) * wpxp(i,kp1), & ! intent(in)
        4784           0 :               stats_zm(i) ) ! intent(inout)
        4785             :
        4786             :         end do ! wpxp loop: 2..nz-1
        4787             :
        4788             :       end do
        4789             :
        4790             :     end if ! stats_metadata%l_stats_samp
        4791             :
        4792             :
        4793             :     ! Apply a monotonic turbulent flux limiter to xm/w'x'.
        4794             :     if ( ( l_mono_flux_lim_thlm .and. solve_type == xm_wpxp_thlm ) .or. &
        4795             :          ( l_mono_flux_lim_rtm .and. solve_type == xm_wpxp_rtm ) .or. &
        4796    35740224 :          ( l_mono_flux_lim_um .and. solve_type == xm_wpxp_um ) .or. &
        4797             :          ( l_mono_flux_lim_vm .and. solve_type == xm_wpxp_vm ) ) then
        4798             :
        4799             :       call monotonic_turbulent_flux_limit( nz, ngrdcol, gr, solve_type, dt, xm_old, & ! intent(in)
        4800             :                                            xp2, wm_zt, xm_forcing, & ! intent(in)
        4801             :                                            rho_ds_zm, rho_ds_zt, & ! intent(in)
        4802             :                                            invrs_rho_ds_zm, invrs_rho_ds_zt, & ! intent(in)
        4803             :                                            xp2_threshold, xm_tol, l_implemented, & ! intent(in)
        4804             :                                            low_lev_effect, high_lev_effect, & ! intent(in)
        4805             :                                            tridiag_solve_method, & ! intent(in)
        4806             :                                            l_upwind_xm_ma, & ! intent(in)
        4807             :                                            l_mono_flux_lim_spikefix, & ! intent(in)
        4808             :                                            stats_metadata, & ! intent(in)
        4809             :                                            stats_zt, stats_zm, & ! intent(inout)
        4810    35740224 :                                            xm, wpxp ) ! intent(inout)
        4811             :
        4812             :     end if ! l_mono_flux_lim
        4813             :
        4814             :     ! Apply a flux limiting positive definite scheme if the solution
        4815             :     ! for the mean field is negative and we're determining total water
        4816             :     if ( solve_type == xm_wpxp_rtm .and. l_pos_def ) then
        4817             :
        4818             :       !$acc update host( xm, xm_old, wpxp )
        4819             :
        4820             :       ! If any xm values are negative and the values at the previous
        4821             :       ! timestep were all non-negative, then call pos_definite_adj
        4822             :       if ( any( xm(:,:) < zero ) .and. .not. any( xm_old(:,:) < zero ) ) then
        4823             :
        4824             :         call pos_definite_adj( nz, ngrdcol, gr, dt, "zt", & ! intent(in)
        4825             :                                xm, wpxp, xm_old,            & ! intent(inout)
        4826             :                                xm_pd, wpxp_pd )             ! intent(out)
        4827             :       end if
        4828             :
        4829             :       !$acc update device( xm, wpxp, xm_old )
        4830             :
        4831             :     else
        4832             :       ! For stats purposes
        4833    35740224 :       if ( stats_metadata%l_stats_samp ) then
        4834           0 :         xm_pd(:,:)   = zero
        4835           0 :         wpxp_pd(:,:) = zero
        4836             :       end if
        4837             :
        4838             :     end if ! l_pos_def and solve_type == "rtm" and rtm <n+1> less than 0
        4839             :
        4840    35740224 :     if ( stats_metadata%l_stats_samp ) then
        4841             :
        4842             :       !$acc update host( xm )
        4843             :
        4844           0 :       do i = 1, ngrdcol
        4845           0 :         call stat_update_var( iwpxp_pd, wpxp_pd(i,1:nz), & ! intent(in)
        4846           0 :                               stats_zm(i) )                ! intent(inout)
        4847             :
        4848           0 :         call stat_update_var( ixm_pd, xm_pd(i,1:nz), & ! intent(in)
        4849           0 :                               stats_zt(i) )            ! intent(inout)
        4850             :
        4851             :         ! Computed value before clipping
        4852           0 :         call stat_begin_update( nz, ixm_cl, xm(i,:) / dt, & ! Intent(in)
        4853           0 :                                 stats_zt(i) )                  ! Intent(inout)
        4854             :       end do
        4855             :     end if
        4856             :
        4857    35740224 :     if ( solve_type /= xm_wpxp_um .and. solve_type /= xm_wpxp_vm .and. l_hole_fill ) then
        4858             :
        4859    17870112 :       if ( clubb_at_least_debug_level( 3 ) ) then
        4860             :
        4861             :         !$acc update host( xm )
        4862             :
        4863           0 :         if ( any( xm < xm_threshold) ) then
        4864             :
        4865           0 :           select case ( solve_type )
        4866             :           case ( xm_wpxp_rtm )
        4867           0 :             solve_type_str = "rtm"
        4868             :           case ( xm_wpxp_thlm )
        4869           0 :             solve_type_str = "thlm"
        4870             :           case default
        4871           0 :             solve_type_str = "scalars"
        4872             :           end select
        4873             :
        4874           0 :           do i = 1, ngrdcol
        4875           0 :             do k = 1, nz
        4876           0 :               if ( xm(i,k) < xm_threshold ) then
        4877           0 :                 write(fstderr,*) solve_type_str//" < ", xm_threshold, &
        4878           0 :                   " in advance_xm_wpxp_module at k= ", k, "i=", i
        4879             :               end if
        4880             :             end do
        4881             :           end do
        4882             :
        4883             :         end if
        4884             :       end if
        4885             :
        4886             :       ! upper_hf_level = nz since we are filling the zt levels
        4887             :       call fill_holes_vertical( nz, ngrdcol, xm_threshold, nz,  & ! In
        4888             :                                 gr%dzt, rho_ds_zt,              & ! In
        4889    17870112 :                                 xm )                              ! InOut
        4890             :
        4891             :       ! Hole filling does not affect the below ground level, perform a blunt clipping
        4892             :       ! here on that level to prevent small values of xm(1)
        4893             :       !$acc parallel loop gang vector default(present)
        4894   298389312 :       do i = 1, ngrdcol
        4895 24142521312 :         if ( any( xm(i,:) < xm_threshold) ) then
        4896           0 :           xm(i,1) = max( xm(i,1), xm_tol )
        4897             :         end if
        4898             :       end do
        4899             :       !$acc end parallel loop
        4900             :
        4901             :     end if
        4902             :
        4903    35740224 :     if ( stats_metadata%l_stats_samp ) then
        4904             :       !$acc update host( xm )
        4905           0 :       do i = 1, ngrdcol
        4906           0 :         call stat_end_update( nz, ixm_cl, xm(i,:) / dt, & ! Intent(in)
        4907           0 :                               stats_zt(i) )                       ! Intent(inout)
        4908             :       end do
        4909             :     end if
        4910             :
        4911             :     ! Clipping for w'x'
        4912             :     ! Clipping w'x' at each vertical level, based on the
        4913             :     ! correlation of w and x at each vertical level, such that:
        4914             :     ! corr_(w,x) = w'x' / [ sqrt(w'^2) * sqrt(x'^2) ];
        4915             :     ! -1 <= corr_(w,x) <= 1.
        4916             :     ! Since w'^2, x'^2, and w'x' are updated in different places
        4917             :     ! from each other, clipping for w'x' has to be done three times
        4918             :     ! (three times each for w'r_t', w'th_l', and w'sclr').  This is
        4919             :     ! the second instance of w'x' clipping.
        4920             :
        4921             :     ! Compute a slightly larger value of rt'^2 for clipping purposes.  This was
        4922             :     ! added to prevent a situation in which both the variance and flux are small
        4923             :     ! and the simulation gets "stuck" at the rt_tol^2 value.
        4924             :     ! See ticket #389 on the CLUBB TRAC for further details.
        4925             :     ! -dschanen 10 Jan 2011
        4926    35740224 :     if ( l_enable_relaxed_clipping ) then
        4927           0 :       if ( solve_type == xm_wpxp_rtm ) then
        4928             :
        4929             :         !$acc parallel loop gang vector collapse(2) default(present)
        4930           0 :         do k = 1, nz
        4931           0 :           do i = 1, ngrdcol
        4932           0 :             xp2_relaxed(i,k) = max( 1e-7_core_rknd , xp2(i,k) )
        4933             :           end do
        4934             :         end do
        4935             :         !$acc end parallel loop
        4936             :
        4937           0 :       else if ( solve_type == xm_wpxp_thlm ) then
        4938             :
        4939             :         !$acc parallel loop gang vector collapse(2) default(present)
        4940           0 :         do k = 1, nz
        4941           0 :           do i = 1, ngrdcol
        4942           0 :             xp2_relaxed(i,k) = max( 0.01_core_rknd, xp2(i,k) )
        4943             :           end do
        4944             :         end do
        4945             :         !$acc end parallel loop
        4946             :
        4947             :       else ! This includes the passive scalars
        4948             :
        4949             :         !$acc parallel loop gang vector collapse(2) default(present)
        4950           0 :         do k = 1, nz
        4951           0 :           do i = 1, ngrdcol
        4952           0 :             xp2_relaxed(i,k) = max( 1e-7_core_rknd , xp2(i,k) )
        4953             :           end do
        4954             :         end do
        4955             :         !$acc end parallel loop
        4956             :
        4957             :       end if
        4958             :
        4959             :     else  ! Don't relax clipping
        4960             :
        4961             :       !$acc parallel loop gang vector collapse(2) default(present)
        4962  3073659264 :       do k = 1, nz
        4963 50761923264 :         do i = 1, ngrdcol
        4964 50726183040 :           xp2_relaxed(i,k) = xp2(i,k)
        4965             :         end do
        4966             :       end do
        4967             :       !$acc end parallel loop
        4968             :
        4969             :     end if
        4970             :
        4971    35740224 :     if ( order_xm_wpxp < order_wp2_wp3 .and. order_xm_wpxp < order_xp2_xpyp ) then
        4972    35740224 :        l_first_clip_ts = .true.
        4973    35740224 :        l_last_clip_ts = .false.
        4974           0 :     elseif ( order_xm_wpxp > order_wp2_wp3 .and. order_xm_wpxp > order_xp2_xpyp ) then
        4975           0 :        l_first_clip_ts = .false.
        4976           0 :        l_last_clip_ts = .true.
        4977             :     else
        4978           0 :        l_first_clip_ts = .false.
        4979           0 :        l_last_clip_ts = .false.
        4980             :     endif
        4981             :
        4982             :     ! Use solve_type to find solve_type_cl, which is used
        4983             :     ! in subroutine clip_covar.
        4984     8935056 :     select case ( solve_type )
        4985             :     case ( xm_wpxp_rtm )
        4986     8935056 :       solve_type_cl = clip_wprtp
        4987             :     case ( xm_wpxp_thlm )
        4988     8935056 :       solve_type_cl = clip_wpthlp
        4989             :     case ( xm_wpxp_um )
        4990     8935056 :       solve_type_cl = clip_upwp
        4991             :     case ( xm_wpxp_vm )
        4992     8935056 :       solve_type_cl = clip_vpwp
        4993             :     case default
        4994    35740224 :       solve_type_cl = clip_wpsclrp
        4995             :     end select
        4996             :
        4997    35740224 :     if ( solve_type /= xm_wpxp_um .and. solve_type /= xm_wpxp_vm ) then
        4998             :       call clip_covar( nz, ngrdcol, gr, solve_type_cl, l_first_clip_ts, & ! In
        4999             :                        l_last_clip_ts, dt, wp2, xp2_relaxed,            & ! In
        5000             :                        l_predict_upwp_vpwp,                             & ! In
        5001             :                        stats_metadata,                                  & ! In
        5002             :                        stats_zm,                                        & ! intent(inout)
        5003    17870112 :                        wpxp, wpxp_chnge )                                 ! In/Out
        5004             :     else ! clipping for upwp or vpwp
        5005             :
        5006    17870112 :       if ( l_tke_aniso ) then
        5007             :         call clip_covar( nz, ngrdcol, gr, solve_type_cl, l_first_clip_ts, & ! In
        5008             :                          l_last_clip_ts, dt, wp2, xp2,                    & ! In
        5009             :                          l_predict_upwp_vpwp,                             & ! In
        5010             :                          stats_metadata,                                  & ! In
        5011             :                          stats_zm,                                        & ! intent(inout)
        5012    17870112 :                          wpxp, wpxp_chnge )                                 ! In/Out
        5013             :       else
        5014             :         call clip_covar( nz, ngrdcol, gr, solve_type_cl, l_first_clip_ts, & ! In
        5015             :                          l_last_clip_ts, dt, wp2, wp2,                    & ! In
        5016             :                          l_predict_upwp_vpwp,                             & ! In
        5017             :                          stats_metadata,                                  & ! In
        5018             :                          stats_zm,                                        & ! intent(inout)
        5019           0 :                          wpxp, wpxp_chnge )                                 ! In/Out
        5020             :        end if ! l_tke_aniso
        5021             :     end if ! solve_type /= xm_wpxp_um .and. solve_type /= xm_wpxp_vm
        5022             :
        5023             :     ! Adjusting xm based on clipping for w'x'.
        5024             :     if ( l_clip_turb_adv ) then
        5025             :       call xm_correction_wpxp_cl( nz, ngrdcol, solve_type, dt,  & ! intent(in)
        5026             :                                   wpxp_chnge, gr%invrs_dzt,     & ! intent(in)
        5027             :                                   stats_metadata,               & ! intent(in)
        5028             :                                   stats_zt,                     & ! intent(inout)
        5029             :                                   xm )                            ! intent(inout)
        5030             :     end if
        5031             :
        5032             :     ! Lower boundary condition on xm
        5033             :     !!$acc parallel loop gang vector default(present)
        5034             :     !do i = 1, ngrdcol
        5035             :     !  xm(i,1) = xm(i,2)
        5036             :     !end do
        5037             :     !!$acc end parallel loop
        5038             :
        5039             :     !$acc exit data delete( xm_old, wpxp_pd, xm_pd, wpxp_chnge, xp2_relaxed )
        5040             :
        5041    35740224 :     return
        5042             :
        5043             :   end subroutine xm_wpxp_clipping_and_stats
        5044             :
        5045             :   !=============================================================================
        5046     8935056 :   subroutine xm_term_ta_lhs( nz, ngrdcol, gr, &
        5047     8935056 :                                   rho_ds_zm, invrs_rho_ds_zt, &
        5048     8935056 :                                   lhs_ta_xm )
        5049             :
        5050             :     ! Description:
        5051             :     ! Turbulent advection of xm:  implicit portion of the code.
        5052             :     !
        5053             :     ! The d(xm)/dt equation contains a turbulent advection term:
        5054             :     !
        5055             :     ! - (1/rho_ds) * d( rho_ds * w'x' )/dz.
        5056             :     !
        5057             :     ! This term is solved for completely implicitly, such that:
        5058             :     !
        5059             :     ! - (1/rho_ds) * d( rho_ds * w'x'(t+1) )/dz.
        5060             :     !
        5061             :     ! Note:  When the term is brought over to the left-hand side, the sign
        5062             :     !        is reversed and the leading "-" in front of the term is changed
        5063             :     !        to a "+".
        5064             :     !
        5065             :     ! The timestep index (t+1) means that the value of w'x' being used is from
        5066             :     ! the next timestep, which is being advanced to in solving the d(xm)/dt and
        5067             :     ! d(w'x')/dt equations.
        5068             :     !
        5069             :     ! This term is discretized as follows:
        5070             :     !
        5071             :     ! While the values of xm are found on the thermodynamic levels, the values
        5072             :     ! of w'x' are found on the momentum levels.  Additionally, the values of
        5073             :     ! rho_ds_zm are found on the momentum levels, and the values of
        5074             :     ! invrs_rho_ds_zt are found on the thermodynamic levels.  On the momentum
        5075             :     ! levels, the values of rho_ds_zm are multiplied by the values of w'x'.  The
        5076             :     ! derivative of (rho_ds_zm * w'x') is taken over the intermediate (central)
        5077             :     ! thermodynamic level, where it is multiplied by invrs_rho_ds_zt, yielding
        5078             :     ! the desired results.
        5079             :     !
        5080             :     ! =====rho_ds_zm=====wpxp================================== m(k)
        5081             :     !
        5082             :     ! ------invrs_rho_ds_zt--------d(rho_ds*wpxp)/dz----------- t(k)
        5083             :     !
        5084             :     ! =====rho_ds_zm=====wpxp================================== m(k-1)
        5085             :     !
        5086             :     ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes
        5087             :     ! zm(k), zt(k), and zm(k-1), respectively.  The letter "t" is used for
        5088             :     ! thermodynamic levels and the letter "m" is used for momentum levels.
        5089             :     !
        5090             :     ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) )
        5091             :
        5092             :     ! References:
        5093             :     !-----------------------------------------------------------------------
        5094             :
        5095             :     use grid_class, only:  &
        5096             :         grid ! Type
        5097             :
        5098             :     use constants_clubb, only: &
        5099             :         zero    ! Constant(s)
        5100             :
        5101             :     use clubb_precision, only: &
        5102             :         core_rknd    ! Variable(s)
        5103             :
        5104             :     implicit none
        5105             :
        5106             :     integer, intent(in) :: &
        5107             :       nz, &
        5108             :       ngrdcol
        5109             :
        5110             :     type (grid), target, intent(in) :: gr
        5111             :
        5112             :     ! Constant parameters
        5113             :     integer, parameter :: &
        5114             :       k_mdiag   = 1,    & ! Momentum superdiagonal index.
        5115             :       km1_mdiag = 2       ! Momentum subdiagonal index.
        5116             :
        5117             :     ! Input Variables
        5118             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        5119             :       rho_ds_zm,       & ! Dry, static density at momentum levels     [kg/m^3]
        5120             :       invrs_rho_ds_zt    ! Inverse dry, static density at thermo levs [m^3/kg]
        5121             :
        5122             :     ! Return Variable
        5123             :     real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(out) :: &
        5124             :       lhs_ta_xm    ! LHS coefficient of xm turbulent advection  [1/m]
        5125             :
        5126             :     ! Local Variable
        5127             :     integer :: i, k    ! Vertical level index
        5128             :
        5129             :     ! Set lower boundary condition to 0
        5130             :     !$acc parallel loop gang vector default(present)
        5131   149194656 :     do i = 1, ngrdcol
        5132   140259600 :       lhs_ta_xm(k_mdiag,i,1)   = zero
        5133   149194656 :       lhs_ta_xm(km1_mdiag,i,1) = zero
        5134             :     end do
        5135             :     !$acc end parallel loop
        5136             :
        5137             :     ! Calculate term at all other grid levels.
        5138             :     !$acc parallel loop gang vector collapse(2) default(present)
        5139   759479760 :     do k = 2, nz
        5140 12541286160 :       do i = 1, ngrdcol
        5141             :
        5142             :         ! Momentum superdiagonal [ x wpxp(k,<t+1>) ]
        5143 23563612800 :         lhs_ta_xm(k_mdiag,i,k) = + invrs_rho_ds_zt(i,k) &
        5144 35345419200 :                                    * gr%invrs_dzt(i,k) * rho_ds_zm(i,k)
        5145             :
        5146             :         ! Momentum subdiagonal [ x wpxp(k-1,<t+1>) ]
        5147             :         lhs_ta_xm(km1_mdiag,i,k) = - invrs_rho_ds_zt(i,k) &
        5148 12532351104 :                                      * gr%invrs_dzt(i,k) * rho_ds_zm(i,k-1)
        5149             :       end do
        5150             :     end do ! k = 2, nz
        5151             :     !$acc end parallel loop
        5152             :
        5153     8935056 :     return
        5154             :
        5155             :   end subroutine xm_term_ta_lhs
        5156             :
        5157             :   !=============================================================================
        5158     8935056 :   subroutine wpxp_term_tp_lhs( nz, ngrdcol, gr, wp2, &
        5159     8935056 :                                     lhs_tp )
        5160             :
        5161             :     ! Description:
        5162             :     ! Turbulent production of w'x':  implicit portion of the code.
        5163             :     !
        5164             :     ! The d(w'x')/dt equation contains a turbulent production term:
        5165             :     !
        5166             :     ! - w'^2 d(xm)/dz.
        5167             :     !
        5168             :     ! This term is solved for completely implicitly, such that:
        5169             :     !
        5170             :     ! - w'^2 * d( xm(t+1) )/dz.
        5171             :     !
        5172             :     ! Note:  When the term is brought over to the left-hand side, the sign
        5173             :     !        is reversed and the leading "-" in front of the term is changed
        5174             :     !        to a "+".
        5175             :     !
        5176             :     ! The timestep index (t+1) means that the value of xm being used is from the
        5177             :     ! next timestep, which is being advanced to in solving the d(w'x')/dt and
        5178             :     ! d(xm)/dt equations.
        5179             :     !
        5180             :     ! This term is discretized as follows:
        5181             :     !
        5182             :     ! The values of xm are found on thermodynamic levels, while the values of
        5183             :     ! w'^2 are found on momentum levels.  The derivative of xm is taken over the
        5184             :     ! intermediate (central) momentum level, where it is multiplied by w'^2,
        5185             :     ! yielding the desired result.
        5186             :     !
        5187             :     ! ---------------------------xm---------------------------- t(k+1)
        5188             :     !
        5189             :     ! ==========wp2=====================d(xm)/dz=============== m(k)
        5190             :     !
        5191             :     ! ---------------------------xm---------------------------- t(k)
        5192             :     !
        5193             :     ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes
        5194             :     ! zt(k+1), zm(k), and zt(k), respectively.  The letter "t" is used for
        5195             :     ! thermodynamic levels and the letter "m" is used for momentum levels.
        5196             :     !
        5197             :     ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) )
        5198             :
        5199             :     ! References:
        5200             :     !-----------------------------------------------------------------------
        5201             :
        5202             :     use grid_class, only:  &
        5203             :         grid ! Type
        5204             :
        5205             :     use constants_clubb, only: &
        5206             :         zero    ! Constant(s)
        5207             :
        5208             :     use clubb_precision, only: &
        5209             :         core_rknd ! Variable(s)
        5210             :
        5211             :     implicit none
        5212             :
        5213             :     integer, intent(in) :: &
        5214             :       nz, &
        5215             :       ngrdcol
        5216             :
        5217             :     type (grid), target, intent(in) :: gr
        5218             :
        5219             :     ! Constant parameters
        5220             :     integer, parameter :: &
        5221             :       kp1_tdiag = 1,    & ! Thermodynamic superdiagonal index.
        5222             :       k_tdiag = 2         ! Thermodynamic subdiagonal index.
        5223             :
        5224             :     ! Input Variables
        5225             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        5226             :       wp2  ! w'^2                       [m^2/s^2]
        5227             :
        5228             :     ! Return Variable
        5229             :     real( kind = core_rknd ), dimension(ndiags2,ngrdcol,nz), intent(out) :: &
        5230             :       lhs_tp    ! LHS coefficient of xm for turbulent production  [1/s]
        5231             :
        5232             :     ! Local Variable
        5233             :     integer :: i, k  ! Vertical level index
        5234             :
        5235             :     ! Set lower boundary to 0
        5236             :     !$acc parallel loop gang vector default(present)
        5237   149194656 :     do i = 1, ngrdcol
        5238   140259600 :       lhs_tp(1,i,1) = zero
        5239   149194656 :       lhs_tp(2,i,1) = zero
        5240             :     end do
        5241             :     !$acc end parallel loop
        5242             :
        5243             :     ! Calculate term at all interior grid levels.
        5244             :     !$acc parallel loop gang vector collapse(2) default(present)
        5245   750544704 :     do k = 2, nz-1
        5246 12392091504 :       do i = 1, ngrdcol
        5247             :
        5248             :        ! Thermodynamic superdiagonal [ x xm(k+1,<t+1>) ]
        5249 11641546800 :        lhs_tp(kp1_tdiag,i,k) = + wp2(i,k) * gr%invrs_dzm(i,k)
        5250             :
        5251             :        ! Thermodynamic subdiagonal [ x xm(k,<t+1>) ]
        5252 12383156448 :        lhs_tp(k_tdiag,i,k)   = - wp2(i,k) * gr%invrs_dzm(i,k)
        5253             :
        5254             :       end do
        5255             :     end do ! k = 2, nz-1
        5256             :     !$acc end parallel loop
        5257             :
        5258             :     ! Set upper boundary to 0
        5259             :     !$acc parallel loop gang vector default(present)
        5260   149194656 :     do i = 1, ngrdcol
        5261   140259600 :       lhs_tp(1,i,nz) = 0.0_core_rknd
        5262   149194656 :       lhs_tp(2,i,nz) = 0.0_core_rknd
        5263             :     end do
        5264             :     !$acc end parallel loop
        5265             :
        5266     8935056 :     return
        5267             :
        5268             :   end subroutine wpxp_term_tp_lhs
        5269             :
        5270             :   !=============================================================================
        5271     8935056 :   subroutine wpxp_terms_ac_pr2_lhs( nz, ngrdcol, C7_Skw_fnc, &
        5272     8935056 :                                          wm_zt, invrs_dzm, &
        5273     8935056 :                                          lhs_ac_pr2  )
        5274             :
        5275             :     ! Description:
        5276             :     ! Accumulation of w'x' and w'x' pressure term 2:  implicit portion of the
        5277             :     ! code.
        5278             :     !
        5279             :     ! The d(w'x')/dt equation contains an accumulation term:
        5280             :     !
        5281             :     ! - w'x' dw/dz;
        5282             :     !
        5283             :     ! and pressure term 2:
        5284             :     !
        5285             :     ! + C_7 w'x' dw/dz.
        5286             :     !
        5287             :     ! Both the w'x' accumulation term and pressure term 2 are completely
        5288             :     ! implicit.  The accumulation term and pressure term 2 are combined and
        5289             :     ! solved together as:
        5290             :     !
        5291             :     ! - ( 1 - C_7 ) * w'x'(t+1) * dw/dz.
        5292             :     !
        5293             :     ! Note:  When the term is brought over to the left-hand side, the sign
        5294             :     !        is reversed and the leading "-" in front of the term is changed
        5295             :     !        to a "+".
        5296             :     !
        5297             :     ! The timestep index (t+1) means that the value of w'x' being used is from
        5298             :     ! the next timestep, which is being advanced to in solving the d(w'x')/dt
        5299             :     ! equation.
        5300             :     !
        5301             :     ! The terms are discretized as follows:
        5302             :     !
        5303             :     ! The values of w'x' are found on momentum levels, while the values of wm_zt
        5304             :     ! (mean vertical velocity on thermodynamic levels) are found on
        5305             :     ! thermodynamic levels.  The vertical derivative of wm_zt is taken over the
        5306             :     ! intermediate (central) momentum level.  It is then multiplied by w'x'
        5307             :     ! (implicitly calculated at timestep (t+1)) and the coefficients to yield
        5308             :     ! the desired results.
        5309             :     !
        5310             :     ! -------wm_zt--------------------------------------------- t(k+1)
        5311             :     !
        5312             :     ! ===============d(wm_zt)/dz============wpxp=============== m(k)
        5313             :     !
        5314             :     ! -------wm_zt--------------------------------------------- t(k)
        5315             :     !
        5316             :     ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes
        5317             :     ! zt(k+1), zm(k), and zt(k), respectively.  The letter "t" is used for
        5318             :     ! thermodynamic levels and the letter "m" is used for momentum levels.
        5319             :     !
        5320             :     ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) )
        5321             :
        5322             :     ! References:
        5323             :     !-----------------------------------------------------------------------
        5324             :
        5325             :     use constants_clubb, only: &
        5326             :         one,  & ! Constant(s)
        5327             :         zero
        5328             :
        5329             :     use clubb_precision, only: &
        5330             :         core_rknd ! Variable(s)
        5331             :
        5332             :     implicit none
        5333             :
        5334             :     ! Input Variables
        5335             :     integer, intent(in) :: &
        5336             :       nz, &
        5337             :       ngrdcol
        5338             :
        5339             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        5340             :       C7_Skw_fnc,  & ! C_7 parameter with Sk_w applied              [-]
        5341             :       wm_zt,       & ! w wind component on thermodynamic levels     [m/s]
        5342             :       invrs_dzm      ! Inverse of grid spacing                      [1/m]
        5343             :
        5344             :     ! Return Variable
        5345             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
        5346             :       lhs_ac_pr2    ! LHS coefficient of accumulation and pressure term 2 [1/s]
        5347             :
        5348             :     ! Local Variable
        5349             :     integer :: i, k    ! Vertical level index
        5350             :
        5351             :     !$acc data copyin( C7_Skw_fnc, wm_zt, invrs_dzm ) &
        5352             :     !$acc     copyout( lhs_ac_pr2 )
        5353             :
        5354             :     ! Set lower boundary to 0
        5355             :     !$acc parallel loop gang vector default(present)
        5356   149194656 :     do i = 1, ngrdcol
        5357   149194656 :       lhs_ac_pr2(i,1) = zero
        5358             :     end do
        5359             :     !$acc end parallel loop
        5360             :
        5361             :     ! Calculate term at all interior grid levels.
        5362             :     !$acc parallel loop gang vector collapse(2) default(present)
        5363   750544704 :     do k = 2, nz-1
        5364 12392091504 :       do i = 1, ngrdcol
        5365             :         ! Momentum main diagonal: [ x wpxp(k,<t+1>) ]
        5366 23283093600 :         lhs_ac_pr2(i,k) = ( one - C7_Skw_fnc(i,k) ) &
        5367 35666250048 :                           * invrs_dzm(i,k) * ( wm_zt(i,k+1) - wm_zt(i,k) )
        5368             :       end do
        5369             :     end do ! k = 2, gr%nz-1
        5370             :     !$acc end parallel loop
        5371             :
        5372             :     ! Set upper boundary to 0
        5373             :     !$acc parallel loop gang vector default(present)
        5374   149194656 :     do i = 1, ngrdcol
        5375   149194656 :       lhs_ac_pr2(i,nz) = zero
        5376             :     end do
        5377             :     !$acc end parallel loop
        5378             :
        5379             :     !$acc end data
        5380             :
        5381     8935056 :     return
        5382             :
        5383             :   end subroutine wpxp_terms_ac_pr2_lhs
        5384             :
        5385             :   !=============================================================================
        5386     8935056 :   subroutine wpxp_term_pr1_lhs( nz, ngrdcol, C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc, &
        5387     8935056 :                                      invrs_tau_C6_zm, l_scalar_calc, &
        5388     8935056 :                                      lhs_pr1_wprtp, lhs_pr1_wpthlp, &
        5389     8935056 :                                      lhs_pr1_wpsclrp )
        5390             :
        5391             :     ! Description
        5392             :     ! Pressure term 1 for w'x':  implicit portion of the code.
        5393             :     !
        5394             :     ! The d(w'x')/dt equation contains pressure term 1:
        5395             :     !
        5396             :     ! - ( C_6 / tau_m ) w'x'.
        5397             :     !
        5398             :     ! This term is solved for completely implicitly, such that:
        5399             :     !
        5400             :     ! - ( C_6 / tau_m ) w'x'(t+1)
        5401             :     !
        5402             :     ! Note:  When the term is brought over to the left-hand side, the sign
        5403             :     !        is reversed and the leading "-" in front of the term is changed
        5404             :     !        to a "+".
        5405             :     !
        5406             :     ! The timestep index (t+1) means that the value of w'x' being used is from
        5407             :     ! the next timestep, which is being advanced to in solving the d(w'x')/dt
        5408             :     ! equation.
        5409             :     !
        5410             :     ! The values of w'x' are found on the momentum levels.  The values of the
        5411             :     ! C_6 skewness function and time-scale tau_m are also found on the momentum
        5412             :     ! levels.
        5413             :     !
        5414             :     !-----------------------------------------------------------------------
        5415             :
        5416             :     use grid_class, only:  &
        5417             :         grid ! Type
        5418             :
        5419             :     use constants_clubb, only: &
        5420             :         zero  ! Constant(s)
        5421             :
        5422             :     use clubb_precision, only: &
        5423             :         core_rknd    ! Variable(s)
        5424             :
        5425             :     implicit none
        5426             :
        5427             :     integer, intent(in) :: &
        5428             :       nz, &
        5429             :       ngrdcol
        5430             :
        5431             :     !--------------------------- Input Variables ---------------------------
        5432             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        5433             :       C6rt_Skw_fnc,  & ! C_6rt parameter with Sk_w applied        [-]
        5434             :       C6thl_Skw_fnc, & ! C_6thl parameter with Sk_w applied       [-]
        5435             :       C7_Skw_fnc,    & ! C_7 parameter with Sk_w applied          [-]
        5436             :       invrs_tau_C6_zm  ! Inverse time-scale tau at momentum levels   [1/s]
        5437             :
        5438             :     logical, intent(in) :: &
        5439             :       l_scalar_calc   ! True if sclr_dim > 0
        5440             :
        5441             :     !--------------------------- Output Variables ---------------------------
        5442             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
        5443             :       lhs_pr1_wprtp,   & ! LHS coefficient for w'r_t' pressure term 1   [1/s]
        5444             :       lhs_pr1_wpthlp,  & ! LHS coefficient for w'thl' pressure term 1   [1/s]
        5445             :       lhs_pr1_wpsclrp    ! LHS coefficient for w'sclr' pressure term 1  [1/s]
        5446             :
        5447             :     !--------------------------- Local Variables ---------------------------
        5448             :     integer :: i, k
        5449             :
        5450             :     !--------------------------- Begin Code ---------------------------
        5451             :
        5452             :     !$acc parallel loop gang vector collapse(2) default(present)
        5453   750544704 :     do k = 2, nz-1
        5454 12392091504 :       do i = 1, ngrdcol
        5455             :
        5456             :         ! Momentum main diagonals: [ x wpxp(k,<t+1>) ]
        5457 11641546800 :         lhs_pr1_wprtp(i,k) = C6rt_Skw_fnc(i,k) * invrs_tau_C6_zm(i,k)
        5458             :
        5459             :         ! Momentum main diagonals: [ x wpxp(k,<t+1>) ]
        5460 12383156448 :         lhs_pr1_wpthlp(i,k) = C6thl_Skw_fnc(i,k) * invrs_tau_C6_zm(i,k)
        5461             :
        5462             :       end do
        5463             :     end do
        5464             :     !$acc end parallel loop
        5465             :
        5466             :     !$acc parallel loop gang vector default(present)
        5467   149194656 :     do i = 1, ngrdcol
        5468             :
        5469             :       ! Set lower boundary to 0
        5470   140259600 :       lhs_pr1_wprtp(i,1) = zero
        5471             :
        5472             :       ! Set upper boundary to 0
        5473   140259600 :       lhs_pr1_wprtp(i,nz) = zero
        5474             :
        5475             :       ! Set lower boundary to 0
        5476   140259600 :       lhs_pr1_wpthlp(i,1) = zero
        5477             :
        5478             :       ! Set upper boundary to 0
        5479   149194656 :       lhs_pr1_wpthlp(i,nz) = zero
        5480             :
        5481             :     end do
        5482             :     !$acc end parallel loop
        5483             :
        5484     8935056 :     if ( l_scalar_calc ) then
        5485             :
        5486             :       !$acc parallel loop gang vector collapse(2) default(present)
        5487           0 :       do k = 2, nz-1
        5488           0 :         do i = 1, ngrdcol
        5489             :
        5490             :           ! Momentum main diagonals: [ x wpxp(k,<t+1>) ]
        5491           0 :           lhs_pr1_wpsclrp(i,k) = C7_Skw_fnc(i,k) * invrs_tau_C6_zm(i,k)
        5492             :
        5493             :         end do
        5494             :       end do
        5495             :       !$acc end parallel loop
        5496             :
        5497             :       !$acc parallel loop gang vector default(present)
        5498           0 :       do i = 1, ngrdcol
        5499             :
        5500             :         ! Set lower boundary to 0
        5501           0 :         lhs_pr1_wpsclrp(i,1) = zero
        5502             :
        5503             :         ! Set upper boundary to 0
        5504           0 :         lhs_pr1_wpsclrp(i,nz) = zero
        5505             :
        5506             :       end do
        5507             :       !$acc end parallel loop
        5508             :
        5509             :     endif ! l_scalar_calc
        5510             :
        5511     8935056 :     return
        5512             :
        5513             :   end subroutine wpxp_term_pr1_lhs
        5514             :
        5515             :   !=============================================================================
        5516    35740224 :   subroutine wpxp_terms_bp_pr3_rhs( nz, ngrdcol, C7_Skw_fnc, thv_ds_zm, xpthvp, &
        5517    35740224 :                                          rhs_bp_pr3 )
        5518             :
        5519             :     ! Description:
        5520             :     ! Buoyancy production of w'x' and w'x' pressure term 3:  explicit portion of
        5521             :     ! the code.
        5522             :     !
        5523             :     ! The d(w'x')/dt equation contains a buoyancy production term:
        5524             :     !
        5525             :     ! + (g/thv_ds) x'th_v';
        5526             :     !
        5527             :     ! and pressure term 3:
        5528             :     !
        5529             :     ! - C_7 (g/thv_ds) x'th_v'.
        5530             :     !
        5531             :     ! Both the w'x' buoyancy production term and pressure term 3 are completely
        5532             :     ! explicit.  The buoyancy production term and pressure term 3 are combined
        5533             :     ! and solved together as:
        5534             :     !
        5535             :     ! + ( 1 - C_7 ) * (g/thv_ds) * x'th_v'.
        5536             :
        5537             :     ! References:
        5538             :     !-----------------------------------------------------------------------
        5539             :
        5540             :     use constants_clubb, only: & ! Constants(s)
        5541             :         grav, & ! Gravitational acceleration [m/s^2]
        5542             :         one,  &
        5543             :         zero
        5544             :
        5545             :     use clubb_precision, only: &
        5546             :         core_rknd ! Variable(s)
        5547             :
        5548             :     implicit none
        5549             :
        5550             :     integer, intent(in) :: &
        5551             :       nz, &
        5552             :       ngrdcol
        5553             :
        5554             :     !---------------------------- Input Variables ----------------------------
        5555             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        5556             :       C7_Skw_fnc,  & ! C_7 parameter with Sk_w applied       [-]
        5557             :       thv_ds_zm,   & ! Dry, base-state theta_v on mom. levs. [K]
        5558             :       xpthvp         ! x'th_v'                               [K {xm units}]
        5559             :
        5560             :     !---------------------------- Output Variables ----------------------------
        5561             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
        5562             :       rhs_bp_pr3    ! RHS portion of bouyancy prod and pressure term 3
        5563             :
        5564             :     !---------------------------- Local Variables ----------------------------
        5565             :     integer :: i, k    ! Vertical level index
        5566             :
        5567             :     !---------------------------- Begin Code ----------------------------
        5568             :
        5569             :     !$acc data copyin( C7_Skw_fnc, thv_ds_zm, xpthvp ) &
        5570             :     !$acc     copyout( rhs_bp_pr3 )
        5571             :
        5572             :     ! Set lower boundary to 0
        5573             :     !$acc parallel loop gang vector default(present)
        5574   596778624 :     do i = 1, ngrdcol
        5575   596778624 :       rhs_bp_pr3(i,1) = zero
        5576             :     end do
        5577             :
        5578             :     ! Calculate term at all interior grid levels.
        5579             :     !$acc parallel loop gang vector collapse(2) default(present)
        5580  3002178816 :     do k = 2, nz-1
        5581 49568366016 :       do i = 1, ngrdcol
        5582 49532625792 :         rhs_bp_pr3(i,k) = ( grav / thv_ds_zm(i,k) ) * ( one - C7_Skw_fnc(i,k) ) * xpthvp(i,k)
        5583             :       end do
        5584             :     end do ! k = 2, nz-1
        5585             :
        5586             :     ! Set upper boundary to 0
        5587             :     !$acc parallel loop gang vector default(present)
        5588   596778624 :     do i = 1, ngrdcol
        5589   596778624 :       rhs_bp_pr3(i,nz) = zero
        5590             :     end do
        5591             :
        5592             :     !$acc end data
        5593             :
        5594    35740224 :     return
        5595             :
        5596             :   end subroutine wpxp_terms_bp_pr3_rhs
        5597             :
        5598             :   !=============================================================================
        5599             :   subroutine xm_correction_wpxp_cl( nz, ngrdcol, solve_type, dt, &
        5600             :                                     wpxp_chnge, invrs_dzt, &
        5601             :                                     stats_metadata, &
        5602             :                                     stats_zt, &
        5603             :                                     xm )
        5604             :
        5605             :     ! Description:
        5606             :     ! Corrects the value of xm if w'x' needed to be clipped, for xm is partially
        5607             :     ! based on the derivative of w'x' with respect to altitude.
        5608             :     !
        5609             :     ! The time-tendency equation for xm is:
        5610             :     !
        5611             :     ! d(xm)/dt = -w d(xm)/dz - d(w'x')/dz + d(xm)/dt|_ls;
        5612             :     !
        5613             :     ! where d(xm)/dt|_ls is the rate of change of xm over time due to radiation,
        5614             :     ! microphysics, and/or any other large-scale forcing(s).
        5615             :     !
        5616             :     ! The time-tendency equation for xm is solved in conjunction with the
        5617             :     ! time-tendency equation for w'x'.  Both equations are solved together in a
        5618             :     ! semi-implicit manner.  However, after both equations have been solved (and
        5619             :     ! thus both xm and w'x' have been advanced to the next timestep with
        5620             :     ! timestep index {t+1}), the value of covariance w'x' may be clipped at any
        5621             :     ! level in order to prevent the correlation of w and x from becoming greater
        5622             :     ! than 1 or less than -1.
        5623             :     !
        5624             :     ! The correlation between w and x is:
        5625             :     !
        5626             :     ! corr_(w,x) = w'x' / [ sqrt(w'^2) * sqrt(x'^2) ].
        5627             :     !
        5628             :     ! The correlation must always have a value between -1 and 1, such that:
        5629             :     !
        5630             :     ! -1 <= corr_(w,x) <= 1.
        5631             :     !
        5632             :     ! Therefore, there is an upper limit on w'x', such that:
        5633             :     !
        5634             :     ! w'x' <=  [ sqrt(w'^2) * sqrt(x'^2) ];
        5635             :     !
        5636             :     ! and a lower limit on w'x', such that:
        5637             :     !
        5638             :     ! w'x' >= -[ sqrt(w'^2) * sqrt(x'^2) ].
        5639             :     !
        5640             :     ! The aforementioned time-tendency equation for xm is based on the value of
        5641             :     ! w'x' without being clipped (w'x'{t+1}_unclipped), such that:
        5642             :     !
        5643             :     ! d(xm)/dt = -w d(xm{t+1})/dz - d(w'x'{t+1}_unclipped)/dz + d(xm{t})/dt|_ls;
        5644             :     !
        5645             :     ! where the both the mean advection term, -w d(xm{t+1})/dz, and the
        5646             :     ! turbulent advection term, -d(w'x'{t+1}_unclipped)/dz, are solved
        5647             :     ! completely implicitly.  The xm forcing term, +d(xm{t})/dt|_ls, is solved
        5648             :     ! completely explicitly.
        5649             :     !
        5650             :     ! However, if w'x' needs to be clipped after being advanced one timestep,
        5651             :     ! then xm needs to be altered to reflect the fact that w'x' has a different
        5652             :     ! value than the value used while both were being solved together.  Ideally,
        5653             :     ! the xm time-tendency equation that should be used is:
        5654             :     !
        5655             :     ! d(xm)/dt = -w d(xm{t+1})/dz - d(w'x'{t+1}_clipped)/dz + d(xm{t})/dt|_ls.
        5656             :     !
        5657             :     ! However, w'x'{t+1}_clipped isn't known until after the w'x' and xm
        5658             :     ! equations have been solved together.  However, a proper adjuster can be
        5659             :     ! applied to xm through the use of the following relationship:
        5660             :     !
        5661             :     ! w'x'{t+1}_clipped = w'x'{t+1}_unclipped + w'x'{t+1}_amount_clipped;
        5662             :     !
        5663             :     ! at any given vertical level.
        5664             :     !
        5665             :     ! When the expression above is substituted into the preceeding xm
        5666             :     ! time-tendency equation, the resulting equation for xm time-tendency is:
        5667             :     !
        5668             :     ! d(xm)/dt = -w d(xm{t+1})/dz - d(w'x'{t+1}_unclipped)/dz
        5669             :     !               - d(w'x'{t+1}_amount_clipped)/dz + d(xm{t})/dt|_ls.
        5670             :     !
        5671             :     ! Thus, the resulting xm time-tendency equation is the same as the original
        5672             :     ! xm time-tendency equation, but with added adjuster term:
        5673             :     !
        5674             :     ! -d(w'x'{t+1}_amount_clipped)/dz.
        5675             :     !
        5676             :     ! Since the adjuster term needs to be applied after xm has already been
        5677             :     ! solved, it needs to be multiplied by the timestep length and added on to
        5678             :     ! xm{t+1}, such that:
        5679             :     !
        5680             :     ! xm{t+1}_after_adjustment =
        5681             :     !    xm{t+1}_before_adjustment + ( -d(w'x'{t+1}_amount_clipped)/dz ) * dt.
        5682             :     !
        5683             :     ! The adjuster term is discretized as follows:
        5684             :     !
        5685             :     ! The values of w'x' are located on the momentum levels.  Thus, the values
        5686             :     ! of w'x'_amount_clipped are also located on the momentum levels.  The
        5687             :     ! values of xm are located on the thermodynamic levels.  The derivatives
        5688             :     ! (d/dz) of w'x'_amount_clipped are taken over the intermediate
        5689             :     ! thermodynamic levels, where they are applied to xm.
        5690             :     !
        5691             :     ! =======wpxp_amount_clipped=============================== m(k)
        5692             :     !
        5693             :     ! -----------------------------d(wpxp_amount_clipped)/dz--- t(k)
        5694             :     !
        5695             :     ! =======wpxp_amount_clipped=============================== m(k-1)
        5696             :     !
        5697             :     ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes
        5698             :     ! zm(k), zt(k), and zm(k-1), respectively.  The letter "t" is used for
        5699             :     ! thermodynamic levels and the letter "m" is used for momentum levels.
        5700             :     !
        5701             :     ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) )
        5702             :
        5703             :     ! Note:  The results of this xm adjustment are highly dependent on the
        5704             :     !        numerical stability and the smoothness of the w'^2 and x'^2 fields.
        5705             :     !        An unstable "sawtooth" profile for w'^2 and/or x'^2 causes an
        5706             :     !        unstable "sawtooth" profile for the upper and lower limits on w'x'.
        5707             :     !        In turn, this causes an unstable "sawtooth" profile for
        5708             :     !        w'x'_amount_clipped.  Taking the derivative of that such a "noisy"
        5709             :     !        field and applying the results to xm causes the xm field to become
        5710             :     !        more "noisy" and unstable.
        5711             :
        5712             :     ! References:
        5713             :     !-----------------------------------------------------------------------
        5714             :
        5715             :     use clubb_precision, only: &
        5716             :         core_rknd ! Variable(s)
        5717             :
        5718             :     use stats_type_utilities, only: &
        5719             :         stat_update_var ! Procedure(s)
        5720             :
        5721             :     use stats_variables, only: &
        5722             :         stats_metadata_type
        5723             :
        5724             :     use stats_type, only: stats ! Type
        5725             :
        5726             :     use constants_clubb, only: &
        5727             :         eps  ! Constant(s)
        5728             :
        5729             :     implicit none
        5730             :
        5731             :     !---------------------------- Input Variables ----------------------------
        5732             :     integer, intent(in) :: &
        5733             :       nz, &
        5734             :       ngrdcol
        5735             :
        5736             :     integer, intent(in) :: &
        5737             :       solve_type    ! Variable that is being solved for.
        5738             :
        5739             :     real( kind = core_rknd ), intent(in) :: &
        5740             :       dt            ! Model timestep                            [s]
        5741             :
        5742             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        5743             :       wpxp_chnge, & ! Amount of change in w'x' due to clipping  [m/s {xm units}]
        5744             :       invrs_dzt     ! Inverse of grid spacing                   [1/m]
        5745             :
        5746             :     type (stats_metadata_type), intent(in) :: &
        5747             :       stats_metadata
        5748             :
        5749             :     !---------------------------- Input/Output Variable ----------------------------
        5750             :     type (stats), dimension(ngrdcol), intent(inout) :: &
        5751             :       stats_zt
        5752             :
        5753             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
        5754             :       xm            ! xm (thermodynamic levels)                 [{xm units}]
        5755             :
        5756             :     !---------------------------- Local Variables ----------------------------
        5757             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        5758             :       xm_tndcy_wpxp_cl ! d(xm)/dt due to clipping of w'x'       [{xm units}/s]
        5759             :
        5760             :     integer :: i, k    ! Array index
        5761             :
        5762             :     integer :: ixm_tacl  ! Statistical index
        5763             :
        5764             :     logical, dimension(ngrdcol) :: &
        5765             :       l_clipping_needed
        5766             :
        5767             :     logical :: &
        5768             :       l_any_clipping_needed
        5769             :
        5770             :     !---------------------------- Begin Code ----------------------------
        5771             :
        5772             :     !$acc enter data create( xm_tndcy_wpxp_cl, l_clipping_needed, l_any_clipping_needed )
        5773             :
        5774             :     l_any_clipping_needed = .false.
        5775             :
        5776             :     !$acc parallel loop gang vector collapse(2) default(present)
        5777             :     do k = 1, nz
        5778             :       do i = 1, ngrdcol
        5779             :         if ( abs( wpxp_chnge(i,k) )  > eps ) then
        5780             :           l_clipping_needed(i) = .true.
        5781             :           l_any_clipping_needed = .true.
        5782             :         end if
        5783             :       end do
        5784             :     end do
        5785             :     !$acc end parallel loop
        5786             :
        5787             :     !$acc update host( l_any_clipping_needed )
        5788             :
        5789             :     if ( .not. l_any_clipping_needed ) then
        5790             :       return
        5791             :     end if
        5792             :
        5793             :     select case ( solve_type )
        5794             :     case ( xm_wpxp_rtm )
        5795             :       ixm_tacl = stats_metadata%irtm_tacl
        5796             :     case ( xm_wpxp_thlm )
        5797             :       ixm_tacl = stats_metadata%ithlm_tacl
        5798             :     case default
        5799             :       ixm_tacl = 0
        5800             :     end select
        5801             :
        5802             :     ! Adjusting xm based on clipping for w'x'.
        5803             :     ! Loop over all thermodynamic levels between the second-lowest and the
        5804             :     ! highest.
        5805             :     !$acc parallel loop gang vector collapse(2) default(present)
        5806             :     do k = 2, nz
        5807             :       do i = 1, ngrdcol
        5808             :         if ( l_clipping_needed(i) ) then
        5809             :           xm_tndcy_wpxp_cl(i,k) = - invrs_dzt(i,k) * ( wpxp_chnge(i,k) - wpxp_chnge(i,k-1) )
        5810             :           xm(i,k) = xm(i,k) + xm_tndcy_wpxp_cl(i,k) * dt
        5811             :         end if
        5812             :       end do
        5813             :     end do
        5814             :     !$acc end parallel loop
        5815             :
        5816             :     if ( stats_metadata%l_stats_samp ) then
        5817             :
        5818             :       !$acc update host( xm_tndcy_wpxp_cl )
        5819             :
        5820             :       ! The adjustment to xm due to turbulent advection term clipping
        5821             :       ! (xm term tacl) is completely explicit; call stat_update_var.
        5822             :       do i = 1, ngrdcol
        5823             :         call stat_update_var( ixm_tacl, xm_tndcy_wpxp_cl(i,:), & ! intent(in)
        5824             :                               stats_zt(i) )                      ! intent(inout)
        5825             :       end do
        5826             :     endif
        5827             :
        5828             :     !$acc exit data delete( xm_tndcy_wpxp_cl, l_clipping_needed, l_any_clipping_needed )
        5829             :
        5830             :     return
        5831             :
        5832             :   end subroutine xm_correction_wpxp_cl
        5833             :
        5834             :
        5835             :   !=============================================================================
        5836    26805168 :   subroutine damp_coefficient( nz, ngrdcol, gr, coefficient, Cx_Skw_fnc, &
        5837    26805168 :                                max_coeff_value, altitude_threshold, &
        5838    26805168 :                                threshold, Lscale_zm, &
        5839    26805168 :                                damped_value )
        5840             :
        5841             :     ! Description:
        5842             :     ! Damps a given coefficient linearly based on the value of Lscale.
        5843             :     ! For additional information see CLUBB ticket #431.
        5844             :
        5845             :     use grid_class, only: &
        5846             :         grid ! Type
        5847             :
        5848             :     use clubb_precision, only: &
        5849             :         core_rknd ! Variable(s)
        5850             :
        5851             :     implicit none
        5852             :
        5853             :     integer, intent(in) :: &
        5854             :       nz, &
        5855             :       ngrdcol
        5856             :
        5857             :     type (grid), target, intent(in) :: gr
        5858             :
        5859             :     ! Input variables
        5860             :     real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
        5861             :       coefficient,        & ! The coefficient to be damped
        5862             :       max_coeff_value,    & ! Maximum value the damped coefficient should have
        5863             :       altitude_threshold, & ! Minimum altitude where damping should occur
        5864             :       threshold             ! Value of Lscale below which the damping should occur
        5865             :
        5866             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        5867             :       Lscale_zm,        &   ! Current value of Lscale (interp to momentum levels)
        5868             :       Cx_Skw_fnc            ! Initial skewness function before damping
        5869             :
        5870             :     ! Return Variable
        5871             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: damped_value
        5872             :
        5873             :     ! Local Variables
        5874             :     integer :: i, k
        5875             :
        5876             :     !$acc parallel loop gang vector collapse(2) default(present)
        5877  2305244448 :     do k = 1, nz
        5878 38071442448 :       do i = 1, ngrdcol
        5879             :
        5880 38044637280 :         if ( Lscale_zm(i,k) < threshold(i) .and. gr%zm(i,k) > altitude_threshold(i) ) then
        5881             :           damped_value(i,k) = max_coeff_value(i) &
        5882             :                               + ( ( coefficient(i) - max_coeff_value(i) ) / threshold(i) ) &
        5883 30861607218 :                                 * Lscale_zm(i,k)
        5884             :         else
        5885  4904590782 :           damped_value(i,k) = Cx_Skw_fnc(i,k)
        5886             :         end if
        5887             :
        5888             :       end do
        5889             :     end do
        5890             :     !$acc end parallel loop
        5891             :
        5892    26805168 :     return
        5893             :
        5894             :   end subroutine damp_coefficient
        5895             :   !-----------------------------------------------------------------------
        5896             :
        5897             :   !=====================================================================================
        5898    35740224 :   subroutine diagnose_upxp( nz, ngrdcol, gr, ypwp, xm, wpxp, ym, &
        5899    35740224 :                                  C6x_Skw_fnc, tau_C6_zm, C7_Skw_fnc, &
        5900    35740224 :                                  ypxp )
        5901             :     ! Description:
        5902             :     !   Diagnose turbulent horizontal flux of a conserved scalar.
        5903             :     !
        5904             :     ! References:
        5905             :     !   Eqn. 7 of Andre et al. (1978)
        5906             :     !   Eqn. 4 of Bougeault et al. (1981)
        5907             :     !   github issue #841
        5908             :     !
        5909             :     !-------------------------------------------------------------------------------------
        5910             :
        5911             :     use clubb_precision, only: &
        5912             :         core_rknd ! Variable(s)
        5913             :
        5914             :     use constants_clubb, only: & ! Constants(s)
        5915             :         one     ! 1.0_core_rknd
        5916             :
        5917             :     use grid_class, only:  &
        5918             :         grid, & ! Type
        5919             :         ddzt  ! Procedure
        5920             :
        5921             :     implicit none
        5922             :
        5923             :     !------------------------------ Input Variables ------------------------------
        5924             :     integer, intent(in) :: &
        5925             :       nz, &
        5926             :       ngrdcol
        5927             :
        5928             :     type (grid), target, intent(in) :: gr
        5929             :
        5930             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
        5931             :       ypwp,        & ! momentum flux component, either upwp or vpwp  [m^2/s^2]
        5932             :       xm,          & ! grid-mean conserved thermodynamic variable, either thlm or rtm [varies]
        5933             :       wpxp,        & ! vertical scalar flux, either wpthlp or wprtp [varies]
        5934             :       ym,          & ! grid-mean velocity component, either um or vm [m/s]
        5935             :       C6x_Skw_fnc, & ! C_6 pressure parameter with effects of Sk_w incorporated (k)  [-]
        5936             :       tau_C6_zm,   & ! Time-scale tau on momentum levels applied to C6 term [s]
        5937             :       C7_Skw_fnc     ! C_7 pressure parameter with effects of Sk_w incorporated (k)  [-]
        5938             :
        5939             :     !------------------------------ Return Variables ------------------------------
        5940             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
        5941             :         ypxp        ! horizontal flux of a conserved scalar, either upthlp, uprtp, vpthlp, or vprtp
        5942             :
        5943             :     !------------------------------ Local Variables ------------------------------
        5944             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
        5945    71480448 :       ddzt_xm, &
        5946    71480448 :       ddzt_ym
        5947             :
        5948             :     integer :: i, k
        5949             :
        5950             :     !----------------------------- Begin Code ------------------------------
        5951             :
        5952             :     !$acc enter data create( ddzt_xm, ddzt_ym )
        5953             :
        5954    35740224 :     ddzt_xm = ddzt( nz, ngrdcol, gr, xm )
        5955    35740224 :     ddzt_ym = ddzt( nz, ngrdcol, gr, ym )
        5956             :
        5957             :     !$acc parallel loop gang vector collapse(2) default(present)
        5958  3002178816 :     do k = 2, nz-1
        5959 49568366016 :       do i = 1, ngrdcol
        5960 93132374400 :         ypxp(i,k) = ( tau_C6_zm(i,k) / C6x_Skw_fnc(i,k) ) &
        5961             :                     * ( - ypwp(i,k) * ddzt_xm(i,k) - (one - C7_Skw_fnc(i,k) ) &
        5962 >14266*10^7 :                       * ( wpxp(i,k) * ddzt_ym(i,k) ) )
        5963             :       end do
        5964             :     end do
        5965             :     !$acc end parallel loop
        5966             :
        5967             :     ! The value of ypxp is irrelevant to the calculations at the upper and
        5968             :     ! lower boundaries
        5969             :     !$acc parallel loop gang vector default(present)
        5970   596778624 :     do i = 1, ngrdcol
        5971   561038400 :       ypxp(i,1) = 0.0_core_rknd
        5972   596778624 :       ypxp(i,nz) = 0.0_core_rknd
        5973             :     end do
        5974             :     !$acc end parallel loop
        5975             :
        5976             :     !$acc exit data delete( ddzt_xm, ddzt_ym )
        5977             :
        5978    35740224 :     return
        5979             :
        5980             :   end subroutine diagnose_upxp
        5981             :
        5982             :   !=============================================================================
        5983           0 :   subroutine error_prints_xm_wpxp( nz, sclr_dim, zt, zm, &
        5984           0 :                                    dt, sigma_sqd_w, wm_zm, wm_zt, wp2, &
        5985           0 :                                    Lscale_zm, wp3_on_wp2, wp3_on_wp2_zt, &
        5986           0 :                                    Kh_zt, Kh_zm, invrs_tau_C6_zm, Skw_zm, &
        5987           0 :                                    wp2rtp, rtpthvp, rtm_forcing, &
        5988           0 :                                    wprtp_forcing, rtm_ref, wp2thlp, &
        5989           0 :                                    thlpthvp, thlm_forcing, wpthlp_forcing, &
        5990           0 :                                    thlm_ref, rho_ds_zm, rho_ds_zt, &
        5991           0 :                                    invrs_rho_ds_zm, invrs_rho_ds_zt, &
        5992           0 :                                    thv_ds_zm, rtp2, thlp2, w_1_zm, w_2_zm, &
        5993           0 :                                    varnce_w_1_zm, varnce_w_2_zm, &
        5994           0 :                                    mixt_frac_zm, l_implemented, em, &
        5995           0 :                                    wp2sclrp, sclrpthvp, sclrm_forcing, &
        5996           0 :                                    sclrp2, exner, rcm, p_in_Pa, thvm, &
        5997           0 :                                    Cx_fnc_Richardson, &
        5998           0 :                                    pdf_implicit_coefs_terms, um_forcing, &
        5999           0 :                                    vm_forcing, ug, vg, wpthvp, fcor, &
        6000           0 :                                    um_ref, vm_ref, up2, vp2, uprcp, vprcp, &
        6001           0 :                                    rc_coef_zm, rtm, wprtp, thlm, wpthlp, &
        6002           0 :                                    sclrm, wpsclrp, um, upwp, vm, vpwp, &
        6003           0 :                                    rtm_old, wprtp_old, thlm_old, &
        6004           0 :                                    wpthlp_old, sclrm_old, wpsclrp_old, &
        6005           0 :                                    um_old, upwp_old, vm_old, vpwp_old, &
        6006             :                                    l_predict_upwp_vpwp, l_lmm_stepping )
        6007             :
        6008             :     ! Description:
        6009             :     ! Prints values of model fields when fatal errors (LU decomp.) occur.
        6010             :     ! All field that are passed into and out of subroutine advance_xm_wpxp are
        6011             :     ! printed.  If additional fields are added to the call to subroutine
        6012             :     ! advance_xm_wpxp, they should also be added here.
        6013             :
        6014             :     use constants_clubb, only: &
        6015             :         fstderr    ! Variable(s)
        6016             :
        6017             :     use pdf_parameter_module, only: &
        6018             :         implicit_coefs_terms    ! Variable Type(s)
        6019             :
        6020             :     use clubb_precision, only: &
        6021             :         core_rknd    ! Variable(s)
        6022             :
        6023             :     implicit none
        6024             :
        6025             :     ! Input Variables
        6026             :     integer, intent(in) :: &
        6027             :       nz, &
        6028             :       sclr_dim
        6029             :
        6030             :     real( kind = core_rknd ), intent(in) ::  &
        6031             :       dt                 ! Timestep                                 [s]
        6032             :
        6033             :     real( kind = core_rknd ), intent(in), dimension(nz) :: &
        6034             :       zm,              & ! Momentum grid
        6035             :       zt,              & ! Thermo grid
        6036             :       sigma_sqd_w,     & ! sigma_sqd_w on momentum levels           [-]
        6037             :       wm_zm,           & ! w wind component on momentum levels      [m/s]
        6038             :       wm_zt,           & ! w wind component on thermodynamic levels [m/s]
        6039             :       wp2,             & ! w'^2 (momentum levels)                   [m^2/s^2]
        6040             :       Lscale_zm,       & ! Turbulent mixing length interp to m levs [m]
        6041             :       em,              & ! Turbulent Kinetic Energy (TKE)           [m^2/s^2]
        6042             :       wp3_on_wp2,      & ! Smoothed wp3 / wp2 on momentum levels    [m/s]
        6043             :       wp3_on_wp2_zt,   & ! Smoothed wp3 / wp2 on thermo. levels     [m/s]
        6044             :       Kh_zt,           & ! Eddy diffusivity on thermodynamic levels [m^2/s]
        6045             :       Kh_zm,           & ! Eddy diffusivity on momentum levels
        6046             :       invrs_tau_C6_zm, & ! Inverse time-scale tau on momentum levels applied to C6 term [1/s]
        6047             :       Skw_zm,          & ! Skewness of w on momentum levels         [-]
        6048             :       wp2rtp,          & ! <w'^2 r_t'> (thermodynamic levels)    [m^2/s^2 kg/kg]
        6049             :       rtpthvp,         & ! r_t'th_v' (momentum levels)              [(kg/kg) K]
        6050             :       rtm_forcing,     & ! r_t forcing (thermodynamic levels)       [(kg/kg)/s]
        6051             :       wprtp_forcing,   & ! <w'r_t'> forcing (momentum levels)       [(kg/kg)/s^2]
        6052             :       rtm_ref,         & ! rtm for nudging                          [kg/kg]
        6053             :       wp2thlp,         & ! <w'^2 th_l'> (thermodynamic levels)      [m^2/s^2 K]
        6054             :       thlpthvp,        & ! th_l'th_v' (momentum levels)             [K^2]
        6055             :       thlm_forcing,    & ! th_l forcing (thermodynamic levels)      [K/s]
        6056             :       wpthlp_forcing,  & ! <w'th_l'> forcing (momentum levels)      [K/s^2]
        6057             :       thlm_ref,        & ! thlm for nudging                         [K]
        6058             :       rho_ds_zm,       & ! Dry, static density on momentum levels   [kg/m^3]
        6059             :       rho_ds_zt,       & ! Dry, static density on thermo. levels    [kg/m^3]
        6060             :       invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg]
        6061             :       invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg]
        6062             :       thv_ds_zm,       & ! Dry, base-state theta_v on moment. levs. [K]
        6063             :       ! Added for clipping by Vince Larson 29 Sep 2007
        6064             :       rtp2,            & ! r_t'^2 (momentum levels)                 [(kg/kg)^2]
        6065             :       thlp2,           & ! th_l'^2 (momentum levels)                [K^2]
        6066             :       ! End of Vince Larson's addition.
        6067             :       w_1_zm,          & ! Mean w (1st PDF component)              [m/s]
        6068             :       w_2_zm,          & ! Mean w (2nd PDF component)              [m/s]
        6069             :       varnce_w_1_zm,   & ! Variance of w (1st PDF component)       [m^2/s^2]
        6070             :       varnce_w_2_zm,   & ! Variance of w (2nd PDF component)       [m^2/s^2]
        6071             :       mixt_frac_zm      ! Weight of 1st PDF component (Sk_w dependent) [-]
        6072             :
        6073             :     logical, intent(in) ::  &
        6074             :       l_implemented      ! Flag for CLUBB being implemented in a larger model.
        6075             :
        6076             :     ! Additional variables for passive scalars
        6077             :     real( kind = core_rknd ), intent(in), dimension(nz,sclr_dim) :: &
        6078             :       wp2sclrp,      & ! <w'^2 sclr'> (thermodynamic levels)   [Units vary]
        6079             :       sclrpthvp,     & ! <sclr' th_v'> (momentum levels)       [Units vary]
        6080             :       sclrm_forcing, & ! sclrm forcing (thermodynamic levels)  [Units vary]
        6081             :       sclrp2           ! For clipping Vince Larson             [Units vary]
        6082             :
        6083             :     real( kind = core_rknd ), intent(in), dimension(nz) ::  &
        6084             :       exner,           & ! Exner function                            [-]
        6085             :       rcm,             & ! cloud water mixing ratio, r_c             [kg/kg]
        6086             :       p_in_Pa,         & ! Air pressure                              [Pa]
        6087             :       thvm,            & ! Virutal potential temperature             [K]
        6088             :       Cx_fnc_Richardson  ! Cx_fnc computed from Richardson_num       [-]
        6089             :
        6090             :     type(implicit_coefs_terms), intent(in) :: &
        6091             :       pdf_implicit_coefs_terms    ! Implicit coefs / explicit terms [units vary]
        6092             :
        6093             :     ! Variables used to predict <u> and <u'w'>, as well as <v> and <v'w'>.
        6094             :     real( kind = core_rknd ), dimension(nz), intent(in) :: &
        6095             :       um_forcing, & ! <u> forcing term (thermodynamic levels)      [m/s^2]
        6096             :       vm_forcing, & ! <v> forcing term (thermodynamic levels)      [m/s^2]
        6097             :       ug,         & ! <u> geostrophic wind (thermodynamic levels)  [m/s]
        6098             :       vg,         & ! <v> geostrophic wind (thermodynamic levels)  [m/s]
        6099             :       wpthvp        ! <w'thv'> (momentum levels)                   [m/s K]
        6100             :
        6101             :     real( kind = core_rknd ), dimension(nz), intent(in) ::  &
        6102             :       uprcp,      & ! < u' r_c' >                                  [(m kg)/(s kg)]
        6103             :       vprcp,      & ! < v' r_c' >                                  [(m kg)/(s kg)]
        6104             :       rc_coef_zm    ! Coefficient on X'r_c' in X'th_v' equation    [K/(kg/kg)]
        6105             :
        6106             :      real( kind = core_rknd ), intent(in) ::  &
        6107             :       fcor          ! Coriolis parameter                           [s^-1]
        6108             :
        6109             :     real( kind = core_rknd ), dimension(nz), intent(in) :: &
        6110             :       um_ref, & ! Reference u wind component for nudging       [m/s]
        6111             :       vm_ref, & ! Reference v wind component for nudging       [m/s]
        6112             :       up2,    & ! Variance of the u wind component             [m^2/s^2]
        6113             :       vp2       ! Variance of the v wind component             [m^2/s^2]
        6114             :
        6115             :     real( kind = core_rknd ), intent(in), dimension(nz) ::  &
        6116             :       rtm,       & ! r_t  (total water mixing ratio)           [kg/kg]
        6117             :       wprtp,     & ! w'r_t'                                    [(kg/kg) m/s]
        6118             :       thlm,      & ! th_l (liquid water potential temperature) [K]
        6119             :       wpthlp       ! w'th_l'                                   [K m/s]
        6120             :
        6121             :     real( kind = core_rknd ), intent(in), dimension(nz,sclr_dim) ::  &
        6122             :       sclrm, wpsclrp !                                     [Units vary]
        6123             :
        6124             :     ! Variables used to predict <u> and <u'w'>, as well as <v> and <v'w'>.
        6125             :     real( kind = core_rknd ), intent(in), dimension(nz) ::  &
        6126             :       um,   & ! <u>:  mean west-east horiz. velocity (thermo. levs.)   [m/s]
        6127             :       upwp, & ! <u'w'>:  momentum flux (momentum levels)               [m^2/s^2]
        6128             :       vm,   & ! <v>:  mean south-north horiz. velocity (thermo. levs.) [m/s]
        6129             :       vpwp    ! <v'w'>:  momentum flux (momentum levels)               [m^2/s^2]
        6130             :
        6131             :     ! Saved values of predictive fields, prior to being advanced, for use in
        6132             :     ! print statements in case of fatal error.
        6133             :     real( kind = core_rknd ), dimension(nz), intent(in) ::  &
        6134             :       rtm_old,    & ! Saved value of r_t        [kg/kg]
        6135             :       wprtp_old,  & ! Saved value of w'r_t'     [(kg/kg) m/s]
        6136             :       thlm_old,   & ! Saved value of th_l       [K]
        6137             :       wpthlp_old    ! Saved value of w'th_l'    [K m/s]
        6138             :
        6139             :     ! Input/Output Variables
        6140             :     real( kind = core_rknd ), dimension(nz,sclr_dim), intent(in) ::  &
        6141             :       sclrm_old,   & ! Saved value of sclrm     [units vary]
        6142             :       wpsclrp_old    ! Saved value of wpsclrp   [units vary]
        6143             :
        6144             :     ! Variables used to predict <u> and <u'w'>, as well as <v> and <v'w'>.
        6145             :     real( kind = core_rknd ), dimension(nz), intent(in) ::  &
        6146             :       um_old,   & ! Saved value of <u>       [m/s]
        6147             :       upwp_old, & ! Saved value of <u'w'>    [m^2/s^2]
        6148             :       vm_old,   & ! Saved value of <v>       [m/s]
        6149             :       vpwp_old    ! Saved value of <v'w'>    [m^2/s^2]
        6150             :
        6151             :     logical, intent(in) :: &
        6152             :       l_predict_upwp_vpwp, & ! Flag to predict <u'w'> and <v'w'> along with <u>
        6153             :                              ! and <v> alongside the advancement of <rt>,
        6154             :                              ! <w'rt'>, <thl>, <wpthlp>, <sclr>, and <w'sclr'>
        6155             :                              ! in subroutine advance_xm_wpxp.  Otherwise, <u'w'>
        6156             :                              ! and <v'w'> are still approximated by eddy
        6157             :                              ! diffusivity when <u> and <v> are advanced in
        6158             :                              ! subroutine advance_windm_edsclrm.
        6159             :       l_lmm_stepping         ! Apply Linear Multistep Method (LMM) Stepping
        6160             :
        6161             :
        6162           0 :     write(fstderr,*) "Error in advance_xm_wpxp", new_line('c')
        6163             :
        6164           0 :     write(fstderr,*) "Intent(in)", new_line('c')
        6165             :
        6166           0 :     write(fstderr,*) "zt = ", zt, new_line('c')
        6167           0 :     write(fstderr,*) "zm = ", zm, new_line('c')
        6168           0 :     write(fstderr,*) "dt = ", dt, new_line('c')
        6169           0 :     write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w, new_line('c')
        6170           0 :     write(fstderr,*) "wm_zm = ", wm_zm, new_line('c')
        6171           0 :     write(fstderr,*) "wm_zt = ", wm_zt, new_line('c')
        6172           0 :     write(fstderr,*) "wp2 = ", wp2, new_line('c')
        6173           0 :     write(fstderr,*) "Lscale_zm = ", Lscale_zm, new_line('c')
        6174           0 :     write(fstderr,*) "wp3_on_wp2 = ", wp3_on_wp2, new_line('c')
        6175           0 :     write(fstderr,*) "wp3_on_wp2_zt = ", wp3_on_wp2_zt, new_line('c')
        6176           0 :     write(fstderr,*) "Kh_zt = ", Kh_zt, new_line('c')
        6177           0 :     write(fstderr,*) "Kh_zm = ", Kh_zm, new_line('c')
        6178           0 :     write(fstderr,*) "invrs_tau_C6_zm = ", invrs_tau_C6_zm, new_line('c')
        6179           0 :     write(fstderr,*) "Skw_zm = ", Skw_zm, new_line('c')
        6180           0 :     write(fstderr,*) "wp2rtp = ", wp2rtp, new_line('c')
        6181           0 :     write(fstderr,*) "rtpthvp = ", rtpthvp, new_line('c')
        6182           0 :     write(fstderr,*) "rtm_forcing = ", rtm_forcing, new_line('c')
        6183           0 :     write(fstderr,*) "wprtp_forcing = ", wprtp_forcing, new_line('c')
        6184           0 :     write(fstderr,*) "rtm_ref = ", rtm_ref, new_line('c')
        6185           0 :     write(fstderr,*) "wp2thlp = ", wp2thlp, new_line('c')
        6186           0 :     write(fstderr,*) "thlpthvp = ", thlpthvp, new_line('c')
        6187           0 :     write(fstderr,*) "thlm_forcing = ", thlm_forcing, new_line('c')
        6188           0 :     write(fstderr,*) "wpthlp_forcing = ", wpthlp_forcing, new_line('c')
        6189           0 :     write(fstderr,*) "thlm_ref = ", thlm_ref, new_line('c')
        6190           0 :     write(fstderr,*) "rho_ds_zm = ", rho_ds_zm, new_line('c')
        6191           0 :     write(fstderr,*) "rho_ds_zt = ", rho_ds_zt, new_line('c')
        6192           0 :     write(fstderr,*) "invrs_rho_ds_zm = ", invrs_rho_ds_zm, new_line('c')
        6193           0 :     write(fstderr,*) "invrs_rho_ds_zt = ", invrs_rho_ds_zt, new_line('c')
        6194           0 :     write(fstderr,*) "thv_ds_zm = ", thv_ds_zm, new_line('c')
        6195           0 :     write(fstderr,*) "rtp2 = ", rtp2, new_line('c')
        6196           0 :     write(fstderr,*) "thlp2 = ", thlp2, new_line('c')
        6197           0 :     write(fstderr,*) "w_1_zm = ", w_1_zm, new_line('c')
        6198           0 :     write(fstderr,*) "w_2_zm = ", w_2_zm, new_line('c')
        6199           0 :     write(fstderr,*) "varnce_w_1_zm = ", varnce_w_1_zm, new_line('c')
        6200           0 :     write(fstderr,*) "varnce_w_2_zm = ", varnce_w_2_zm, new_line('c')
        6201           0 :     write(fstderr,*) "mixt_frac_zm = ", mixt_frac_zm, new_line('c')
        6202           0 :     write(fstderr,*) "l_implemented = ", l_implemented, new_line('c')
        6203           0 :     write(fstderr,*) "em = ", em, new_line('c')
        6204           0 :     write(fstderr,*) "exner = ", exner, new_line('c')
        6205           0 :     write(fstderr,*) "rcm = ", rcm, new_line('c')
        6206           0 :     write(fstderr,*) "p_in_Pa = ", p_in_Pa, new_line('c')
        6207           0 :     write(fstderr,*) "thvm = ", thvm, new_line('c')
        6208           0 :     write(fstderr,*) "Cx_fnc_Richardson = ", Cx_fnc_Richardson, new_line('c')
        6209           0 :     write(fstderr,*) "pdf_implicit_coefs_terms%coef_wp2rtp_implicit = ", &
        6210           0 :                      pdf_implicit_coefs_terms%coef_wp2rtp_implicit, &
        6211           0 :                      new_line('c')
        6212           0 :     write(fstderr,*) "pdf_implicit_coefs_terms%term_wp2rtp_explicit = ", &
        6213           0 :                      pdf_implicit_coefs_terms%term_wp2rtp_explicit, &
        6214           0 :                      new_line('c')
        6215           0 :     write(fstderr,*) "pdf_implicit_coefs_terms%coef_wp2thlp_implicit = ", &
        6216           0 :                      pdf_implicit_coefs_terms%coef_wp2thlp_implicit, &
        6217           0 :                      new_line('c')
        6218           0 :     write(fstderr,*) "pdf_implicit_coefs_terms%term_wp2thlp_explicit = ", &
        6219           0 :                      pdf_implicit_coefs_terms%term_wp2thlp_explicit, &
        6220           0 :                      new_line('c')
        6221             :
        6222           0 :     if ( sclr_dim > 0 )  then
        6223           0 :        write(fstderr,*) "sclrp2 = ", sclrp2, new_line('c')
        6224           0 :        write(fstderr,*) "wp2sclrp = ", wp2sclrp, new_line('c')
        6225           0 :        write(fstderr,*) "sclrpthvp = ", sclrpthvp, new_line('c')
        6226           0 :        write(fstderr,*) "sclrm_forcing = ", sclrm_forcing, new_line('c')
        6227           0 :        write(fstderr,*) "pdf_implicit_coefs_terms%coef_wp2sclrp_implicit = ", &
        6228           0 :                         pdf_implicit_coefs_terms%coef_wp2sclrp_implicit, &
        6229           0 :                         new_line('c')
        6230           0 :        write(fstderr,*) "pdf_implicit_coefs_terms%term_wp2sclrp_explicit = ", &
        6231           0 :                         pdf_implicit_coefs_terms%term_wp2sclrp_explicit, &
        6232           0 :                         new_line('c')
        6233             :     endif
        6234             :
        6235           0 :     if ( l_predict_upwp_vpwp ) then
        6236           0 :        write(fstderr,*) "um_forcing = ", um_forcing, new_line('c')
        6237           0 :        write(fstderr,*) "vm_forcing = ", vm_forcing, new_line('c')
        6238           0 :        write(fstderr,*) "ug = ", ug, new_line('c')
        6239           0 :        write(fstderr,*) "vg = ", vg, new_line('c')
        6240           0 :        write(fstderr,*) "wpthvp = ", wpthvp, new_line('c')
        6241           0 :        write(fstderr,*) "fcor = ", fcor, new_line('c')
        6242           0 :        write(fstderr,*) "um_ref = ", um_ref, new_line('c')
        6243           0 :        write(fstderr,*) "vm_ref = ", vm_ref, new_line('c')
        6244           0 :        write(fstderr,*) "up2 = ", up2, new_line('c')
        6245           0 :        write(fstderr,*) "vp2 = ", vp2, new_line('c')
        6246           0 :        write(fstderr,*) "uprcp = ", uprcp, new_line('c')
        6247           0 :        write(fstderr,*) "vprcp = ", vprcp, new_line('c')
        6248           0 :        write(fstderr,*) "rc_coef_zm = ",  rc_coef_zm, new_line('c')
        6249           0 :        write(fstderr,*) "pdf_implicit_coefs_terms%coef_wp2up_implicit = ", &
        6250           0 :                         pdf_implicit_coefs_terms%coef_wp2up_implicit, &
        6251           0 :                         new_line('c')
        6252           0 :        write(fstderr,*) "pdf_implicit_coefs_terms%term_wp2up_explicit = ", &
        6253           0 :                         pdf_implicit_coefs_terms%term_wp2up_explicit, &
        6254           0 :                         new_line('c')
        6255           0 :        write(fstderr,*) "pdf_implicit_coefs_terms%coef_wp2vp_implicit = ", &
        6256           0 :                         pdf_implicit_coefs_terms%coef_wp2vp_implicit, &
        6257           0 :                         new_line('c')
        6258           0 :        write(fstderr,*) "pdf_implicit_coefs_terms%term_wp2vp_explicit = ", &
        6259           0 :                         pdf_implicit_coefs_terms%term_wp2vp_explicit, &
        6260           0 :                         new_line('c')
        6261             :     endif ! l_predict_upwp_vpwp
        6262             :
        6263           0 :     write(fstderr,*) "Intent(inout)", new_line('c')
        6264             :
        6265           0 :     if ( l_lmm_stepping ) &
        6266           0 :       write(fstderr,*) "rtm (pre-solve) = ", rtm_old, new_line('c')
        6267           0 :       write(fstderr,*) "rtm = ", rtm, new_line('c')
        6268           0 :     if ( l_lmm_stepping )  &
        6269           0 :       write(fstderr,*) "wprtp (pre-solve) = ", wprtp_old, new_line('c')
        6270           0 :       write(fstderr,*) "wprtp = ", wprtp, new_line('c')
        6271           0 :     if ( l_lmm_stepping ) &
        6272           0 :       write(fstderr,*) "thlm (pre-solve) = ", thlm_old, new_line('c')
        6273           0 :       write(fstderr,*) "thlm = ", thlm, new_line('c')
        6274           0 :     if ( l_lmm_stepping ) &
        6275           0 :       write(fstderr,*) "wpthlp (pre-solve) =", wpthlp_old, new_line('c')
        6276           0 :       write(fstderr,*) "wpthlp =", wpthlp, new_line('c')
        6277             :
        6278           0 :     if ( sclr_dim > 0 )  then
        6279           0 :       if ( l_lmm_stepping ) &
        6280           0 :         write(fstderr,*) "sclrm (pre-solve) = ", sclrm_old, new_line('c')
        6281           0 :         write(fstderr,*) "sclrm = ", sclrm, new_line('c')
        6282           0 :       if ( l_lmm_stepping ) &
        6283           0 :         write(fstderr,*) "wpsclrp (pre-solve) = ", wpsclrp_old, new_line('c')
        6284           0 :         write(fstderr,*) "wpsclrp = ", wpsclrp, new_line('c')
        6285             :     endif
        6286             :
        6287           0 :     if ( l_predict_upwp_vpwp ) then
        6288           0 :       if ( l_lmm_stepping ) &
        6289           0 :         write(fstderr,*) "um (pre-solve) = ", um_old, new_line('c')
        6290           0 :         write(fstderr,*) "um = ", um, new_line('c')
        6291           0 :       if ( l_lmm_stepping ) &
        6292           0 :         write(fstderr,*) "upwp (pre-solve) = ",  upwp_old, new_line('c')
        6293           0 :         write(fstderr,*) "upwp = ",  upwp, new_line('c')
        6294           0 :       if ( l_lmm_stepping ) &
        6295           0 :         write(fstderr,*) "vm (pre-solve) = ", vm_old, new_line('c')
        6296           0 :         write(fstderr,*) "vm = ", vm, new_line('c')
        6297           0 :       if ( l_lmm_stepping ) &
        6298           0 :         write(fstderr,*) "vpwp (pre-solve) = ",  vpwp_old, new_line('c')
        6299           0 :         write(fstderr,*) "vpwp = ",  vpwp, new_line('c')
        6300             :     end if ! l_predict_upwp_vpwp
        6301             :
        6302           0 :     return
        6303             :
        6304             :   end subroutine error_prints_xm_wpxp
        6305             :
        6306             :   !=============================================================================
        6307             :
        6308             : end module advance_xm_wpxp_module

Generated by: LCOV version 1.14