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

Generated by: LCOV version 1.14