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 17:57:11 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 30968256630 :                                 * Lscale_zm(i,k)
    5884             :         else
    5885  4797941370 :           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