LCOV - code coverage report
Current view: top level - physics/clubb/src/CLUBB_core - advance_clubb_core_module.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 728 1326 54.9 %
Date: 2024-12-17 17:57:11 Functions: 10 12 83.3 %

          Line data    Source code
       1             : 
       2             : module advance_clubb_core_module
       3             : 
       4             : ! Description:
       5             : !   The module containing the `core' of the CLUBB parameterization.
       6             : !   It advances CLUBB's equations one model time step.
       7             : !
       8             : ! References:
       9             : ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:overview_clubb
      10             : !
      11             : !  ``A PDF-Based Model for Boundary Layer Clouds. Part I:
      12             : !    Method and Model Description'' Golaz, et al. (2002)
      13             : !    JAS, Vol. 59, pp. 3540--3551.
      14             : !
      15             : !                         Copyright Notice:
      16             : !
      17             : !   This code and the source code it references are (C) 2006-2020.
      18             : !
      19             : !   The distribution of this code and derived works thereof
      20             : !                   should include this notice.
      21             : !
      22             : !   Portions of this code derived from other sources (Hugh Morrison,
      23             : !   ACM TOMS, et cetera) are the intellectual
      24             : !   property of their respective authors as noted and are also subject
      25             : !   to copyright.
      26             : !
      27             : !
      28             : !
      29             : ! Cloud Layers Unified By Binormals (CLUBB) user license
      30             : ! agreement.
      31             : !
      32             : ! Thank you for your interest in CLUBB. We work hard to create a
      33             : ! code that implements the best software engineering practices,
      34             : ! is supported to the extent allowed by our limited resources,
      35             : ! and is available without cost to non-commercial users. You may
      36             : ! use CLUBB if, in return, you abide by these conditions:
      37             : !
      38             : ! 1. Please cite CLUBB in presentations and publications that
      39             : !  contain results obtained using CLUBB.
      40             : !
      41             : ! 2. You may not use any part of CLUBB to create or modify
      42             : !  another single-column (1D) model that is not called CLUBB.
      43             : !  However, you may modify or augment CLUBB or parts of CLUBB if
      44             : !  you include "CLUBB" in the name of the resulting single-column
      45             : !  model. For example, a user at MIT might modify CLUBB and call
      46             : !  the modified version "CLUBB-MIT." Or, for example, a user of
      47             : !  the CLM land-surface model might interface CLM to CLUBB and
      48             : !  call it "CLM-CLUBB." This naming convention recognizes the
      49             : !  contributions of both sets of developers.
      50             : !
      51             : ! 3. You may implement CLUBB as a parameterization in a large-
      52             : !  scale host model that has 2 or 3 spatial dimensions without
      53             : !  including "CLUBB" in the combined model name, but please
      54             : !  acknowledge in presentations and publications that CLUBB has
      55             : !  been included as a parameterization.
      56             : !
      57             : ! 4. You may not provide all or part of CLUBB to anyone without
      58             : !  prior permission from Vincent Larson (vlarson@uwm.edu). If
      59             : !  you wish to share CLUBB with your collaborators without
      60             : !  seeking permission, please ask your collaborators to register
      61             : !  as CLUBB users at https://carson.math.uwm.edu/larson-group/clubb_site/ and to
      62             : !  download CLUBB from there.
      63             : !
      64             : ! 5. You may not use CLUBB for commercial purposes unless you
      65             : !  receive permission from Vincent Larson.
      66             : !
      67             : ! 6. You may not re-license all or any part of CLUBB.
      68             : !
      69             : ! 7. CLUBB is provided "as is" and without warranty.
      70             : !
      71             : ! We hope that CLUBB will develop into a community resource. We
      72             : ! encourage users to contribute their CLUBB modifications or
      73             : ! extensions to the CLUBB development group. We will then
      74             : ! consider them for inclusion in CLUBB. Such contributions will
      75             : ! benefit all CLUBB users. We would be pleased to acknowledge
      76             : ! contributors and list their CLUBB-related papers on our "About
      77             : ! CLUBB" webpage (https://carson.math.uwm.edu/larson-group/clubb_site/about.html) for
      78             : ! those contributors who so desire.
      79             : !
      80             : ! Thanks so much and best wishes for your research!
      81             : !
      82             : ! The CLUBB Development Group
      83             : ! (Present and past contributors to the source code include
      84             : ! Vincent Larson, Chris Golaz, David Schanen, Brian Griffin,
      85             : ! Joshua Fasching, Adam Smith, and Michael Falk).
      86             : !-----------------------------------------------------------------------
      87             : 
      88             :   ! Options for the placement of the call to CLUBB's PDF.
      89             :   use model_flags, only: &
      90             :       ipdf_pre_advance_fields, &      ! Call before advancing predictive fields
      91             :       ipdf_post_advance_fields, &     ! Call after advancing predictive fields
      92             :       ipdf_pre_post_advance_fields, & ! Call both before and after advancing
      93             :                                       ! predictive fields
      94             :       saturation_bolton, &
      95             :       saturation_gfdl, &
      96             :       saturation_flatau, &
      97             :       saturation_lookup
      98             :                              
      99             : 
     100             :   implicit none
     101             : 
     102             :   public ::  &
     103             :     check_clubb_settings, &
     104             :     advance_clubb_core, &
     105             :     cleanup_clubb_core, &
     106             :     set_Lscale_max, &
     107             :     calculate_thlp2_rad
     108             : 
     109             :   private ! Default Scope
     110             : 
     111             :   ! Advance subroutine ordering variables
     112             :   integer, parameter, private :: &
     113             :     order_xm_wpxp = 1, &
     114             :     order_xp2_xpyp = 2, &
     115             :     order_wp2_wp3 = 3, &
     116             :     order_windm = 4
     117             : 
     118             :   contains
     119             : 
     120             :   !-----------------------------------------------------------------------
     121             : 
     122             :   !#######################################################################
     123             :   !#######################################################################
     124             :   ! If you change the argument list of advance_clubb_core you also have to
     125             :   ! change the calls to this function in the host models CAM, WRF, SAM
     126             :   ! and GFDL.
     127             :   !#######################################################################
     128             :   !#######################################################################
     129     8935056 :   subroutine advance_clubb_core( gr, nz, ngrdcol, &                 ! intent(in)
     130     8935056 :                l_implemented, dt, fcor, sfc_elevation,            & ! intent(in)
     131             :                hydromet_dim,                                      & ! intent(in)
     132     8935056 :                sclr_dim, sclr_tol, edsclr_dim, sclr_idx,      & ! intent(in)
     133     8935056 :                thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & ! intent(in)
     134     8935056 :                sclrm_forcing, edsclrm_forcing, wprtp_forcing, &     ! intent(in)
     135     8935056 :                wpthlp_forcing, rtp2_forcing, thlp2_forcing, &       ! intent(in)
     136     8935056 :                rtpthlp_forcing, wm_zm, wm_zt, &                     ! intent(in)
     137     8935056 :                wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, &         ! intent(in)
     138     8935056 :                wpsclrp_sfc, wpedsclrp_sfc, &                        ! intent(in)
     139     8935056 :                upwp_sfc_pert, vpwp_sfc_pert, &                      ! intent(in)
     140     8935056 :                rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, &         ! Intent(in)
     141     8935056 :                p_in_Pa, rho_zm, rho, exner, &                       ! intent(in)
     142     8935056 :                rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, &             ! intent(in)
     143     8935056 :                invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, &             ! intent(in)
     144     8935056 :                hydromet, l_mix_rat_hm, &                            ! intent(in)
     145     8935056 :                rfrzm, radf, &                                       ! intent(in)
     146             : #ifdef CLUBBND_CAM
     147             :                varmu, &                                             ! intent(in)
     148             : #endif
     149     8935056 :                wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, &        ! intent(in)
     150     8935056 :                host_dx, host_dy, &                                  ! intent(in)
     151     8935056 :                clubb_params, nu_vert_res_dep, lmin, &               ! intent(in)
     152             :                clubb_config_flags, &                                ! intent(in)
     153             :                stats_metadata, &                                    ! intent(in)
     154     8935056 :                stats_zt, stats_zm, stats_sfc, &                     ! intent(inout)
     155     8935056 :                um, vm, upwp, vpwp, up2, vp2, up3, vp3, &            ! intent(inout)
     156     8935056 :                thlm, rtm, wprtp, wpthlp, &                          ! intent(inout)
     157     8935056 :                wp2, wp3, rtp2, rtp3, thlp2, thlp3, rtpthlp, &       ! intent(inout)
     158     8935056 :                sclrm,   &                                           ! intent(inout)
     159             : #ifdef GFDL
     160             :                sclrm_trsport_only,  &  ! h1g, 2010-06-16            ! intent(inout)
     161             : #endif
     162     8935056 :                sclrp2, sclrp3, sclrprtp, sclrpthlp, &               ! intent(inout)
     163     8935056 :                wpsclrp, edsclrm, &                                  ! intent(inout)
     164     8935056 :                rcm, cloud_frac, &                                   ! intent(inout)
     165     8935056 :                wpthvp, wp2thvp, rtpthvp, thlpthvp, &                ! intent(inout)
     166     8935056 :                sclrpthvp, &                                         ! intent(inout)
     167     8935056 :                wp2rtp, wp2thlp, uprcp, vprcp, rc_coef_zm, wp4, &    ! intent(inout)
     168     8935056 :                wpup2, wpvp2, wp2up2, wp2vp2, ice_supersat_frac, &   ! intent(inout)
     169     8935056 :                um_pert, vm_pert, upwp_pert, vpwp_pert, &            ! intent(inout)
     170             :                pdf_params, pdf_params_zm, &                         ! intent(inout)
     171             :                pdf_implicit_coefs_terms, &                          ! intent(inout)
     172             : #ifdef GFDL
     173             :                RH_crit, & !h1g, 2010-06-16                          ! intent(inout)
     174             :                do_liquid_only_in_clubb, &                           ! intent(in)
     175             : #endif
     176     8935056 :                Kh_zm, Kh_zt, &                                      ! intent(out)
     177             : #ifdef CLUBB_CAM
     178     8935056 :                qclvar, &                                            ! intent(out)
     179             : #endif
     180     8935056 :                thlprcp, wprcp, w_up_in_cloud, w_down_in_cloud, &    ! intent(out)
     181     8935056 :                cloudy_updraft_frac, cloudy_downdraft_frac, &        ! intent(out)
     182     8935056 :                rcm_in_layer, cloud_cover, invrs_tau_zm, &           ! intent(out)
     183             :                err_code_out )                                       ! intent(out)
     184             : 
     185             :     ! Description:
     186             :     !   Subroutine to advance CLUBB one timestep
     187             : 
     188             :     ! References:
     189             :     !   https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:overview_clubb
     190             :     !
     191             :     !   ``A PDF-Based Model for Boundary Layer Clouds. Part I:
     192             :     !     Method and Model Description'' Golaz, et al. (2002)
     193             :     !   JAS, Vol. 59, pp. 3540--3551.
     194             :     !-----------------------------------------------------------------------
     195             : 
     196             :     ! Modules to be included
     197             : 
     198             :     use constants_clubb, only: &
     199             :         em_min, &
     200             :         thl_tol, &
     201             :         rt_tol, &
     202             :         w_tol, &
     203             :         w_tol_sqd, &
     204             :         fstderr, &
     205             :         zero_threshold, &
     206             :         three_halves, &
     207             :         one, &
     208             :         two, &
     209             :         zero, &
     210             :         unused_var, &
     211             :         grav, &
     212             :         eps, &
     213             :         num_hf_draw_points
     214             : 
     215             :     use parameter_indices, only: &
     216             :         nparams,                 & ! Variable(s)
     217             :         itaumax,                 &
     218             :         ic_K,                    &
     219             :         ic_K10,                  &
     220             :         ic_K10h,                 &
     221             :         imu,                     &
     222             :         igamma_coef,             &
     223             :         igamma_coefb,            &
     224             :         igamma_coefc,            &
     225             :         iC_wp2_splat,            &
     226             :         ixp3_coef_base,          &
     227             :         ixp3_coef_slope,         &
     228             :         ilambda0_stability_coef, &
     229             :         iup2_sfc_coef,           &
     230             :         ia_const,                &
     231             :         ia3_coef_min,            &
     232             :         ibv_efold
     233             : 
     234             :     use parameters_tunable, only: &
     235             :         nu_vertical_res_dep    ! Type(s)
     236             : 
     237             :     use model_flags, only: &
     238             :         clubb_config_flags_type, & ! Type
     239             :         l_gamma_Skw, & ! Variable(s)
     240             :         l_advance_xp3, &
     241             :         iiPDF_ADG1
     242             : 
     243             :     use grid_class, only: &
     244             :         grid, & ! Type
     245             :         zm2zt,  & ! Procedure(s)
     246             :         zt2zm, &
     247             :         ddzm, &
     248             :         ddzt, &
     249             :         zm2zt2zm
     250             : 
     251             :     use numerical_check, only: &
     252             :         parameterization_check, & ! Procedure(s)
     253             :         calculate_spurious_source
     254             : 
     255             :     use pdf_parameter_module, only: &
     256             :         pdf_parameter, &
     257             :         implicit_coefs_terms
     258             : 
     259             : #ifdef GFDL
     260             :     use advance_sclrm_Nd_module, only: &  ! h1g, 2010-06-16 begin mod
     261             :          advance_sclrm_Nd_diffusion_OG, &
     262             :          advance_sclrm_Nd_upwind, &
     263             :        advance_sclrm_Nd_semi_implicit     ! h1g, 2010-06-16 end mod
     264             : #endif
     265             : 
     266             :     use advance_xm_wpxp_module, only: &
     267             :         advance_xm_wpxp          ! Compute mean/flux terms
     268             : 
     269             :     use advance_xp2_xpyp_module, only: &
     270             :         advance_xp2_xpyp     ! Computes variance terms
     271             : 
     272             :     use sfc_varnce_module, only:  &
     273             :         calc_sfc_varnce ! Procedure
     274             : 
     275             :     use mixing_length, only: &
     276             :         calc_Lscale_directly,  &  ! for Lscale
     277             :         diagnose_Lscale_from_tau  ! for Lscale from tau
     278             : 
     279             :     use advance_windm_edsclrm_module, only:  &
     280             :         advance_windm_edsclrm  ! Procedure(s)
     281             : 
     282             :     use saturation, only:  &
     283             :         ! Procedure
     284             :         sat_mixrat_liq ! Saturation mixing ratio
     285             : 
     286             :     use advance_wp2_wp3_module, only:  &
     287             :         advance_wp2_wp3 ! Procedure
     288             : 
     289             :     use advance_xp3_module, only: &
     290             :         advance_xp3    ! Procedure(s)
     291             : 
     292             :     use calc_pressure, only: &
     293             :         calculate_thvm
     294             : 
     295             :     use clubb_precision, only:  &
     296             :         core_rknd ! Variable(s)
     297             : 
     298             :     use error_code, only: &
     299             :         clubb_at_least_debug_level,  & ! Procedure
     300             :         err_code,                    & ! Error Indicator
     301             :         clubb_no_error, &              ! Constant
     302             :         clubb_fatal_error              ! Constant
     303             : 
     304             :     use Skx_module, only: &
     305             :         Skx_func,           & ! Procedure(s)
     306             :         xp3_LG_2005_ansatz
     307             : 
     308             :     use clip_explicit, only: &
     309             :         clip_covars_denom ! Procedure(s)
     310             : 
     311             :     use T_in_K_module, only: &
     312             :         ! Read values from namelist
     313             :         thlm2T_in_K ! Procedure
     314             : 
     315             :     use sigma_sqd_w_module, only: &
     316             :         compute_sigma_sqd_w    ! Procedure(s)
     317             : 
     318             :     use stats_clubb_utilities, only: &
     319             :         stats_accumulate ! Procedure
     320             : 
     321             :     use stats_type_utilities, only:   &
     322             :         stat_update_var_pt,   & ! Procedure(s)
     323             :         stat_update_var,      &
     324             :         stat_begin_update,    &
     325             :         stat_begin_update_pt, &
     326             :         stat_end_update,      &
     327             :         stat_end_update_pt
     328             : 
     329             :     use fill_holes, only: &
     330             :         fill_holes_vertical
     331             : 
     332             :     use advance_helper_module, only: &
     333             :         calc_stability_correction, & ! Procedure(s)
     334             :         compute_Cx_fnc_Richardson, &
     335             :         calc_brunt_vaisala_freq_sqd, &
     336             :         wp2_term_splat_lhs, &
     337             :         wp3_term_splat_lhs, &
     338             :         vertical_integral, &
     339             :         Lscale_width_vert_avg
     340             : 
     341             :     use interpolation, only: &
     342             :         pvertinterp
     343             : 
     344             :     use stats_type, only: stats ! Type
     345             :     
     346             :     use pdf_parameter_module, only: &
     347             :       copy_single_pdf_params_to_multi, &
     348             :       copy_multi_pdf_params_to_single, &
     349             :       init_pdf_params
     350             : 
     351             :     use stats_variables, only: &
     352             :       stats_metadata_type
     353             : 
     354             :     use array_index, only: &
     355             :       sclr_idx_type
     356             : 
     357             :     implicit none
     358             : 
     359             :     !!! External
     360             :     intrinsic :: sqrt, min, max, exp, mod, real
     361             : 
     362             :     ! Constant Parameters
     363             : 
     364             :     real( kind = core_rknd ), parameter :: &
     365             :       tau_const = 1000._core_rknd
     366             : 
     367             :     !--------------------------- Input Variables ---------------------------
     368             :     integer, intent(in) :: &
     369             :       nz, &   ! Number of vertical levels
     370             :       ngrdcol ! Number of grid columns
     371             : 
     372             :     type (grid), target, intent(in) :: gr
     373             : 
     374             :     logical, intent(in) ::  &
     375             :       l_implemented    ! True if CLUBB is being run within a large-scale host model,
     376             :                        !   rather than a standalone single-column model.
     377             : 
     378             :     real( kind = core_rknd ), intent(in) ::  &
     379             :       dt  ! Current timestep duration    [s]
     380             : 
     381             :     real( kind = core_rknd ) ::  &
     382             :       dt_advance  ! General timestep duration for advance_wp2_wp3,
     383             :                   ! advance_xm_xpwp, and advance_xp2_xpyp.
     384             :                   ! Only differs from dt if l_lmm_stepping is used    [s]
     385             : 
     386             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol) ::  &
     387             :       fcor,  &          ! Coriolis forcing             [s^-1]
     388             :       sfc_elevation     ! Elevation of ground level    [m above MSL]
     389             : 
     390             :     integer, intent(in) :: &
     391             :       hydromet_dim,   & ! Total number of hydrometeor species       [#]
     392             :       sclr_dim,       & ! Number of passive scalars                 [#]
     393             :       edsclr_dim        ! Number of eddy-diff. passive scalars      [#]
     394             : 
     395             :     real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: & 
     396             :       sclr_tol          ! Threshold(s) on the passive scalars  [units vary]
     397             : 
     398             :     type (sclr_idx_type), intent(in) :: &
     399             :       sclr_idx
     400             : 
     401             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) ::  &
     402             :       thlm_forcing,    & ! liquid potential temp. forcing (thermodynamic levels)    [K/s]
     403             :       rtm_forcing,     & ! total water forcing (thermodynamic levels)        [(kg/kg)/s]
     404             :       um_forcing,      & ! eastward wind forcing (thermodynamic levels)     [m/s/s]
     405             :       vm_forcing,      & ! northward wind forcing (thermodynamic levels)     [m/s/s]
     406             :       wprtp_forcing,   & ! total water turbulent flux forcing (momentum levels)    [m*K/s^2]
     407             :       wpthlp_forcing,  & ! liq pot temp turb flux forcing (momentum levels)   [m*(kg/kg)/s^2]
     408             :       rtp2_forcing,    & ! total water variance forcing (momentum levels)    [(kg/kg)^2/s]
     409             :       thlp2_forcing,   & ! liq pot temp variance forcing (momentum levels)   [K^2/s]
     410             :       rtpthlp_forcing, & ! <r_t'th_l'> covariance forcing (momentum levels) [K*(kg/kg)/s]
     411             :       wm_zm,           & ! vertical mean wind component on momentum levels  [m/s]
     412             :       wm_zt,           & ! vertical mean wind component on thermo. levels   [m/s]
     413             :       rho_zm,          & ! Air density on momentum levels            [kg/m^3]
     414             :       rho,             & ! Air density on thermodynamic levels       [kg/m^3]
     415             :       rho_ds_zm,       & ! Dry, static density on momentum levels    [kg/m^3]
     416             :       rho_ds_zt,       & ! Dry, static density on thermo. levels     [kg/m^3]
     417             :       invrs_rho_ds_zm, & ! Inverse dry, static density on momentum levs. [m^3/kg]
     418             :       invrs_rho_ds_zt, & ! Inverse dry, static density on thermo levs.  [m^3/kg]
     419             :       thv_ds_zm,       & ! Dry, base-state theta_v on momentum levs. [K]
     420             :       thv_ds_zt,       & ! Dry, base-state theta_v on thermo levs.  [K]
     421             :       rfrzm              ! Total ice-phase water mixing ratio        [kg/kg]
     422             : 
     423             :     real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim), intent(in) :: &
     424             :       hydromet           ! Array of hydrometeors                [units vary]
     425             : 
     426             :     logical, dimension(hydromet_dim), intent(in) :: &
     427             :       l_mix_rat_hm   ! if true, then the quantity is a hydrometeor mixing ratio
     428             : 
     429             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
     430             :       radf          ! Buoyancy production at cloud top due to longwave radiative cooling [m^2/s^3]
     431             : 
     432             : #ifdef CLUBBND_CAM
     433             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol) :: &
     434             :       varmu
     435             : #endif
     436             : 
     437             :     real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim), intent(in) :: &
     438             :       wphydrometp, & ! Covariance of w and a hydrometeor      [(m/s) <hm units>]
     439             :       wp2hmp,      & ! Third-order moment:  < w'^2 hm' > (hm = hydrometeor) [(m/s)^2 <hm units>]
     440             :       rtphmp_zt,   & ! Covariance of rt and hm (on thermo levs.) [(kg/kg) <hm units>]
     441             :       thlphmp_zt     ! Covariance of thl and hm (on thermo levs.)      [K <hm units>]
     442             : 
     443             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol) ::  &
     444             :       wpthlp_sfc,   & ! w' theta_l' at surface   [(m K)/s]
     445             :       wprtp_sfc,    & ! w' r_t' at surface       [(kg m)/( kg s)]
     446             :       upwp_sfc,     & ! u'w' at surface          [m^2/s^2]
     447             :       vpwp_sfc        ! v'w' at surface          [m^2/s^2]
     448             : 
     449             :     ! Passive scalar variables
     450             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,sclr_dim) :: &
     451             :       sclrm_forcing    ! Passive scalar forcing         [{units vary}/s]
     452             : 
     453             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,sclr_dim) ::  &
     454             :       wpsclrp_sfc      ! Passive scalar flux at surface         [{units vary} m/s]
     455             : 
     456             :     ! Eddy passive scalar variables
     457             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz,edsclr_dim) :: &
     458             :       edsclrm_forcing  ! Eddy-diffusion passive scalar forcing    [{units vary}/s]
     459             : 
     460             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol,edsclr_dim) ::  &
     461             :       wpedsclrp_sfc    ! Eddy-diffusion passive scalar flux at surface    [{units vary} m/s
     462             : 
     463             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol) :: &
     464             :       upwp_sfc_pert, & ! pertubed u'w' at surface    [m^2/s^2]
     465             :       vpwp_sfc_pert    ! pertubed v'w' at surface    [m^2/s^2]
     466             : 
     467             :     ! Reference profiles (used for nudging, sponge damping, and Coriolis effect)
     468             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
     469             :       rtm_ref,  & ! Initial total water mixing ratio             [kg/kg]
     470             :       thlm_ref, & ! Initial liquid water potential temperature   [K]
     471             :       um_ref,   & ! Initial u wind; Michael Falk                 [m/s]
     472             :       vm_ref,   & ! Initial v wind; Michael Falk                 [m/s]
     473             :       ug,       & ! u geostrophic wind                           [m/s]
     474             :       vg          ! v geostrophic wind                           [m/s]
     475             : 
     476             :     ! Host model horizontal grid spacing, if part of host model.
     477             :     real( kind = core_rknd ), intent(in), dimension(ngrdcol) :: &
     478             :       host_dx,  & ! East-west horizontal grid spacing     [m]
     479             :       host_dy     ! North-south horizontal grid spacing   [m]
     480             : 
     481             :     real( kind = core_rknd ), dimension(ngrdcol,nparams), intent(in) :: &
     482             :       clubb_params    ! Array of CLUBB's tunable parameters    [units vary]
     483             : 
     484             :     type(nu_vertical_res_dep), intent(in) :: &
     485             :       nu_vert_res_dep    ! Vertical resolution dependent nu values
     486             : 
     487             :     real( kind = core_rknd ), intent(in) :: &
     488             :       lmin    ! Min. value for the length scale    [m]
     489             : 
     490             :     type( clubb_config_flags_type ), intent(in) :: &
     491             :       clubb_config_flags ! Derived type holding all configurable CLUBB flags
     492             : 
     493             :     type (stats_metadata_type), intent(in) :: &
     494             :       stats_metadata
     495             : 
     496             :     !--------------------------- Input/Output Variables ---------------------------
     497             :     type (stats), target, intent(inout), dimension(ngrdcol) :: &
     498             :       stats_zt, &
     499             :       stats_zm, &
     500             :       stats_sfc
     501             : 
     502             :     ! These are prognostic or are planned to be in the future
     503             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  &
     504             :       um,      & ! eastward grid-mean wind component (thermodynamic levels)   [m/s]
     505             :       upwp,    & ! u'w' (momentum levels)                         [m^2/s^2]
     506             :       vm,      & ! northward grid-mean wind component (thermodynamic levels)   [m/s]
     507             :       vpwp,    & ! v'w' (momentum levels)                         [m^2/s^2]
     508             :       up2,     & ! u'^2 (momentum levels)                         [m^2/s^2]
     509             :       vp2,     & ! v'^2 (momentum levels)                         [m^2/s^2]
     510             :       up3,     & ! u'^3 (thermodynamic levels)                    [m^3/s^3]
     511             :       vp3,     & ! v'^3 (thermodynamic levels)                    [m^3/s^3]
     512             :       rtm,     & ! total water mixing ratio, r_t (thermo. levels) [kg/kg]
     513             :       wprtp,   & ! w' r_t' (momentum levels)                      [(kg/kg) m/s]
     514             :       thlm,    & ! liq. water pot. temp., th_l (thermo. levels)   [K]
     515             :       wpthlp,  & ! w'th_l' (momentum levels)                      [(m/s) K]
     516             :       rtp2,    & ! r_t'^2 (momentum levels)                       [(kg/kg)^2]
     517             :       rtp3,    & ! r_t'^3 (thermodynamic levels)                  [(kg/kg)^3]
     518             :       thlp2,   & ! th_l'^2 (momentum levels)                      [K^2]
     519             :       thlp3,   & ! th_l'^3 (thermodynamic levels)                 [K^3]
     520             :       rtpthlp, & ! r_t'th_l' (momentum levels)                    [(kg/kg) K]
     521             :       wp2,     & ! w'^2 (momentum levels)                         [m^2/s^2]
     522             :       wp3        ! w'^3 (thermodynamic levels)                    [m^3/s^3]
     523             : 
     524             :     ! Passive scalar variables
     525             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) :: &
     526             :       sclrm,     & ! Passive scalar mean (thermo. levels) [units vary]
     527             :       wpsclrp,   & ! w'sclr' (momentum levels)            [{units vary} m/s]
     528             :       sclrp2,    & ! sclr'^2 (momentum levels)            [{units vary}^2]
     529             :       sclrp3,    & ! sclr'^3 (thermodynamic levels)       [{units vary}^3]
     530             :       sclrprtp,  & ! sclr'rt' (momentum levels)           [{units vary} (kg/kg)]
     531             :       sclrpthlp    ! sclr'thl' (momentum levels)          [{units vary} K]
     532             : 
     533             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  &
     534             :       p_in_Pa, & ! Air pressure (thermodynamic levels)       [Pa]
     535             :       exner      ! Exner function (thermodynamic levels)     [-]
     536             : 
     537             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  &
     538             :       rcm,        & ! cloud water mixing ratio, r_c (thermo. levels) [kg/kg]
     539             :       cloud_frac, & ! cloud fraction (thermodynamic levels)          [-]
     540             :       wpthvp,     & ! < w' th_v' > (momentum levels)                 [kg/kg K]
     541             :       wp2thvp,    & ! < w'^2 th_v' > (thermodynamic levels)          [m^2/s^2 K]
     542             :       rtpthvp,    & ! < r_t' th_v' > (momentum levels)               [kg/kg K]
     543             :       thlpthvp      ! < th_l' th_v' > (momentum levels)              [K^2]
     544             : 
     545             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) :: &
     546             :       sclrpthvp     ! < sclr' th_v' > (momentum levels)   [units vary]
     547             : 
     548             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) ::  &
     549             :       wp2rtp,            & ! w'^2 rt' (thermodynamic levels)      [m^2/s^2 kg/kg]
     550             :       wp2thlp,           & ! w'^2 thl' (thermodynamic levels)     [m^2/s^2 K]
     551             :       uprcp,             & ! < u' r_c' > (momentum levels)        [(m/s)(kg/kg)]
     552             :       vprcp,             & ! < v' r_c' > (momentum levels)        [(m/s)(kg/kg)]
     553             :       rc_coef_zm,        & ! Coef of X'r_c' in Eq. (34) (m-levs.) [K/(kg/kg)]
     554             :       wp4,               & ! w'^4 (momentum levels)               [m^4/s^4]
     555             :       wpup2,             & ! w'u'^2 (thermodynamic levels)        [m^3/s^3]
     556             :       wpvp2,             & ! w'v'^2 (thermodynamic levels)        [m^3/s^3]
     557             :       wp2up2,            & ! w'^2 u'^2 (momentum levels)          [m^4/s^4]
     558             :       wp2vp2,            & ! w'^2 v'^2 (momentum levels)          [m^4/s^4]
     559             :       ice_supersat_frac    ! ice cloud fraction (thermo. levels)  [-]
     560             : 
     561             :     ! Variables used to track perturbed version of winds.
     562             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz) :: &
     563             :       um_pert,   & ! perturbed <u>       [m/s]
     564             :       vm_pert,   & ! perturbed <v>       [m/s]
     565             :       upwp_pert, & ! perturbed <u'w'>    [m^2/s^2]
     566             :       vpwp_pert    ! perturbed <v'w'>    [m^2/s^2] 
     567             : 
     568             :     type(pdf_parameter), intent(inout) :: &
     569             :       pdf_params,    & ! Fortran structure of PDF parameters on thermodynamic levels    [units vary]
     570             :       pdf_params_zm    ! Fortran structure of PDF parameters on momentum levels        [units vary]
     571             : 
     572             :     type(implicit_coefs_terms), intent(inout) :: &
     573             :       pdf_implicit_coefs_terms    ! Implicit coefs / explicit terms [units vary]
     574             : 
     575             : #ifdef GFDL
     576             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,sclr_dim) :: &  ! h1g, 2010-06-16
     577             :       sclrm_trsport_only  ! Passive scalar concentration due to pure transport [{units vary}/s]
     578             : #endif
     579             : 
     580             :     ! Eddy passive scalar variable
     581             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz,edsclr_dim) :: &
     582             :       edsclrm   ! Eddy passive scalar grid-mean (thermo. levels)   [units vary]
     583             : 
     584             :     ! Variables that need to be output for use in other parts of the CLUBB
     585             :     ! code, such as microphysics (rcm, pdf_params), forcings (rcm), and/or
     586             :     ! BUGSrad (cloud_cover).
     587             :     real( kind = core_rknd ), intent(out), dimension(ngrdcol,nz) ::  &
     588             :       rcm_in_layer, & ! rcm within cloud layer                          [kg/kg]
     589             :       cloud_cover     ! cloud cover                                     [-]
     590             : 
     591             :     ! Variables that need to be output for use in host models
     592             :     real( kind = core_rknd ), intent(out), dimension(ngrdcol,nz) ::  &
     593             :       wprcp,                 & ! w'r_c' (momentum levels)              [(kg/kg) m/s]
     594             :       w_up_in_cloud,         & ! Average cloudy updraft velocity       [m/s]
     595             :       w_down_in_cloud,       & ! Average cloudy downdraft velocity     [m/s]
     596             :       cloudy_updraft_frac,   & ! cloudy updraft fraction               [-]
     597             :       cloudy_downdraft_frac, & ! cloudy downdraft fraction             [-]
     598             :       invrs_tau_zm             ! One divided by tau on zm levels       [1/s]
     599             : 
     600             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
     601             :       Kh_zt, & ! Eddy diffusivity coefficient on thermodynamic levels   [m^2/s]
     602             :       Kh_zm    ! Eddy diffusivity coefficient on momentum levels        [m^2/s]
     603             : 
     604             : #ifdef CLUBB_CAM
     605             :     real( kind = core_rknd), intent(out), dimension(ngrdcol,nz) :: &
     606             :       qclvar        ! cloud water variance
     607             : #endif
     608             : 
     609             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
     610             :       thlprcp    ! thl'rc'              [K kg/kg]
     611             : 
     612             : #ifdef GFDL
     613             :     ! hlg, 2010-06-16
     614             :     real( kind = core_rknd ), intent(inout), dimension(ngrdcol,nz, min(1,sclr_dim) , 2) :: &
     615             :       RH_crit  ! critical relative humidity for droplet and ice nucleation
     616             : ! ---> h1g, 2012-06-14
     617             :     logical, intent(in)                 ::  do_liquid_only_in_clubb
     618             : ! <--- h1g, 2012-06-14
     619             : #endif
     620             : 
     621             :     !--------------------------- Local Variables ---------------------------
     622             :     integer :: i, k, j
     623             : 
     624             : #ifdef CLUBB_CAM
     625             :     integer ::  ixind
     626             : #endif
     627             : 
     628             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     629    17870112 :       Skw_zm,       & ! Skewness of w on momentum levels                 [-]
     630    17870112 :       Skw_zt,       & ! Skewness of w on thermodynamic levels            [-]
     631    17870112 :       thvm,         & ! Virtual potential temperature                    [K]
     632    17870112 :       thvm_zm,      & ! Virtual potential temperature on momentum levs.  [K]
     633    17870112 :       ddzm_thvm_zm    ! d(thvm_zm)/dz, centered over thermodynamic levs. [K/m]
     634             : 
     635             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     636    17870112 :       rsat   ! Saturation mixing ratio  ! Brian
     637             : 
     638             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     639    17870112 :       rtprcp, & ! rt'rc'               [kg^2/kg^2]
     640    17870112 :       rcp2      ! rc'^2                [kg^2/kg^2]
     641             : 
     642             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     643    17870112 :       wpthlp2,   & ! w'thl'^2    [m K^2/s]
     644    17870112 :       wprtp2,    & ! w'rt'^2     [m kg^2/kg^2]
     645    17870112 :       wprtpthlp, & ! w'rt'thl'   [m kg K/kg s]
     646    17870112 :       wp2rcp,    & ! w'^2 rc'    [m^2 kg/kg s^2]
     647    17870112 :       wp3_zm       ! w'^3        [m^3/s^3]
     648             : 
     649             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     650    17870112 :       Lscale,      & ! Length scale                          [m]
     651    17870112 :       Lscale_up,   & ! Length scale (upwards component)      [m]
     652    17870112 :       Lscale_down, & ! Length scale (downwards component)    [m]
     653    17870112 :       Lscale_zm      ! Length scale on momentum levels       [m]
     654             : 
     655             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     656    17870112 :       em,     & ! Turbulent Kinetic Energy (TKE)                      [m^2/s^2]
     657    17870112 :       tau_zm, & ! Eddy dissipation time scale on momentum levels      [s]
     658    17870112 :       tau_zt    ! Eddy dissipation time scale on thermodynamic levels [s]
     659             : 
     660             :     real( kind = core_rknd ), dimension(ngrdcol,nz,edsclr_dim) :: &
     661    17870112 :       wpedsclrp   ! w'edsclr'
     662             : 
     663             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
     664    17870112 :       sclrprcp,    & ! sclr'rc'
     665    17870112 :       wp2sclrp,    & ! w'^2 sclr'
     666    17870112 :       wpsclrp2,    & ! w'sclr'^2
     667    17870112 :       wpsclrprtp,  & ! w'sclr'rt'
     668    17870112 :       wpsclrpthlp    ! w'sclr'thl'
     669             : 
     670             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     671    17870112 :       wp2_zt,     & ! w'^2 on thermo. grid     [m^2/s^2]
     672    17870112 :       thlp2_zt,   & ! thl'^2 on thermo. grid   [K^2]
     673    17870112 :       wpthlp_zt,  & ! w'thl' on thermo. grid   [m K/s]
     674    17870112 :       wprtp_zt,   & ! w'rt' on thermo. grid    [m kg/(kg s)]
     675    17870112 :       rtp2_zt,    & ! rt'^2 on therm. grid     [(kg/kg)^2]
     676    17870112 :       rtpthlp_zt, & ! rt'thl' on thermo. grid  [kg K/kg]
     677    17870112 :       up2_zt,     & ! u'^2 on thermo. grid     [m^2/s^2]
     678    17870112 :       vp2_zt,     & ! v'^2 on thermo. grid     [m^2/s^2]
     679    17870112 :       upwp_zt,    & ! u'w' on thermo. grid     [m^2/s^2]
     680    17870112 :       vpwp_zt       ! v'w' on thermo. grid     [m^2/s^2]
     681             : 
     682             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     683    17870112 :       Skw_velocity,     & ! Skewness velocity                              [m/s]
     684    17870112 :       a3_coef,          & ! The a3 coefficient from CLUBB eqns             [-]
     685    17870112 :       a3_coef_zt          ! The a3 coefficient interpolated to the zt grid [-]
     686             : 
     687             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     688    17870112 :       wp3_on_wp2,   &  ! w'^3 / w'^2 on the zm grid [m/s]
     689    17870112 :       wp3_on_wp2_zt    ! w'^3 / w'^2 on the zt grid [m/s]
     690             : 
     691             :     ! Eric Raut declared this variable solely for output to disk
     692             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     693    17870112 :       rc_coef    ! Coefficient of X'r_c' in Eq. (34) on t-levs.  [K/(kg/kg)]
     694             : 
     695             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     696    17870112 :       Km_zm, & ! Eddy diffusivity for momentum on zm grid levels [m^2/s]
     697    17870112 :       Kmh_zm   ! Eddy diffusivity for thermodynamic variables [m^2/s]
     698             : 
     699             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     700    17870112 :       gamma_Skw_fnc,  & ! Gamma as a function of skewness               [-]
     701    17870112 :       sigma_sqd_w,    & ! PDF width parameter (momentum levels)         [-]
     702    17870112 :       sigma_sqd_w_tmp, & 
     703    17870112 :       sigma_sqd_w_zt, & ! PDF width parameter (thermodynamic levels)    [-]
     704    17870112 :       sqrt_em_zt,     & ! sqrt( em ) on zt levels; where em is TKE      [m/s]
     705    17870112 :       xp3_coef_fnc      ! Coefficient in simple xp3 equation            [-]
     706             : !Lscale_weight Uncomment this if you need to use this vairable at some point.
     707             : 
     708             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     709    17870112 :       w_1_zm,        & ! Mean w (1st PDF component)                   [m/s]
     710    17870112 :       w_2_zm,        & ! Mean w (2nd PDF component)                   [m/s]
     711    17870112 :       varnce_w_1_zm, & ! Variance of w (1st PDF component)            [m^2/s^2]
     712    17870112 :       varnce_w_2_zm, & ! Variance of w (2nd PDF component)            [m^2/s^2]
     713    17870112 :       mixt_frac_zm    ! Weight of 1st PDF component (Sk_w dependent) [-]
     714             : 
     715             :     integer :: &
     716             :       wprtp_cl_num,   & ! Instance of w'r_t' clipping (1st or 3rd).
     717             :       wpthlp_cl_num,  & ! Instance of w'th_l' clipping (1st or 3rd).
     718             :       wpsclrp_cl_num, & ! Instance of w'sclr' clipping (1st or 3rd).
     719             :       upwp_cl_num,    & ! Instance of u'w' clipping (1st or 2nd).
     720             :       vpwp_cl_num       ! Instance of v'w' clipping (1st or 2nd).
     721             : 
     722             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     723    17870112 :       rcp2_zt,              & ! r_c'^2 (on thermo. grid)             [kg^2/kg^2]
     724    17870112 :       cloud_frac_zm,        & ! Cloud Fraction on momentum grid      [-]
     725    17870112 :       ice_supersat_frac_zm, & ! Ice Cloud Fraction on momentum grid  [-]
     726    17870112 :       rtm_zm,               & ! Total water mixing ratio             [kg/kg]
     727    17870112 :       thlm_zm,              & ! Liquid potential temperature         [kg/kg]
     728    17870112 :       rcm_zm,               & ! Liquid water mixing ratio on m-levs. [kg/kg]
     729    17870112 :       wpsclrp_zt,           & ! Scalar flux on thermo. levels        [un. vary]
     730    17870112 :       sclrp2_zt               ! Scalar variance on thermo.levels     [un. vary]
     731             : 
     732             :     real( kind = core_rknd ), dimension(ngrdcol) :: &
     733    17870112 :       rtm_integral_before, &
     734    17870112 :       rtm_integral_after, &
     735    17870112 :       rtm_integral_forcing, &
     736    17870112 :       rtm_flux_top, &
     737    17870112 :       rtm_flux_sfc, &
     738    17870112 :       rtm_spur_src, &
     739    17870112 :       thlm_integral_before, &
     740    17870112 :       thlm_integral_after, &
     741    17870112 :       thlm_integral_forcing, &
     742    17870112 :       thlm_flux_top, &
     743    17870112 :       thlm_flux_sfc, &
     744    17870112 :       thlm_spur_src
     745             : 
     746             :     real( kind = core_rknd ), dimension(ngrdcol) :: &
     747    17870112 :       thlm1000, &
     748    17870112 :       thlm700                      
     749             : 
     750             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     751    17870112 :       rcm_supersat_adj, & ! Adjustment to rcm due to spurious supersaturation
     752    17870112 :       rel_humidity        ! Relative humidity after PDF closure [-]
     753             : 
     754             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     755    17870112 :        stability_correction,         & ! Stability correction factor
     756    17870112 :        invrs_tau_N2_zm,              & ! Inverse tau with static stability correction applied [1/s]
     757    17870112 :        invrs_tau_C6_zm,              & ! Inverse tau values used for C6 (pr1) term in wpxp [1/s]
     758    17870112 :        invrs_tau_C1_zm,              & ! Inverse tau values used for C1 (dp1) term in wp2 [1/s]
     759    17870112 :        invrs_tau_xp2_zm,             & ! Inverse tau values used for advance_xp2_wpxp [s^-1]
     760    17870112 :        invrs_tau_N2_iso,             & ! Inverse tau values used for C4 when 
     761             :                                        ! l_use_invrs_tau_N2_iso = .true.              [s^-1]
     762    17870112 :        invrs_tau_C4_zm,              & ! Inverse tau values used for C4 terms         [s^-1]
     763    17870112 :        invrs_tau_C14_zm,             & ! Inverse tau valuse used for C14 terms        [s^-1]
     764    17870112 :        invrs_tau_wp2_zm,             & ! Inverse tau values used for advance_wp2_wpxp [s^-1]
     765    17870112 :        invrs_tau_wpxp_zm,            & ! invrs_tau_C6_zm = invrs_tau_wpxp_zm
     766    17870112 :        invrs_tau_wp3_zm,             & ! Inverse tau values used for advance_wp3_wp2 [s^-1]
     767    17870112 :        invrs_tau_no_N2_zm,           & ! One divided by tau (without N2) on zm levels [s^-1]
     768    17870112 :        invrs_tau_bkgnd,              & ! One divided by tau_wp3 [s^-1]
     769    17870112 :        invrs_tau_shear,              & ! One divided by tau with stability effects    [s^-1]
     770    17870112 :        invrs_tau_sfc,                & ! One divided by tau (without N2) on zm levels [s^-1]
     771    17870112 :        invrs_tau_zt,                 & ! Inverse time-scale tau on thermodynamics levels [1/s]
     772    17870112 :        invrs_tau_wp3_zt,             & ! Inverse tau wp3 at zt levels
     773    17870112 :        Cx_fnc_Richardson,            & ! Cx_fnc computed from Richardson_num          [-]
     774    17870112 :        brunt_vaisala_freq_sqd,       & ! Buoyancy frequency squared, N^2              [s^-2]
     775    17870112 :        brunt_vaisala_freq_sqd_mixed, & ! A mixture of dry and moist N^2               [s^-2]
     776    17870112 :        brunt_vaisala_freq_sqd_dry,   & ! dry N^2                                      [s^-2]
     777    17870112 :        brunt_vaisala_freq_sqd_moist, & ! moist N^2                                    [s^-2]
     778    17870112 :        brunt_vaisala_freq_sqd_splat, & !                                              [s^-2]
     779    17870112 :        brunt_vaisala_freq_sqd_zt,    & ! Buoyancy frequency squared on t-levs.        [s^-2]
     780    17870112 :        Ri_zm                           ! Richardson number                            [-]
     781             : 
     782             : 
     783             :     real( kind = core_rknd ), parameter :: &
     784             :        ufmin = 0.01_core_rknd           ! minimum value of friction velocity     [m/s]
     785             : 
     786             :     real( kind = core_rknd ), dimension(ngrdcol) :: &
     787    17870112 :       Lscale_max    ! Max. allowable mixing length (based on grid box size) [m]
     788             : 
     789             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     790    17870112 :       tau_max_zm, & ! Max. allowable eddy dissipation time scale on m-levs  [s]
     791     8935056 :       tau_max_zt    ! Max. allowable eddy dissipation time scale on t-levs  [s]
     792             : 
     793             :     real( kind = core_rknd ) :: &
     794             :       below_grnd_val = 0.01_core_rknd
     795             : 
     796             :     real( kind = core_rknd ), dimension(ngrdcol) :: &
     797    17870112 :       mu
     798             : 
     799             :     real( kind = core_rknd ) :: &
     800             :       gamma_coef,     & ! CLUBB tunable parameter gamma_coef
     801             :       gamma_coefb,    & ! CLUBB tunable parameter gamma_coefb
     802             :       gamma_coefc       ! CLUBB tunable parameter gamma_coefc
     803             : 
     804             :     ! Flag to sample stats in a particular call to subroutine
     805             :     ! pdf_closure_driver.
     806             :     logical :: l_samp_stats_in_pdf_call
     807             : 
     808             :     ! Flag to determine whether invrs_tau_N2_iso is used in C4 terms.
     809             :     ! Important! This flag is only in use when l_diag_Lscale_from_tau = true
     810             :     ! Setting l_use_invrs_tau_N2_iso = true will not change anything unless
     811             :     ! l_diag_Lscale_from_tau is also true
     812             :     logical, parameter :: l_use_invrs_tau_N2_iso = .false.
     813             : 
     814             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     815    17870112 :        lhs_splat_wp2, & ! LHS coefficient of wp2 splatting term  [1/s]
     816    17870112 :        lhs_splat_wp3    ! LHS coefficient of wp3 splatting term  [1/s]
     817             : 
     818             :     ! Variables associated with upgradient momentum contributions due to cumuli
     819             :     !real( kind = core_rknd ), dimension(nz) :: &
     820             :     !  Km_Skw_factor ! Factor, with value < 1, that reduces eddy diffusivity,
     821             :     !                                          Km_zm, in skewed layers
     822             :     !real( kind = core_rknd ),parameter :: &
     823             :     !  Km_Skw_thresh = zero_threshold, &  ! Value of Skw at which Skw correction kicks in
     824             :     !  Km_Skw_factor_efold = 0.5_core_rknd, & ! E-folding rate of exponential Skw correction
     825             :     !  Km_Skw_factor_min   = 0.2_core_rknd    ! Minimum value of Km_Skw_factor
     826             : 
     827             :     integer, intent(out) :: &
     828             :       err_code_out  ! Error code indicator
     829             : 
     830  7039785168 :     type(pdf_parameter) :: pdf_params_single_col(ngrdcol), &
     831  7030850112 :                            pdf_params_zm_single_col(ngrdcol)
     832             : 
     833             :     integer :: advance_order_loop_iter
     834             : 
     835             :     integer :: smth_type = 2  ! Used for Lscale_width_vert_avg
     836             : 
     837             :     !----- Begin Code -----
     838             : 
     839             :     !$acc enter data create( Skw_zm, Skw_zt, thvm, thvm_zm, ddzm_thvm_zm, rtprcp, rcp2, &
     840             :     !$acc              wpthlp2, wprtp2, wprtpthlp, wp2rcp, wp3_zm, Lscale, Lscale_up, Lscale_zm, &
     841             :     !$acc              Lscale_down, em, tau_zm, tau_zt, &
     842             :     !$acc              wp2_zt, thlp2_zt, wpthlp_zt, &
     843             :     !$acc              wprtp_zt, rtp2_zt, rtpthlp_zt, up2_zt, vp2_zt, upwp_zt, vpwp_zt, &
     844             :     !$acc              Skw_velocity, a3_coef, a3_coef_zt, wp3_on_wp2, wp3_on_wp2_zt, &
     845             :     !$acc              rc_coef, Km_zm, Kmh_zm, gamma_Skw_fnc, sigma_sqd_w, sigma_sqd_w_tmp, sigma_sqd_w_zt, &
     846             :     !$acc              sqrt_em_zt, xp3_coef_fnc, w_1_zm, w_2_zm, varnce_w_1_zm, varnce_w_2_zm, &
     847             :     !$acc              mixt_frac_zm, rcp2_zt, cloud_frac_zm, ice_supersat_frac_zm, rtm_zm, &
     848             :     !$acc              thlm_zm, rcm_zm, thlm1000, thlm700, &
     849             :     !$acc              rcm_supersat_adj, stability_correction, invrs_tau_N2_zm, &
     850             :     !$acc              invrs_tau_C6_zm, invrs_tau_C1_zm, invrs_tau_xp2_zm, invrs_tau_N2_iso, &
     851             :     !$acc              invrs_tau_C4_zm, invrs_tau_C14_zm, invrs_tau_wp2_zm, invrs_tau_wpxp_zm, &
     852             :     !$acc              invrs_tau_wp3_zm, invrs_tau_no_N2_zm, invrs_tau_bkgnd, invrs_tau_shear, &
     853             :     !$acc              invrs_tau_sfc, invrs_tau_zt, invrs_tau_wp3_zt, Cx_fnc_Richardson, &
     854             :     !$acc              brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, &
     855             :     !$acc              brunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_moist, &
     856             :     !$acc              brunt_vaisala_freq_sqd_splat, &
     857             :     !$acc              brunt_vaisala_freq_sqd_zt, Ri_zm, Lscale_max, &
     858             :     !$acc              tau_max_zm, tau_max_zt, mu, lhs_splat_wp2, lhs_splat_wp3 )
     859             : 
     860             :     !$acc enter data if( sclr_dim > 0 ) &
     861             :     !$acc            create( sclrprcp, wp2sclrp, &
     862             :     !$acc                    wpsclrp2, wpsclrprtp, wpsclrpthlp, wpsclrp_zt, sclrp2_zt )
     863             : 
     864             :     !$acc enter data if( edsclr_dim > 0 ) &
     865             :     !$acc            create( wpedsclrp )
     866             : 
     867     8935056 :     if ( clubb_config_flags%l_lmm_stepping ) then
     868           0 :       dt_advance = two * dt
     869             :     else
     870     8935056 :       dt_advance = dt
     871             :     end if
     872             : 
     873     8935056 :     err_code_out = clubb_no_error  ! Initialize to no error value
     874             : 
     875             :     ! Determine the maximum allowable value for Lscale (in meters).
     876             :     call set_Lscale_max( ngrdcol, l_implemented, host_dx, host_dy, & ! intent(in)
     877     8935056 :                          Lscale_max )                                ! intent(out)
     878             : 
     879     8935056 :     if ( stats_metadata%l_stats .and. stats_metadata%l_stats_samp ) then
     880             : 
     881             :       !$acc update host( wm_zt, wm_zm, rho_ds_zt, rtm, gr%dzt, &
     882             :       !$acc              rtm, thlm )
     883             : 
     884             :       ! Spurious source will only be calculated if rtm_ma and thlm_ma are zero.
     885             :       ! Therefore, wm must be zero or l_implemented must be true.
     886             :       
     887           0 :       do i = 1, ngrdcol
     888           0 :         if ( l_implemented .or. ( all( abs(wm_zt(i,:)) < eps ) .and. &
     889           0 :              all( abs(wm_zm(i,:)) < eps ) ) ) then
     890             :           ! Get the vertical integral of rtm and thlm before this function begins
     891             :           ! so that spurious source can be calculated
     892             :           rtm_integral_before(i)  &
     893           0 :           = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
     894           0 :                                rtm(i,2:nz), gr%dzt(i,2:nz) )
     895             : 
     896           0 :           thlm_integral_before(i)  &
     897             :           = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
     898           0 :                                thlm(i,2:nz), gr%dzt(i,2:nz) )
     899             :         end if
     900             :       end do
     901             :     end if
     902             : 
     903             :     !----------------------------------------------------------------
     904             :     ! Test input variables
     905             :     !----------------------------------------------------------------
     906     8935056 :     if ( clubb_at_least_debug_level( 2 ) ) then
     907             : 
     908             :       !$acc update host( thlm_forcing, rtm_forcing, um_forcing, vm_forcing, &
     909             :       !$acc              wm_zm, wm_zt, p_in_Pa, rho_zm, rho, exner, rho_ds_zm, &
     910             :       !$acc              rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, &
     911             :       !$acc              thv_ds_zt, wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, &
     912             :       !$acc              um, upwp, vm, vpwp, up2, vp2, rtm, wprtp, thlm, wpthlp, &
     913             :       !$acc              wp2, wp3, rtp2, thlp2, rtpthlp )
     914             : 
     915             :       !$acc update host( wpsclrp_sfc, wpedsclrp_sfc, sclrm, wpsclrp, &
     916             :       !$acc              sclrp2, sclrprtp, sclrpthlp, sclrm_forcing ) &
     917             :       !$acc if ( sclr_dim > 0 )
     918             : 
     919             :       !$acc update host( edsclrm, edsclrm_forcing  ) if ( edsclr_dim > 0 )
     920             : 
     921           0 :       do i = 1, ngrdcol
     922             :         call parameterization_check( &
     923             :                nz, sclr_dim, edsclr_dim, &
     924           0 :                thlm_forcing(i,:), rtm_forcing(i,:), um_forcing(i,:),                         & ! intent(in)
     925           0 :                vm_forcing(i,:), wm_zm(i,:), wm_zt(i,:), p_in_Pa(i,:),                                 & ! intent(in)
     926           0 :                rho_zm(i,:), rho(i,:), exner(i,:), rho_ds_zm(i,:),                                     & ! intent(in)
     927           0 :                rho_ds_zt(i,:), invrs_rho_ds_zm(i,:), invrs_rho_ds_zt(i,:),                       & ! intent(in)
     928           0 :                thv_ds_zm(i,:), thv_ds_zt(i,:), wpthlp_sfc(i), wprtp_sfc(i), upwp_sfc(i),             & ! intent(in)
     929             :                vpwp_sfc(i), um(i,:), upwp(i,:), vm(i,:), vpwp(i,:), up2(i,:), vp2(i,:),                            & ! intent(in)
     930           0 :                rtm(i,:), wprtp(i,:), thlm(i,:), wpthlp(i,:), wp2(i,:), wp3(i,:),                                & ! intent(in)
     931           0 :                rtp2(i,:), thlp2(i,:), rtpthlp(i,:),                                              & ! intent(in)
     932             :                !rcm,                                                               &
     933             :                "beginning of ",                                                   & ! intent(in)
     934           0 :                wpsclrp_sfc(i,:), wpedsclrp_sfc(i,:), sclrm(i,:,:), wpsclrp(i,:,:), sclrp2(i,:,:),                & ! intent(in)
     935           0 :                sclrprtp(i,:,:), sclrpthlp(i,:,:), sclrm_forcing(i,:,:), edsclrm(i,:,:), edsclrm_forcing(i,:,:) )       ! intent(in)
     936             : 
     937             :       end do
     938             : 
     939           0 :       if ( err_code == clubb_fatal_error ) then
     940           0 :         write(fstderr,*) "Fatal error when testing input"
     941           0 :         err_code_out = err_code
     942           0 :         return
     943             :       end if
     944             : 
     945             :     end if
     946             :     !-----------------------------------------------------------------------
     947             : 
     948     8935056 :     if ( stats_metadata%l_stats_samp ) then
     949             : 
     950             :       !$acc update host( rfrzm, wp2, vp2, up2, wprtp, wpthlp, upwp, vpwp, &
     951             :       !$acc              rtp2, thlp2, rtpthlp, rtm, thlm, um, vm, wp3 )
     952             : 
     953           0 :       do i = 1, ngrdcol
     954             : 
     955           0 :         call stat_update_var( stats_metadata%irfrzm, rfrzm(i,:), & ! intent(in)
     956           0 :                               stats_zt(i) ) ! intent(inout)
     957             : 
     958             :       ! Set up budget stats variables.
     959             :         
     960             :         !print *, "B stats_zt(i)%accum_field_values", stats_zt(i)%accum_field_values
     961             :         !print *, "wp2(i,:) = ", wp2(i,:)
     962             : 
     963           0 :          call stat_begin_update( nz, stats_metadata%iwp2_bt, wp2(i,:) / dt, & ! intent(in)
     964           0 :                                  stats_zm(i) )           ! intent(inout)
     965             :                                  
     966             :          !print *, "A stats_zt(i)%accum_field_values", stats_zt(i)%accum_field_values
     967             :                                  
     968             :                                  
     969           0 :          call stat_begin_update( nz, stats_metadata%ivp2_bt, vp2(i,:) / dt, & ! intent(in)
     970           0 :                                  stats_zm(i) )           ! intent(inout)
     971           0 :          call stat_begin_update( nz, stats_metadata%iup2_bt, up2(i,:) / dt, & ! intent(in)
     972           0 :                                  stats_zm(i) )           ! intent(inout)
     973           0 :          call stat_begin_update( nz, stats_metadata%iwprtp_bt, wprtp(i,:) / dt, & ! intent(in)
     974           0 :                                  stats_zm(i) )               ! intent(inout)
     975           0 :          call stat_begin_update( nz, stats_metadata%iwpthlp_bt, wpthlp(i,:) / dt, & ! intent(in)
     976           0 :                                  stats_zm(i) )                 ! intent(inout)
     977           0 :          if ( clubb_config_flags%l_predict_upwp_vpwp ) then
     978           0 :             call stat_begin_update( nz, stats_metadata%iupwp_bt, upwp(i,:) / dt, & ! intent(in)
     979           0 :                                     stats_zm(i) )             ! intent(inout)
     980           0 :             call stat_begin_update( nz, stats_metadata%ivpwp_bt, vpwp(i,:) / dt, & ! intent(in)
     981           0 :                                     stats_zm(i) )             ! intent(inout)
     982             :          endif ! l_predict_upwp_vpwp
     983           0 :          call stat_begin_update( nz, stats_metadata%irtp2_bt, rtp2(i,:) / dt, & ! intent(in)
     984           0 :                                  stats_zm(i) )             ! intent(inout)
     985           0 :          call stat_begin_update( nz, stats_metadata%ithlp2_bt, thlp2(i,:) / dt, & ! intent(in)
     986           0 :                                  stats_zm(i) )               ! intent(inout)
     987           0 :          call stat_begin_update( nz, stats_metadata%irtpthlp_bt, rtpthlp(i,:) / dt, & ! intent(in)
     988           0 :                                  stats_zm(i) )                   ! intent(inout)
     989             : 
     990           0 :          call stat_begin_update( nz, stats_metadata%irtm_bt, rtm(i,:) / dt, & ! intent(in)
     991           0 :                                  stats_zt(i) )           ! intent(inout)
     992           0 :          call stat_begin_update( nz, stats_metadata%ithlm_bt, thlm(i,:) / dt, & ! intent(in)
     993           0 :                                  stats_zt(i) )             ! intent(inout)
     994           0 :          call stat_begin_update( nz, stats_metadata%ium_bt, um(i,:) / dt, & ! intent(in)
     995           0 :                                  stats_zt(i) )         ! intent(inout)
     996           0 :          call stat_begin_update( nz, stats_metadata%ivm_bt, vm(i,:) / dt, & ! intent(in)
     997           0 :                                  stats_zt(i) )         ! intent(inout)
     998           0 :          call stat_begin_update( nz, stats_metadata%iwp3_bt, wp3(i,:) / dt, & ! intent(in)
     999           0 :                                  stats_zt(i) )           ! intent(inout)
    1000             : 
    1001             :       end do
    1002             : 
    1003             :     end if
    1004             : 
    1005             :     ! SET SURFACE VALUES OF FLUXES (BROUGHT IN)
    1006             :     ! We only do this for host models that do not apply the flux
    1007             :     ! elsewhere in the code (e.g. WRF).  In other cases the _sfc variables will
    1008             :     ! only be used to compute the variance at the surface. -dschanen 8 Sept 2009
    1009     8935056 :     if ( .not. clubb_config_flags%l_host_applies_sfc_fluxes ) then
    1010             : 
    1011             :       !$acc parallel loop gang vector default(present)
    1012   149194656 :       do i = 1, ngrdcol
    1013   140259600 :         wpthlp(i,1) = wpthlp_sfc(i)
    1014   140259600 :         wprtp(i,1)  = wprtp_sfc(i)
    1015   140259600 :         upwp(i,1)   = upwp_sfc(i)
    1016   149194656 :         vpwp(i,1)   = vpwp_sfc(i)
    1017             :       end do
    1018             :       !$acc end parallel loop
    1019             : 
    1020     8935056 :       if ( clubb_config_flags%l_linearize_pbl_winds ) then
    1021             :         !$acc parallel loop gang vector default(present)
    1022           0 :         do i = 1, ngrdcol
    1023           0 :           upwp_pert(i,1) = upwp_sfc_pert(i)
    1024           0 :           vpwp_pert(i,1) = vpwp_sfc_pert(i)
    1025             :         end do
    1026             :         !$acc end parallel loop
    1027             :       endif ! l_linearize_pbl_winds
    1028             : 
    1029             :       ! Set fluxes for passive scalars (if enabled)
    1030     8935056 :       if ( sclr_dim > 0 ) then
    1031             :         !$acc parallel loop gang vector collapse(2) default(present)
    1032           0 :         do j = 1, sclr_dim
    1033           0 :           do i = 1, ngrdcol
    1034           0 :             wpsclrp(i,1,j)   = wpsclrp_sfc(i,j)
    1035             :           end do
    1036             :         end do
    1037             :         !$acc end parallel loop
    1038             :       end if
    1039             : 
    1040     8935056 :       if ( edsclr_dim > 0 ) then
    1041             :         !$acc parallel loop gang vector collapse(2) default(present)
    1042   125090784 :         do j = 1, edsclr_dim
    1043  1948465584 :           do i = 1, ngrdcol
    1044  1939530528 :             wpedsclrp(i,1,j) = wpedsclrp_sfc(i,j)
    1045             :           end do
    1046             :         end do
    1047             :         !$acc end parallel loop
    1048             :       end if
    1049             : 
    1050             :     else
    1051             : 
    1052             :       !$acc parallel loop gang vector default(present)
    1053           0 :       do i = 1, ngrdcol
    1054           0 :         wpthlp(i,1) = 0.0_core_rknd
    1055           0 :         wprtp(i,1)  = 0.0_core_rknd
    1056           0 :         upwp(i,1)   = 0.0_core_rknd
    1057           0 :         vpwp(i,1)   = 0.0_core_rknd
    1058             :       end do
    1059             :       !$acc end parallel loop
    1060             : 
    1061             :       ! Set fluxes for passive scalars (if enabled)
    1062           0 :       if ( sclr_dim > 0 ) then
    1063             :         !$acc parallel loop gang vector collapse(2) default(present)
    1064           0 :         do j = 1, edsclr_dim
    1065           0 :           do i = 1, ngrdcol
    1066           0 :             wpsclrp(i,1,j) = 0.0_core_rknd
    1067             :           end do
    1068             :         end do
    1069             :         !$acc end parallel loop
    1070             :       end if
    1071             : 
    1072           0 :       if ( edsclr_dim > 0 ) then
    1073             :         !$acc parallel loop gang vector collapse(2) default(present)
    1074           0 :         do j = 1, edsclr_dim
    1075           0 :           do i = 1, ngrdcol
    1076           0 :             wpedsclrp(i,1,j) = 0.0_core_rknd
    1077             :           end do
    1078             :         end do
    1079             :         !$acc end parallel loop
    1080             :       end if
    1081             : 
    1082             :     end if ! ~l_host_applies_sfc_fluxes
    1083             : 
    1084             : #ifdef CLUBBND_CAM
    1085             :     !$acc parallel loop gang vector default(present)
    1086             :     do i = 1, ngrdcol
    1087             :       mu(i) = varmu(i)
    1088             :     end do
    1089             :     !$acc end parallel loop
    1090             : #else
    1091             :     !$acc parallel loop gang vector default(present)
    1092   149194656 :     do i = 1, ngrdcol
    1093   149194656 :       mu(i) = clubb_params(i,imu)
    1094             :     end do
    1095             :     !$acc end parallel loop
    1096             : #endif
    1097             : 
    1098             :     if ( clubb_config_flags%ipdf_call_placement == ipdf_pre_advance_fields &
    1099     8935056 :          .or. clubb_config_flags%ipdf_call_placement &
    1100             :               == ipdf_pre_post_advance_fields ) then
    1101             : 
    1102             :       ! Sample stats in this call to subroutine pdf_closure_driver for
    1103             :       ! both of these options (ipdf_pre_advance_fields and
    1104             :       ! ipdf_pre_post_advance_fields).
    1105           0 :       if ( clubb_config_flags%ipdf_call_placement &
    1106             :            == ipdf_pre_advance_fields ) then
    1107           0 :         l_samp_stats_in_pdf_call = .true.
    1108           0 :       elseif ( clubb_config_flags%ipdf_call_placement &
    1109             :                == ipdf_pre_post_advance_fields ) then
    1110           0 :         l_samp_stats_in_pdf_call = .true.
    1111             :       end if
    1112             : 
    1113             :       !########################################################################
    1114             :       !#######                     CALL CLUBB's PDF                     #######
    1115             :       !#######   AND OUTPUT PDF PARAMETERS AND INTEGRATED QUANTITITES   #######
    1116             :       !########################################################################
    1117             :       call pdf_closure_driver( gr, nz, ngrdcol,                             & ! Intent(in)
    1118             :                                dt, hydromet_dim, sclr_dim, sclr_tol,        & ! Intent(in)
    1119             :                                wprtp, thlm, wpthlp, rtp2, rtp3,             & ! Intent(in)
    1120             :                                thlp2, thlp3, rtpthlp, wp2,                  & ! Intent(in)
    1121             :                                wp3, wm_zm, wm_zt,                           & ! Intent(in)
    1122             :                                um, up2, upwp, up3,                          & ! Intent(in)
    1123             :                                vm, vp2, vpwp, vp3,                          & ! Intent(in)
    1124             :                                p_in_Pa, exner,                              & ! Intent(in)
    1125             :                                thv_ds_zm, thv_ds_zt, rtm_ref,               & ! Intent(in)
    1126             :                                ! rfrzm, hydromet,                             &
    1127             :                                wphydrometp,                                 & ! Intent(in)
    1128             :                                wp2hmp, rtphmp_zt, thlphmp_zt,               & ! Intent(in)
    1129             :                                sclrm, wpsclrp, sclrp2,                      & ! Intent(in)
    1130             :                                sclrprtp, sclrpthlp, sclrp3,                 & ! Intent(in)
    1131             :                                l_samp_stats_in_pdf_call,                    & ! Intent(in)
    1132             :                                clubb_params,                                & ! Intent(in)
    1133             :                                clubb_config_flags%iiPDF_type,               & ! Intent(in)
    1134             :                                clubb_config_flags%saturation_formula,       & ! Intent(in)
    1135             :                                clubb_config_flags%l_predict_upwp_vpwp,      & ! Intent(in)
    1136             :                                clubb_config_flags%l_rtm_nudge,              & ! Intent(in)
    1137             :                                clubb_config_flags%l_trapezoidal_rule_zt,    & ! Intent(in)
    1138             :                                clubb_config_flags%l_trapezoidal_rule_zm,    & ! Intent(in)
    1139             :                                clubb_config_flags%l_call_pdf_closure_twice, & ! Intent(in)
    1140             :                                clubb_config_flags%l_use_cloud_cover,        & ! Intent(in)
    1141             :                                clubb_config_flags%l_rcm_supersat_adj,       & ! Intent(in)
    1142             :                                l_mix_rat_hm,                                & ! Intent(in)
    1143             :                                stats_metadata,                              & ! Intent(in)
    1144             :                                stats_zt, stats_zm,                          & ! Intent(inout)
    1145             :                                rtm,                                         & ! Intent(inout)
    1146             :                                pdf_implicit_coefs_terms,                    & ! Intent(inout)
    1147             :                                pdf_params, pdf_params_zm,                   & ! Intent(inout)
    1148             : #ifdef GFDL
    1149             :                                RH_crit(k, : , :),                           & ! Intent(inout)
    1150             :                                do_liquid_only_in_clubb,                     & ! Intent(in)
    1151             : #endif
    1152             :                                rcm, cloud_frac,                             & ! Intent(out)
    1153             :                                ice_supersat_frac, wprcp,                    & ! Intent(out)
    1154             :                                sigma_sqd_w, wpthvp, wp2thvp,                & ! Intent(out)
    1155             :                                rtpthvp, thlpthvp, rc_coef,                  & ! Intent(out)
    1156             :                                rcm_in_layer, cloud_cover,                   & ! Intent(out)
    1157             :                                rcp2_zt, thlprcp,                            & ! Intent(out)
    1158             :                                rc_coef_zm, sclrpthvp,                       & ! Intent(out)
    1159             :                                wpup2, wpvp2,                                & ! Intent(out)
    1160             :                                wp2up2, wp2vp2, wp4,                         & ! Intent(out)
    1161             :                                wp2rtp, wprtp2, wp2thlp,                     & ! Intent(out)
    1162             :                                wpthlp2, wprtpthlp, wp2rcp,                  & ! Intent(out)
    1163             :                                rtprcp, rcp2,                                & ! Intent(out)
    1164             :                                uprcp, vprcp,                                & ! Intent(out)
    1165             :                                w_up_in_cloud, w_down_in_cloud,              & ! Intent(out)
    1166             :                                cloudy_updraft_frac,                         & ! Intent(out)
    1167             :                                cloudy_downdraft_frac,                       & ! intent(out)
    1168             :                                Skw_velocity,                                & ! Intent(out)
    1169             :                                cloud_frac_zm,                               & ! Intent(out)
    1170             :                                ice_supersat_frac_zm,                        & ! Intent(out)
    1171             :                                rtm_zm, thlm_zm, rcm_zm,                     & ! Intent(out)
    1172             :                                rcm_supersat_adj,                            & ! Intent(out)
    1173             :                                wp2sclrp, wpsclrp2, sclrprcp,                & ! Intent(out)
    1174           0 :                                wpsclrprtp, wpsclrpthlp )                      ! Intent(out)
    1175             :       
    1176             :     endif ! clubb_config_flags%ipdf_call_placement == ipdf_pre_advance_fields
    1177             :           ! or clubb_config_flags%ipdf_call_placement
    1178             :           !    == ipdf_pre_post_advance_fields
    1179             : 
    1180             :     ! Interpolate wp3 to momentum levels, and wp2 to thermodynamic levels
    1181             :     ! and then compute Skw for m & t grid.
    1182     8935056 :     wp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, wp2(:,:), w_tol_sqd )  ! Positive definite quantity
    1183     8935056 :     wp3_zm(:,:) = zt2zm( nz, ngrdcol, gr, wp3(:,:) )
    1184             : 
    1185             :     call Skx_func( nz, ngrdcol, wp2_zt, wp3, &
    1186             :                    w_tol, clubb_params, &
    1187     8935056 :                    Skw_zt )
    1188             :                    
    1189             :     call Skx_func( nz, ngrdcol, wp2, wp3_zm, &
    1190             :                    w_tol, clubb_params, &
    1191     8935056 :                    Skw_zm )
    1192             :    
    1193     8935056 :     if ( clubb_config_flags%ipdf_call_placement == ipdf_post_advance_fields ) then
    1194             : 
    1195             :       ! Calculate sigma_sqd_w here in order to avoid having to pass it in
    1196             :       ! and out of subroutine advance_clubb_core.
    1197             :       if ( l_gamma_Skw ) then
    1198             : 
    1199             :         !$acc parallel loop gang vector collapse(2) default(present)
    1200   768414816 :         do k = 1, nz
    1201 12690480816 :           do i = 1, ngrdcol
    1202             : 
    1203 11922066000 :             gamma_coef = clubb_params(i,igamma_coef)
    1204 11922066000 :             gamma_coefb = clubb_params(i,igamma_coefb)
    1205 11922066000 :             gamma_coefc = clubb_params(i,igamma_coefc)
    1206             : 
    1207 12681545760 :             if ( abs(gamma_coef-gamma_coefb) > abs(gamma_coef+gamma_coefb)*eps/2) then
    1208             :             
    1209           0 :               gamma_Skw_fnc(i,k) = gamma_coefb + (gamma_coef-gamma_coefb) &
    1210           0 :                     *exp( -(1.0_core_rknd/2.0_core_rknd) * (Skw_zm(i,k)/gamma_coefc)**2 )
    1211             :             else
    1212 11922066000 :               gamma_Skw_fnc(i,k) = gamma_coef
    1213             :             end if
    1214             : 
    1215             :           end do
    1216             :         end do
    1217             :         !$acc end parallel loop
    1218             : 
    1219             :       else
    1220             : 
    1221             :         !$acc parallel loop gang vector collapse(2) default(present)
    1222             :         do k = 1, nz
    1223             :           do i = 1, ngrdcol
    1224             :             gamma_Skw_fnc(i,k) = clubb_params(i,igamma_coef)
    1225             :           end do
    1226             :         end do
    1227             :         !$acc end parallel loop
    1228             : 
    1229             :       end if
    1230             : 
    1231             :       ! Compute sigma_sqd_w (dimensionless PDF width parameter)
    1232             :       call compute_sigma_sqd_w( nz, ngrdcol, &
    1233             :                                 gamma_Skw_fnc, wp2, thlp2, rtp2, &
    1234             :                                 up2, vp2, wpthlp, wprtp, upwp, vpwp, &
    1235             :                                 clubb_config_flags%l_predict_upwp_vpwp, &
    1236     8935056 :                                 sigma_sqd_w_tmp )
    1237             : 
    1238             :       ! Smooth in the vertical using interpolation
    1239     8935056 :       sigma_sqd_w(:,:) = zm2zt2zm( nz, ngrdcol, gr, sigma_sqd_w_tmp(:,:), zero_threshold )
    1240             : 
    1241             :     endif ! clubb_config_flags%ipdf_call_placement == ipdf_post_advance_fields
    1242             : 
    1243             : 
    1244             :     ! Compute the a3 coefficient (formula 25 in `Equations for CLUBB')
    1245             :     ! Note:  a3 has been modified because the wp3 turbulent advection term is
    1246             :     !        now discretized on its own.  This removes the "- 3" from the end.
    1247             : !   a3_coef = 3.0_core_rknd * sigma_sqd_w*sigma_sqd_w  &
    1248             : !      + 6.0_core_rknd*(1.0_core_rknd-sigma_sqd_w)*sigma_sqd_w  &
    1249             : !      + (1.0_core_rknd-sigma_sqd_w)*(1.0_core_rknd-sigma_sqd_w)
    1250             : 
    1251             :     ! This is a simplified version of the formula above.
    1252             :     ! Note:  a3 has been modified because the wp3 turbulent advection term is
    1253             :     !        now discretized on its own.
    1254             :     !$acc parallel loop gang vector collapse(2) default(present)
    1255   768414816 :     do k = 1, nz
    1256 12690480816 :       do i = 1, ngrdcol
    1257 12681545760 :         a3_coef(i,k) = -2._core_rknd * ( 1._core_rknd - sigma_sqd_w(i,k) )**2 + 3.0_core_rknd
    1258             :       end do
    1259             :     end do
    1260             :     !$acc end parallel loop
    1261             : 
    1262             :     ! We found we obtain fewer spikes in wp3 when we clip a3 to be no greater
    1263             :     ! than -1.4 -dschanen 4 Jan 2011
    1264             :     !a3_coef = max( a3_coef, -1.4_core_rknd ) ! Known magic number
    1265             :     !$acc parallel loop gang vector collapse(2) default(present)
    1266   768414816 :     do k = 1, nz
    1267 12690480816 :       do i = 1, ngrdcol
    1268 12681545760 :         a3_coef(i,k) = max( a3_coef(i,k), clubb_params(i,ia3_coef_min) )
    1269             :       end do
    1270             :     end do
    1271             :     !$acc end parallel loop
    1272             : 
    1273     8935056 :     a3_coef_zt(:,:) = zm2zt( nz, ngrdcol, gr, a3_coef(:,:) )
    1274             : 
    1275             :     ! Interpolate thlp2, rtp2, and rtpthlp to thermodynamic levels.
    1276     8935056 :     thlp2_zt(:,:)   = zm2zt( nz, ngrdcol, gr, thlp2(:,:), thl_tol**2 )  ! Positive def. quantity
    1277     8935056 :     rtp2_zt(:,:)    = zm2zt( nz, ngrdcol, gr, rtp2(:,:), rt_tol**2 )   ! Positive def. quantity
    1278     8935056 :     rtpthlp_zt(:,:) = zm2zt( nz, ngrdcol, gr, rtpthlp(:,:) )
    1279             : 
    1280             :     ! Compute wp3 / wp2 on zt levels.  Always use the interpolated value in the
    1281             :     ! denominator since it's less likely to create spikes
    1282             :     !$acc parallel loop gang vector collapse(2) default(present)
    1283   768414816 :     do k = 1, nz
    1284 12690480816 :       do i = 1, ngrdcol
    1285 12681545760 :         wp3_on_wp2_zt(i,k) = ( wp3(i,k) / max( wp2_zt(i,k), w_tol_sqd ) )
    1286             :       end do
    1287             :     end do
    1288             :     !$acc end parallel loop
    1289             : 
    1290             :     ! Clip wp3_on_wp2_zt if it's too large
    1291             :     !$acc parallel loop gang vector collapse(2) default(present)
    1292   768414816 :     do k = 1, nz
    1293 12690480816 :       do i = 1, ngrdcol
    1294 12681545760 :         if( wp3_on_wp2_zt(i,k) < 0._core_rknd ) then
    1295  9112710406 :           wp3_on_wp2_zt(i,k) = max( -1000._core_rknd, wp3_on_wp2_zt(i,k) )
    1296             :         else
    1297  2809355594 :           wp3_on_wp2_zt(i,k) = min( 1000._core_rknd, wp3_on_wp2_zt(i,k) )
    1298             :         end if
    1299             :       end do
    1300             :     end do
    1301             :     !$acc end parallel loop
    1302             : 
    1303             :     ! Compute wp3_on_wp2 by interpolating wp3_on_wp2_zt
    1304     8935056 :     wp3_on_wp2(:,:) = zt2zm( nz, ngrdcol, gr, wp3_on_wp2_zt(:,:) )
    1305             : 
    1306             :     ! Smooth again as above
    1307     8935056 :     wp3_on_wp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, wp3_on_wp2(:,:) )
    1308             : 
    1309             :     !----------------------------------------------------------------
    1310             :     ! Compute thvm
    1311             :     !----------------------------------------------------------------
    1312             :     call calculate_thvm( nz, ngrdcol, &
    1313             :                          thlm, rtm, rcm, exner, thv_ds_zt, &
    1314     8935056 :                          thvm )
    1315             : 
    1316             :     !----------------------------------------------------------------
    1317             :     ! Compute tke (turbulent kinetic energy)
    1318             :     !----------------------------------------------------------------
    1319     8935056 :     if ( .not. clubb_config_flags%l_tke_aniso ) then
    1320             :       ! tke is assumed to be 3/2 of wp2
    1321             :       !$acc parallel loop gang vector collapse(2) default(present)
    1322           0 :       do k = 1, nz
    1323           0 :         do i = 1, ngrdcol
    1324           0 :           em(i,k) = three_halves * wp2(i,k) 
    1325             :         end do
    1326             :       end do
    1327             :       !$acc end parallel loop
    1328             :     else
    1329             :       !$acc parallel loop gang vector collapse(2) default(present)
    1330   768414816 :       do k = 1, nz
    1331 12690480816 :         do i = 1, ngrdcol
    1332 12681545760 :           em(i,k) = 0.5_core_rknd * ( wp2(i,k) + vp2(i,k) + up2(i,k) )
    1333             :         end do
    1334             :       end do
    1335             :       !$acc end parallel loop
    1336             :     end if
    1337             : 
    1338     8935056 :     sqrt_em_zt(:,:) = zm2zt( nz, ngrdcol, gr, em(:,:), em_min )
    1339             : 
    1340             :     !$acc parallel loop gang vector collapse(2) default(present)
    1341   768414816 :     do k = 1, nz
    1342 12690480816 :       do i = 1, ngrdcol
    1343 12681545760 :         sqrt_em_zt(i,k) = sqrt( sqrt_em_zt(i,k) )
    1344             :       end do
    1345             :     end do
    1346             :     !$acc end parallel loop
    1347             : 
    1348             :     !----------------------------------------------------------------
    1349             :     ! Compute mixing length and dissipation time
    1350             :     !----------------------------------------------------------------
    1351             : 
    1352     8935056 :     if ( .not. clubb_config_flags%l_diag_Lscale_from_tau ) then ! compute Lscale 1st, using
    1353             :                                                                 ! buoyant parcel calc
    1354             :       call calc_Lscale_directly ( ngrdcol, nz, gr,                             & ! intent(in)
    1355             :                                   l_implemented, p_in_Pa,                      & ! intent(in)
    1356             :                                   exner, rtm, thlm, thvm,                      & ! intent(in)
    1357             :                                   mu, rtp2_zt, thlp2_zt, rtpthlp_zt, pdf_params, em,    & ! intent(in)
    1358             :                                   thv_ds_zt, Lscale_max, lmin,                 & ! intent(in)
    1359             :                                   clubb_params,                                & ! intent(in)
    1360             :                                   clubb_config_flags%saturation_formula,       & ! intent(in)
    1361             :                                   clubb_config_flags%l_Lscale_plume_centered,  & ! intent(in)
    1362             :                                   stats_metadata,                              & ! intent(in)
    1363             :                                   stats_zt,                                    & ! intent(inout)
    1364     8935056 :                                   Lscale, Lscale_up, Lscale_down )               ! intent(out)
    1365             : 
    1366     8935056 :       if ( clubb_at_least_debug_level( 0 ) ) then
    1367     8935056 :         if ( err_code == clubb_fatal_error ) then
    1368           0 :           err_code_out = err_code
    1369           0 :           write(fstderr,*) "Error calling calc_Lscale_directly"
    1370           0 :           return
    1371             :         end if
    1372             :       end if
    1373             : 
    1374             :       ! Calculate CLUBB's turbulent eddy-turnover time scale as
    1375             :       !   CLUBB's length scale divided by a velocity scale.
    1376             :       !$acc parallel loop gang vector collapse(2) default(present)
    1377   768414816 :       do k = 1, nz
    1378 12690480816 :         do i = 1, ngrdcol
    1379 12681545760 :           tau_zt(i,k) = min( Lscale(i,k) / sqrt_em_zt(i,k), clubb_params(i,itaumax) )
    1380             :         end do
    1381             :       end do
    1382             :       !$acc end parallel loop
    1383             : 
    1384     8935056 :       tau_zm(:,:) = zt2zm( nz, ngrdcol, gr, Lscale(:,:), zero_threshold )
    1385             :           
    1386             :       !$acc parallel loop gang vector collapse(2) default(present)
    1387   768414816 :       do k = 1, nz
    1388 12690480816 :         do i = 1, ngrdcol
    1389 23844132000 :           tau_zm(i,k) = min( tau_zm(i,k) / sqrt( max( em_min, em(i,k) ) ),  &
    1390 36525677760 :                              clubb_params(i,itaumax) )
    1391             :         end do
    1392             :       end do
    1393             :       !$acc end parallel loop
    1394             : 
    1395             :       !$acc parallel loop gang vector collapse(2) default(present)
    1396   768414816 :       do k = 1, nz
    1397 12690480816 :         do i = 1, ngrdcol
    1398 11922066000 :           invrs_tau_zm(i,k)      = one / tau_zm(i,k)
    1399 11922066000 :           invrs_tau_zt(i,k)      = one / tau_zt(i,k)
    1400 11922066000 :           invrs_tau_wp2_zm(i,k)  = invrs_tau_zm(i,k)
    1401 11922066000 :           invrs_tau_xp2_zm(i,k)  = invrs_tau_zm(i,k)
    1402 11922066000 :           invrs_tau_wpxp_zm(i,k) = invrs_tau_zm(i,k)
    1403 11922066000 :           invrs_tau_wp3_zt(i,k)  = invrs_tau_zt(i,k)
    1404 11922066000 :           invrs_tau_wp3_zm(i,k)  = invrs_tau_zm(i,k)
    1405             : 
    1406 11922066000 :           tau_max_zm(i,k) = clubb_params(i,itaumax)
    1407 11922066000 :           tau_max_zt(i,k) = clubb_params(i,itaumax)
    1408             : 
    1409 12681545760 :           Ri_zm(i,k) = zero 
    1410             : 
    1411             :         end do
    1412             :       end do
    1413             :       !$acc end parallel loop
    1414             : 
    1415             :       ! End Vince Larson's replacement.
    1416             : 
    1417             :       call calc_brunt_vaisala_freq_sqd( nz, ngrdcol, gr, thlm,                         & ! In
    1418             :                                         exner, rtm, rcm, p_in_Pa, thvm,                & ! In
    1419             :                                         ice_supersat_frac,                             & ! In
    1420             :                                         clubb_config_flags%saturation_formula,         & ! In
    1421             :                                         clubb_config_flags%l_brunt_vaisala_freq_moist, & ! In
    1422             :                                         clubb_config_flags%l_use_thvm_in_bv_freq,      & ! In
    1423             :                                         clubb_params(:,ibv_efold),                       & ! In
    1424             :                                         brunt_vaisala_freq_sqd,                        & ! Out
    1425             :                                         brunt_vaisala_freq_sqd_mixed,                  & ! Out
    1426             :                                         brunt_vaisala_freq_sqd_dry,                    & ! Out
    1427     8935056 :                                         brunt_vaisala_freq_sqd_moist )                   ! Out
    1428             : 
    1429             :     else ! l_diag_Lscale_from_tau = .true., diagnose simple tau and Lscale.
    1430             : 
    1431             :       call diagnose_Lscale_from_tau( nz, ngrdcol, gr,                             & ! In
    1432             :                         upwp_sfc, vpwp_sfc, um, vm,                               & ! In
    1433             :                         exner, p_in_Pa,                                           & ! In
    1434             :                         rtm, thlm, thvm,                                          & ! In
    1435             :                         rcm, ice_supersat_frac,                                   & ! In
    1436             :                         em, sqrt_em_zt,                                           & ! In
    1437             :                         ufmin, tau_const,                                         & ! In
    1438             :                         sfc_elevation, Lscale_max,                                & ! In
    1439             :                         clubb_params,                                             & ! In
    1440             :                         stats_metadata,                                           & ! In
    1441             :                         clubb_config_flags%saturation_formula,                    & ! In
    1442             :                         clubb_config_flags%l_e3sm_config,                         & ! In
    1443             :                         clubb_config_flags%l_brunt_vaisala_freq_moist,            & ! In
    1444             :                         clubb_config_flags%l_use_thvm_in_bv_freq,                 & ! In
    1445             :                         clubb_config_flags%l_smooth_Heaviside_tau_wpxp,           & ! In
    1446             :                         clubb_config_flags%l_modify_limiters_for_cnvg_test,       & ! In
    1447             :                         stats_zm,                                                 & ! Inout
    1448             :                         brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed,     & ! Out
    1449             :                         brunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_moist, & ! Out
    1450             :                         Ri_zm,                                                    & ! Out
    1451             :                         invrs_tau_zt, invrs_tau_zm,                               & ! Out
    1452             :                         invrs_tau_sfc, invrs_tau_no_N2_zm, invrs_tau_bkgnd,       & ! Out
    1453             :                         invrs_tau_shear, invrs_tau_N2_iso,                        & ! Out
    1454             :                         invrs_tau_wp2_zm, invrs_tau_xp2_zm,                       & ! Out
    1455             :                         invrs_tau_wp3_zm, invrs_tau_wp3_zt, invrs_tau_wpxp_zm,    & ! Out
    1456             :                         tau_max_zm, tau_max_zt, tau_zm, tau_zt,                   & ! Out
    1457           0 :                         Lscale, Lscale_up, Lscale_down )                            ! Out
    1458             :     end if ! l_diag_Lscale_from_tau
    1459             : 
    1460             : 
    1461             : 
    1462             :         ! Modification to damp noise in stable region
    1463             :   ! Vince Larson commented out because it may prevent turbulence from
    1464             :   !    initiating in unstable regions.  7 Jul 2007
    1465             :   !       do k = 1, nz
    1466             :   !         if ( wp2(k) <= 0.005_core_rknd ) then
    1467             :   !           tau_zt(k) = taumin
    1468             :   !           tau_zm(k) = taumin
    1469             :   !         end if
    1470             :   !       end do
    1471             :   ! End Vince Larson's commenting.
    1472             : 
    1473             :     !----------------------------------------------------------------
    1474             :     ! Eddy diffusivity coefficient
    1475             :     !----------------------------------------------------------------
    1476             :     ! c_K is 0.548 usually (Duynkerke and Driedonks 1987)
    1477             :     ! CLUBB uses a smaller value to better fit empirical data.
    1478             : 
    1479             :     ! Calculate CLUBB's eddy diffusivity as
    1480             :     !   CLUBB's length scale times a velocity scale.
    1481             :     !$acc parallel loop gang vector collapse(2) default(present)
    1482   768414816 :     do k = 1, nz
    1483 12690480816 :       do i = 1, ngrdcol
    1484 12681545760 :         Kh_zt(i,k) = clubb_params(i,ic_K) * Lscale(i,k) * sqrt_em_zt(i,k)
    1485             :       end do
    1486             :     end do
    1487             :     !$acc end parallel loop
    1488             : 
    1489     8935056 :     Lscale_zm(:,:) = zt2zm( nz, ngrdcol, gr, Lscale(:,:) )
    1490             : 
    1491             :     !$acc parallel loop gang vector collapse(2) default(present)
    1492   768414816 :     do k = 1, nz
    1493 12690480816 :       do i = 1, ngrdcol
    1494 23844132000 :         Kh_zm(i,k) = clubb_params(i,ic_K) * max( Lscale_zm(i,k), zero_threshold )  &
    1495 36525677760 :                      * sqrt( max( em(i,k), em_min ) )
    1496             :       end do
    1497             :     end do
    1498             :     !$acc end parallel loop
    1499             : 
    1500             :     ! calculate Brunt-Vaisala frequency used for splatting
    1501             :     brunt_vaisala_freq_sqd_splat  &
    1502             :                = Lscale_width_vert_avg( nz, ngrdcol, gr, smth_type, &
    1503             :                                         brunt_vaisala_freq_sqd_mixed, Lscale_zm, rho_ds_zm, &
    1504     8935056 :                                         below_grnd_val )
    1505             : 
    1506             :     ! Vertical compression of eddies causes gustiness (increase in up2 and vp2)
    1507             :     call wp2_term_splat_lhs( nz, ngrdcol, gr, clubb_params(:,iC_wp2_splat),       & ! Intent(in)
    1508             :                              brunt_vaisala_freq_sqd_splat,                      & ! Intent(in)
    1509     8935056 :                              lhs_splat_wp2 )                                      ! Intent(out)
    1510             : 
    1511             :     ! Vertical compression of eddies also diminishes w'3
    1512             :     call wp3_term_splat_lhs( nz, ngrdcol, gr, clubb_params(:,iC_wp2_splat),       & ! Intent(in)
    1513             :                              brunt_vaisala_freq_sqd_splat,                      & ! Intent(in)
    1514     8935056 :                              lhs_splat_wp3 )                                      ! Intent(out)
    1515             : 
    1516             :     !----------------------------------------------------------------
    1517             :     ! Set Surface variances
    1518             :     !----------------------------------------------------------------
    1519             :     ! Surface variances should be set here, before the call to either
    1520             :     ! advance_xp2_xpyp or advance_wp2_wp3.
    1521             :     ! Surface effects should not be included with any case where the lowest
    1522             :     ! level is not the ground level.  Brian Griffin.  December 22, 2005.
    1523             : 
    1524             :     ! Diagnose surface variances based on surface fluxes.
    1525             :     call calc_sfc_varnce( nz, ngrdcol, sclr_dim, sclr_idx,            & ! Intent(in)
    1526             :                           gr, dt, sfc_elevation,                          & ! Intent(in)
    1527             :                           upwp_sfc, vpwp_sfc, wpthlp, wprtp_sfc,          & ! Intent(in)
    1528             :                           um, vm, Lscale_up, wpsclrp_sfc,                 & ! Intent(in)
    1529             :                           lhs_splat_wp2, tau_zm,                          & ! Intent(in)
    1530             :                           !wp2_splat, tau_zm,                             & ! Intent(in)
    1531             :                           clubb_config_flags%l_vary_convect_depth,        & ! Intent(in)
    1532             :                           clubb_params(:,iup2_sfc_coef),                  & ! Intent(in)
    1533             :                           clubb_params(:,ia_const),                        & ! Intent(in)
    1534             :                           stats_metadata,                                 & ! Intent(in)
    1535             :                           stats_zm,                                       & ! Intent(inout)
    1536             :                           wp2, up2, vp2,                                  & ! Intent(inout)
    1537             :                           thlp2, rtp2, rtpthlp,                           & ! Intent(inout)
    1538     8935056 :                           sclrp2, sclrprtp, sclrpthlp )                     ! Intent(inout)
    1539             : 
    1540     8935056 :     if ( clubb_at_least_debug_level( 0 ) ) then
    1541     8935056 :       if ( err_code == clubb_fatal_error ) then
    1542           0 :         err_code_out = err_code
    1543           0 :         write(fstderr, *) "Error calling calc_sfc_varnce"
    1544           0 :         return
    1545             :       end if
    1546             :     end if
    1547             : 
    1548             :     !#######################################################################
    1549             :     !############## ADVANCE PROGNOSTIC VARIABLES ONE TIMESTEP ##############
    1550             :     !#######################################################################
    1551             : 
    1552     8935056 :     if ( stats_metadata%l_stats_samp ) then
    1553             : 
    1554             :       !$acc update host( rtm, rcm, thlm, exner, p_in_Pa )
    1555             : 
    1556           0 :       do i = 1, ngrdcol
    1557           0 :         call stat_update_var( stats_metadata%irvm, rtm(i,:) - rcm(i,:), & !intent(in)
    1558           0 :                               stats_zt(i) )               !intent(inout)
    1559             :       end do
    1560             : 
    1561             :       ! Output relative humidity (q/q∗ where q∗ is the saturation mixing ratio over liquid)
    1562             :       ! Added an extra check for stats_metadata%irel_humidity > 0; otherwise, if both stats_metadata%irsat = 0 and
    1563             :       ! stats_metadata%irel_humidity = 0, rsat is not computed, leading to a floating-point exception
    1564             :       ! when stat_update_var is called for rel_humidity.  ldgrant
    1565           0 :       if ( stats_metadata%irel_humidity > 0 ) then
    1566             :         
    1567             :         rsat = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, &
    1568             :                                thlm2T_in_K( nz, ngrdcol, thlm, exner, rcm ), &
    1569           0 :                                clubb_config_flags%saturation_formula )
    1570             : 
    1571             :         ! Recompute rsat and rel_humidity. They might have changed.
    1572           0 :         do i = 1, ngrdcol
    1573           0 :           rel_humidity(i,:) = (rtm(i,:) - rcm(i,:)) / rsat(i,:)
    1574             : 
    1575             :           call stat_update_var( stats_metadata%irel_humidity, rel_humidity(i,:), &             ! intent(in)
    1576           0 :                                 stats_zt(i))                                  ! intent(inout)
    1577             :         end do
    1578             :       end if ! stats_metadata%irel_humidity > 0
    1579             :     end if ! stats_metadata%l_stats_samp
    1580             : 
    1581             :     !----------------------------------------------------------------
    1582             :     ! Advance rtm/wprtp and thlm/wpthlp one time step
    1583             :     !----------------------------------------------------------------
    1584     8935056 :     if ( clubb_config_flags%l_call_pdf_closure_twice ) then
    1585             :       !$acc parallel loop gang vector collapse(2) default(present)
    1586   768414816 :       do k = 1, nz
    1587 12690480816 :         do i = 1, ngrdcol
    1588 11922066000 :           w_1_zm(i,k)        = pdf_params_zm%w_1(i,k)
    1589 11922066000 :           w_2_zm(i,k)        = pdf_params_zm%w_2(i,k)
    1590 11922066000 :           varnce_w_1_zm(i,k) = pdf_params_zm%varnce_w_1(i,k)
    1591 11922066000 :           varnce_w_2_zm(i,k) = pdf_params_zm%varnce_w_2(i,k)
    1592 12681545760 :           mixt_frac_zm(i,k)  = pdf_params_zm%mixt_frac(i,k)
    1593             :         end do
    1594             :       end do
    1595             :       !$acc end parallel loop
    1596             :     else
    1597           0 :       w_1_zm(:,:)        = zt2zm( nz, ngrdcol, gr, pdf_params%w_1(:,:) )
    1598           0 :       w_2_zm(:,:)        = zt2zm( nz, ngrdcol, gr, pdf_params%w_2(:,:) )
    1599           0 :       varnce_w_1_zm(:,:) = zt2zm( nz, ngrdcol, gr, pdf_params%varnce_w_1(:,:) )
    1600           0 :       varnce_w_2_zm(:,:) = zt2zm( nz, ngrdcol, gr, pdf_params%varnce_w_2(:,:) )
    1601           0 :       mixt_frac_zm(:,:)  = zt2zm( nz, ngrdcol, gr, pdf_params%mixt_frac(:,:) )
    1602             :     end if
    1603             : 
    1604             :     ! Here we determine if we're using tau_zm or tau_N2_zm, which is tau
    1605             :     ! that has been stability corrected for stably stratified regions.
    1606             :     ! -dschanen 7 Nov 2014
    1607     8935056 :     if ( clubb_config_flags%l_stability_correct_tau_zm ) then
    1608             : 
    1609             :       ! Determine stability correction factor
    1610             :       call calc_stability_correction( nz, ngrdcol, gr,                               & ! In
    1611             :                                       thlm, Lscale_zm, em,                           & ! In
    1612             :                                       exner, rtm, rcm,                               & ! In
    1613             :                                       p_in_Pa, thvm, ice_supersat_frac,              & ! In
    1614             :                                       clubb_params(:,ilambda0_stability_coef),       & ! In
    1615             :                                       clubb_params(:,ibv_efold),                     & ! In
    1616             :                                       clubb_config_flags%saturation_formula,         & ! In
    1617             :                                       clubb_config_flags%l_brunt_vaisala_freq_moist, & ! In
    1618             :                                       clubb_config_flags%l_use_thvm_in_bv_freq,      & ! In
    1619     8935056 :                                       stability_correction )                           ! Out
    1620             : 
    1621     8935056 :       if ( stats_metadata%l_stats_samp ) then
    1622             :         !$acc update host( stability_correction )
    1623           0 :         do i = 1, ngrdcol
    1624           0 :           call stat_update_var( stats_metadata%istability_correction, stability_correction(i,:), & ! In
    1625           0 :                                 stats_zm(i) ) ! In/Out
    1626             :         end do
    1627             :       end if
    1628             : 
    1629             :       ! Determine the static stability corrected version of tau_zm
    1630             :       ! Create a damping time scale that is more strongly damped at the
    1631             :       ! altitudes where the Brunt-Vaisala frequency (N^2) is large.
    1632             :       !$acc parallel loop gang vector collapse(2) default(present)
    1633   768414816 :       do k = 1, nz
    1634 12690480816 :         do i = 1, ngrdcol
    1635 11922066000 :           invrs_tau_N2_zm(i,k) = invrs_tau_zm(i,k) * stability_correction(i,k)
    1636 11922066000 :           invrs_tau_C6_zm(i,k) = invrs_tau_N2_zm(i,k)
    1637 12681545760 :           invrs_tau_C1_zm(i,k) = invrs_tau_N2_zm(i,k)
    1638             :         end do
    1639             :       end do
    1640             :       !$acc end parallel loop
    1641             :     else
    1642             :       !$acc parallel loop gang vector collapse(2) default(present)
    1643           0 :       do k = 1, nz
    1644           0 :         do i = 1, ngrdcol
    1645           0 :           invrs_tau_N2_zm(i,k) = unused_var
    1646           0 :           invrs_tau_C6_zm(i,k) = invrs_tau_wpxp_zm(i,k)
    1647           0 :           invrs_tau_C1_zm(i,k) = invrs_tau_wp2_zm(i,k)
    1648             :         end do
    1649             :       end do
    1650             :       !$acc end parallel loop
    1651             :     end if ! l_stability_correction
    1652             : 
    1653             :     ! Set invrs_tau variables for C4 and C14
    1654             :       !$acc parallel loop gang vector collapse(2) default(present)
    1655   768414816 :     do k = 1, nz
    1656 12690480816 :       do i = 1, ngrdcol
    1657 12681545760 :         invrs_tau_C14_zm(i,k) = invrs_tau_wp2_zm(i,k)
    1658             :       end do
    1659             :     end do
    1660             :     !$acc end parallel loop
    1661             : 
    1662             :     if ( .not. clubb_config_flags%l_diag_Lscale_from_tau .and. l_use_invrs_tau_N2_iso) then
    1663             :       write(fstderr,*) "Error! l_use_invrs_tau_N2_iso is not used when "// &
    1664             :                        "l_diag_Lscale_from_tau=false."// &
    1665             :                        "If you want to use Lscale code, go to file "// &
    1666             :                        "src/CLUBB_core/advance_clubb_core_module.F90 and "// &
    1667             :                        "change l_use_invrs_tau_N2_iso to false"
    1668             :       error stop
    1669             :     end if
    1670             : 
    1671             :     if ( .not. l_use_invrs_tau_N2_iso ) then
    1672             :       !$acc parallel loop gang vector collapse(2) default(present)
    1673   768414816 :       do k = 1, nz
    1674 12690480816 :         do i = 1, ngrdcol
    1675 12681545760 :           invrs_tau_C4_zm(i,k) = invrs_tau_wp2_zm(i,k)
    1676             :         end do
    1677             :       end do
    1678             :       !$acc end parallel loop
    1679             :     else
    1680             :       !$acc parallel loop gang vector collapse(2) default(present)
    1681             :       do k = 1, nz
    1682             :         do i = 1, ngrdcol
    1683             :           invrs_tau_C4_zm(i,k) = invrs_tau_N2_iso(i,k)
    1684             :         end do
    1685             :       end do
    1686             :       !$acc end parallel loop
    1687             :     end if
    1688             : 
    1689     8935056 :     if ( stats_metadata%l_stats_samp ) then
    1690             : 
    1691             :       !$acc update host( invrs_tau_zm, invrs_tau_xp2_zm, invrs_tau_wp2_zm, invrs_tau_wpxp_zm, &
    1692             :       !$acc              Ri_zm, invrs_tau_wp3_zm, invrs_tau_no_N2_zm, invrs_tau_bkgnd, &
    1693             :       !$acc              invrs_tau_sfc, invrs_tau_shear, brunt_vaisala_freq_sqd, &
    1694             :       !$acc              brunt_vaisala_freq_sqd_splat, brunt_vaisala_freq_sqd_mixed, &
    1695             :       !$acc              brunt_vaisala_freq_sqd_moist, brunt_vaisala_freq_sqd_dry )
    1696             : 
    1697           0 :       do i = 1, ngrdcol
    1698             :     
    1699           0 :         call stat_update_var(stats_metadata%iinvrs_tau_zm, invrs_tau_zm(i,:), & ! intent(in)
    1700           0 :                              stats_zm(i))                      ! intent(inout)
    1701           0 :         call stat_update_var(stats_metadata%iinvrs_tau_xp2_zm, invrs_tau_xp2_zm(i,:), & ! intent(in)
    1702           0 :                              stats_zm(i))                              ! intent(inout)
    1703           0 :         call stat_update_var(stats_metadata%iinvrs_tau_wp2_zm, invrs_tau_wp2_zm(i,:), & ! intent(in)
    1704           0 :                              stats_zm(i))                              ! intent(inout)
    1705           0 :         call stat_update_var(stats_metadata%iinvrs_tau_wpxp_zm, invrs_tau_wpxp_zm(i,:), & ! intent(in)
    1706           0 :                              stats_zm(i))                                ! intent(inout)
    1707           0 :         call stat_update_var(stats_metadata%iRi_zm, Ri_zm(i,:), & ! intent(in)
    1708           0 :                              stats_zm(i))                  ! intent(inout)
    1709           0 :         call stat_update_var(stats_metadata%iinvrs_tau_wp3_zm, invrs_tau_wp3_zm(i,:), &   ! intent(in)
    1710           0 :                              stats_zm(i))                                ! intent(inout)
    1711             : 
    1712           0 :         if ( clubb_config_flags%l_diag_Lscale_from_tau ) then
    1713           0 :           call stat_update_var(stats_metadata%iinvrs_tau_no_N2_zm, invrs_tau_no_N2_zm(i,:), & ! intent(in)
    1714           0 :                                stats_zm(i))                                  ! intent(inout)
    1715           0 :           call stat_update_var(stats_metadata%iinvrs_tau_bkgnd, invrs_tau_bkgnd(i,:), & ! intent(in)
    1716           0 :                                stats_zm(i))                            ! intent(inout)
    1717           0 :           call stat_update_var(stats_metadata%iinvrs_tau_sfc, invrs_tau_sfc(i,:), & ! intent(in)
    1718           0 :                                stats_zm(i))                        ! intent(inout)
    1719           0 :           call stat_update_var(stats_metadata%iinvrs_tau_shear, invrs_tau_shear(i,:), & ! intent(in)
    1720           0 :                                stats_zm(i))                            ! intent(inout)
    1721             :         end if
    1722           0 :         call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd(i,:), & ! intent(in)
    1723           0 :                              stats_zm(i))
    1724           0 :         call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd_splat, brunt_vaisala_freq_sqd_splat(i,:), & ! intent(in)
    1725           0 :                              stats_zm(i))                                       ! intent(inout)
    1726           0 :         call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd_mixed, brunt_vaisala_freq_sqd_mixed(i,:), & ! intent(in)
    1727           0 :                              stats_zm(i))                                          ! intent(inout)
    1728           0 :         call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd_moist, brunt_vaisala_freq_sqd_moist(i,:), & ! intent(in)
    1729           0 :                              stats_zm(i))                                          ! intent(inout)
    1730           0 :         call stat_update_var(stats_metadata%ibrunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_dry(i,:), & ! intent(in)
    1731           0 :                              stats_zm(i))                                          ! intent(inout)
    1732             :       end do
    1733             :     end if
    1734             : 
    1735             :     ! Cx_fnc_Richardson is only used if one of these flags is true,
    1736             :     ! otherwise its value is irrelevant, set it to 0 to avoid NaN problems
    1737     8935056 :     if ( clubb_config_flags%l_use_C7_Richardson .or. &
    1738             :          clubb_config_flags%l_use_C11_Richardson ) then
    1739             : 
    1740             :       call compute_Cx_fnc_Richardson( nz, ngrdcol, gr,                               & ! intent(in)
    1741             :                                       thlm, um, vm, em, Lscale, exner, rtm,          & ! intent(in)
    1742             :                                       rcm, p_in_Pa, thvm, rho_ds_zm,                 & ! intent(in)
    1743             :                                       ice_supersat_frac,                             & ! intent(in)
    1744             :                                       clubb_params,                                  & ! intent(in)
    1745             :                                       clubb_config_flags%saturation_formula,         & ! intent(in)
    1746             :                                       clubb_config_flags%l_brunt_vaisala_freq_moist, & ! intent(in)
    1747             :                                       clubb_config_flags%l_use_thvm_in_bv_freq,      & ! intent(in
    1748             :                                       clubb_config_flags%l_use_shear_Richardson,     & ! intent(in)
    1749             :                                       clubb_config_flags%l_modify_limiters_for_cnvg_test, & ! intent(in)
    1750             :                                       stats_metadata,                                & ! intent(in)
    1751             :                                       stats_zm,                                      & ! intent(inout)
    1752           0 :                                       Cx_fnc_Richardson )                              ! intent(out)
    1753             :     else
    1754             :       !$acc parallel loop gang vector collapse(2) default(present)
    1755   768414816 :       do k = 1, nz
    1756 12690480816 :         do i = 1, ngrdcol
    1757 12681545760 :           Cx_fnc_Richardson(i,k) = 0.0
    1758             :         end do
    1759             :       end do
    1760             :       !$acc end parallel loop
    1761             :     end if
    1762             : 
    1763             :     ! Loop over the 4 main advance subroutines -- advance_xm_wpxp,
    1764             :     ! advance_wp2_wp3, advance_xp2_xpyp, and advance_windm_edsclrm -- in the
    1765             :     ! order determined by order_xm_wpxp, order_wp2_wp3, order_xp2_xpyp, and
    1766             :     ! order_windm.
    1767    44675280 :     do advance_order_loop_iter = 1, 4, 1
    1768             : 
    1769    44675280 :      if ( advance_order_loop_iter == order_xm_wpxp ) then
    1770             : 
    1771             :       ! Advance the prognostic equations for
    1772             :       !   the scalar grid means (rtm, thlm, sclrm) and
    1773             :       !   scalar turbulent fluxes (wprtp, wpthlp, and wpsclrp)
    1774             :       !   by one time step.
    1775             :       ! advance_xm_wpxp_bad_wp2 ! Test error comment, DO NOT modify or move
    1776             :       call advance_xm_wpxp( nz, ngrdcol, sclr_dim, sclr_tol, gr, dt_advance,      & ! intent(in)  
    1777             :                             sigma_sqd_w, wm_zm, wm_zt, wp2,                       & ! intent(in)
    1778             :                             Lscale_zm, wp3_on_wp2, wp3_on_wp2_zt, Kh_zt, Kh_zm,   & ! intent(in)
    1779             :                             invrs_tau_C6_zm, tau_max_zm, Skw_zm, wp2rtp, rtpthvp, & ! intent(in)
    1780             :                             rtm_forcing, wprtp_forcing, rtm_ref, wp2thlp,         & ! intent(in)
    1781             :                             thlpthvp, thlm_forcing, wpthlp_forcing, thlm_ref,     & ! intent(in)
    1782             :                             rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm,                & ! intent(in)
    1783             :                             invrs_rho_ds_zt, thv_ds_zm, rtp2, thlp2,              & ! intent(in)
    1784             :                             w_1_zm, w_2_zm, varnce_w_1_zm, varnce_w_2_zm,         & ! intent(in)
    1785             :                             mixt_frac_zm, l_implemented, em, wp2sclrp,            & ! intent(in)
    1786             :                             sclrpthvp, sclrm_forcing, sclrp2, exner, rcm,         & ! intent(in)
    1787             :                             p_in_Pa, thvm, Cx_fnc_Richardson,                     & ! intent(in)
    1788             :                             ice_supersat_frac,                                    & ! intent(in)
    1789             :                             pdf_implicit_coefs_terms,                             & ! intent(in)
    1790             :                             um_forcing, vm_forcing, ug, vg, wpthvp,               & ! intent(in)
    1791             :                             fcor, um_ref, vm_ref, up2, vp2,                       & ! intent(in)
    1792             :                             uprcp, vprcp, rc_coef_zm,                             & ! intent(in)
    1793             :                             clubb_params, nu_vert_res_dep,                        & ! intent(in)
    1794             :                             clubb_config_flags%iiPDF_type,                        & ! intent(in)
    1795             :                             clubb_config_flags%penta_solve_method,                & ! intent(in)
    1796             :                             clubb_config_flags%tridiag_solve_method,              & ! intent(in)
    1797             :                             clubb_config_flags%saturation_formula,                & ! intent(in)
    1798             :                             clubb_config_flags%l_predict_upwp_vpwp,               & ! intent(in)
    1799             :                             clubb_config_flags%l_diffuse_rtm_and_thlm,            & ! intent(in)
    1800             :                             clubb_config_flags%l_stability_correct_Kh_N2_zm,      & ! intent(in)
    1801             :                             clubb_config_flags%l_godunov_upwind_wpxp_ta,          & ! intent(in)
    1802             :                             clubb_config_flags%l_upwind_xm_ma,                    & ! intent(in)
    1803             :                             clubb_config_flags%l_uv_nudge,                        & ! intent(in)
    1804             :                             clubb_config_flags%l_tke_aniso,                       & ! intent(in)
    1805             :                             clubb_config_flags%l_diag_Lscale_from_tau,            & ! intent(in)
    1806             :                             clubb_config_flags%l_use_C7_Richardson,               & ! intent(in)
    1807             :                             clubb_config_flags%l_brunt_vaisala_freq_moist,        & ! intent(in)
    1808             :                             clubb_config_flags%l_use_thvm_in_bv_freq,             & ! intent(in)
    1809             :                             clubb_config_flags%l_lmm_stepping,                    & ! intent(in)
    1810             :                             clubb_config_flags%l_enable_relaxed_clipping,         & ! intent(in)
    1811             :                             clubb_config_flags%l_linearize_pbl_winds,             & ! intent(in)
    1812             :                             clubb_config_flags%l_mono_flux_lim_thlm,              & ! intent(in)
    1813             :                             clubb_config_flags%l_mono_flux_lim_rtm,               & ! intent(in)
    1814             :                             clubb_config_flags%l_mono_flux_lim_um,                & ! intent(in)
    1815             :                             clubb_config_flags%l_mono_flux_lim_vm,                & ! intent(in)
    1816             :                             clubb_config_flags%l_mono_flux_lim_spikefix,          & ! intent(in)
    1817             :                             order_xm_wpxp, order_xp2_xpyp, order_wp2_wp3,         & ! intent(in)
    1818             :                             stats_metadata,                                       & ! intent(in)
    1819             :                             stats_zt, stats_zm, stats_sfc,                        & ! intent(i/o)
    1820             :                             rtm, wprtp, thlm, wpthlp,                             & ! intent(i/o)
    1821             :                             sclrm, wpsclrp, um, upwp, vm, vpwp,                   & ! intent(i/o)
    1822     8935056 :                             um_pert, vm_pert, upwp_pert, vpwp_pert )                ! intent(i/o)
    1823             : 
    1824     8935056 :       if ( clubb_at_least_debug_level( 0 ) ) then
    1825     8935056 :          if ( err_code == clubb_fatal_error ) then
    1826           0 :             err_code_out = err_code
    1827           0 :             write(fstderr,*) "Error calling advance_xm_wpxp"
    1828           0 :             return
    1829             :          end if
    1830             :       end if
    1831             : 
    1832             :       ! Vince Larson clipped rcm in order to prevent rvm < 0.  5 Apr 2008.
    1833             :       ! This code won't work unless rtm >= 0 !!!
    1834             :       ! We do not clip rcm_in_layer because rcm_in_layer only influences
    1835             :       ! radiation, and we do not want to bother recomputing it.  6 Aug 2009
    1836             :       call clip_rcm( nz, ngrdcol, rtm,                & ! intent(in)
    1837             :                      'rtm < rcm in advance_xm_wpxp',  & ! intent(in)
    1838     8935056 :                      rcm )                              ! intent(inout)
    1839             : 
    1840             : #ifdef GFDL
    1841             :       do i = 1, ngrdcol
    1842             :         call advance_sclrm_Nd_diffusion_OG( dt, &  ! h1g, 2012-06-16     ! intent(in)
    1843             :                                             sclrm(i,:,:), sclrm_trsport_only(i,:,:), & ! intent(inout)
    1844             :                                             Kh_zm(i,:),  cloud_frac(i,:) )         ! intent(in)
    1845             :       end do
    1846             : #endif
    1847             : 
    1848    26805168 :      elseif ( advance_order_loop_iter == order_xp2_xpyp ) then
    1849             : 
    1850             :       !----------------------------------------------------------------
    1851             :       ! Compute some of the variances and covariances.  These include the
    1852             :       ! variance of total water (rtp2), liquid water potential temperature
    1853             :       ! (thlp2), their covariance (rtpthlp), and the variance of horizontal
    1854             :       ! wind (up2 and vp2).  The variance of vertical velocity is computed
    1855             :       ! in a different section, which will come either earlier or later
    1856             :       ! depending on the chosen call order.
    1857             :       !----------------------------------------------------------------
    1858             : 
    1859             :       ! We found that certain cases require a time tendency to run
    1860             :       ! at shorter timesteps so these are prognosed now.
    1861             : 
    1862             :       ! We found that if we call advance_xp2_xpyp first, we can use a longer timestep.
    1863             : 
    1864             :       ! Advance the prognostic equations
    1865             :       !   for scalar variances and covariances,
    1866             :       !   plus the horizontal wind variances by one time step, by one time step.
    1867             :       call advance_xp2_xpyp( nz, ngrdcol, sclr_dim, sclr_tol, gr, sclr_idx,  & ! intent(in)
    1868             :                              invrs_tau_xp2_zm, invrs_tau_C4_zm,           & ! intent(in)
    1869             :                              invrs_tau_C14_zm, wm_zm,                     & ! intent(in)
    1870             :                              rtm, wprtp, thlm, wpthlp, wpthvp, um, vm,    & ! intent(in)
    1871             :                              wp2, wp2_zt, wp3, upwp, vpwp,                & ! intent(in)
    1872             :                              sigma_sqd_w, wprtp2, wpthlp2,                & ! intent(in)
    1873             :                              wprtpthlp, Kh_zt, rtp2_forcing,              & ! intent(in)
    1874             :                              thlp2_forcing, rtpthlp_forcing,              & ! intent(in)
    1875             :                              rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm,       & ! intent(in)
    1876             :                              thv_ds_zm, cloud_frac,                       & ! intent(in)
    1877             :                              wp3_on_wp2, wp3_on_wp2_zt,                   & ! intent(in)
    1878             :                              pdf_implicit_coefs_terms,                    & ! intent(in)
    1879             :                              dt_advance,                                  & ! intent(in)
    1880             :                              sclrm, wpsclrp,                              & ! intent(in)
    1881             :                              wpsclrp2, wpsclrprtp, wpsclrpthlp,           & ! intent(in)
    1882             :                              lhs_splat_wp2,                               & ! intent(in)
    1883             :                              clubb_params, nu_vert_res_dep,               & ! intent(in)
    1884             :                              clubb_config_flags%iiPDF_type,               & ! intent(in)
    1885             :                              clubb_config_flags%tridiag_solve_method,     & ! intent(in)
    1886             :                              clubb_config_flags%l_predict_upwp_vpwp,      & ! intent(in)
    1887             :                              clubb_config_flags%l_min_xp2_from_corr_wx,   & ! intent(in)
    1888             :                              clubb_config_flags%l_C2_cloud_frac,          & ! intent(in)
    1889             :                              clubb_config_flags%l_upwind_xpyp_ta,         & ! intent(in)
    1890             :                              clubb_config_flags%l_godunov_upwind_xpyp_ta, & ! intent(in)
    1891             :                              clubb_config_flags%l_lmm_stepping,           & ! intent(in)
    1892             :                              stats_metadata,                              & ! In
    1893             :                              stats_zt, stats_zm, stats_sfc,               & ! intent(inout)
    1894             :                              rtp2, thlp2, rtpthlp, up2, vp2,              & ! intent(inout)
    1895     8935056 :                              sclrp2, sclrprtp, sclrpthlp)                   ! intent(inout)
    1896             :       
    1897     8935056 :       if ( clubb_at_least_debug_level( 0 ) ) then
    1898     8935056 :          if ( err_code == clubb_fatal_error ) then
    1899           0 :             err_code_out = err_code
    1900           0 :             write(fstderr,*) "Error calling advance_xp2_xpyp"
    1901           0 :             return
    1902             :          end if
    1903             :       end if
    1904             : 
    1905             :       !----------------------------------------------------------------
    1906             :       ! Covariance clipping for wprtp, wpthlp, wpsclrp, upwp, and vpwp
    1907             :       ! after subroutine advance_xp2_xpyp updated xp2.
    1908             :       !----------------------------------------------------------------
    1909             :       if ( order_xp2_xpyp < order_xm_wpxp &
    1910             :            .and. order_xp2_xpyp < order_wp2_wp3 ) then
    1911             :          wprtp_cl_num   = 1 ! First instance of w'r_t' clipping.
    1912             :          wpthlp_cl_num  = 1 ! First instance of w'th_l' clipping.
    1913             :          wpsclrp_cl_num = 1 ! First instance of w'sclr' clipping.
    1914             :          if ( clubb_config_flags%l_predict_upwp_vpwp ) then
    1915             :             upwp_cl_num = 1 ! First instance of u'w' clipping.
    1916             :             vpwp_cl_num = 1 ! First instance of v'w' clipping.
    1917             :          endif
    1918             :       elseif ( order_xp2_xpyp > order_xm_wpxp &
    1919             :                .and. order_xp2_xpyp > order_wp2_wp3 ) then
    1920             :          wprtp_cl_num   = 3 ! Third instance of w'r_t' clipping.
    1921             :          wpthlp_cl_num  = 3 ! Third instance of w'th_l' clipping.
    1922             :          wpsclrp_cl_num = 3 ! Third instance of w'sclr' clipping.
    1923             :          if ( clubb_config_flags%l_predict_upwp_vpwp ) then
    1924             :             upwp_cl_num = 3 ! Third instance of u'w' clipping.
    1925             :             vpwp_cl_num = 3 ! Third instance of v'w' clipping.
    1926             :          endif
    1927             :       else
    1928     8935056 :          wprtp_cl_num   = 2 ! Second instance of w'r_t' clipping.
    1929     8935056 :          wpthlp_cl_num  = 2 ! Second instance of w'th_l' clipping.
    1930     8935056 :          wpsclrp_cl_num = 2 ! Second instance of w'sclr' clipping.
    1931     8935056 :          if ( clubb_config_flags%l_predict_upwp_vpwp ) then
    1932     8935056 :             upwp_cl_num = 2 ! Second instance of u'w' clipping.
    1933     8935056 :             vpwp_cl_num = 2 ! Second instance of v'w' clipping.
    1934             :          endif
    1935             :       endif
    1936             : 
    1937     8935056 :       if ( .not. clubb_config_flags%l_predict_upwp_vpwp ) then
    1938             :          if ( order_xp2_xpyp < order_wp2_wp3 &
    1939             :               .and. order_xp2_xpyp < order_windm ) then
    1940           0 :             upwp_cl_num = 1 ! First instance of u'w' clipping.
    1941           0 :             vpwp_cl_num = 1 ! First instance of v'w' clipping.
    1942             :          elseif ( order_xp2_xpyp > order_wp2_wp3 &
    1943             :                   .and. order_xp2_xpyp > order_windm ) then
    1944             :             upwp_cl_num = 3 ! Third instance of u'w' clipping.
    1945             :             vpwp_cl_num = 3 ! Third instance of v'w' clipping.
    1946             :          else
    1947             :             upwp_cl_num = 2 ! Second instance of u'w' clipping.
    1948             :             vpwp_cl_num = 2 ! Second instance of v'w' clipping.
    1949             :          endif ! l_predict_upwp_vpwp
    1950             :       endif
    1951             : 
    1952             :       call clip_covars_denom( nz, ngrdcol, sclr_dim, gr, dt,                    & ! intent(in)
    1953             :                               rtp2, thlp2, up2, vp2, wp2,                       & ! intent(in)
    1954             :                               sclrp2, wprtp_cl_num, wpthlp_cl_num,              & ! intent(in)
    1955             :                               wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num,         & ! intent(in)
    1956             :                               clubb_config_flags%l_predict_upwp_vpwp,           & ! intent(in)
    1957             :                               clubb_config_flags%l_tke_aniso,                   & ! intent(in)
    1958             :                               clubb_config_flags%l_linearize_pbl_winds,         & ! intent(in)
    1959             :                               stats_metadata,                                   & ! intent(in)
    1960             :                               stats_zm,                                         & ! intent(inout)
    1961             :                               wprtp, wpthlp, upwp, vpwp, wpsclrp,               & ! intent(inout)
    1962     8935056 :                               upwp_pert, vpwp_pert )                              ! intent(inout)
    1963             :       
    1964    17870112 :      elseif ( advance_order_loop_iter == order_wp2_wp3 ) then
    1965             : 
    1966             :       !----------------------------------------------------------------
    1967             :       ! Advance the 2nd- and 3rd-order moments
    1968             :       !   of vertical velocity (wp2, wp3) by one timestep.
    1969             :       !----------------------------------------------------------------
    1970             : 
    1971             :       ! advance_wp2_wp3_bad_wp2 ! Test error comment, DO NOT modify or move
    1972             :       call advance_wp2_wp3( nz, ngrdcol, gr, dt_advance,                          & ! intent(in)
    1973             :                             sfc_elevation, sigma_sqd_w, wm_zm,                    & ! intent(in)
    1974             :                             wm_zt, a3_coef, a3_coef_zt, wp3_on_wp2,               & ! intent(in)
    1975             :                             wpup2, wpvp2, wp2up2, wp2vp2, wp4,                    & ! intent(in)
    1976             :                             wpthvp, wp2thvp, um, vm, upwp, vpwp,                  & ! intent(in)
    1977             :                             up2, vp2, em, Kh_zm, Kh_zt, invrs_tau_C4_zm,          & ! intent(in)
    1978             :                             invrs_tau_wp3_zt, invrs_tau_C1_zm, Skw_zm,            & ! intent(in)
    1979             :                             Skw_zt, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm,        & ! intent(in)
    1980             :                             invrs_rho_ds_zt, radf, thv_ds_zm,                     & ! intent(in)
    1981             :                             thv_ds_zt, pdf_params%mixt_frac, Cx_fnc_Richardson,   & ! intent(in)
    1982             :                             lhs_splat_wp2, lhs_splat_wp3,                         & ! intent(in)
    1983             :                             pdf_implicit_coefs_terms,                             & ! intent(in)
    1984             :                             wprtp, wpthlp, rtp2, thlp2,                           & ! intent(in)
    1985             :                             clubb_params, nu_vert_res_dep,                        & ! intent(in)
    1986             :                             clubb_config_flags%iiPDF_type,                        & ! intent(in)
    1987             :                             clubb_config_flags%penta_solve_method,                & ! intent(in)
    1988             :                             clubb_config_flags%l_min_wp2_from_corr_wx,            & ! intent(in)
    1989             :                             clubb_config_flags%l_upwind_xm_ma,                    & ! intent(in)
    1990             :                             clubb_config_flags%l_tke_aniso,                       & ! intent(in)
    1991             :                             clubb_config_flags%l_standard_term_ta,                & ! intent(in)
    1992             :                             clubb_config_flags%l_partial_upwind_wp3,              & ! intent(in)
    1993             :                             clubb_config_flags%l_damp_wp2_using_em,               & ! intent(in)
    1994             :                             clubb_config_flags%l_use_C11_Richardson,              & ! intent(in)
    1995             :                             clubb_config_flags%l_damp_wp3_Skw_squared,            & ! intent(in)
    1996             :                             clubb_config_flags%l_lmm_stepping,                    & ! intent(in)
    1997             :                             clubb_config_flags%l_use_tke_in_wp3_pr_turb_term,     & ! intent(in)
    1998             :                             clubb_config_flags%l_use_tke_in_wp2_wp3_K_dfsn,       & ! intent(in)
    1999             :                             clubb_config_flags%l_use_wp3_lim_with_smth_Heaviside, & ! intent(in)
    2000             :                             stats_metadata,                                       & ! intent(in)
    2001             :                             stats_zt, stats_zm, stats_sfc,                        & ! intent(inout)
    2002     8935056 :                             wp2, wp3, wp3_zm, wp2_zt )                              ! intent(inout)
    2003             : 
    2004     8935056 :       if ( clubb_at_least_debug_level( 0 ) ) then
    2005     8935056 :          if ( err_code == clubb_fatal_error ) then
    2006           0 :             err_code_out = err_code
    2007           0 :             write(fstderr,*) "Error calling advance_wp2_wp3"
    2008           0 :             return
    2009             :          end if
    2010             :       end if
    2011             : 
    2012             :       !----------------------------------------------------------------
    2013             :       ! Covariance clipping for wprtp, wpthlp, wpsclrp, upwp, and vpwp
    2014             :       ! after subroutine advance_wp2_wp3 updated wp2.
    2015             :       !----------------------------------------------------------------
    2016             : 
    2017             :       if ( order_wp2_wp3 < order_xm_wpxp &
    2018             :            .and. order_wp2_wp3 < order_xp2_xpyp ) then
    2019             :          wprtp_cl_num   = 1 ! First instance of w'r_t' clipping.
    2020             :          wpthlp_cl_num  = 1 ! First instance of w'th_l' clipping.
    2021             :          wpsclrp_cl_num = 1 ! First instance of w'sclr' clipping.
    2022             :          if ( clubb_config_flags%l_predict_upwp_vpwp ) then
    2023             :             upwp_cl_num = 1 ! First instance of u'w' clipping.
    2024             :             vpwp_cl_num = 1 ! First instance of v'w' clipping.
    2025             :          endif
    2026             :       elseif ( order_wp2_wp3 > order_xm_wpxp &
    2027             :                .and. order_wp2_wp3 > order_xp2_xpyp ) then
    2028     8935056 :          wprtp_cl_num   = 3 ! Third instance of w'r_t' clipping.
    2029     8935056 :          wpthlp_cl_num  = 3 ! Third instance of w'th_l' clipping.
    2030     8935056 :          wpsclrp_cl_num = 3 ! Third instance of w'sclr' clipping.
    2031     8935056 :          if ( clubb_config_flags%l_predict_upwp_vpwp ) then
    2032     8935056 :             upwp_cl_num = 3 ! Third instance of u'w' clipping.
    2033     8935056 :             vpwp_cl_num = 3 ! Third instance of v'w' clipping.
    2034             :          endif
    2035             :       else
    2036             :          wprtp_cl_num   = 2 ! Second instance of w'r_t' clipping.
    2037             :          wpthlp_cl_num  = 2 ! Second instance of w'th_l' clipping.
    2038             :          wpsclrp_cl_num = 2 ! Second instance of w'sclr' clipping.
    2039             :          if ( clubb_config_flags%l_predict_upwp_vpwp ) then
    2040             :             upwp_cl_num = 2 ! Second instance of u'w' clipping.
    2041             :             vpwp_cl_num = 2 ! Second instance of v'w' clipping.
    2042             :          endif
    2043             :       endif
    2044             :     
    2045     8935056 :       if ( .not. clubb_config_flags%l_predict_upwp_vpwp ) then
    2046             :          if ( order_wp2_wp3 < order_xp2_xpyp &
    2047             :               .and. order_wp2_wp3 < order_windm ) then
    2048             :             upwp_cl_num = 1 ! First instance of u'w' clipping.
    2049             :             vpwp_cl_num = 1 ! First instance of v'w' clipping.
    2050             :          elseif ( order_wp2_wp3 > order_xp2_xpyp &
    2051             :                   .and. order_wp2_wp3 > order_windm ) then
    2052             :             upwp_cl_num = 3 ! Third instance of u'w' clipping.
    2053             :             vpwp_cl_num = 3 ! Third instance of v'w' clipping.
    2054             :          else
    2055           0 :             upwp_cl_num = 2 ! Second instance of u'w' clipping.
    2056           0 :             vpwp_cl_num = 2 ! Second instance of v'w' clipping.
    2057             :          endif ! l_predict_upwp_vpwp
    2058             :       endif
    2059             : 
    2060             :       call clip_covars_denom( nz, ngrdcol, sclr_dim, gr, dt,                    & ! intent(in)
    2061             :                               rtp2, thlp2, up2, vp2, wp2,                       & ! intent(in)
    2062             :                               sclrp2, wprtp_cl_num, wpthlp_cl_num,              & ! intent(in)
    2063             :                               wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num,         & ! intent(in)
    2064             :                               clubb_config_flags%l_predict_upwp_vpwp,           & ! intent(in)
    2065             :                               clubb_config_flags%l_tke_aniso,                   & ! intent(in)
    2066             :                               clubb_config_flags%l_linearize_pbl_winds,         & ! intent(in)
    2067             :                               stats_metadata,                                   & ! intent(in)
    2068             :                               stats_zm,                                         & ! intent(inout)
    2069             :                               wprtp, wpthlp, upwp, vpwp, wpsclrp,               & ! intent(inout)
    2070     8935056 :                               upwp_pert, vpwp_pert )                              ! intent(inout)
    2071             : 
    2072     8935056 :      elseif ( advance_order_loop_iter == order_windm ) then
    2073             : 
    2074             :       !----------------------------------------------------------------
    2075             :       ! Advance the horizontal mean winds (um, vm),
    2076             :       !   the mean of the eddy-diffusivity scalars (i.e. edsclrm),
    2077             :       !   and their fluxes (upwp, vpwp, wpedsclrp) by one time step.
    2078             :       !----------------------------------------------------------------
    2079             :       !$acc parallel loop gang vector collapse(2) default(present)
    2080   768414816 :       do k = 1, nz
    2081 12690480816 :         do i = 1, ngrdcol
    2082 11922066000 :           Km_zm(i,k) = Kh_zm(i,k) * clubb_params(i,ic_K10)   ! Coefficient for momentum
    2083             : 
    2084 12681545760 :           Kmh_zm(i,k) = Kh_zm(i,k) * clubb_params(i,ic_K10h) ! Coefficient for thermo
    2085             :         end do
    2086             :       end do
    2087             :       !$acc end parallel loop
    2088             : 
    2089     8935056 :       if ( edsclr_dim > 1 .and. clubb_config_flags%l_do_expldiff_rtm_thlm ) then
    2090             :         !$acc parallel loop gang vector collapse(2) default(present)
    2091   768414816 :         do k = 1, nz
    2092 12690480816 :           do i = 1, ngrdcol
    2093 11922066000 :             edsclrm(i,k,edsclr_dim-1) = thlm(i,k)
    2094 12681545760 :             edsclrm(i,k,edsclr_dim) = rtm(i,k)
    2095             :           end do
    2096             :         end do
    2097             :         !$acc end parallel loop
    2098             :       end if
    2099             : 
    2100             :       call advance_windm_edsclrm( nz, ngrdcol, edsclr_dim, gr, dt,            & ! intent(in)
    2101             :                                   wm_zt, Km_zm, Kmh_zm,                       & ! intent(in)
    2102             :                                   ug, vg, um_ref, vm_ref,                     & ! intent(in)
    2103             :                                   wp2, up2, vp2, um_forcing, vm_forcing,      & ! intent(in)
    2104             :                                   edsclrm_forcing,                            & ! intent(in)
    2105             :                                   rho_ds_zm, invrs_rho_ds_zt,                 & ! intent(in)
    2106             :                                   fcor, l_implemented,                        & ! intent(in)
    2107             :                                   nu_vert_res_dep,                            & ! intent(in)
    2108             :                                   clubb_config_flags%tridiag_solve_method,    & ! intent(in)
    2109             :                                   clubb_config_flags%l_predict_upwp_vpwp,     & ! intent(in)
    2110             :                                   clubb_config_flags%l_upwind_xm_ma,          & ! intent(in)
    2111             :                                   clubb_config_flags%l_uv_nudge,              & ! intent(in)
    2112             :                                   clubb_config_flags%l_tke_aniso,             & ! intent(in)
    2113             :                                   clubb_config_flags%l_lmm_stepping,          & ! intent(in)
    2114             :                                   clubb_config_flags%l_linearize_pbl_winds,   & ! intent(in)
    2115             :                                   order_xp2_xpyp, order_wp2_wp3, order_windm, & ! intent(in)
    2116             :                                   stats_metadata,                             & ! intent(in)
    2117             :                                   stats_zt, stats_zm, stats_sfc,              & ! intent(inout)
    2118             :                                   um, vm, edsclrm,                            & ! intent(inout)
    2119             :                                   upwp, vpwp, wpedsclrp,                      & ! intent(inout)
    2120     8935056 :                                   um_pert, vm_pert, upwp_pert, vpwp_pert )      ! intent(inout)
    2121             : 
    2122     8935056 :       if ( edsclr_dim > 1 .and. clubb_config_flags%l_do_expldiff_rtm_thlm ) then
    2123             : 
    2124             :         call pvertinterp( nz, ngrdcol,                      & ! intent(in)
    2125             :                           p_in_Pa, 70000.0_core_rknd, thlm, & ! intent(in)
    2126     8935056 :                           thlm700 )                           ! intent(out)
    2127             : 
    2128             :         call pvertinterp( nz, ngrdcol,                        & ! intent(in)
    2129             :                           p_in_Pa, 100000.0_core_rknd, thlm,  & ! intent(in)
    2130     8935056 :                           thlm1000 )                            ! intent(out)
    2131             : 
    2132             :         !$acc parallel loop gang vector collapse(2) default(present)
    2133   768414816 :         do k = 1, nz
    2134 12690480816 :           do i = 1, ngrdcol         
    2135 12681545760 :             if ( thlm700(i) - thlm1000(i) < 20.0_core_rknd ) then
    2136 10073925790 :               thlm(i,k) = edsclrm(i,k,edsclr_dim-1)
    2137 10073925790 :               rtm(i,k) = edsclrm(i,k,edsclr_dim)
    2138             :             end if
    2139             :           end do
    2140             :         end do
    2141             :         !$acc end parallel loop
    2142             : 
    2143             :       end if
    2144             : 
    2145             :       ! Eric Raut: this seems dangerous to call without any attached flag.
    2146             :       ! Hence the preprocessor.
    2147             : #ifdef CLUBB_CAM
    2148   125090784 :       do ixind=1,edsclr_dim
    2149             :         ! upper_hf_level = nz since we are filling the zt levels
    2150             :         call fill_holes_vertical( nz, ngrdcol, zero_threshold, nz,  & ! In
    2151             :                                   gr%dzt, rho_ds_zt,                & ! In
    2152   125090784 :                                   edsclrm(:,:,ixind) )                ! InOut
    2153             :       enddo
    2154             : #endif
    2155             : 
    2156             :      endif ! advance_order_loop_iter
    2157             : 
    2158             :     enddo ! advance_order_loop_iter = 1, 4, 1
    2159             : 
    2160             :     !----------------------------------------------------------------
    2161             :     ! Advance or otherwise calculate <thl'^3>, <rt'^3>, and
    2162             :     ! <sclr'^3>.
    2163             :     !----------------------------------------------------------------
    2164             :     if ( l_advance_xp3 &
    2165             :          .and. clubb_config_flags%iiPDF_type /= iiPDF_ADG1 ) then
    2166             : 
    2167             :       ! Advance <rt'^3>, <thl'^3>, and <sclr'^3> one model timestep using a
    2168             :       ! simplified form of the <x'^3> predictive equation.  The simplified
    2169             :       ! <x'^3> equation can either be advanced from its previous value or
    2170             :       ! calculated using a steady-state approximation.
    2171             :       call advance_xp3( nz, ngrdcol, sclr_dim, sclr_tol, gr, dt,    & ! Intent(in)
    2172             :                         rtm, thlm, rtp2, thlp2, wprtp,              & ! Intent(in)
    2173             :                         wpthlp, wprtp2, wpthlp2, rho_ds_zm,         & ! Intent(in)
    2174             :                         invrs_rho_ds_zt, invrs_tau_zt, tau_max_zt,  & ! Intent(in)
    2175             :                         sclrm, sclrp2, wpsclrp, wpsclrp2,           & ! Intent(in)
    2176             :                         clubb_config_flags%l_lmm_stepping,          & ! intent(in)
    2177             :                         stats_metadata,                             & ! intent(in)
    2178             :                         stats_zt,                                   & ! intent(inout)
    2179             :                         rtp3, thlp3, sclrp3 )                         ! Intent(inout)
    2180             : 
    2181             :       ! Use a modified form of the Larson and Golaz (2005) ansatz for the
    2182             :       ! ADG1 PDF to calculate <u'^3> and <v'^3> for another type of PDF.
    2183             :       call Skx_func( nz, ngrdcol, wp2_zt, wp3, &
    2184             :                      w_tol, clubb_params, &
    2185             :                      Skw_zt )
    2186             : 
    2187             :       upwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, upwp(:,:) )
    2188             :       vpwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, vpwp(:,:) )
    2189             :       up2_zt(:,:)  = zm2zt( nz, ngrdcol, gr, up2(:,:), w_tol_sqd ) ! Positive def. quantity
    2190             :       vp2_zt(:,:)  = zm2zt( nz, ngrdcol, gr, vp2(:,:), w_tol_sqd ) ! Positive def. quantity
    2191             : 
    2192             :       thvm_zm(:,:)                   = zt2zm( nz, ngrdcol, gr, thvm(:,:), zero_threshold )
    2193             :       ddzm_thvm_zm(:,:)              = ddzm( nz, ngrdcol, gr, thvm_zm(:,:) )
    2194             :       brunt_vaisala_freq_sqd_zt(:,:) = max( ( grav / thvm(:,:) ) * ddzm_thvm_zm(:,:), zero )
    2195             : 
    2196             :       ! The xp3_coef_fnc is used in place of sigma_sqd_w_zt when the ADG1 PDF
    2197             :       ! is not being used.  The xp3_coef_fnc provides some extra tunability to
    2198             :       ! the simple xp3 equation.
    2199             :       ! When xp3_coef_fnc goes to 0, the value of Skx goes to the smallest
    2200             :       ! magnitude permitted by the function.  When xp3_coef_fnc goes to 1, the
    2201             :       ! magnitude of Skx becomes huge.
    2202             :       do k = 1, nz
    2203             :         do i = 1, ngrdcol
    2204             :           xp3_coef_fnc(i,k) = clubb_params(i,ixp3_coef_base) &
    2205             :                               + ( one - clubb_params(i,ixp3_coef_slope) ) &
    2206             :                                 * ( one - exp( brunt_vaisala_freq_sqd_zt(i,k) / clubb_params(i,ixp3_coef_slope) ) )
    2207             :         end do
    2208             :       end do
    2209             : 
    2210             :       call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, upwp_zt, wp2_zt, &
    2211             :                                up2_zt, xp3_coef_fnc, &
    2212             :                                clubb_params, w_tol, &
    2213             :                                up3 )
    2214             : 
    2215             :       call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, vpwp_zt, wp2_zt, &
    2216             :                                vp2_zt, xp3_coef_fnc, &
    2217             :                                clubb_params, w_tol, &
    2218             :                                vp3 )
    2219             : 
    2220             :     else ! .not. l_advance_xp3 .or. clubb_config_flags%iiPDF_type = iiPDF_ADG1
    2221             : 
    2222             :       ! The ADG1 PDF must use this option.
    2223             :       call Skx_func( nz, ngrdcol, wp2_zt, wp3, &
    2224             :                      w_tol, clubb_params, &
    2225     8935056 :                      Skw_zt )
    2226             : 
    2227     8935056 :       wpthlp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wpthlp(:,:) )
    2228     8935056 :       wprtp_zt(:,:)  = zm2zt( nz, ngrdcol, gr, wprtp(:,:) )
    2229     8935056 :       thlp2_zt(:,:)  = zm2zt( nz, ngrdcol, gr, thlp2(:,:), thl_tol**2 ) ! Positive def. quantity
    2230     8935056 :       rtp2_zt(:,:)   = zm2zt( nz, ngrdcol, gr, rtp2(:,:), rt_tol**2 )   ! Positive def. quantity
    2231             : 
    2232     8935056 :       upwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, upwp(:,:) )
    2233     8935056 :       vpwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, vpwp(:,:) )
    2234     8935056 :       up2_zt(:,:)  = zm2zt( nz, ngrdcol, gr, up2(:,:), w_tol_sqd ) ! Positive def. quantity
    2235     8935056 :       vp2_zt(:,:)  = zm2zt( nz, ngrdcol, gr, vp2(:,:), w_tol_sqd ) ! Positive def. quantity
    2236             : 
    2237     8935056 :       if ( clubb_config_flags%iiPDF_type == iiPDF_ADG1 ) then
    2238             : 
    2239             :         ! Use the Larson and Golaz (2005) ansatz for the ADG1 PDF to
    2240             :         ! calculate <rt'^3>, <thl'^3>, <u'^3>, <v'^3>, and <sclr'^3>.
    2241     8935056 :         sigma_sqd_w_zt(:,:) = zm2zt( nz, ngrdcol, gr, sigma_sqd_w(:,:), zero_threshold )
    2242             : 
    2243             :         call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wpthlp_zt, wp2_zt, &
    2244             :                                  thlp2_zt, sigma_sqd_w_zt, &
    2245             :                                  clubb_params, thl_tol, &
    2246     8935056 :                                  thlp3 )
    2247             : 
    2248             :         call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wprtp_zt, wp2_zt, &
    2249             :                                  rtp2_zt, sigma_sqd_w_zt, &
    2250             :                                  clubb_params, rt_tol, &
    2251     8935056 :                                  rtp3 )
    2252             : 
    2253             :         call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, upwp_zt, wp2_zt, &
    2254             :                                  up2_zt, sigma_sqd_w_zt, &
    2255             :                                  clubb_params, w_tol, &
    2256     8935056 :                                  up3 )
    2257             : 
    2258             :         call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, vpwp_zt, wp2_zt, &
    2259             :                                  vp2_zt, sigma_sqd_w_zt, &
    2260             :                                  clubb_params, w_tol, &
    2261     8935056 :                                  vp3 )
    2262             : 
    2263     8935056 :         do j = 1, sclr_dim, 1
    2264             :           
    2265           0 :           wpsclrp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wpsclrp(:,:,j), sclr_tol(j)**2 )
    2266           0 :           sclrp2_zt(:,:)  = zm2zt( nz, ngrdcol, gr, sclrp2(:,:,j), sclr_tol(j)**2 )
    2267             : 
    2268             :           call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wpsclrp_zt, wp2_zt, &
    2269             :                                    sclrp2_zt, sigma_sqd_w_zt, &
    2270             :                                    clubb_params, sclr_tol(j), &
    2271     8935056 :                                    sclrp3 )
    2272             : 
    2273             :         enddo ! i = 1, sclr_dim
    2274             : 
    2275             :       else ! clubb_config_flags%iiPDF_type /= iiPDF_ADG1
    2276             : 
    2277             :         ! Use a modified form of the Larson and Golaz (2005) ansatz for the
    2278             :         ! ADG1 PDF to calculate <u'^3> and <v'^3> for another type of PDF.
    2279           0 :         thvm_zm(:,:)                   = zt2zm( nz, ngrdcol, gr, thvm(:,:), zero_threshold )
    2280           0 :         ddzm_thvm_zm(:,:)              = ddzm( nz, ngrdcol, gr, thvm_zm(:,:) )
    2281           0 :         brunt_vaisala_freq_sqd_zt(:,:) = max( ( grav / thvm(:,:) ) * ddzm_thvm_zm(:,:), zero )
    2282             :         
    2283             :         
    2284             :         ! Initialize sigma_sqd_w_zt to zero so we don't break output
    2285           0 :         do k = 1, nz
    2286           0 :           do i = 1, ngrdcol
    2287           0 :             sigma_sqd_w_zt(i,k) = zero
    2288             :           end do
    2289             :         end do
    2290             : 
    2291             :         ! The xp3_coef_fnc is used in place of sigma_sqd_w_zt when the
    2292             :         ! ADG1 PDF is not being used.  The xp3_coef_fnc provides some extra
    2293             :         ! tunability to the simple xp3 equation.
    2294             :         ! When xp3_coef_fnc goes to 0, the value of Skx goes to the smallest
    2295             :         ! magnitude permitted by the function.  When xp3_coef_fnc goes to 1,
    2296             :         ! the magnitude of Skx becomes huge.
    2297             :         ! The value of Skx becomes large near cloud top, where there is a
    2298             :         ! higher degree of static stability.  The exp{ } portion of the
    2299             :         ! xp3_coef_fnc allows the xp3_coef_fnc to become larger in regions
    2300             :         ! of high static stability, producing larger magnitude values of Skx.
    2301           0 :         do k = 1, nz
    2302           0 :           do i = 1, ngrdcol
    2303           0 :             xp3_coef_fnc(i,k) = clubb_params(i,ixp3_coef_base) &
    2304             :               + ( one - clubb_params(i,ixp3_coef_slope) ) &
    2305           0 :                 * ( one - exp( brunt_vaisala_freq_sqd_zt(i,k) / clubb_params(i,ixp3_coef_slope) ) )
    2306             :           end do
    2307             :         end do
    2308             :         
    2309             :         call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wpthlp_zt, wp2_zt, &
    2310             :                                  thlp2_zt, xp3_coef_fnc, &
    2311             :                                  clubb_params, thl_tol, &
    2312           0 :                                  thlp3 )
    2313             : 
    2314             :         call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wprtp_zt, wp2_zt, &
    2315             :                                  rtp2_zt, xp3_coef_fnc, &
    2316             :                                  clubb_params, rt_tol, &
    2317           0 :                                  rtp3 )
    2318             : 
    2319             :         call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, upwp_zt, wp2_zt, &
    2320             :                                  up2_zt, xp3_coef_fnc, &
    2321             :                                  clubb_params, w_tol, &
    2322           0 :                                  up3 )
    2323             : 
    2324             :         call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, vpwp_zt, wp2_zt, &
    2325             :                                  vp2_zt, xp3_coef_fnc, &
    2326             :                                  clubb_params, w_tol, &
    2327           0 :                                  vp3 )
    2328             : 
    2329           0 :         do j = 1, sclr_dim, 1
    2330             :           
    2331           0 :           wpsclrp_zt(:,:) = zm2zt( nz, ngrdcol, gr, wpsclrp(:,:,j) )
    2332           0 :           sclrp2_zt(:,:)  = zm2zt( nz, ngrdcol, gr, sclrp2(:,:,j), sclr_tol(j)**2 )
    2333             : 
    2334             :           call xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt(:,:), wpsclrp_zt(:,:), wp2_zt(:,:), &
    2335             :                                    sclrp2_zt(:,:), xp3_coef_fnc(:,:), &
    2336             :                                    clubb_params, sclr_tol(j), &
    2337           0 :                                    sclrp3(:,:,j) )
    2338             :         end do ! i = 1, sclr_dim
    2339             : 
    2340             :       end if ! clubb_config_flags%iiPDF_type == iiPDF_ADG1
    2341             : 
    2342             :     end if ! l_advance_xp3 .and. clubb_config_flags%iiPDF_type /= iiPDF_ADG1
    2343             : 
    2344             :     if ( clubb_config_flags%ipdf_call_placement == ipdf_post_advance_fields &
    2345     8935056 :          .or. clubb_config_flags%ipdf_call_placement &
    2346             :               == ipdf_pre_post_advance_fields ) then
    2347             : 
    2348             :       ! Sample stats in this call to subroutine pdf_closure_driver for
    2349             :       ! ipdf_post_advance_fields, but not for ipdf_pre_post_advance_fields
    2350             :       ! because stats were sampled during the first call to subroutine
    2351             :       ! pdf_closure_driver.
    2352     8935056 :       if ( clubb_config_flags%ipdf_call_placement &
    2353             :           == ipdf_post_advance_fields ) then
    2354     8935056 :         l_samp_stats_in_pdf_call = .true.
    2355           0 :       elseif ( clubb_config_flags%ipdf_call_placement &
    2356             :               == ipdf_pre_post_advance_fields ) then
    2357           0 :         l_samp_stats_in_pdf_call = .false.
    2358             :       endif
    2359             : 
    2360             :       !########################################################################
    2361             :       !#######                     CALL CLUBB's PDF                     #######
    2362             :       !#######   AND OUTPUT PDF PARAMETERS AND INTEGRATED QUANTITITES   #######
    2363             :       !########################################################################
    2364             :       ! Given CLUBB's prognosed moments, diagnose CLUBB's PDF parameters
    2365             :       !   and quantities integrated over that PDF, including
    2366             :       !   quantities related to clouds, buoyancy, and turbulent advection.
    2367             :       call pdf_closure_driver( gr, nz, ngrdcol,                             & ! Intent(in)
    2368             :                                dt, hydromet_dim, sclr_dim, sclr_tol,        & ! Intent(in)
    2369             :                                wprtp, thlm, wpthlp, rtp2, rtp3,             & ! Intent(in)
    2370             :                                thlp2, thlp3, rtpthlp, wp2,                  & ! Intent(in)
    2371             :                                wp3, wm_zm, wm_zt,                           & ! Intent(in)
    2372             :                                um, up2, upwp, up3,                          & ! Intent(in)
    2373             :                                vm, vp2, vpwp, vp3,                          & ! Intent(in)
    2374             :                                p_in_Pa, exner,                              & ! Intent(in)
    2375             :                                thv_ds_zm, thv_ds_zt, rtm_ref,               & ! Intent(in)
    2376             :                                ! rfrzm, hydromet,                             &
    2377             :                                wphydrometp,                                 & ! Intent(in)
    2378             :                                wp2hmp, rtphmp_zt, thlphmp_zt,               & ! Intent(in)
    2379             :                                sclrm, wpsclrp, sclrp2,                      & ! Intent(in)
    2380             :                                sclrprtp, sclrpthlp, sclrp3,                 & ! Intent(in)
    2381             :                                l_samp_stats_in_pdf_call,                    & ! Intent(in)
    2382             :                                clubb_params,                                & ! Intent(in)
    2383             :                                clubb_config_flags%iiPDF_type,               & ! Intent(in)
    2384             :                                clubb_config_flags%saturation_formula,       & ! Intent(in)
    2385             :                                clubb_config_flags%l_predict_upwp_vpwp,      & ! Intent(in)
    2386             :                                clubb_config_flags%l_rtm_nudge,              & ! Intent(in)
    2387             :                                clubb_config_flags%l_trapezoidal_rule_zt,    & ! Intent(in)
    2388             :                                clubb_config_flags%l_trapezoidal_rule_zm,    & ! Intent(in)
    2389             :                                clubb_config_flags%l_call_pdf_closure_twice, & ! Intent(in)
    2390             :                                clubb_config_flags%l_use_cloud_cover,        & ! Intent(in)
    2391             :                                clubb_config_flags%l_rcm_supersat_adj,       & ! Intent(in)
    2392             :                                l_mix_rat_hm,                                & ! Intent(in)
    2393             :                                stats_metadata,                              & ! Intent(in)
    2394             :                                stats_zt, stats_zm,                          & ! Intent(inout)
    2395             :                                rtm,                                         & ! Intent(inout)
    2396             :                                pdf_implicit_coefs_terms,                    & ! Intent(inout)
    2397             :                                pdf_params, pdf_params_zm,                   & ! Intent(inout)
    2398             : #ifdef GFDL
    2399             :                                RH_crit(k, : , :),                           & ! Intent(inout)
    2400             :                                do_liquid_only_in_clubb,                     & ! Intent(in)
    2401             : #endif
    2402             :                                rcm, cloud_frac,                             & ! Intent(out)
    2403             :                                ice_supersat_frac, wprcp,                    & ! Intent(out)
    2404             :                                sigma_sqd_w, wpthvp, wp2thvp,                & ! Intent(out)
    2405             :                                rtpthvp, thlpthvp, rc_coef,                  & ! Intent(out)
    2406             :                                rcm_in_layer, cloud_cover,                   & ! Intent(out)
    2407             :                                rcp2_zt, thlprcp,                            & ! Intent(out)
    2408             :                                rc_coef_zm, sclrpthvp,                       & ! Intent(out)
    2409             :                                wpup2, wpvp2,                                & ! Intent(out)
    2410             :                                wp2up2, wp2vp2, wp4,                         & ! Intent(out)
    2411             :                                wp2rtp, wprtp2, wp2thlp,                     & ! Intent(out)
    2412             :                                wpthlp2, wprtpthlp, wp2rcp,                  & ! Intent(out)
    2413             :                                rtprcp, rcp2,                                & ! Intent(out)
    2414             :                                uprcp, vprcp,                                & ! Intent(out)
    2415             :                                w_up_in_cloud, w_down_in_cloud,              & ! Intent(out)
    2416             :                                cloudy_updraft_frac,                         & ! Intent(out)
    2417             :                                cloudy_downdraft_frac,                       & ! intent(out)
    2418             :                                Skw_velocity,                                & ! Intent(out)
    2419             :                                cloud_frac_zm,                               & ! Intent(out)
    2420             :                                ice_supersat_frac_zm,                        & ! Intent(out)
    2421             :                                rtm_zm, thlm_zm, rcm_zm,                     & ! Intent(out)
    2422             :                                rcm_supersat_adj,                            & ! Intent(out)
    2423             :                                wp2sclrp, wpsclrp2, sclrprcp,                & ! Intent(out)
    2424     8935056 :                                wpsclrprtp, wpsclrpthlp )                      ! Intent(out)
    2425             : 
    2426             :     end if ! clubb_config_flags%ipdf_call_placement == ipdf_post_advance_fields
    2427             :           ! or clubb_config_flags%ipdf_call_placement
    2428             :           !    == ipdf_pre_post_advance_fields
    2429             : 
    2430             : #ifdef CLUBB_CAM
    2431             :     !$acc parallel loop gang vector collapse(2) default(present)
    2432   768414816 :     do k = 1, nz
    2433 12690480816 :       do i = 1, ngrdcol
    2434 12681545760 :         qclvar(i,k) = rcp2_zt(i,k)
    2435             :       end do
    2436             :     end do
    2437             :     !$acc end parallel loop
    2438             : #endif
    2439             : 
    2440             : 
    2441             :     !#######################################################################
    2442             :     !#############            ACCUMULATE STATISTICS            #############
    2443             :     !#######################################################################
    2444             : 
    2445     8935056 :     if ( stats_metadata%l_stats_samp ) then
    2446             : 
    2447             :       !$acc update host( wp2, vp2, up2, wprtp, wpthlp, upwp, vpwp, rtp2, thlp2, &
    2448             :       !$acc              rtpthlp, rtm, thlm, um, vm, wp3, &
    2449             :       !$acc              pdf_params%w_1, pdf_params%w_2, &
    2450             :       !$acc              pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
    2451             :       !$acc              pdf_params%rt_1, pdf_params%rt_2, &
    2452             :       !$acc              pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,  &
    2453             :       !$acc              pdf_params%thl_1, pdf_params%thl_2, &
    2454             :       !$acc              pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, &
    2455             :       !$acc              pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2,  &
    2456             :       !$acc              pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2, &
    2457             :       !$acc              pdf_params%corr_rt_thl_1, pdf_params%corr_rt_thl_2,&
    2458             :       !$acc              pdf_params%alpha_thl, pdf_params%alpha_rt, &
    2459             :       !$acc              pdf_params%crt_1, pdf_params%crt_2, pdf_params%cthl_1, &
    2460             :       !$acc              pdf_params%cthl_2, pdf_params%chi_1, &
    2461             :       !$acc              pdf_params%chi_2, pdf_params%stdev_chi_1, &
    2462             :       !$acc              pdf_params%stdev_chi_2, pdf_params%stdev_eta_1, &
    2463             :       !$acc              pdf_params%stdev_eta_2, pdf_params%covar_chi_eta_1, &
    2464             :       !$acc              pdf_params%covar_chi_eta_2, pdf_params%corr_w_chi_1, &
    2465             :       !$acc              pdf_params%corr_w_chi_2, pdf_params%corr_w_eta_1, &
    2466             :       !$acc              pdf_params%corr_w_eta_2, pdf_params%corr_chi_eta_1, &
    2467             :       !$acc              pdf_params%corr_chi_eta_2, pdf_params%rsatl_1, &
    2468             :       !$acc              pdf_params%rsatl_2, pdf_params%rc_1, pdf_params%rc_2, &
    2469             :       !$acc              pdf_params%cloud_frac_1, pdf_params%cloud_frac_2,  &
    2470             :       !$acc              pdf_params%mixt_frac, pdf_params%ice_supersat_frac_1, &
    2471             :       !$acc              pdf_params%ice_supersat_frac_2, &
    2472             :       !$acc              pdf_params_zm%w_1, pdf_params_zm%w_2, &
    2473             :       !$acc              pdf_params_zm%varnce_w_1, pdf_params_zm%varnce_w_2, &
    2474             :       !$acc              pdf_params_zm%rt_1, pdf_params_zm%rt_2, &
    2475             :       !$acc              pdf_params_zm%varnce_rt_1, pdf_params_zm%varnce_rt_2,  &
    2476             :       !$acc              pdf_params_zm%thl_1, pdf_params_zm%thl_2, &
    2477             :       !$acc              pdf_params_zm%varnce_thl_1, pdf_params_zm%varnce_thl_2, &
    2478             :       !$acc              pdf_params_zm%corr_w_rt_1, pdf_params_zm%corr_w_rt_2,  &
    2479             :       !$acc              pdf_params_zm%corr_w_thl_1, pdf_params_zm%corr_w_thl_2, &
    2480             :       !$acc              pdf_params_zm%corr_rt_thl_1, pdf_params_zm%corr_rt_thl_2,&
    2481             :       !$acc              pdf_params_zm%alpha_thl, pdf_params_zm%alpha_rt, &
    2482             :       !$acc              pdf_params_zm%crt_1, pdf_params_zm%crt_2, pdf_params_zm%cthl_1, &
    2483             :       !$acc              pdf_params_zm%cthl_2, pdf_params_zm%chi_1, &
    2484             :       !$acc              pdf_params_zm%chi_2, pdf_params_zm%stdev_chi_1, &
    2485             :       !$acc              pdf_params_zm%stdev_chi_2, pdf_params_zm%stdev_eta_1, &
    2486             :       !$acc              pdf_params_zm%stdev_eta_2, pdf_params_zm%covar_chi_eta_1, &
    2487             :       !$acc              pdf_params_zm%covar_chi_eta_2, pdf_params_zm%corr_w_chi_1, &
    2488             :       !$acc              pdf_params_zm%corr_w_chi_2, pdf_params_zm%corr_w_eta_1, &
    2489             :       !$acc              pdf_params_zm%corr_w_eta_2, pdf_params_zm%corr_chi_eta_1, &
    2490             :       !$acc              pdf_params_zm%corr_chi_eta_2, pdf_params_zm%rsatl_1, &
    2491             :       !$acc              pdf_params_zm%rsatl_2, pdf_params_zm%rc_1, pdf_params_zm%rc_2, &
    2492             :       !$acc              pdf_params_zm%cloud_frac_1, pdf_params_zm%cloud_frac_2,  &
    2493             :       !$acc              pdf_params_zm%mixt_frac, pdf_params_zm%ice_supersat_frac_1, &
    2494             :       !$acc              pdf_params_zm%ice_supersat_frac_2, &
    2495             :       !$acc              um, vm, upwp, vpwp, up2, vp2, &
    2496             :       !$acc              thlm, rtm, wprtp, wpthlp, &
    2497             :       !$acc              wp2, wp3, rtp2, rtp3, thlp2, thlp3, rtpthlp, &
    2498             :       !$acc              wpthvp, wp2thvp, rtpthvp, thlpthvp, &
    2499             :       !$acc              p_in_Pa, exner, rho, rho_zm, &
    2500             :       !$acc              rho_ds_zm, rho_ds_zt, thv_ds_zm, thv_ds_zt, &
    2501             :       !$acc              wm_zt, wm_zm, rcm, wprcp, rc_coef_zm, rc_coef, &
    2502             :       !$acc              rcm_zm, rtm_zm, thlm_zm, cloud_frac, ice_supersat_frac, &
    2503             :       !$acc              cloud_frac_zm, ice_supersat_frac_zm, rcm_in_layer, &
    2504             :       !$acc              cloud_cover, rcm_supersat_adj, sigma_sqd_w, &
    2505             :       !$acc              thvm, ug, vg, Lscale, wpthlp2, wp2thlp, wprtp2, wp2rtp, &
    2506             :       !$acc              Lscale_up, Lscale_down, tau_zt, Kh_zt, wp2rcp, &
    2507             :       !$acc              wprtpthlp, sigma_sqd_w_zt, wp2_zt, thlp2_zt, &
    2508             :       !$acc              wpthlp_zt, wprtp_zt, rtp2_zt, rtpthlp_zt, up2_zt, &
    2509             :       !$acc              vp2_zt, upwp_zt, vpwp_zt, wpup2, wpvp2, &
    2510             :       !$acc              wp2up2, wp2vp2, wp4, &
    2511             :       !$acc              tau_zm, Kh_zm, thlprcp, &
    2512             :       !$acc              rtprcp, rcp2, em, a3_coef, a3_coef_zt, &
    2513             :       !$acc              wp3_zm, wp3_on_wp2, wp3_on_wp2_zt, Skw_velocity, &
    2514             :       !$acc              w_up_in_cloud, w_down_in_cloud, &
    2515             :       !$acc              cloudy_updraft_frac, cloudy_downdraft_frac )
    2516             : 
    2517             :       !$acc update host( sclrm, sclrp2, sclrprtp, sclrpthlp, sclrm_forcing, &
    2518             :       !$acc              sclrpthvp, wpsclrp, sclrprcp, wp2sclrp, wpsclrp2, &
    2519             :       !$acc              wpsclrprtp, wpsclrpthlp, wpedsclrp ) &
    2520             :       !$acc if ( sclr_dim > 0 )
    2521             : 
    2522             :       !$acc update host( edsclrm, edsclrm_forcing  ) if ( edsclr_dim > 0 )
    2523             : 
    2524           0 :       do i = 1, ngrdcol
    2525             : 
    2526           0 :         call stat_end_update( nz, stats_metadata%iwp2_bt, wp2(i,:) / dt, & ! intent(in)
    2527           0 :                               stats_zm(i) )           ! intent(inout)
    2528           0 :         call stat_end_update( nz, stats_metadata%ivp2_bt, vp2(i,:) / dt, & ! intent(in)
    2529           0 :                               stats_zm(i) )           ! intent(inout)
    2530           0 :         call stat_end_update( nz, stats_metadata%iup2_bt, up2(i,:) / dt, & ! intent(in)
    2531           0 :                               stats_zm(i) )           ! intent(inout)
    2532           0 :         call stat_end_update( nz, stats_metadata%iwprtp_bt, wprtp(i,:) / dt, & ! intent(in)
    2533           0 :                               stats_zm(i) )               ! intent(inout)
    2534           0 :         call stat_end_update( nz, stats_metadata%iwpthlp_bt, wpthlp(i,:) / dt, & ! intent(in)
    2535           0 :                               stats_zm(i) )                 ! intent(inout)
    2536           0 :         if ( clubb_config_flags%l_predict_upwp_vpwp ) then
    2537           0 :            call stat_end_update( nz, stats_metadata%iupwp_bt, upwp(i,:) / dt, & ! intent(in)
    2538           0 :                                  stats_zm(i) )             ! intent(inout)
    2539           0 :            call stat_end_update( nz, stats_metadata%ivpwp_bt, vpwp(i,:) / dt, & ! intent(in)
    2540           0 :                                  stats_zm(i) )             ! intent(inout)
    2541             :         endif ! l_predict_upwp_vpwp
    2542           0 :         call stat_end_update( nz, stats_metadata%irtp2_bt, rtp2(i,:) / dt, & ! intent(in)
    2543           0 :                               stats_zm(i) )             ! intent(inout)
    2544           0 :         call stat_end_update( nz, stats_metadata%ithlp2_bt, thlp2(i,:) / dt, & ! intent(in)
    2545           0 :                               stats_zm(i) )               ! intent(inout)
    2546           0 :         call stat_end_update( nz, stats_metadata%irtpthlp_bt, rtpthlp(i,:) / dt, & ! intent(in)
    2547           0 :                               stats_zm(i) )                   ! intent(inout)
    2548             :  
    2549           0 :         call stat_end_update( nz, stats_metadata%irtm_bt, rtm(i,:) / dt, & ! intent(in)
    2550           0 :                               stats_zt(i) )           ! intent(inout)
    2551           0 :         call stat_end_update( nz, stats_metadata%ithlm_bt, thlm(i,:) / dt, & ! intent(in)
    2552           0 :                               stats_zt(i) )             ! intent(inout)
    2553           0 :         call stat_end_update( nz, stats_metadata%ium_bt, um(i,:) / dt, & ! intent(in)
    2554           0 :                               stats_zt(i) )         ! intent(inout)
    2555           0 :         call stat_end_update( nz, stats_metadata%ivm_bt, vm(i,:) / dt, & ! intent(in)
    2556           0 :                               stats_zt(i) )         ! intent(inout)
    2557           0 :         call stat_end_update( nz, stats_metadata%iwp3_bt, wp3(i,:) / dt, & ! intent(in)
    2558           0 :                               stats_zt(i) )           ! intent(inout)
    2559             :       end do
    2560             : 
    2561           0 :       if ( stats_metadata%iwpthlp_zt > 0 ) then
    2562           0 :         wpthlp_zt(:,:)  = zm2zt( nz, ngrdcol, gr, wpthlp(:,:) )
    2563             :       end if
    2564             : 
    2565           0 :       if ( stats_metadata%iwprtp_zt > 0 ) then
    2566           0 :         wprtp_zt(:,:)   = zm2zt( nz, ngrdcol, gr, wprtp(:,:) )
    2567             :       end if
    2568             : 
    2569           0 :       if ( stats_metadata%iup2_zt > 0 ) then
    2570           0 :         up2_zt(:,:) = zm2zt( nz, ngrdcol, gr, up2(:,:), w_tol_sqd )
    2571             :       end if
    2572             : 
    2573           0 :       if (stats_metadata%ivp2_zt > 0 ) then
    2574           0 :         vp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, vp2(:,:), w_tol_sqd )
    2575             :       end if
    2576             : 
    2577           0 :       if ( stats_metadata%iupwp_zt > 0 ) then
    2578           0 :         upwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, upwp(:,:) )
    2579             :       end if
    2580             : 
    2581           0 :       if ( stats_metadata%ivpwp_zt > 0 ) then
    2582           0 :         vpwp_zt(:,:) = zm2zt( nz, ngrdcol, gr, vpwp(:,:) )
    2583             :       end if
    2584             :       
    2585           0 :       do i = 1, ngrdcol
    2586             :         
    2587             :         ! Allocate arrays in single column versions of pdf_params
    2588           0 :         call init_pdf_params( nz, 1, pdf_params_single_col(i) )
    2589           0 :         call init_pdf_params( nz, 1, pdf_params_zm_single_col(i) )
    2590             :         
    2591             :         ! Copy multicolumn pdf_params to single column version  
    2592             :         call copy_multi_pdf_params_to_single( pdf_params, i, &
    2593           0 :                                               pdf_params_single_col(i) )
    2594             :                                               
    2595             :         call copy_multi_pdf_params_to_single( pdf_params_zm, i, &
    2596           0 :                                               pdf_params_zm_single_col(i) )
    2597             :         
    2598             :         call stats_accumulate( &
    2599             :                nz, sclr_dim, edsclr_dim, &
    2600           0 :                gr%invrs_dzm(i,:), gr%zt(i,:), gr%dzm(i,:), gr%dzt(i,:), dt, & ! intent(in)
    2601           0 :                um(i,:), vm(i,:), upwp(i,:), vpwp(i,:), up2(i,:), vp2(i,:),     & ! intent(in)
    2602           0 :                thlm(i,:), rtm(i,:), wprtp(i,:), wpthlp(i,:),                              & ! intent(in)
    2603           0 :                wp2(i,:), wp3(i,:), rtp2(i,:), rtp3(i,:), thlp2(i,:), thlp3(i,:), rtpthlp(i,:),           & ! intent(in)
    2604           0 :                wpthvp(i,:), wp2thvp(i,:), rtpthvp(i,:), thlpthvp(i,:),                    & ! intent(in)
    2605           0 :                p_in_Pa(i,:), exner(i,:), rho(i,:), rho_zm(i,:),                           & ! intent(in)
    2606           0 :                rho_ds_zm(i,:), rho_ds_zt(i,:), thv_ds_zm(i,:), thv_ds_zt(i,:),            & ! intent(in)
    2607           0 :                wm_zt(i,:), wm_zm(i,:), rcm(i,:), wprcp(i,:), rc_coef(i,:), rc_coef_zm(i,:),         & ! intent(in)
    2608           0 :                rcm_zm(i,:), rtm_zm(i,:), thlm_zm(i,:), cloud_frac(i,:), ice_supersat_frac(i,:),& ! intent(in)
    2609           0 :                cloud_frac_zm(i,:), ice_supersat_frac_zm(i,:), rcm_in_layer(i,:),     & ! intent(in)
    2610           0 :                cloud_cover(i,:), rcm_supersat_adj(i,:), sigma_sqd_w(i,:),            & ! intent(in)
    2611           0 :                thvm(i,:), ug(i,:), vg(i,:), Lscale(i,:), wpthlp2(i,:), wp2thlp(i,:), wprtp2(i,:), wp2rtp(i,:),& ! intent(in)
    2612           0 :                Lscale_up(i,:), Lscale_down(i,:), tau_zt(i,:), Kh_zt(i,:), wp2rcp(i,:),         & ! intent(in)
    2613           0 :                wprtpthlp(i,:), sigma_sqd_w_zt(i,:), rsat(i,:), wp2_zt(i,:), thlp2_zt(i,:),     & ! intent(in)
    2614           0 :                wpthlp_zt(i,:), wprtp_zt(i,:), rtp2_zt(i,:), rtpthlp_zt(i,:), up2_zt(i,:),      & ! intent(in)
    2615           0 :                vp2_zt(i,:), upwp_zt(i,:), vpwp_zt(i,:), wpup2(i,:), wpvp2(i,:),                & ! intent(in)
    2616           0 :                wp2up2(i,:), wp2vp2(i,:), wp4(i,:),                                   & ! intent(in)
    2617           0 :                tau_zm(i,:), Kh_zm(i,:), thlprcp(i,:),                                & ! intent(in)
    2618           0 :                rtprcp(i,:), rcp2(i,:), em(i,:), a3_coef(i,:), a3_coef_zt(i,:),                 & ! intent(in)
    2619           0 :                wp3_zm(i,:), wp3_on_wp2(i,:), wp3_on_wp2_zt(i,:), Skw_velocity(i,:),       & ! intent(in)
    2620           0 :                w_up_in_cloud(i,:), w_down_in_cloud(i,:),                             & ! intent(in)
    2621           0 :                cloudy_updraft_frac(i,:), cloudy_downdraft_frac(i,:),                 & ! intent(in)
    2622           0 :                pdf_params_single_col(i), pdf_params_zm_single_col(i), sclrm(i,:,:), sclrp2(i,:,:),              & ! intent(in)
    2623             :                sclrprtp(i,:,:), sclrpthlp(i,:,:), sclrm_forcing(i,:,:), sclrpthvp(i,:,:),         & ! intent(in)
    2624             :                wpsclrp(i,:,:), sclrprcp(i,:,:), wp2sclrp(i,:,:), wpsclrp2(i,:,:), wpsclrprtp(i,:,:),     & ! intent(in)
    2625             :                wpsclrpthlp(i,:,:), wpedsclrp(i,:,:), edsclrm(i,:,:), edsclrm_forcing(i,:,:),      & ! intent(in)
    2626             :                clubb_config_flags%saturation_formula,                                         & ! intent(in)
    2627             :                stats_metadata,                                                               & ! intent(in)
    2628           0 :                stats_zt(i), stats_zm(i), stats_sfc(i) )                                           ! intent(inout)
    2629             :       end do
    2630             :     endif ! stats_metadata%l_stats_samp
    2631             : 
    2632     8935056 :     if ( clubb_at_least_debug_level( 2 ) ) then
    2633             : 
    2634             :       !$acc update host( thlm_forcing, rtm_forcing, um_forcing, vm_forcing, &
    2635             :       !$acc              wm_zm, wm_zt, p_in_Pa, rho_zm, rho, exner, rho_ds_zm, &
    2636             :       !$acc              rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, &
    2637             :       !$acc              thv_ds_zt, wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, &
    2638             :       !$acc              um, upwp, vm, vpwp, up2, vp2, rtm, wprtp, thlm, wpthlp, &
    2639             :       !$acc              wp2, wp3, rtp2, thlp2, rtpthlp )
    2640             : 
    2641             :       !$acc update host( wpsclrp_sfc, wpedsclrp_sfc, sclrm, wpsclrp, &
    2642             :       !$acc              sclrp2, sclrprtp, sclrpthlp, sclrm_forcing ) &
    2643             :       !$acc if ( sclr_dim > 0 )
    2644             : 
    2645             :       !$acc update host( edsclrm, edsclrm_forcing  ) if ( edsclr_dim > 0 )
    2646             : 
    2647           0 :       do i = 1, ngrdcol
    2648             :         call parameterization_check( &
    2649             :              nz, sclr_dim, edsclr_dim, &
    2650           0 :              thlm_forcing(i,:), rtm_forcing(i,:), um_forcing(i,:),                         & ! intent(in)
    2651           0 :              vm_forcing(i,:), wm_zm(i,:), wm_zt(i,:), p_in_Pa(i,:),                                 & ! intent(in)
    2652           0 :              rho_zm(i,:), rho(i,:), exner(i,:), rho_ds_zm(i,:),                                     & ! intent(in)
    2653           0 :              rho_ds_zt(i,:), invrs_rho_ds_zm(i,:), invrs_rho_ds_zt(i,:),                       & ! intent(in)
    2654           0 :              thv_ds_zm(i,:), thv_ds_zt(i,:), wpthlp_sfc(i), wprtp_sfc(i), upwp_sfc(i),             & ! intent(in)
    2655             :              vpwp_sfc(i), um(i,:), upwp(i,:), vm(i,:), vpwp(i,:), up2(i,:), vp2(i,:),                            & ! intent(in)
    2656           0 :              rtm(i,:), wprtp(i,:), thlm(i,:), wpthlp(i,:), wp2(i,:), wp3(i,:),                                & ! intent(in)
    2657           0 :              rtp2(i,:), thlp2(i,:), rtpthlp(i,:),                                              & ! intent(in)
    2658             :              !rcm,                                                               &
    2659             :              "end of ",                                                          & ! intent(in)
    2660           0 :              wpsclrp_sfc(i,:), wpedsclrp_sfc(i,:), sclrm(i,:,:), wpsclrp(i,:,:), sclrp2(i,:,:),                & ! intent(in)
    2661           0 :              sclrprtp(i,:,:), sclrpthlp(i,:,:), sclrm_forcing(i,:,:), edsclrm(i,:,:), edsclrm_forcing(i,:,:)       ) ! intent(in)
    2662             :       end do
    2663             : 
    2664           0 :       if ( err_code == clubb_fatal_error ) then
    2665             :         write(fstderr,*) "Error occurred during parameterization_check at"// &
    2666           0 :                          " end of advance_clubb_core"
    2667           0 :         err_code_out = err_code
    2668           0 :         return
    2669             :       end if
    2670             : 
    2671             :     end if
    2672             : 
    2673     8935056 :     if ( stats_metadata%l_stats .and. stats_metadata%l_stats_samp ) then
    2674             : 
    2675             :       !$acc update host( wm_zt, wm_zm, rho_ds_zm, wprtp, wprtp_sfc, rho_ds_zt, &
    2676             :       !$acc              rtm, rtm_forcing, thlm, thlm_forcing )
    2677             : 
    2678             :       ! Spurious source will only be calculated if rtm_ma and thlm_ma are zero.
    2679             :       ! Therefore, wm must be zero or l_implemented must be true.
    2680           0 :       do i = 1, ngrdcol
    2681           0 :         if ( l_implemented .or. &
    2682           0 :              (all( abs(wm_zt(i,:)) < eps ) .and. all( abs(wm_zm(i,:)) < eps ))) then
    2683             :           ! Calculate the spurious source for rtm
    2684           0 :           rtm_flux_top(i) = rho_ds_zm(i,nz) * wprtp(i,nz)
    2685             : 
    2686           0 :           if ( .not. clubb_config_flags%l_host_applies_sfc_fluxes ) then
    2687           0 :             rtm_flux_sfc(i) = rho_ds_zm(i,1) * wprtp_sfc(i)
    2688             :           else
    2689           0 :             rtm_flux_sfc(i) = 0.0_core_rknd
    2690             :           end if
    2691             : 
    2692             :           rtm_integral_after(i)  &
    2693           0 :           = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
    2694           0 :                                rtm(i,2:nz), gr%dzt(i,2:nz) )
    2695             : 
    2696           0 :           rtm_integral_forcing(i)  &
    2697             :           = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
    2698           0 :                                rtm_forcing(i,2:nz), gr%dzt(i,2:nz) )
    2699             : 
    2700           0 :           rtm_spur_src(i)  &
    2701             :           = calculate_spurious_source( rtm_integral_after(i), &
    2702             :                                        rtm_integral_before(i), &
    2703             :                                        rtm_flux_top(i), rtm_flux_sfc(i), &
    2704             :                                        rtm_integral_forcing(i), &
    2705           0 :                                        dt )
    2706             : 
    2707             :           ! Calculate the spurious source for thlm
    2708           0 :           thlm_flux_top(i) = rho_ds_zm(i,nz) * wpthlp(i,nz)
    2709             : 
    2710           0 :           if ( .not. clubb_config_flags%l_host_applies_sfc_fluxes ) then
    2711           0 :             thlm_flux_sfc(i) = rho_ds_zm(i,1) * wpthlp_sfc(i)
    2712             :           else
    2713           0 :             thlm_flux_sfc(i) = 0.0_core_rknd
    2714             :           end if
    2715             : 
    2716             :           thlm_integral_after(i)  &
    2717             :           = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
    2718           0 :                                thlm(i,2:nz), gr%dzt(i,2:nz) )
    2719             : 
    2720           0 :           thlm_integral_forcing(i)  &
    2721             :           = vertical_integral( (nz - 2 + 1), rho_ds_zt(i,2:nz), &
    2722           0 :                                thlm_forcing(i,2:nz), gr%dzt(i,2:nz) )
    2723             : 
    2724           0 :           thlm_spur_src(i)  &
    2725             :           = calculate_spurious_source( thlm_integral_after(i), &
    2726             :                                        thlm_integral_before(i), &
    2727             :                                        thlm_flux_top(i), thlm_flux_sfc(i), &
    2728             :                                        thlm_integral_forcing(i), &
    2729           0 :                                        dt )
    2730             :         else ! If l_implemented is false, we don't want spurious source output
    2731           0 :           rtm_spur_src(i) = -9999.0_core_rknd
    2732           0 :           thlm_spur_src(i) = -9999.0_core_rknd
    2733             :         end if
    2734             :       end do
    2735             : 
    2736             :       ! Write the var to stats
    2737           0 :       do i = 1, ngrdcol
    2738           0 :         call stat_update_var_pt( stats_metadata%irtm_spur_src, 1, rtm_spur_src(i),   & ! intent(in)
    2739           0 :                                  stats_sfc(i) )                               ! intent(inout)
    2740           0 :         call stat_update_var_pt( stats_metadata%ithlm_spur_src, 1, thlm_spur_src(i), & ! intent(in)
    2741           0 :                                  stats_sfc(i) )                               ! intent(inout)
    2742             :       end do
    2743             :     end if
    2744             : 
    2745             :     !$acc exit data if( sclr_dim > 0 ) &
    2746             :     !$acc           delete( sclrprcp, wp2sclrp, &
    2747             :     !$acc                   wpsclrp2, wpsclrprtp, wpsclrpthlp, wpsclrp_zt, sclrp2_zt )
    2748             : 
    2749             :     !$acc exit data if( edsclr_dim > 0 ) &
    2750             :     !$acc           delete( wpedsclrp )
    2751             : 
    2752             :     !$acc exit data delete( Skw_zm, Skw_zt, thvm, thvm_zm, ddzm_thvm_zm, rtprcp, rcp2, &
    2753             :     !$acc                   wpthlp2, wprtp2, wprtpthlp, wp2rcp, wp3_zm, Lscale, Lscale_up, &
    2754             :     !$acc                   Lscale_zm, Lscale_down, em, tau_zm, tau_zt, sigma_sqd_w_zt, &
    2755             :     !$acc                   wp2_zt, thlp2_zt, wpthlp_zt, &
    2756             :     !$acc                   wprtp_zt, rtp2_zt, rtpthlp_zt, up2_zt, vp2_zt, upwp_zt, vpwp_zt, &
    2757             :     !$acc                   Skw_velocity, a3_coef, a3_coef_zt, wp3_on_wp2, wp3_on_wp2_zt, &
    2758             :     !$acc                   rc_coef, Km_zm, Kmh_zm, gamma_Skw_fnc, sigma_sqd_w, sigma_sqd_w_tmp, &
    2759             :     !$acc                   sqrt_em_zt, xp3_coef_fnc, w_1_zm, w_2_zm, varnce_w_1_zm, varnce_w_2_zm, &
    2760             :     !$acc                   mixt_frac_zm, rcp2_zt, cloud_frac_zm, ice_supersat_frac_zm, rtm_zm, &
    2761             :     !$acc                   thlm_zm, rcm_zm, thlm1000, thlm700, &
    2762             :     !$acc                   rcm_supersat_adj, stability_correction, invrs_tau_N2_zm, &
    2763             :     !$acc                   invrs_tau_C6_zm, invrs_tau_C1_zm, invrs_tau_xp2_zm, invrs_tau_N2_iso, &
    2764             :     !$acc                   invrs_tau_C4_zm, invrs_tau_C14_zm, invrs_tau_wp2_zm, invrs_tau_wpxp_zm, &
    2765             :     !$acc                   invrs_tau_wp3_zm, invrs_tau_no_N2_zm, invrs_tau_bkgnd, invrs_tau_shear, &
    2766             :     !$acc                   invrs_tau_sfc, invrs_tau_zt, invrs_tau_wp3_zt, Cx_fnc_Richardson, &
    2767             :     !$acc                   brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, &
    2768             :     !$acc                   brunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_moist, &
    2769             :     !$acc                   brunt_vaisala_freq_sqd_splat, &
    2770             :     !$acc                   brunt_vaisala_freq_sqd_zt, Ri_zm, Lscale_max, &
    2771             :     !$acc                   tau_max_zm, tau_max_zt, mu, lhs_splat_wp2, lhs_splat_wp3 )
    2772             :     
    2773             :     return
    2774             : 
    2775 13464921600 :   end subroutine advance_clubb_core
    2776             : 
    2777             :   !=============================================================================
    2778     8935056 :   subroutine pdf_closure_driver( gr, nz, ngrdcol,                         & ! Intent(in)
    2779     8935056 :                                  dt, hydromet_dim, sclr_dim, sclr_tol,    & ! Intent(in)
    2780     8935056 :                                  wprtp, thlm, wpthlp, rtp2, rtp3,         & ! Intent(in)
    2781     8935056 :                                  thlp2, thlp3, rtpthlp, wp2,              & ! Intent(in)
    2782     8935056 :                                  wp3, wm_zm, wm_zt,                       & ! Intent(in)
    2783     8935056 :                                  um, up2, upwp, up3,                      & ! Intent(in)
    2784     8935056 :                                  vm, vp2, vpwp, vp3,                      & ! Intent(in)
    2785     8935056 :                                  p_in_Pa, exner,                          & ! Intent(in)
    2786     8935056 :                                  thv_ds_zm, thv_ds_zt, rtm_ref,           & ! Intent(in)
    2787             : !                                rfrzm, hydromet,                         &
    2788     8935056 :                                  wphydrometp,                             & ! Intent(in)
    2789     8935056 :                                  wp2hmp, rtphmp_zt, thlphmp_zt,           & ! Intent(in)
    2790     8935056 :                                  sclrm, wpsclrp, sclrp2,                  & ! Intent(in)
    2791     8935056 :                                  sclrprtp, sclrpthlp, sclrp3,             & ! Intent(in)
    2792             :                                  l_samp_stats_in_pdf_call,                & ! Intent(in)
    2793     8935056 :                                  clubb_params,                            & ! Intent(in)
    2794             :                                  iiPDF_type,                              & ! Intent(in)
    2795             :                                  saturation_formula,                      & ! Intent(in)
    2796             :                                  l_predict_upwp_vpwp,                     & ! Intent(in)
    2797             :                                  l_rtm_nudge,                             & ! Intent(in)
    2798             :                                  l_trapezoidal_rule_zt,                   & ! Intent(in)
    2799             :                                  l_trapezoidal_rule_zm,                   & ! Intent(in)
    2800             :                                  l_call_pdf_closure_twice,                & ! Intent(in)
    2801             :                                  l_use_cloud_cover,                       & ! Intent(in)
    2802             :                                  l_rcm_supersat_adj,                      & ! Intent(in
    2803     8935056 :                                  l_mix_rat_hm,                            & ! Intent(in)
    2804             :                                  stats_metadata,                          & ! Intent(in)
    2805     8935056 :                                  stats_zt, stats_zm,                      & ! Intent(inout)
    2806     8935056 :                                  rtm,                                     & ! Intent(inout)
    2807             :                                  pdf_implicit_coefs_terms,                & ! Intent(inout)
    2808             :                                  pdf_params, pdf_params_zm,               & ! Intent(inout)
    2809             : #ifdef GFDL
    2810             :                                  RH_crit(k, : , :),                       & ! Intent(inout)
    2811             :                                  do_liquid_only_in_clubb,                 & ! Intent(in)
    2812             : #endif
    2813     8935056 :                                  rcm, cloud_frac,                         & ! Intent(out)
    2814     8935056 :                                  ice_supersat_frac, wprcp,                & ! Intent(out)
    2815     8935056 :                                  sigma_sqd_w, wpthvp, wp2thvp,            & ! Intent(out)
    2816     8935056 :                                  rtpthvp, thlpthvp, rc_coef,              & ! Intent(out)
    2817     8935056 :                                  rcm_in_layer, cloud_cover,               & ! Intent(out)
    2818     8935056 :                                  rcp2_zt, thlprcp,                        & ! Intent(out)
    2819     8935056 :                                  rc_coef_zm, sclrpthvp,                   & ! Intent(out)
    2820     8935056 :                                  wpup2, wpvp2,                            & ! Intent(out)
    2821     8935056 :                                  wp2up2, wp2vp2, wp4,                     & ! Intent(out)
    2822     8935056 :                                  wp2rtp, wprtp2, wp2thlp,                 & ! Intent(out)
    2823     8935056 :                                  wpthlp2, wprtpthlp, wp2rcp,              & ! Intent(out)
    2824     8935056 :                                  rtprcp, rcp2,                            & ! Intent(out)
    2825     8935056 :                                  uprcp, vprcp,                            & ! Intent(out)
    2826     8935056 :                                  w_up_in_cloud, w_down_in_cloud,          & ! Intent(out)
    2827     8935056 :                                  cloudy_updraft_frac,                     & ! Intent(out)
    2828     8935056 :                                  cloudy_downdraft_frac,                   & ! intent(out)
    2829     8935056 :                                  Skw_velocity,                            & ! Intent(out)
    2830     8935056 :                                  cloud_frac_zm,                           & ! Intent(out)
    2831     8935056 :                                  ice_supersat_frac_zm,                    & ! Intent(out)
    2832     8935056 :                                  rtm_zm, thlm_zm, rcm_zm,                 & ! Intent(out)
    2833     8935056 :                                  rcm_supersat_adj,                        & ! Intent(out)
    2834     8935056 :                                  wp2sclrp, wpsclrp2, sclrprcp,            & ! Intent(out)
    2835     8935056 :                                  wpsclrprtp, wpsclrpthlp )                  ! Intent(out)
    2836             : 
    2837             :     use grid_class, only: &
    2838             :         grid, & ! Type
    2839             :         zt2zm, & ! Procedure(s)
    2840             :         zm2zt, &
    2841             :         zm2zt2zm
    2842             : 
    2843             :     use constants_clubb, only: &
    2844             :         one_half,       & ! Variable(s)
    2845             :         w_tol,          & 
    2846             :         w_tol_sqd,      &
    2847             :         rt_tol,         &
    2848             :         thl_tol,        &
    2849             :         p0,             &
    2850             :         kappa,          &
    2851             :         fstderr,        &
    2852             :         zero,           &
    2853             :         zero_threshold, &
    2854             :         eps
    2855             : 
    2856             :     use pdf_parameter_module, only: &
    2857             :         pdf_parameter,        & ! Variable Type
    2858             :         implicit_coefs_terms, &  ! Variable Type
    2859             :         init_pdf_implicit_coefs_terms ! Procedure
    2860             : 
    2861             :     use parameters_model, only: &
    2862             :         ts_nudge,               & ! Variable(s)
    2863             :         rtm_min,                &
    2864             :         rtm_nudge_max_altitude
    2865             : 
    2866             :     use parameter_indices, only: &
    2867             :         nparams,         & ! Variable(s)
    2868             :         igamma_coef,     &
    2869             :         igamma_coefb,    &
    2870             :         igamma_coefc,    &
    2871             :         iSkw_denom_coef, &
    2872             :         iSkw_max_mag
    2873             : 
    2874             :     use pdf_closure_module, only: &
    2875             :         pdf_closure ! Procedure(s)
    2876             : 
    2877             :     use Skx_module, only: &
    2878             :         Skx_func    ! Procedure(s)
    2879             : 
    2880             :     use sigma_sqd_w_module, only: &
    2881             :         compute_sigma_sqd_w    ! Procedure(s)
    2882             : 
    2883             :     use pdf_utilities, only: &
    2884             :         compute_mean_binormal    ! Procedure(s)
    2885             : 
    2886             :     use T_in_K_module, only: &
    2887             :         thlm2T_in_K    ! Procedure(s)
    2888             : 
    2889             :     use saturation, only:  &
    2890             :         sat_mixrat_liq    ! Procedure(s)
    2891             : 
    2892             :     use model_flags, only: &
    2893             :         l_gamma_Skw,      & ! Variable(s)
    2894             :         iiPDF_new,        & ! new PDF
    2895             :         iiPDF_new_hybrid    ! new hybrid PDF
    2896             : 
    2897             :     use error_code, only: &
    2898             :         clubb_at_least_debug_level,  & ! Procedure
    2899             :         err_code,                    & ! Error Indicator
    2900             :         clubb_fatal_error              ! Constant
    2901             : 
    2902             :     use stats_type_utilities, only: &
    2903             :         stat_update_var,    & ! Procedure(s)
    2904             :         stat_update_var_pt
    2905             : 
    2906             :     use stats_variables, only: &
    2907             :         stats_metadata_type
    2908             : 
    2909             :     use clubb_precision, only: &
    2910             :         core_rknd    ! Variable(s)
    2911             : 
    2912             :     use stats_type, only: stats ! Type
    2913             : 
    2914             :     implicit none
    2915             : 
    2916             :     !------------------------------- Input Variables -------------------------------
    2917             :     type (grid), target, intent(in) :: &
    2918             :       gr
    2919             : 
    2920             :     integer, intent(in) :: &
    2921             :       nz, &
    2922             :       ngrdcol
    2923             : 
    2924             :     real( kind = core_rknd ), intent(in) ::  &
    2925             :       dt  ! Current timestep duration    [s]
    2926             : 
    2927             :     integer, intent(in) :: &
    2928             :       hydromet_dim,   & ! Total number of hydrometeor species       [#]
    2929             :       sclr_dim          ! Number of passive scalars                 [#]
    2930             : 
    2931             :     real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: & 
    2932             :       sclr_tol          ! Threshold(s) on the passive scalars  [units vary]
    2933             : 
    2934             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
    2935             :       !rtm,       & ! total water mixing ratio, r_t (thermo. levels) [kg/kg]
    2936             :       wprtp,     & ! w' r_t' (momentum levels)                      [(kg/kg)m/s]
    2937             :       thlm,      & ! liq. water pot. temp., th_l (thermo. levels)   [K]
    2938             :       wpthlp,    & ! w' th_l' (momentum levels)                     [(m/s) K]
    2939             :       rtp2,      & ! r_t'^2 (momentum levels)                       [(kg/kg)^2]
    2940             :       rtp3,      & ! r_t'^3 (thermodynamic levels)                  [(kg/kg)^3]
    2941             :       thlp2,     & ! th_l'^2 (momentum levels)                      [K^2]
    2942             :       thlp3,     & ! th_l'^3 (thermodynamic levels)                 [K^3]
    2943             :       rtpthlp,   & ! r_t' th_l' (momentum levels)                   [(kg/kg) K]
    2944             :       wp2,       & ! w'^2 (momentum levels)                         [m^2/s^2]
    2945             :       wp3,       & ! w'^3 (thermodynamic levels)                    [m^3/s^3]
    2946             :       wm_zm,     & ! w mean wind component on momentum levels       [m/s]
    2947             :       wm_zt,     & ! w mean wind component on thermo. levels        [m/s]
    2948             :       p_in_Pa,   & ! Air pressure (thermodynamic levels)            [Pa]
    2949             :       exner,     & ! Exner function (thermodynamic levels)          [-]
    2950             :       thv_ds_zm, & ! Dry, base-state theta_v on momentum levs.      [K]
    2951             :       thv_ds_zt, & ! Dry, base-state theta_v on thermo. levs.       [K]
    2952             :       rtm_ref!,  & ! Initial total water mixing ratio               [kg/kg]
    2953             :       !rfrzm        ! Total ice-phase water mixing ratio             [kg/kg]
    2954             : 
    2955             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
    2956             :       um,          & ! Grid-mean eastward wind     [m/s]
    2957             :       up2,         & ! u'^2                        [(m/s)^2]
    2958             :       upwp,        & ! u'w'                        [(m/s)^2]
    2959             :       up3,         & ! u'^3                        [(m/s)^3]
    2960             :       vm,          & ! Grid-mean northward wind    [m/s]
    2961             :       vp2,         & ! v'^2                        [(m/s)^2]
    2962             :       vpwp,        & ! v'w'                        [(m/s)^2]
    2963             :       vp3            ! v'^3                        [(m/s)^3]
    2964             : 
    2965             :     ! Hydrometeor variables
    2966             :     !real( kind = core_rknd ), dimension(gr%nz,hydromet_dim), intent(in) :: &
    2967             :     !hydromet       ! Mean of hydrometeor fields               [units vary]
    2968             : 
    2969             :     real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim), intent(in) :: &
    2970             :       wphydrometp, & ! Covariance of w and a hydrometeor      [(m/s) <hm units>]
    2971             :       wp2hmp,      & ! Third-order moment:  < w'^2 hm' >    [(m/s)^2 <hm units>]
    2972             :       rtphmp_zt,   & ! Covariance of rt and hm (on t-levs.) [(kg/kg) <hm units>]
    2973             :       thlphmp_zt     ! Covariance of thl and hm (on t-levs.)      [K <hm units>]
    2974             : 
    2975             :     ! Passive scalar variables
    2976             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(in) :: &
    2977             :       sclrm,     & ! Passive scalar mean (thermo. levels) [units vary]
    2978             :       wpsclrp,   & ! w'sclr' (momentum levels)            [{units vary} m/s]
    2979             :       sclrp2,    & ! sclr'^2 (momentum levels)            [{units vary}^2]
    2980             :       sclrprtp,  & ! sclr'rt' (momentum levels)           [{units vary} (kg/kg)]
    2981             :       sclrpthlp, & ! sclr'thl' (momentum levels)          [{units vary} K]
    2982             :       sclrp3       ! sclr'^3 (thermodynamic levels)       [{units vary}^3]
    2983             : 
    2984             :     logical, intent(in) :: &
    2985             :       l_samp_stats_in_pdf_call    ! Sample stats in this call to this subroutine
    2986             : 
    2987             :     real( kind = core_rknd ), dimension(ngrdcol,nparams), intent(in) :: &
    2988             :       clubb_params    ! Array of CLUBB's tunable parameters    [units vary]
    2989             : 
    2990             :     integer, intent(in) :: &
    2991             :       iiPDF_type,      & ! Selected option for the two-component normal (double
    2992             :                          ! Gaussian) PDF type to use for the w, rt, and theta-l (or
    2993             :                          ! w, chi, and eta) portion of CLUBB's multivariate,
    2994             :                          ! two-component PDF.
    2995             :       saturation_formula ! Integer that stores the saturation formula to be used
    2996             : 
    2997             :     logical, dimension(hydromet_dim), intent(in) :: &
    2998             :       l_mix_rat_hm   ! if true, then the quantity is a hydrometeor mixing ratio
    2999             : 
    3000             :     logical, intent(in) :: &
    3001             :       l_predict_upwp_vpwp,      & ! Flag to predict <u'w'> and <v'w'> along with <u> and <v>
    3002             :                                   ! alongside the advancement of <rt>, <w'rt'>, <thl>, <wpthlp>,
    3003             :                                   ! <sclr>, and <w'sclr'> in subroutine advance_xm_wpxp.
    3004             :                                   ! Otherwise, <u'w'> and <v'w'> are still approximated by eddy
    3005             :                                   ! diffusivity when <u> and <v> are advanced in subroutine
    3006             :                                   ! advance_windm_edsclrm.
    3007             :       l_rtm_nudge,              & ! For rtm nudging
    3008             :       l_trapezoidal_rule_zt,    & ! If true, the trapezoidal rule is called for the
    3009             :                                   ! thermodynamic-level variables output from pdf_closure.
    3010             :       l_trapezoidal_rule_zm,    & ! If true, the trapezoidal rule is called for three
    3011             :                                   ! momentum-level variables – wpthvp, thlpthvp, and rtpthvp -
    3012             :                                   ! output from pdf_closure.
    3013             :       l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call subroutine
    3014             :                                   ! pdf_closure twice.  If true, pdf_closure is called first on
    3015             :                                   ! thermodynamic levels and then on momentum levels so that each
    3016             :                                   ! variable is computed on its native level.  If false,
    3017             :                                   ! pdf_closure is only called on thermodynamic levels, and
    3018             :                                   ! variables which belong on momentum levels are interpolated.
    3019             :       l_use_cloud_cover,        & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac and
    3020             :                                   ! rcm to help increase cloudiness at coarser grid resolutions.
    3021             :       l_rcm_supersat_adj          ! Add excess supersaturated vapor to cloud water
    3022             : 
    3023             :     type (stats_metadata_type), intent(in) :: &
    3024             :       stats_metadata
    3025             : 
    3026             :     !------------------------------- InOut Variables -------------------------------
    3027             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
    3028             :       stats_zt, &
    3029             :       stats_zm
    3030             : 
    3031             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) ::  &
    3032             :       rtm    ! total water mixing ratio, r_t (thermo. levels) [kg/kg]
    3033             : 
    3034             :     type(implicit_coefs_terms), intent(inout) :: &
    3035             :       pdf_implicit_coefs_terms    ! Implicit coefs / explicit terms [units vary]
    3036             : 
    3037             :     ! Variable being passed back to and out of advance_clubb_core.
    3038             :     type(pdf_parameter), intent(inout) :: &
    3039             :       pdf_params,    & ! PDF parameters                           [units vary]
    3040             :       pdf_params_zm    ! PDF parameters                           [units vary]
    3041             : 
    3042             : #ifdef GFDL
    3043             :     ! hlg, 2010-06-16
    3044             :     real( kind = core_rknd ), dimension(ngrdcol,nz, min(1,sclr_dim) , 2), intent(inout) :: &
    3045             :       RH_crit  ! critical relative humidity for droplet and ice nucleation
    3046             : ! ---> h1g, 2012-06-14
    3047             :     logical, intent(in)                 ::  do_liquid_only_in_clubb
    3048             : ! <--- h1g, 2012-06-14
    3049             : #endif
    3050             : 
    3051             :     !------------------------------- Output Variables -------------------------------
    3052             :     ! Variables being passed back to and out of advance_clubb_core.
    3053             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  &
    3054             :       rcm,               & ! mean r_c (thermodynamic levels)        [kg/kg]
    3055             :       cloud_frac,        & ! cloud fraction (thermodynamic levels)  [-]
    3056             :       ice_supersat_frac, & ! ice supersat. frac. (thermo. levels)   [-]
    3057             :       wprcp,             & ! < w'r_c' > (momentum levels)           [m/s kg/kg]
    3058             :       sigma_sqd_w,       & ! PDF width parameter (momentum levels)  [-]
    3059             :       wpthvp,            & ! < w' th_v' > (momentum levels)         [kg/kg K]
    3060             :       wp2thvp,           & ! < w'^2 th_v' > (thermodynamic levels)  [m^2/s^2 K]
    3061             :       rtpthvp,           & ! < r_t' th_v' > (momentum levels)       [kg/kg K]
    3062             :       thlpthvp,          & ! < th_l' th_v' > (momentum levels)      [K^2]
    3063             :       rc_coef,           & ! Coefficient of X'r_c' (thermo. levs.)  [K/(kg/kg)]
    3064             :       rcm_in_layer,      & ! rcm in cloud layer                     [kg/kg]
    3065             :       cloud_cover,       & ! cloud cover                            [-]
    3066             :       rcp2_zt,           & ! r_c'^2 (on thermo. grid)               [kg^2/kg^2]
    3067             :       thlprcp,           & ! < th_l' r_c' > (momentum levels)       [K kg/kg]
    3068             :       rc_coef_zm           ! Coefficient of X'r_c' on m-levs.       [K/(kg/kg)]
    3069             : 
    3070             :     ! Variable being passed back to and out of advance_clubb_core.
    3071             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(out) :: &
    3072             :       sclrpthvp    ! < sclr' th_v' > (momentum levels)   [units vary]
    3073             : 
    3074             :     ! Variables being passed back to only advance_clubb_core (for statistics).
    3075             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  &
    3076             :       wpup2,     & ! < w'u'^2 > (thermodynamic levels)        [m^3/s^3]
    3077             :       wpvp2,     & ! < w'v'^2 > (thermodynamic levels)        [m^3/s^3]
    3078             :       wp2up2,    & ! < w'^2u'^2 > (momentum levels)           [m^4/s^4]
    3079             :       wp2vp2,    & ! < w'^2v'^2 > (momentum levels)           [m^4/s^4]
    3080             :       wp4,       & ! < w'^4 > (momentum levels)               [m^4/s^4]
    3081             :       wp2rtp,    & ! < w'^2 r_t' > (thermodynamic levels)     [m^2/s^2 kg/kg]
    3082             :       wprtp2,    & ! < w' r_t'^2 > (thermodynamic levels)     [m/s kg^2/kg^2]
    3083             :       wp2thlp,   & ! < w'^2 th_l' > (thermodynamic levels)    [m^2/s^2 K]
    3084             :       wpthlp2,   & ! < w' th_l'^2 > (thermodynamic levels)    [m/s K^2]
    3085             :       wprtpthlp, & ! < w' r_t' th_l' > (thermodynamic levels) [m/s kg/kg K]
    3086             :       wp2rcp,    & ! < w'^2 r_c' > (thermodynamic levels)     [m^2/s^2 kg/kg]
    3087             :       rtprcp,    & ! < r_t' r_c' > (momentum levels)          [kg^2/kg^2]
    3088             :       rcp2         ! Variance of r_c (momentum levels)        [kg^2/kg^2]
    3089             : 
    3090             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  &
    3091             :       uprcp,                 & ! < u' r_c' >                [(m kg)/(s kg)]
    3092             :       vprcp,                 & ! < v' r_c' >                [(m kg)/(s kg)]
    3093             :       w_up_in_cloud,         & ! mean cloudy updraft vel    [m/s]
    3094             :       w_down_in_cloud,       & ! mean cloudy downdraft vel  [m/s]
    3095             :       cloudy_updraft_frac,   & ! cloudy updraft fraction    [-]
    3096             :       cloudy_downdraft_frac    ! cloudy downdraft fraction  [-]
    3097             : 
    3098             :     ! Variables being passed back to only advance_clubb_core (for statistics).
    3099             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  &
    3100             :       Skw_velocity,         & ! Skewness velocity                        [m/s]
    3101             :       cloud_frac_zm,        & ! Cloud Fraction on momentum levels        [-]
    3102             :       ice_supersat_frac_zm, & ! Ice supersat. frac. on momentum levels   [-]
    3103             :       rtm_zm,               & ! Total water mixing ratio at mom. levs.   [kg/kg]
    3104             :       thlm_zm,              & ! Liquid water pot. temp. at mom. levs.    [K]
    3105             :       rcm_zm,               & ! rcm at momentum levels                   [kg/kg]
    3106             :       rcm_supersat_adj        ! Adjust. to rcm due to spurious supersat. [kg/kg]
    3107             : 
    3108             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(out) :: &
    3109             :       wp2sclrp,    & ! < w'^2 sclr' > (thermodynamic levels)      [units vary]
    3110             :       wpsclrp2,    & ! < w' sclr'^2 > (thermodynamic levels)      [units vary]
    3111             :       sclrprcp,    & ! < sclr' r_c' > (momentum levels)           [units vary]
    3112             :       wpsclrprtp,  & ! < w' sclr' r_t' > (thermodynamic levels)   [units vary]
    3113             :       wpsclrpthlp    ! < w' sclr' th_l' > (thermodynamic levels)  [units vary]
    3114             : 
    3115             :     !------------------------------- Local Variables -------------------------------
    3116             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3117    17870112 :       wp2_zt,           & ! wp2 interpolated to thermodynamic levels   [m^2/s^2]
    3118    17870112 :       wp3_zm,           & ! wp3 interpolated to momentum levels        [m^3/s^3]
    3119    17870112 :       rtp2_zt,          & ! rtp2 interpolated to thermodynamic levels  [kg^2/kg^2]
    3120    17870112 :       rtp3_zm,          & ! rtp3 interpolated to momentum levels       [kg^3/kg^3]
    3121    17870112 :       thlp2_zt,         & ! thlp2 interpolated to thermodynamic levels [K^2]
    3122    17870112 :       thlp3_zm,         & ! thlp3 interpolated to momentum levels      [K^3]
    3123    17870112 :       wprtp_zt,         & ! wprtp interpolated to thermodynamic levels [m/s kg/kg]
    3124    17870112 :       wpthlp_zt,        & ! wpthlp interpolated to thermodynamic levs. [m/s K]
    3125    17870112 :       rtpthlp_zt,       & ! rtpthlp interp. to thermodynamic levels    [kg/kg K]
    3126    17870112 :       up2_zt,           & ! up2 interpolated to thermodynamic levels   [m^2/s^2]
    3127    17870112 :       up3_zm,           & ! up3 interpolated to momentum levels        [m^3/s^3]
    3128    17870112 :       vp2_zt,           & ! vp2 interpolated to thermodynamic levels   [m^2/s^2]
    3129    17870112 :       vp3_zm,           & ! vp3 interpolated to momentum levels        [m^3/s^3]
    3130    17870112 :       upwp_zt,          & ! upwp interpolated to thermodynamic levels  [m^2/s^2]
    3131    17870112 :       vpwp_zt,          & ! vpwp interpolated to thermodynamic levels  [m^2/s^2]
    3132    17870112 :       gamma_Skw_fnc,    & ! Gamma as a function of skewness            [-]
    3133    17870112 :       gamma_Skw_fnc_zt, & ! Gamma as a function of skewness (t-levs.)  [-]
    3134    17870112 :       sigma_sqd_w_zt,   & ! PDF width parameter (thermodynamic levels) [-]
    3135    17870112 :       Skw_zt,           & ! Skewness of w on thermodynamic levels      [-]
    3136    17870112 :       Skw_zm,           & ! Skewness of w on momentum levels           [-]
    3137    17870112 :       Skrt_zt,          & ! Skewness of rt on thermodynamic levels     [-]
    3138    17870112 :       Skrt_zm,          & ! Skewness of rt on momentum levels          [-]
    3139    17870112 :       Skthl_zt,         & ! Skewness of thl on thermodynamic levels    [-]
    3140    17870112 :       Skthl_zm,         & ! Skewness of thl on momentum levels         [-]
    3141    17870112 :       Sku_zt,           & ! Skewness of u on thermodynamic levels      [-]
    3142    17870112 :       Sku_zm,           & ! Skewness of u on momentum levels           [-]
    3143    17870112 :       Skv_zt,           & ! Skewness of v on thermodynamic levels      [-]
    3144    17870112 :       Skv_zm              ! Skewness of v on momentum levels           [-]
    3145             : 
    3146             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3147    17870112 :       w_up_in_cloud_zm,         & ! Avg. cloudy updraft velocity; m-levs   [m/s]
    3148    17870112 :       w_down_in_cloud_zm,       & ! Avg. cloudy downdraft velocity; m-levs [m/s]
    3149    17870112 :       cloudy_updraft_frac_zm,   & ! cloudy updraft fraction; m-levs        [-]
    3150    17870112 :       cloudy_downdraft_frac_zm    ! cloudy downdraft fraction; m-levs      [-]
    3151             : 
    3152             :     ! Interpolated values for optional second call to PDF closure.
    3153             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3154    17870112 :       p_in_Pa_zm, & ! Pressure interpolated to momentum levels  [Pa]
    3155    17870112 :       exner_zm      ! Exner interpolated to momentum levels     [-]
    3156             : 
    3157             :     real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim) :: &
    3158    17870112 :       wphydrometp_zt, & ! Covariance of w and hm (on t-levs.) [(m/s) <hm units>]
    3159    17870112 :       wp2hmp_zm,      & ! Moment <w'^2 hm'> (on m-levs.)    [(m/s)^2 <hm units>]
    3160    17870112 :       rtphmp,         & ! Covariance of rt and hm           [(kg/kg) <hm units>]
    3161    17870112 :       thlphmp           ! Covariance of thl and hm                [K <hm units>]
    3162             : 
    3163             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
    3164    17870112 :       wpsclrp_zt,   & ! w' sclr' interpolated to thermo. levels
    3165    17870112 :       sclrp2_zt,    & ! sclr'^2 interpolated to thermo. levels
    3166    17870112 :       sclrp3_zm,    & ! sclr'^3 interpolated to momentum levels
    3167    17870112 :       sclrprtp_zt,  & ! sclr' r_t' interpolated to thermo. levels
    3168    17870112 :       sclrpthlp_zt, & ! sclr' th_l' interpolated thermo. levels
    3169    17870112 :       Sksclr_zt,    & ! Skewness of sclr on thermodynamic levels      [-]
    3170    17870112 :       Sksclr_zm       ! Skewness of sclr on momentum levels           [-]
    3171             : 
    3172             :     ! These local variables are declared because they originally belong on the
    3173             :     ! momentum grid levels, but pdf_closure outputs them on the thermodynamic
    3174             :     ! grid levels.
    3175             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3176    17870112 :       wpup2_zm,    & ! w'u'^2 (on momentum grid)        [m^3/s^3]
    3177    17870112 :       wpvp2_zm,    & ! w'v'^2 (on momentum grid)        [m^3/s^3]
    3178    17870112 :       wp2up2_zt,   & ! w'^2u'^2 (on thermo. grid)       [m^4/s^4]
    3179    17870112 :       wp2vp2_zt,   & ! w'^2v'^2 (on thermo. grid)       [m^4/s^4]
    3180    17870112 :       wp4_zt,      & ! w'^4 (on thermo. grid)           [m^4/s^4]
    3181    17870112 :       wpthvp_zt,   & ! Buoyancy flux (on thermo. grid)  [(K m)/s]
    3182    17870112 :       rtpthvp_zt,  & ! r_t' th_v' (on thermo. grid)     [(kg K)/kg]
    3183    17870112 :       thlpthvp_zt, & ! th_l' th_v' (on thermo. grid)    [K^2]
    3184    17870112 :       wprcp_zt,    & ! w' r_c' (on thermo. grid)        [(m kg)/(s kg)]
    3185    17870112 :       rtprcp_zt,   & ! r_t' r_c' (on thermo. grid)      [(kg^2)/(kg^2)]
    3186    17870112 :       thlprcp_zt,  & ! th_l' r_c' (on thermo. grid)     [(K kg)/kg]
    3187    17870112 :       uprcp_zt,    & ! u' r_c' (on thermo. grid)        [(m kg)/(s kg)]
    3188    17870112 :       vprcp_zt       ! v' r_c' (on thermo. grid)        [(m kg)/(s kg)]
    3189             : 
    3190             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
    3191    17870112 :       sclrpthvp_zt, & ! sclr'th_v' (on thermo. grid)
    3192    17870112 :       sclrprcp_zt     ! sclr'rc' (on thermo. grid)
    3193             : 
    3194             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3195    17870112 :       wprtp2_zm,    & ! < w' r_t'^2 > on momentum levels      [m/s kg^2/kg^2]
    3196    17870112 :       wp2rtp_zm,    & ! < w'^2 r_t' > on momentum levels      [m^2/s^2 kg/kg]
    3197    17870112 :       wpthlp2_zm,   & ! < w' th_l'^2 > on momentum levels     [m/s K^2]
    3198    17870112 :       wp2thlp_zm,   & ! < w'^2 th_l' > on momentum levels     [m^2/s^2 K]
    3199    17870112 :       wprtpthlp_zm, & ! < w' r_t' th_l' > on momentum levels  [m/s kg/kg K]
    3200    17870112 :       wp2thvp_zm,   & ! < w'^2 th_v' > on momentum levels     [m^2/s^2 K]
    3201    17870112 :       wp2rcp_zm       ! < w'^2 r_c' > on momentum levles      [m^2/s^2 kg/kg]
    3202             : 
    3203             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
    3204    17870112 :       wpsclrprtp_zm,  & ! w'sclr'rt' on momentum grid
    3205    17870112 :       wpsclrp2_zm,    & ! w'sclr'^2 on momentum grid
    3206    17870112 :       wpsclrpthlp_zm, & ! w'sclr'thl' on momentum grid
    3207    17870112 :       wp2sclrp_zm,    & ! w'^2 sclr' on momentum grid
    3208    17870112 :       sclrm_zm          ! Passive scalar mean on momentum grid
    3209             : 
    3210             :     ! Output from new PDF for recording statistics.
    3211             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3212    17870112 :       F_w,   & ! Parameter for the spread of the PDF component means of w    [-]
    3213    17870112 :       F_rt,  & ! Parameter for the spread of the PDF component means of rt   [-]
    3214    17870112 :       F_thl    ! Parameter for the spread of the PDF component means of thl  [-]
    3215             : 
    3216             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3217    17870112 :       min_F_w,   & ! Minimum allowable value of parameter F_w      [-]
    3218    17870112 :       max_F_w,   & ! Maximum allowable value of parameter F_w      [-]
    3219    17870112 :       min_F_rt,  & ! Minimum allowable value of parameter F_rt     [-]
    3220    17870112 :       max_F_rt,  & ! Maximum allowable value of parameter F_rt     [-]
    3221    17870112 :       min_F_thl, & ! Minimum allowable value of parameter F_thl    [-]
    3222    17870112 :       max_F_thl    ! Maximum allowable value of parameter F_thl    [-]
    3223             : 
    3224             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3225    17870112 :       F_w_zm,       &
    3226    17870112 :       F_rt_zm,      &
    3227    17870112 :       F_thl_zm,     &
    3228    17870112 :       min_F_w_zm,   &
    3229    17870112 :       max_F_w_zm,   &
    3230    17870112 :       min_F_rt_zm,  &
    3231    17870112 :       max_F_rt_zm,  &
    3232    17870112 :       min_F_thl_zm, &
    3233    17870112 :       max_F_thl_zm
    3234             : 
    3235             :     type(implicit_coefs_terms) :: &
    3236     8935056 :       pdf_implicit_coefs_terms_zm
    3237             : 
    3238             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    3239    17870112 :       rsat,             & ! Saturation mixing ratio from mean rt and thl.
    3240    17870112 :       rel_humidity        ! Relative humidity after PDF closure [-]
    3241             : 
    3242             :     real( kind = core_rknd ) :: &
    3243             :       gamma_coef,     & ! CLUBB tunable parameter gamma_coef
    3244             :       gamma_coefb,    & ! CLUBB tunable parameter gamma_coefb
    3245             :       gamma_coefc       ! CLUBB tunable parameter gamma_coefc
    3246             :       
    3247             :     real( kind = core_rknd ), dimension(ngrdcol, nz) :: &
    3248    17870112 :       um_zm, &
    3249    17870112 :       vm_zm, &
    3250    17870112 :       T_in_K, &
    3251    17870112 :       sigma_sqd_w_tmp
    3252             : 
    3253             :     logical :: l_spur_supersat   ! Spurious supersaturation?
    3254             : 
    3255             :     integer :: i, k, j
    3256             : 
    3257             :     !-------------------------------------- Begin Code --------------------------------------
    3258             : 
    3259             :     !$acc enter data create( wp2_zt,wp3_zm, rtp2_zt,rtp3_zm, thlp2_zt,  thlp3_zm, &
    3260             :     !$acc                    wprtp_zt, wpthlp_zt, rtpthlp_zt, up2_zt, up3_zm, &
    3261             :     !$acc                    vp2_zt, vp3_zm, upwp_zt, vpwp_zt, gamma_Skw_fnc, &
    3262             :     !$acc                    gamma_Skw_fnc_zt,sigma_sqd_w_zt,  Skw_zt, Skw_zm, &
    3263             :     !$acc                    Skrt_zt, Skrt_zm, Skthl_zt, Skthl_zm, Sku_zt, &
    3264             :     !$acc                    Sku_zm, Skv_zt, Skv_zm, wp2up2_zt, &
    3265             :     !$acc                    wp2vp2_zt, wp4_zt, wpthvp_zt, rtpthvp_zt, thlpthvp_zt, &
    3266             :     !$acc                    wprcp_zt, rtprcp_zt, thlprcp_zt, uprcp_zt, vprcp_zt, &
    3267             :     !$acc                    rsat, rel_humidity, um_zm, vm_zm, T_in_K, sigma_sqd_w_tmp )
    3268             : 
    3269             :     !$acc enter data if( l_call_pdf_closure_twice ) &
    3270             :     !$acc            create( w_up_in_cloud_zm, wpup2_zm, wpvp2_zm, &
    3271             :     !$acc                    w_down_in_cloud_zm, cloudy_updraft_frac_zm,  &
    3272             :     !$acc                    cloudy_downdraft_frac_zm, p_in_Pa_zm, exner_zm, &
    3273             :     !$acc                    wprtp2_zm, wp2rtp_zm, wpthlp2_zm, &
    3274             :     !$acc                    wp2thlp_zm, wprtpthlp_zm, wp2thvp_zm, wp2rcp_zm )
    3275             : 
    3276             :     !$acc enter data if( sclr_dim > 0 ) &
    3277             :     !$acc            create( wpsclrp_zt, sclrp2_zt, sclrp3_zm, sclrprtp_zt, sclrpthlp_zt, &
    3278             :     !$acc                    Sksclr_zt, Sksclr_zm, sclrpthvp_zt, sclrprcp_zt, wpsclrprtp_zm, &
    3279             :     !$acc                    wpsclrp2_zm, wpsclrpthlp_zm, wp2sclrp_zm, sclrm_zm )
    3280             : 
    3281             :     !$acc enter data if( hydromet_dim > 0 ) create( wphydrometp_zt, wp2hmp_zm, rtphmp, thlphmp )
    3282             : 
    3283             :     !---------------------------------------------------------------------------
    3284             :     ! Interpolate wp3, rtp3, thlp3, up3, vp3, and sclrp3 to momentum levels, and
    3285             :     ! wp2, rtp2, thlp2, up2, vp2, and sclrp2 to thermodynamic levels, and then
    3286             :     ! compute Skw, Skrt, Skthl, Sku, Skv, and Sksclr for both the momentum and
    3287             :     ! thermodynamic grid levels.
    3288             :     !---------------------------------------------------------------------------
    3289     8935056 :     wp2_zt(:,:)   = zm2zt( nz, ngrdcol, gr, wp2(:,:), w_tol_sqd ) ! Positive definite quantity
    3290     8935056 :     wp3_zm(:,:)   = zt2zm( nz, ngrdcol, gr, wp3(:,:) )
    3291     8935056 :     thlp2_zt(:,:) = zm2zt( nz, ngrdcol, gr, thlp2(:,:), thl_tol**2 ) ! Positive definite quantity
    3292     8935056 :     thlp3_zm(:,:) = zt2zm( nz, ngrdcol, gr, thlp3(:,:) )
    3293     8935056 :     rtp2_zt(:,:)  = zm2zt( nz, ngrdcol, gr, rtp2(:,:), rt_tol**2 ) ! Positive definite quantity
    3294     8935056 :     rtp3_zm(:,:)  = zt2zm( nz, ngrdcol, gr, rtp3(:,:) )
    3295     8935056 :     up2_zt(:,:)   = zm2zt( nz, ngrdcol, gr, up2(:,:), w_tol_sqd ) ! Positive definite quantity
    3296     8935056 :     up3_zm(:,:)   = zt2zm( nz, ngrdcol, gr, up3(:,:) )
    3297     8935056 :     vp2_zt(:,:)   = zm2zt( nz, ngrdcol, gr, vp2(:,:), w_tol_sqd ) ! Positive definite quantity
    3298     8935056 :     vp3_zm(:,:)   = zt2zm( nz, ngrdcol, gr, vp3(:,:) )
    3299             : 
    3300     8935056 :     do j = 1, sclr_dim, 1
    3301           0 :       sclrp2_zt(:,:,j) = zm2zt( nz, ngrdcol, gr, sclrp2(:,:,j), sclr_tol(j)**2 ) ! Pos. def. quantity
    3302     8935056 :       sclrp3_zm(:,:,j) = zt2zm( nz, ngrdcol, gr, sclrp3(:,:,j) )
    3303             :     end do ! i = 1, sclr_dim, 1
    3304             : 
    3305             :     call Skx_func( nz, ngrdcol, wp2_zt, wp3, &
    3306             :                    w_tol, clubb_params, &
    3307     8935056 :                    Skw_zt )
    3308             :                    
    3309             :     call Skx_func( nz, ngrdcol, wp2, wp3_zm, &
    3310             :                    w_tol, clubb_params, &
    3311     8935056 :                    Skw_zm )    
    3312             :                    
    3313             :     call Skx_func( nz, ngrdcol, thlp2_zt, thlp3, &
    3314             :                    thl_tol, clubb_params, &
    3315     8935056 :                    Skthl_zt )  
    3316             :                    
    3317             :     call Skx_func( nz, ngrdcol, thlp2, thlp3_zm, &
    3318             :                    thl_tol, clubb_params, &
    3319     8935056 :                    Skthl_zm )  
    3320             :                    
    3321             :     call Skx_func( nz, ngrdcol, rtp2_zt, rtp3, &
    3322             :                    rt_tol, clubb_params, &
    3323     8935056 :                    Skrt_zt )   
    3324             :                    
    3325             :     call Skx_func( nz, ngrdcol, rtp2, rtp3_zm, &
    3326             :                    rt_tol, clubb_params, &
    3327     8935056 :                    Skrt_zm )   
    3328             :                    
    3329             :     call Skx_func( nz, ngrdcol, up2_zt, up3, &
    3330             :                    w_tol, clubb_params, &
    3331     8935056 :                    Sku_zt )   
    3332             :                                       
    3333             :     call Skx_func( nz, ngrdcol, up2, up3_zm, &
    3334             :                    w_tol, clubb_params, &
    3335     8935056 :                    Sku_zm )   
    3336             :                    
    3337             :     call Skx_func( nz, ngrdcol, vp2_zt, vp3, &
    3338             :                    w_tol, clubb_params, &
    3339     8935056 :                    Skv_zt )   
    3340             :                    
    3341             :     call Skx_func( nz, ngrdcol, vp2, vp3_zm, &
    3342             :                    w_tol, clubb_params, &
    3343     8935056 :                    Skv_zm )      
    3344             : 
    3345     8935056 :     do j = 1, sclr_dim
    3346             :       
    3347             :       call Skx_func( nz, ngrdcol, sclrp2_zt(:,:,j), sclrp3(:,:,j), &
    3348           0 :                      sclr_tol(j), clubb_params, &
    3349           0 :                      Sksclr_zt(:,:,j) )   
    3350             :                      
    3351             :       call Skx_func( nz, ngrdcol, sclrp2(:,:,j), sclrp3_zm(:,:,j), &
    3352             :                      sclr_tol(j), clubb_params, &
    3353     8935056 :                      Sksclr_zm(:,:,j) )  
    3354             :                       
    3355             :     end do ! i = 1, sclr_dim, 1
    3356             : 
    3357     8935056 :     if ( stats_metadata%l_stats_samp .and. l_samp_stats_in_pdf_call ) then
    3358             : 
    3359             :       !$acc update host( Skw_zt, Skw_zm, Skthl_zt, Skrt_zt, Skrt_zm, Skthl_zm )
    3360             : 
    3361           0 :       do i = 1, ngrdcol
    3362           0 :         call stat_update_var( stats_metadata%iSkw_zt, Skw_zt(i,:), & ! In
    3363           0 :                               stats_zt(i) ) ! In/Out
    3364             :         call stat_update_var( stats_metadata%iSkw_zm, Skw_zm(i,:), &
    3365           0 :                               stats_zm(i) ) ! In/Out
    3366             :         call stat_update_var( stats_metadata%iSkthl_zt, Skthl_zt(i,:), &
    3367           0 :                               stats_zt(i) ) ! In/Out
    3368             :         call stat_update_var( stats_metadata%iSkthl_zm, Skthl_zm(i,:), &
    3369           0 :                               stats_zm(i) ) ! In/Out
    3370             :         call stat_update_var( stats_metadata%iSkrt_zt, Skrt_zt(i,:), &
    3371           0 :                               stats_zt(i) ) ! In/Out
    3372             :         call stat_update_var( stats_metadata%iSkrt_zm, Skrt_zm(i,:), &
    3373           0 :                               stats_zm(i) ) ! In/Out
    3374             :       end do
    3375             :     end if
    3376             : 
    3377             :     ! The right hand side of this conjunction is only for reducing cpu time,
    3378             :     ! since the more complicated formula is mathematically equivalent
    3379             :     if ( l_gamma_Skw ) then
    3380             : 
    3381             :       !----------------------------------------------------------------
    3382             :       ! Compute gamma as a function of Skw  - 14 April 06 dschanen
    3383             :       !----------------------------------------------------------------
    3384             :       !$acc parallel loop gang vector collapse(2) default(present)
    3385   768414816 :       do k = 1, nz
    3386 12690480816 :         do i = 1, ngrdcol
    3387             : 
    3388 11922066000 :           gamma_coef  = clubb_params(i,igamma_coef)
    3389 11922066000 :           gamma_coefb = clubb_params(i,igamma_coefb)
    3390 11922066000 :           gamma_coefc = clubb_params(i,igamma_coefc)
    3391             : 
    3392 12681545760 :           if ( abs( gamma_coef - gamma_coefb ) > abs( gamma_coef + gamma_coefb ) * eps/2 ) then
    3393           0 :             gamma_Skw_fnc(i,k) = gamma_coefb &
    3394             :                                  + ( gamma_coef - gamma_coefb ) &
    3395           0 :                                    * exp( -one_half * ( Skw_zm(i,k) / gamma_coefc )**2 )
    3396             : 
    3397             :             gamma_Skw_fnc_zt(i,k) = gamma_coefb &
    3398             :                                     + ( gamma_coef - gamma_coefb ) &
    3399           0 :                                       * exp( -one_half * ( Skw_zt(i,k) / gamma_coefc )**2 )
    3400             :           else
    3401             : 
    3402 11922066000 :             gamma_Skw_fnc(i,k)    = gamma_coef
    3403 11922066000 :             gamma_Skw_fnc_zt(i,k) = gamma_coef
    3404             : 
    3405             :           end if
    3406             : 
    3407             :         end do
    3408             :       end do
    3409             :       !$acc end parallel loop
    3410             : 
    3411             :     else
    3412             :       
    3413             :       !$acc parallel loop gang vector collapse(2) default(present)
    3414             :       do k = 1, nz
    3415             :         do i = 1, ngrdcol
    3416             :           gamma_Skw_fnc(i,k)    = clubb_params(i,igamma_coef)
    3417             :           gamma_Skw_fnc_zt(i,k) = clubb_params(i,igamma_coef)
    3418             :         end do
    3419             :       end do
    3420             :       !$acc end parallel loop
    3421             : 
    3422             :     end if
    3423             : 
    3424     8935056 :     if ( stats_metadata%l_stats_samp .and. l_samp_stats_in_pdf_call ) then
    3425             :       !$acc update host(gamma_Skw_fnc)      
    3426           0 :       do i = 1, ngrdcol
    3427           0 :         call stat_update_var( stats_metadata%igamma_Skw_fnc, gamma_Skw_fnc(i,:), & ! intent(in)
    3428           0 :                               stats_zm(i) )                       ! intent(inout)
    3429             :       end do
    3430             :     endif
    3431             : 
    3432             :     ! Compute sigma_sqd_w (dimensionless PDF width parameter)
    3433             :     call compute_sigma_sqd_w( nz, ngrdcol, &
    3434             :                               gamma_Skw_fnc, wp2, thlp2, rtp2, &
    3435             :                               up2, vp2, wpthlp, wprtp, upwp, vpwp, &
    3436             :                               l_predict_upwp_vpwp, &
    3437     8935056 :                               sigma_sqd_w_tmp )
    3438             : 
    3439             :     ! Smooth in the vertical using interpolation
    3440     8935056 :     sigma_sqd_w(:,:) = zm2zt2zm( nz, ngrdcol, gr, sigma_sqd_w_tmp(:,:), zero_threshold ) ! Pos. def. quantity
    3441             : 
    3442             : 
    3443             :     ! Interpolate the the stats_zt grid
    3444     8935056 :     sigma_sqd_w_zt(:,:) = zm2zt( nz, ngrdcol, gr, sigma_sqd_w(:,:), zero_threshold )  ! Pos. def. quantity
    3445             : 
    3446             :     !---------------------------------------------------------------------------
    3447             :     ! Interpolate thlp2, rtp2, and rtpthlp to thermodynamic levels,
    3448             :     !---------------------------------------------------------------------------
    3449             : 
    3450             :     ! Interpolate variances to the stats_zt grid (statistics and closure)
    3451     8935056 :     rtp2_zt(:,:)    = zm2zt( nz, ngrdcol, gr, rtp2(:,:), rt_tol**2 )   ! Positive def. quantity
    3452     8935056 :     thlp2_zt(:,:)   = zm2zt( nz, ngrdcol, gr, thlp2(:,:), thl_tol**2 ) ! Positive def. quantity
    3453     8935056 :     up2_zt(:,:)     = zm2zt( nz, ngrdcol, gr, up2(:,:), w_tol_sqd )    ! Positive def. quantity
    3454     8935056 :     vp2_zt(:,:)     = zm2zt( nz, ngrdcol, gr, vp2(:,:), w_tol_sqd )    ! Positive def. quantity
    3455     8935056 :     wprtp_zt(:,:)   = zm2zt( nz, ngrdcol, gr, wprtp(:,:) )
    3456     8935056 :     wpthlp_zt(:,:)  = zm2zt( nz, ngrdcol, gr, wpthlp(:,:) )
    3457     8935056 :     rtpthlp_zt(:,:) = zm2zt( nz, ngrdcol, gr, rtpthlp(:,:) )
    3458     8935056 :     upwp_zt(:,:)    = zm2zt( nz, ngrdcol, gr, upwp(:,:) )
    3459     8935056 :     vpwp_zt(:,:)    = zm2zt( nz, ngrdcol, gr, vpwp(:,:) )
    3460             : 
    3461             :     ! Compute skewness velocity for stats output purposes
    3462     8935056 :     if ( stats_metadata%iSkw_velocity > 0 ) then
    3463             :       !$acc parallel loop gang vector collapse(2) default(present)
    3464           0 :       do k = 1, nz
    3465           0 :         do i = 1, ngrdcol
    3466           0 :           Skw_velocity(i,k) = ( 1.0_core_rknd / ( 1.0_core_rknd - sigma_sqd_w(i,k) ) ) &
    3467           0 :                        * ( wp3_zm(i,k) / max( wp2(i,k), w_tol_sqd ) )
    3468             :         end do
    3469             :       end do
    3470             :       !$acc end parallel loop
    3471             :     end if
    3472             : 
    3473             :     !----------------------------------------------------------------
    3474             :     ! Call closure scheme
    3475             :     !----------------------------------------------------------------
    3476             : 
    3477             :     ! Put passive scalar input on the t grid for the PDF
    3478     8935056 :     do j = 1, sclr_dim
    3479           0 :       wpsclrp_zt(:,:,j)   = zm2zt( nz, ngrdcol, gr, wpsclrp(:,:,j) )
    3480           0 :       sclrp2_zt(:,:,j)    = zm2zt( nz, ngrdcol, gr, sclrp2(:,:,j), sclr_tol(j)**2 ) ! Pos. def. quantity
    3481           0 :       sclrprtp_zt(:,:,j)  = zm2zt( nz, ngrdcol, gr, sclrprtp(:,:,j) )
    3482     8935056 :       sclrpthlp_zt(:,:,j) = zm2zt( nz, ngrdcol, gr, sclrpthlp(:,:,j) )
    3483             :     end do ! i = 1, sclr_dim, 1
    3484             : 
    3485             :     ! Interpolate hydrometeor mixed moments to momentum levels.
    3486     8935056 :     do j = 1, hydromet_dim
    3487     8935056 :       wphydrometp_zt(:,:,j) = zm2zt( nz, ngrdcol, gr, wphydrometp(:,:,j) )
    3488             :     end do ! i = 1, hydromet_dim, 1
    3489             : 
    3490             :     call pdf_closure( nz, ngrdcol, sclr_dim, sclr_tol,     & ! intent(in)
    3491             :            hydromet_dim, p_in_Pa, exner, thv_ds_zt,        & ! intent(in)
    3492             :            wm_zt, wp2_zt, wp3,                             & ! intent(in)
    3493             :            Skw_zt, Skthl_zt, Skrt_zt, Sku_zt, Skv_zt,      & ! intent(in)
    3494             :            rtm, rtp2_zt, wprtp_zt,                         & ! intent(in)
    3495             :            thlm, thlp2_zt, wpthlp_zt,                      & ! intent(in)
    3496             :            um, up2_zt, upwp_zt,                            & ! intent(in)
    3497             :            vm, vp2_zt, vpwp_zt,                            & ! intent(in)
    3498             :            rtpthlp_zt,                                     & ! intent(in)
    3499             :            sclrm, wpsclrp_zt, sclrp2_zt,                   & ! intent(in)
    3500             :            sclrprtp_zt, sclrpthlp_zt, Sksclr_zt,           & ! intent(in)
    3501             :            gamma_Skw_fnc_zt,                               & ! intent(in)
    3502             : #ifdef GFDL
    3503             :            RH_crit,                                        & ! intent(inout)
    3504             :            do_liquid_only_in_clubb,                        & ! intent(in)
    3505             : #endif
    3506             :            wphydrometp_zt, wp2hmp,                         & ! intent(in)
    3507             :            rtphmp_zt, thlphmp_zt,                          & ! intent(in)
    3508             :            clubb_params,                                   & ! intent(in)
    3509             :            saturation_formula,                             & ! intent(in)
    3510             :            stats_metadata,                                 & ! intent(in)
    3511             :            iiPDF_type,                                     & ! intent(in)
    3512             :            l_mix_rat_hm,                                   & ! intent(in)
    3513             :            sigma_sqd_w_zt,                                 & ! intent(inout)
    3514             :            pdf_params, pdf_implicit_coefs_terms,           & ! intent(inout)
    3515             :            wpup2, wpvp2,                                   & ! intent(out)
    3516             :            wp2up2_zt, wp2vp2_zt, wp4_zt,                   & ! intent(out)
    3517             :            wprtp2, wp2rtp,                                 & ! intent(out)
    3518             :            wpthlp2, wp2thlp, wprtpthlp,                    & ! intent(out)
    3519             :            cloud_frac, ice_supersat_frac,                  & ! intent(out)
    3520             :            rcm, wpthvp_zt, wp2thvp, rtpthvp_zt,            & ! intent(out)
    3521             :            thlpthvp_zt, wprcp_zt, wp2rcp, rtprcp_zt,       & ! intent(out)
    3522             :            thlprcp_zt, rcp2_zt,                            & ! intent(out)
    3523             :            uprcp_zt, vprcp_zt,                             & ! intent(out)
    3524             :            w_up_in_cloud, w_down_in_cloud,                 & ! intent(out)
    3525             :            cloudy_updraft_frac, cloudy_downdraft_frac,     & ! intent(out)
    3526             :            F_w, F_rt, F_thl,                               & ! intent(out)
    3527             :            min_F_w, max_F_w,                               & ! intent(out)
    3528             :            min_F_rt, max_F_rt,                             & ! intent(out)
    3529             :            min_F_thl, max_F_thl,                           & ! intent(out)
    3530             :            wpsclrprtp, wpsclrp2, sclrpthvp_zt,             & ! intent(out)
    3531             :            wpsclrpthlp, sclrprcp_zt, wp2sclrp,             & ! intent(out)
    3532     8935056 :            rc_coef                                         ) ! intent(out)
    3533             : 
    3534             :     ! Subroutine may produce NaN values, and if so, return
    3535     8935056 :     if ( clubb_at_least_debug_level( 0 ) ) then
    3536     8935056 :        if ( err_code == clubb_fatal_error ) then
    3537           0 :           write(fstderr,*) "After pdf_closure"
    3538           0 :           return
    3539             :        endif
    3540             :     endif
    3541             : 
    3542             :     ! Stats output
    3543     8935056 :     if ( stats_metadata%l_stats_samp .and. l_samp_stats_in_pdf_call ) then
    3544             : 
    3545           0 :       do i = 1, ngrdcol
    3546           0 :         call stat_update_var( stats_metadata%iF_w, F_w(i,:), & ! intent(in)
    3547           0 :                               stats_zt(i) )   ! intent(inout)
    3548             :         call stat_update_var( stats_metadata%iF_rt, F_rt(i,:), & ! intent(in)
    3549           0 :                               stats_zt(i) )     ! intent(inout)
    3550             :         call stat_update_var( stats_metadata%iF_thl, F_thl(i,:), & ! intent(in)
    3551           0 :                               stats_zt(i) )       ! intent(inout)
    3552             :         call stat_update_var( stats_metadata%imin_F_w, min_F_w(i,:), & ! intent(in)
    3553           0 :                               stats_zt(i) )           ! intent(inout)
    3554             :         call stat_update_var( stats_metadata%imax_F_w, max_F_w(i,:), & ! intent(in)
    3555           0 :                               stats_zt(i) )           ! intent(inout)
    3556             :         call stat_update_var( stats_metadata%imin_F_rt, min_F_rt(i,:), & ! intent(in)
    3557           0 :                               stats_zt(i) )             ! intent(inout)
    3558             :         call stat_update_var( stats_metadata%imax_F_rt, max_F_rt(i,:), & ! intent(in)
    3559           0 :                               stats_zt(i) )             ! intent(inout)
    3560             :         call stat_update_var( stats_metadata%imin_F_thl, min_F_thl(i,:), & ! intent(in)
    3561           0 :                               stats_zt(i) )               ! intent(inout)
    3562             :         call stat_update_var( stats_metadata%imax_F_thl, max_F_thl(i,:), & ! intent(in)
    3563           0 :                               stats_zt(i) )               ! intent(inout)
    3564             :       end do
    3565             :     end if
    3566             : 
    3567     8935056 :     if( l_rtm_nudge ) then
    3568             :       ! Nudge rtm to prevent excessive drying
    3569             :       !$acc parallel loop gang vector collapse(2) default(present)
    3570           0 :       do k = 1, nz
    3571           0 :         do i = 1, ngrdcol
    3572           0 :           if ( rtm(i,k) < rtm_min .and. gr%zt(i,k) < rtm_nudge_max_altitude ) then
    3573           0 :             rtm(i,k) = rtm(i,k) + (rtm_ref(i,k) - rtm(i,k)) * ( dt / ts_nudge )
    3574             :           end if
    3575             :         end do
    3576             :       end do
    3577             :       !$acc end parallel loop
    3578             :     end if
    3579             : 
    3580     8935056 :     if ( l_call_pdf_closure_twice ) then
    3581             : 
    3582             :       ! Call pdf_closure a second time on momentum levels, to
    3583             :       ! output (rather than interpolate) the variables which
    3584             :       ! belong on the momentum levels.
    3585             : 
    3586             :       ! Interpolate sclrm to the momentum level for use in
    3587             :       ! the second call to pdf_closure
    3588     8935056 :       do j = 1, sclr_dim
    3589             :         ! Clip if extrap. causes sclrm_zm to be less than sclr_tol
    3590     8935056 :         sclrm_zm(:,:,j) = zt2zm( nz, ngrdcol, gr, sclrm(:,:,j), sclr_tol(j) )
    3591             :       end do ! i = 1, sclr_dim
    3592             : 
    3593             :       ! Interpolate pressure, p_in_Pa, to momentum levels.
    3594             :       ! The pressure at thermodynamic level k = 1 has been set to be the surface
    3595             :       ! (or model lower boundary) pressure.  Since the surface (or model lower
    3596             :       ! boundary) is located at momentum level k = 1, the pressure there is
    3597             :       ! p_sfc, which is p_in_Pa(1).  Thus, p_in_Pa_zm(1) = p_in_Pa(1).
    3598     8935056 :       p_in_Pa_zm(:,:) = zt2zm( nz, ngrdcol, gr, p_in_Pa(:,:) )
    3599             : 
    3600             :       !$acc parallel loop gang vector default(present)
    3601   149194656 :       do i = 1, ngrdcol
    3602   140259600 :         p_in_Pa_zm(i,1) = p_in_Pa(i,1)
    3603             : 
    3604             :         ! Clip pressure if the extrapolation leads to a negative value of pressure
    3605   149194656 :         p_in_Pa_zm(i,nz) = max( p_in_Pa_zm(i,nz), 0.5_core_rknd*p_in_Pa(i,nz) )
    3606             :       end do
    3607             :       !$acc end parallel loop
    3608             : 
    3609             :       ! Set exner at momentum levels, exner_zm, based on p_in_Pa_zm.
    3610             :       !$acc parallel loop gang vector collapse(2) default(present)
    3611   768414816 :       do k = 1, nz
    3612 12690480816 :         do i = 1, ngrdcol
    3613 12681545760 :           exner_zm(i,k) = (p_in_Pa_zm(i,k)/p0)**kappa
    3614             :         end do
    3615             :       end do
    3616             :       !$acc end parallel loop
    3617             : 
    3618             :       ! Clip if extrapolation at the top level causes rtm_zm to be < rt_tol
    3619     8935056 :       rtm_zm(:,:) = zt2zm( nz, ngrdcol, gr, rtm(:,:), rt_tol )
    3620             : 
    3621             :         ! Clip if extrapolation at the top level causes thlm_zm to be < thl_tol
    3622     8935056 :       thlm_zm(:,:) = zt2zm( nz, ngrdcol, gr, thlm(:,:), thl_tol )
    3623             : 
    3624             :       ! Interpolate hydrometeor mixed moments to momentum levels.
    3625     8935056 :       do j = 1, hydromet_dim
    3626           0 :         rtphmp(:,:,j)    = zt2zm( nz, ngrdcol, gr, rtphmp_zt(:,:,j) )
    3627           0 :         thlphmp(:,:,j)   = zt2zm( nz, ngrdcol, gr, thlphmp_zt(:,:,j) )
    3628     8935056 :         wp2hmp_zm(:,:,j) = zt2zm( nz, ngrdcol, gr, wp2hmp(:,:,j) )
    3629             :       end do ! i = 1, hydromet_dim, 1
    3630             :       
    3631     8935056 :       um_zm(:,:) = zt2zm( nz, ngrdcol, gr, um(:,:) )
    3632     8935056 :       vm_zm(:,:) = zt2zm( nz, ngrdcol, gr, vm(:,:) )
    3633             :       
    3634             :       ! pdf_implicit_coefs_terms is only used in the iiPDF_new and iiPDF_new_hybrid closures.
    3635             :       ! So we only need to initialize our local _zm version if we're working with one of those.
    3636     8935056 :       if ( iiPDF_type == iiPDF_new .or. iiPDF_type == iiPDF_new_hybrid ) then
    3637             :         call init_pdf_implicit_coefs_terms( nz, ngrdcol, sclr_dim, &      ! Intent(in)
    3638           0 :                                             pdf_implicit_coefs_terms_zm ) ! Intent(out)
    3639             :       end if 
    3640             : 
    3641             :       ! Call pdf_closure to output the variables which belong on the momentum grid.
    3642             :       call pdf_closure( nz, ngrdcol, sclr_dim, sclr_tol,           & ! intent(in)
    3643             :              hydromet_dim, p_in_Pa_zm, exner_zm, thv_ds_zm,        & ! intent(in)
    3644             :              wm_zm, wp2, wp3_zm,                                   & ! intent(in)
    3645             :              Skw_zm, Skthl_zm, Skrt_zm, Sku_zm, Skv_zm,            & ! intent(in)
    3646             :              rtm_zm, rtp2, wprtp,                                  & ! intent(in)
    3647             :              thlm_zm, thlp2, wpthlp,                               & ! intent(in)
    3648             :              um_zm, up2, upwp,                                     & ! intent(in)
    3649             :              vm_zm, vp2, vpwp,                                     & ! intent(in)
    3650             :              rtpthlp,                                              & ! intent(in)
    3651             :              sclrm_zm, wpsclrp, sclrp2,                            & ! intent(in)
    3652             :              sclrprtp, sclrpthlp, Sksclr_zm,                       & ! intent(in)
    3653             :              gamma_Skw_fnc,                                        & ! intent(in)
    3654             : #ifdef GFDL
    3655             :              RH_crit,                                              & ! intent(inout)
    3656             :              do_liquid_only_in_clubb,                              & ! intent(in)
    3657             : #endif
    3658             :              wphydrometp, wp2hmp_zm,                               & ! intent(in)
    3659             :              rtphmp, thlphmp,                                      & ! intent(in)
    3660             :              clubb_params,                                         & ! intent(in)
    3661             :              saturation_formula,                                   & ! intent(in)
    3662             :              stats_metadata,                                       & ! intent(in)
    3663             :              iiPDF_type,                                           & ! intent(in)
    3664             :              l_mix_rat_hm,                                         & ! intent(in)
    3665             :              sigma_sqd_w,                                          & ! intent(inout)
    3666             :              pdf_params_zm, pdf_implicit_coefs_terms_zm,           & ! intent(inout)
    3667             :              wpup2_zm, wpvp2_zm,                                   & ! intent(out)
    3668             :              wp2up2, wp2vp2, wp4,                                  & ! intent(out)
    3669             :              wprtp2_zm, wp2rtp_zm,                                 & ! intent(out)
    3670             :              wpthlp2_zm, wp2thlp_zm, wprtpthlp_zm,                 & ! intent(out)
    3671             :              cloud_frac_zm, ice_supersat_frac_zm,                  & ! intent(out)
    3672             :              rcm_zm, wpthvp, wp2thvp_zm, rtpthvp,                  & ! intent(out)
    3673             :              thlpthvp, wprcp, wp2rcp_zm, rtprcp,                   & ! intent(out)
    3674             :              thlprcp, rcp2,                                        & ! intent(out)
    3675             :              uprcp, vprcp,                                         & ! intent(out)
    3676             :              w_up_in_cloud_zm, w_down_in_cloud_zm,                 & ! intent(out)
    3677             :              cloudy_updraft_frac_zm, cloudy_downdraft_frac_zm,     & ! intent(out)
    3678             :              F_w_zm, F_rt_zm, F_thl_zm,                            & ! intent(out)
    3679             :              min_F_w_zm, max_F_w_zm,                               & ! intent(out)
    3680             :              min_F_rt_zm, max_F_rt_zm,                             & ! intent(out)
    3681             :              min_F_thl_zm, max_F_thl_zm,                           & ! intent(out)
    3682             :              wpsclrprtp_zm, wpsclrp2_zm, sclrpthvp,                & ! intent(out)
    3683             :              wpsclrpthlp_zm, sclrprcp, wp2sclrp_zm,                & ! intent(out)
    3684     8935056 :              rc_coef_zm                                            ) ! intent(out)
    3685             : 
    3686             :       ! Subroutine may produce NaN values, and if so, return
    3687     8935056 :       if ( clubb_at_least_debug_level( 0 ) ) then
    3688     8935056 :          if ( err_code == clubb_fatal_error ) then
    3689           0 :             write(fstderr,*) "After pdf_closure"
    3690           0 :             return
    3691             :          endif
    3692             :       endif
    3693             : 
    3694             :     else ! l_call_pdf_closure_twice is false
    3695             :       
    3696             :       ! Interpolate momentum variables output from the first call to
    3697             :       ! pdf_closure back to momentum grid.
    3698           0 :       wp4(:,:) = zt2zm( nz, ngrdcol, gr, wp4_zt(:,:), zero_threshold )  ! Pos. def. quantity
    3699             : 
    3700             :       !$acc parallel loop gang vector default(present)
    3701           0 :       do i = 1, ngrdcol
    3702             :         ! Since top momentum level is higher than top thermo level,
    3703             :         ! set variables at top momentum level to 0.
    3704           0 :         wp4(i,nz) = zero
    3705             :         ! Set wp4 to 0 at the lowest momentum level (momentum level 1).
    3706             :         ! The value of wp4 at momentum level 1 is found by interpolation of
    3707             :         ! the values produced by the PDF for wp4_zt at thermodynamic levels
    3708             :         ! 1 and 2.  This value is unreliable at thermodynamic level 1.
    3709           0 :         wp4(i,1) = zero
    3710             :       end do
    3711             :       !$acc end parallel loop
    3712             : 
    3713             : #ifndef CLUBB_CAM
    3714             :       ! CAM-CLUBB needs cloud water variance thus always compute this
    3715             :       if ( stats_metadata%ircp2 > 0 ) then
    3716             : #endif
    3717           0 :         rcp2(:,:) = zt2zm( nz, ngrdcol, gr, rcp2_zt(:,:), zero_threshold )  ! Pos. def. quantity
    3718             : #ifndef CLUBB_CAM
    3719             :         !$acc parallel loop gang vector default(present) 
    3720             :         do i = 1, ngrdcol
    3721             :           rcp2(i,nz) = zero
    3722             :         end do
    3723             :         !$acc end parallel loop
    3724             :       endif
    3725             : #endif
    3726             : 
    3727           0 :       wpthvp(:,:)      = zt2zm( nz, ngrdcol, gr, wpthvp_zt(:,:) )
    3728           0 :       thlpthvp(:,:)    = zt2zm( nz, ngrdcol, gr, thlpthvp_zt(:,:) )
    3729           0 :       rtpthvp(:,:)     = zt2zm( nz, ngrdcol, gr, rtpthvp_zt(:,:) )
    3730           0 :       wprcp(:,:)       = zt2zm( nz, ngrdcol, gr, wprcp_zt(:,:) )
    3731           0 :       rc_coef_zm(:,:)  = zt2zm( nz, ngrdcol, gr, rc_coef(:,:) )
    3732           0 :       rtprcp(:,:)      = zt2zm( nz, ngrdcol, gr, rtprcp_zt(:,:) )
    3733           0 :       thlprcp(:,:)     = zt2zm( nz, ngrdcol, gr, thlprcp_zt(:,:) )
    3734           0 :       uprcp(:,:)       = zt2zm( nz, ngrdcol, gr, uprcp_zt(:,:) )
    3735           0 :       vprcp(:,:)       = zt2zm( nz, ngrdcol, gr, vprcp_zt(:,:) )
    3736           0 :       wp2up2(:,:)      = zt2zm( nz, ngrdcol, gr, wp2up2_zt(:,:) )
    3737           0 :       wp2vp2(:,:)      = zt2zm( nz, ngrdcol, gr, wp2vp2_zt(:,:) )
    3738             : 
    3739             :       !$acc parallel loop gang vector default(present) 
    3740           0 :       do i = 1, ngrdcol 
    3741           0 :         wpthvp(i,nz)     = 0.0_core_rknd
    3742           0 :         thlpthvp(i,nz)   = 0.0_core_rknd
    3743           0 :         rtpthvp(i,nz)    = 0.0_core_rknd
    3744           0 :         wprcp(i,nz)      = 0.0_core_rknd
    3745           0 :         rc_coef_zm(i,nz) = 0.0_core_rknd
    3746           0 :         rtprcp(i,nz)     = 0.0_core_rknd
    3747           0 :         thlprcp(i,nz)    = 0.0_core_rknd
    3748           0 :         uprcp(i,nz)      = 0.0_core_rknd
    3749           0 :         vprcp(i,nz)      = 0.0_core_rknd
    3750           0 :         wp2up2(i,nz)     = 0.0_core_rknd
    3751           0 :         wp2vp2(i,nz)     = 0.0_core_rknd
    3752             :       end do
    3753             :       !$acc end parallel loop
    3754             : 
    3755             :       ! Initialize variables to avoid uninitialized variables.
    3756             :       !$acc parallel loop gang vector collapse(2) default(present)
    3757           0 :       do k = 1, nz
    3758           0 :         do i = 1, ngrdcol
    3759           0 :           cloud_frac_zm(i,k)        = 0.0_core_rknd
    3760           0 :           ice_supersat_frac_zm(i,k) = 0.0_core_rknd
    3761           0 :           rcm_zm(i,k)               = 0.0_core_rknd
    3762           0 :           rtm_zm(i,k)               = 0.0_core_rknd
    3763           0 :           thlm_zm(i,k)              = 0.0_core_rknd
    3764             :         end do
    3765             :       end do
    3766             :       !$acc end parallel loop
    3767             : 
    3768             :       ! Interpolate passive scalars back onto the m grid
    3769           0 :       do j = 1, sclr_dim
    3770           0 :         sclrpthvp(:,:,j)       = zt2zm( nz, ngrdcol, gr, sclrpthvp_zt(:,:,j) )
    3771           0 :         sclrprcp(:,:,j)        = zt2zm( nz, ngrdcol, gr, sclrprcp_zt(:,:,j) )
    3772             : 
    3773             :         !$acc parallel loop gang vector default(present)
    3774           0 :         do k = 1, nz
    3775           0 :           do i = 1, ngrdcol
    3776           0 :             sclrpthvp(i,nz,j) = 0.0_core_rknd
    3777           0 :             sclrprcp(i,nz,j)  = 0.0_core_rknd
    3778             :           end do
    3779             :         end do
    3780             :         !$acc end parallel loop
    3781             : 
    3782             :       end do ! i=1, sclr_dim
    3783             : 
    3784             :     end if ! l_call_pdf_closure_twice
    3785             :     
    3786     8935056 :     if ( stats_metadata%l_stats_samp .and. l_samp_stats_in_pdf_call ) then
    3787             :       !$acc update host( uprcp, vprcp )
    3788           0 :       do i = 1, ngrdcol
    3789           0 :         call stat_update_var( stats_metadata%iuprcp,  uprcp(i,:),  & ! intent(in)
    3790           0 :                               stats_zm(i) )           ! intent(inout)
    3791             :         call stat_update_var( stats_metadata%ivprcp,  vprcp(i,:),  & ! intent(in)
    3792           0 :                               stats_zm(i) )           ! intent(inout)
    3793             :       end do
    3794             :     end if
    3795             :     
    3796             :     ! If l_trapezoidal_rule_zt is true, call trapezoidal_rule_zt for
    3797             :     ! thermodynamic-level variables output from pdf_closure.
    3798             :     ! ldgrant June 2009
    3799     8935056 :     if ( l_trapezoidal_rule_zt ) then
    3800             :       call trapezoidal_rule_zt( nz, ngrdcol, sclr_dim, gr,                   & ! intent(in)
    3801             :                                 l_call_pdf_closure_twice,                    & ! intent(in)
    3802             :                                 stats_metadata,                              & ! intent(in)
    3803             :                                 wprtp2, wpthlp2,                             & ! intent(inout)
    3804             :                                 wprtpthlp, cloud_frac, ice_supersat_frac,    & ! intent(inout)
    3805             :                                 rcm, wp2thvp, wpsclrprtp, wpsclrp2,          & ! intent(inout)
    3806             :                                 wpsclrpthlp,                                 & ! intent(inout)
    3807             :                                 wprtp2_zm, wpthlp2_zm,                       & ! intent(inout)
    3808             :                                 wprtpthlp_zm, cloud_frac_zm,                 & ! intent(inout)
    3809             :                                 ice_supersat_frac_zm, rcm_zm, wp2thvp_zm,    & ! intent(inout)
    3810     8935056 :                                 wpsclrprtp_zm, wpsclrp2_zm, wpsclrpthlp_zm )   ! intent(inout)
    3811             :     else ! l_trapezoidal_rule_zt
    3812           0 :       cloud_frac_zm = zt2zm( nz, ngrdcol, gr, cloud_frac )
    3813             :       ! Since top momentum level is higher than top thermo. level,
    3814             :       ! set variables at top momentum level to 0.
    3815             :       !$acc parallel loop gang vector default(present)
    3816           0 :       do i = 1, ngrdcol
    3817           0 :         cloud_frac_zm(i,nz)  = 0.0_core_rknd
    3818             :       end do
    3819             :       !$acc end parallel loop
    3820             :     end if ! l_trapezoidal_rule_zt
    3821             : 
    3822             :     ! If l_trapezoidal_rule_zm is true, call trapezoidal_rule_zm for
    3823             :     ! the important momentum-level variabes output from pdf_closure.
    3824             :     ! ldgrant Feb. 2010
    3825     8935056 :     if ( l_trapezoidal_rule_zm ) then
    3826             :       call trapezoidal_rule_zm( nz, ngrdcol, gr,                    & ! intent(in)
    3827             :                                 wpthvp_zt, thlpthvp_zt, rtpthvp_zt, & ! intent(in)
    3828     8935056 :                                 wpthvp, thlpthvp, rtpthvp )           ! intent(inout)
    3829             :     end if ! l_trapezoidal_rule_zm
    3830             : 
    3831             : 
    3832             :     ! Vince Larson clipped rcm in order to prevent rvm < 0.  5 Apr 2008.
    3833             :     ! This code won't work unless rtm >= 0 !!!
    3834             :     ! We do not clip rcm_in_layer because rcm_in_layer only influences
    3835             :     ! radiation, and we do not want to bother recomputing it.
    3836             :     ! Code is duplicated from below to ensure that relative humidity
    3837             :     ! is calculated properly.  3 Sep 2009
    3838             :     call clip_rcm( nz, ngrdcol, rtm,              & ! intent(in)
    3839             :                    'rtm < rcm after pdf_closure', & ! intent(in)
    3840     8935056 :                    rcm )                            ! intent(inout)
    3841             : 
    3842             :     ! Compute variables cloud_cover and rcm_in_layer.
    3843             :     ! Added July 2009
    3844             :     call compute_cloud_cover( gr, nz, ngrdcol,             & ! intent(in)
    3845             :                               pdf_params, cloud_frac, rcm, & ! intent(in)
    3846     8935056 :                               cloud_cover, rcm_in_layer )    ! intent(out)
    3847             : 
    3848     8935056 :     if ( l_use_cloud_cover ) then
    3849             :       ! Use cloud_cover and rcm_in_layer to help boost cloud_frac and rcm to help
    3850             :       ! increase cloudiness at coarser grid resolutions.
    3851             :       !$acc parallel loop gang vector collapse(2) default(present)
    3852   768414816 :       do k = 1, nz
    3853 12690480816 :         do i = 1, ngrdcol
    3854 11922066000 :           cloud_frac(i,k) = cloud_cover(i,k)
    3855 12681545760 :           rcm(i,k) = rcm_in_layer(i,k)
    3856             :         end do
    3857             :       end do
    3858             :     !$acc end parallel loop
    3859             :     end if
    3860             : 
    3861             :     !$acc parallel loop gang vector collapse(2) default(present)
    3862   768414816 :     do k = 1, nz
    3863 12690480816 :       do i = 1, ngrdcol
    3864             :         ! Clip cloud fraction here if it still exceeds 1.0 due to round off
    3865 11922066000 :         cloud_frac(i,k) = min( 1.0_core_rknd, cloud_frac(i,k) )
    3866             :         ! Ditto with ice cloud fraction
    3867 12681545760 :         ice_supersat_frac(i,k) = min( 1.0_core_rknd, ice_supersat_frac(i,k) )
    3868             :       end do
    3869             :     end do
    3870             :     !$acc end parallel loop
    3871             : 
    3872     8935056 :     T_in_K = thlm2T_in_K( nz, ngrdcol, thlm, exner, rcm )
    3873     8935056 :     rsat = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, T_in_K, saturation_formula )
    3874             : 
    3875             :     !$acc parallel loop gang vector collapse(2) default(present)
    3876   768414816 :     do k = 1, nz
    3877 12690480816 :       do i = 1, ngrdcol
    3878 11922066000 :         rel_humidity(i,k) = (rtm(i,k) - rcm(i,k)) / rsat(i,k)
    3879 12681545760 :         rcm_supersat_adj(i,k) = zero
    3880             :       end do
    3881             :     end do
    3882             :     !$acc end parallel loop
    3883             :       
    3884     8935056 :     if ( l_rcm_supersat_adj ) then
    3885             :       ! +PAB mods, take remaining supersaturation that may exist
    3886             :       !   after CLUBB PDF call and add it to rcm.  Supersaturation
    3887             :       !   may exist after PDF call due to issues with calling PDF on the
    3888             :       !   thermo grid and momentum grid and the interpolation between the two
    3889             :       l_spur_supersat = .false.
    3890             :       
    3891             : 
    3892             :       !$acc parallel loop gang vector collapse(2) default(present) reduction(.or.:l_spur_supersat)
    3893           0 :       do k = 2, nz
    3894           0 :         do i = 1, ngrdcol
    3895           0 :           if (rel_humidity(i,k) > 1.0_core_rknd) then
    3896           0 :             rcm_supersat_adj(i,k) = (rtm(i,k) - rcm(i,k)) - rsat(i,k)
    3897           0 :             rcm(i,k) = rcm(i,k) + rcm_supersat_adj(i,k)
    3898           0 :             l_spur_supersat = .true.
    3899             :           end if
    3900             :         end do
    3901             :       end do
    3902             :       !$acc end parallel loop
    3903             : 
    3904           0 :       if ( clubb_at_least_debug_level( 1 ) .and. l_spur_supersat ) then
    3905           0 :         write(fstderr,*) 'Warning: spurious supersaturation was removed after pdf_closure!'
    3906             :       end if
    3907             : 
    3908             :     end if ! l_rcm_supersat_adj
    3909             : 
    3910             :     !$acc exit data delete( wp2_zt,wp3_zm, rtp2_zt,rtp3_zm, thlp2_zt,  thlp3_zm, &
    3911             :     !$acc                   wprtp_zt, wpthlp_zt, rtpthlp_zt, up2_zt, up3_zm, &
    3912             :     !$acc                   vp2_zt, vp3_zm, upwp_zt, vpwp_zt, gamma_Skw_fnc, &
    3913             :     !$acc                   gamma_Skw_fnc_zt,sigma_sqd_w_zt,  Skw_zt, Skw_zm, &
    3914             :     !$acc                   Skrt_zt, Skrt_zm, Skthl_zt, Skthl_zm, Sku_zt, &
    3915             :     !$acc                   Sku_zm, Skv_zt, Skv_zm, wp2up2_zt, &
    3916             :     !$acc                   wp2vp2_zt, wp4_zt, wpthvp_zt, rtpthvp_zt, thlpthvp_zt, &
    3917             :     !$acc                   wprcp_zt, rtprcp_zt, thlprcp_zt, uprcp_zt, vprcp_zt, &
    3918             :     !$acc                   rsat, rel_humidity, um_zm, vm_zm, T_in_K, sigma_sqd_w_tmp )
    3919             : 
    3920             :     !$acc exit data if( l_call_pdf_closure_twice ) &
    3921             :     !$acc           delete( w_up_in_cloud_zm, wpup2_zm, wpvp2_zm, &
    3922             :     !$acc                   w_down_in_cloud_zm, cloudy_updraft_frac_zm,  &
    3923             :     !$acc                   cloudy_downdraft_frac_zm, p_in_Pa_zm, exner_zm, &
    3924             :     !$acc                   wprtp2_zm, wp2rtp_zm, wpthlp2_zm, &
    3925             :     !$acc                   wp2thlp_zm, wprtpthlp_zm, wp2thvp_zm, wp2rcp_zm )
    3926             : 
    3927             :     !$acc exit data if( sclr_dim > 0 ) &
    3928             :     !$acc           delete( wpsclrp_zt, sclrp2_zt, sclrp3_zm, sclrprtp_zt, sclrpthlp_zt, &
    3929             :     !$acc                   Sksclr_zt, Sksclr_zm, sclrpthvp_zt, sclrprcp_zt, wpsclrprtp_zm, &
    3930             :     !$acc                   wpsclrp2_zm, wpsclrpthlp_zm, wp2sclrp_zm, sclrm_zm )
    3931             : 
    3932             :     !$acc exit data if( hydromet_dim > 0 ) delete( wphydrometp_zt, wp2hmp_zm, rtphmp, thlphmp )
    3933             : 
    3934             :     return
    3935             : 
    3936     8935056 :   end subroutine pdf_closure_driver
    3937             : 
    3938             :   !=============================================================================
    3939        1536 :   subroutine check_clubb_settings( nzmax, params,       & ! intent(in)
    3940             :                                    l_implemented,       & ! intent(in)
    3941             :                                    l_input_fields,      & ! intent(in)
    3942             :                                    clubb_config_flags,  & ! intent(in)
    3943             :                                    err_code_out )         ! intent(out)
    3944             : 
    3945             :       ! Description:
    3946             :       !   Subroutine to set up the model for execution.
    3947             :       !
    3948             :       ! References:
    3949             :       !   None
    3950             :       !---------------------------------------------------------------------
    3951             : 
    3952             :       use grid_class, only: &
    3953             :           grid ! Type
    3954             : 
    3955             :       use parameter_indices, only:  &
    3956             :           nparams,      & ! Variable(s)
    3957             :           iC1,          & ! Constant(s)
    3958             :           iC1b,         &
    3959             :           iC2rt,        &
    3960             :           iC2thl,       &
    3961             :           iC2rtthl,     &
    3962             :           iC6rt,        &
    3963             :           iC6rtb,       &
    3964             :           iC6thl,       &
    3965             :           iC6thlb,      &
    3966             :           iC14,         &
    3967             :           iSkw_max_mag
    3968             : 
    3969             :       use parameters_tunable, only: &
    3970             :           setup_parameters,    & ! Procedure
    3971             :           nu_vertical_res_dep    ! Type(s)
    3972             : 
    3973             :       use constants_clubb, only:  &
    3974             :           fstderr, &  ! Variable(s)
    3975             :           one, &
    3976             :           eps
    3977             : 
    3978             :       use error_code, only: &
    3979             :           clubb_at_least_debug_level,  & ! Procedures
    3980             :           initialize_error_headers,    &
    3981             :           err_code,                    & ! Error Indicator
    3982             :           clubb_no_error, &              ! Constant
    3983             :           clubb_fatal_error              ! Constant
    3984             : 
    3985             :       use model_flags, only: &
    3986             :           clubb_config_flags_type, & ! Type
    3987             :           iiPDF_ADG1,       & ! Variable(s)
    3988             :           iiPDF_ADG2,       &
    3989             :           iiPDF_3D_Luhar,   &
    3990             :           iiPDF_new,        &
    3991             :           iiPDF_TSDADG,     &
    3992             :           iiPDF_LY93,       &
    3993             :           iiPDF_new_hybrid, &
    3994             :           lapack,           &
    3995             :           l_explicit_turbulent_adv_wpxp
    3996             : 
    3997             :       use clubb_precision, only: &
    3998             :           core_rknd ! Variable(s)
    3999             : 
    4000             :       use sponge_layer_damping, only: &
    4001             :           thlm_sponge_damp_settings,    & ! Variable(s)
    4002             :           rtm_sponge_damp_settings,     &
    4003             :           uv_sponge_damp_settings,      &
    4004             :           wp2_sponge_damp_settings,     &
    4005             :           wp3_sponge_damp_settings,     &
    4006             :           up2_vp2_sponge_damp_settings
    4007             : 
    4008             : 
    4009             :       implicit none
    4010             : 
    4011             :       !---------------------- Input Variables ----------------------
    4012             : 
    4013             :       ! Grid definition
    4014             :       integer, intent(in) :: nzmax  ! Vertical grid levels            [#]
    4015             :       !                      Only true when used in a host model
    4016             :       !                      CLUBB determines what nzmax should be
    4017             :       !                      given zm_init and zm_top when
    4018             :       !                      running in standalone mode.
    4019             : 
    4020             :       real( kind = core_rknd ), intent(in), dimension(nparams) :: &
    4021             :         params  ! Including C1, nu1, nu2, etc.
    4022             : 
    4023             :       ! Flags
    4024             :       logical, intent(in) ::  &
    4025             :         l_implemented, & ! Flag for whether CLUBB is being run in a host model
    4026             :         l_input_fields   ! Flag for whether LES input fields are being used
    4027             : 
    4028             :       type(clubb_config_flags_type), intent(in) :: &
    4029             :         clubb_config_flags
    4030             : 
    4031             :       !---------------------- Output Variables ----------------------
    4032             :       integer, intent(out) :: &
    4033             :         err_code_out  ! Error code indicator
    4034             : 
    4035             :       !---------------------- Begin Code ----------------------
    4036             : 
    4037        1536 :       err_code_out = clubb_no_error ! Initialize to no error value
    4038        1536 :       call initialize_error_headers
    4039             : 
    4040             : #ifdef CLUBB_GPU
    4041             :       if ( clubb_config_flags%penta_solve_method == lapack ) then
    4042             :         write(fstderr,*) "WARNING: The penta-diagonal lapack solver is not GPU accelerated"
    4043             :         write(fstderr,*) " Set penta_solve_method = 2, to use an accelerated penta-diagonal solver"
    4044             :       end if
    4045             : 
    4046             :       if ( clubb_config_flags%tridiag_solve_method == lapack ) then
    4047             :         write(fstderr,*) "WARNING: The tri-diagonal lapack solver is not GPU accelerated"
    4048             :         write(fstderr,*) " Set tridiag_solve_method = 2, to use an accelerated tri-diagonal solver"
    4049             :       end if
    4050             : #endif
    4051             : 
    4052             :       ! Sanity check
    4053        1536 :       if ( clubb_at_least_debug_level( 0 ) ) then
    4054             : 
    4055        1536 :         if ( clubb_config_flags%l_damp_wp2_using_em .and. &
    4056             :            (abs(params(iC1) - params(iC14)) > abs(params(iC1) + params(iC14)) / 2 * eps .or. &
    4057             :              clubb_config_flags%l_stability_correct_tau_zm) ) then
    4058             :           write(fstderr,*) "l_damp_wp2_using_em = T requires C1=C14 and" &
    4059           0 :                             // " l_stability_correct_tau_zm = F"
    4060           0 :           write(fstderr,*) "C1 = ", params(iC1)
    4061           0 :           write(fstderr,*) "C14 = ", params(iC14)
    4062           0 :           write(fstderr,*) "l_stability_correct_tau_zm = ", clubb_config_flags%l_stability_correct_tau_zm
    4063           0 :           write(fstderr,*) "Fatal error in check_clubb_settings"
    4064           0 :           err_code_out = clubb_fatal_error
    4065           0 :           return
    4066             :         end if
    4067             : 
    4068             :       end if
    4069             : 
    4070             :       ! Sanity check for the saturation formula
    4071        1536 :       select case ( clubb_config_flags%saturation_formula )
    4072             :       case ( saturation_bolton )
    4073             :         ! Using the Bolton 1980 approximations for SVP over vapor/ice
    4074             : 
    4075             :       case ( saturation_gfdl )
    4076             :         ! Using the Flatau, et al. polynomial approximation for SVP over vapor/ice
    4077             : 
    4078             :       case ( saturation_flatau )   ! h1g, 2010-06-16
    4079             :         ! Using the GFDL SVP formula (Goff-Gratch)
    4080             : 
    4081             :         ! Add new saturation formulas after this
    4082             : 
    4083             :       case ( saturation_lookup )
    4084             :         ! Using the lookup table
    4085             : 
    4086             :       case default
    4087           0 :         write(fstderr,*) "Unknown approx. of saturation vapor pressure: ", &
    4088           0 :            clubb_config_flags%saturation_formula
    4089           0 :         write(fstderr,*) "Fatal error in check_clubb_settings"
    4090           0 :         err_code_out = clubb_fatal_error
    4091        1536 :         return
    4092             :       end select
    4093             : 
    4094             :       ! Check for the type of two component normal (double Gaussian) PDF being
    4095             :       ! used for w, rt, and theta-l (or w, chi, and eta).
    4096             :       if ( clubb_config_flags%iiPDF_type < iiPDF_ADG1 &
    4097        1536 :            .or. clubb_config_flags%iiPDF_type > iiPDF_new_hybrid ) then
    4098           0 :          write(fstderr,*) "Unknown type of double Gaussian PDF selected: ", clubb_config_flags%iiPDF_type
    4099           0 :          write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
    4100           0 :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4101           0 :          err_code_out = clubb_fatal_error
    4102           0 :          return
    4103             :       endif ! iiPDF_type < iiPDF_ADG1 or iiPDF_type > iiPDF_lY93
    4104             : 
    4105             :       ! The ADG2 and 3D Luhar PDFs can only be used as part of input fields.
    4106        1536 :       if ( clubb_config_flags%iiPDF_type == iiPDF_ADG2 ) then
    4107           0 :          if ( .not. l_input_fields ) then
    4108             :             write(fstderr,*) "The ADG2 PDF can only be used with" &
    4109           0 :                              // " input fields (l_input_fields = .true.)."
    4110           0 :             write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
    4111           0 :             write(fstderr,*) "l_input_fields = ", l_input_fields
    4112           0 :             write(fstderr,*) "Fatal error in check_clubb_settings"
    4113           0 :             err_code_out = clubb_fatal_error
    4114           0 :             return
    4115             :          endif ! .not. l_input_fields
    4116             :       endif ! iiPDF_type == iiPDF_ADG2
    4117             : 
    4118        1536 :       if ( clubb_config_flags%iiPDF_type == iiPDF_3D_Luhar ) then
    4119           0 :          if ( .not. l_input_fields ) then
    4120             :             write(fstderr,*) "The 3D Luhar PDF can only be used with" &
    4121           0 :                              // " input fields (l_input_fields = .true.)."
    4122           0 :             write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
    4123           0 :             write(fstderr,*) "l_input_fields = ", l_input_fields
    4124           0 :             write(fstderr,*) "Fatal error in check_clubb_settings"
    4125           0 :             err_code_out = clubb_fatal_error
    4126           0 :             return
    4127             :          endif ! .not. l_input_fields
    4128             :       endif ! iiPDF_type == iiPDF_3D_Luhar
    4129             : 
    4130             :       ! This also currently applies to the new PDF until it has been fully
    4131             :       ! implemented.
    4132        1536 :       if ( clubb_config_flags%iiPDF_type == iiPDF_new ) then
    4133           0 :          if ( .not. l_input_fields ) then
    4134             :             write(fstderr,*) "The new PDF can only be used with" &
    4135           0 :                              // " input fields (l_input_fields = .true.)."
    4136           0 :             write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
    4137           0 :             write(fstderr,*) "l_input_fields = ", l_input_fields
    4138           0 :             write(fstderr,*) "Fatal error in check_clubb_settings"
    4139           0 :             err_code_out = clubb_fatal_error
    4140           0 :             return
    4141             :          endif ! .not. l_input_fields
    4142             :       endif ! iiPDF_type == iiPDF_new
    4143             : 
    4144             :       ! This also currently applies to the TSDADG PDF until it has been fully
    4145             :       ! implemented.
    4146        1536 :       if ( clubb_config_flags%iiPDF_type == iiPDF_TSDADG ) then
    4147           0 :          if ( .not. l_input_fields ) then
    4148             :             write(fstderr,*) "The new TSDADG PDF can only be used with" &
    4149           0 :                              // " input fields (l_input_fields = .true.)."
    4150           0 :             write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
    4151           0 :             write(fstderr,*) "l_input_fields = ", l_input_fields
    4152           0 :             write(fstderr,*) "Fatal error in check_clubb_settings"
    4153           0 :             err_code_out = clubb_fatal_error
    4154           0 :             return
    4155             :          endif ! .not. l_input_fields
    4156             :       endif ! iiPDF_type == iiPDF_TSDADG
    4157             : 
    4158             :       ! This also applies to Lewellen and Yoh (1993).
    4159        1536 :       if ( clubb_config_flags%iiPDF_type == iiPDF_LY93 ) then
    4160           0 :          if ( .not. l_input_fields ) then
    4161             :             write(fstderr,*) "The Lewellen and Yoh PDF can only be used with" &
    4162           0 :                              // " input fields (l_input_fields = .true.)."
    4163           0 :             write(fstderr,*) "iiPDF_type = ", clubb_config_flags%iiPDF_type
    4164           0 :             write(fstderr,*) "l_input_fields = ", l_input_fields
    4165           0 :             write(fstderr,*) "Fatal error in check_clubb_settings"
    4166           0 :             err_code_out = clubb_fatal_error
    4167           0 :             return
    4168             :          endif ! .not. l_input_fields
    4169             :       endif ! iiPDF_type == iiPDF_LY93
    4170             : 
    4171             :       ! Check the option for the placement of the call to CLUBB's PDF.
    4172             :       if ( clubb_config_flags%ipdf_call_placement < ipdf_pre_advance_fields &
    4173        1536 :            .or. clubb_config_flags%ipdf_call_placement > ipdf_pre_post_advance_fields ) then
    4174           0 :          write(fstderr,*) "Invalid option selected for ipdf_call_placement: ", &
    4175           0 :                           clubb_config_flags%ipdf_call_placement
    4176           0 :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4177           0 :          err_code_out = clubb_fatal_error
    4178           0 :          return
    4179             :       endif
    4180             : 
    4181             :       ! The l_predict_upwp_vpwp flag requires that the ADG1 PDF is used
    4182             :       ! implicitly in subroutine advance_xm_wpxp.
    4183        1536 :       if ( clubb_config_flags%l_predict_upwp_vpwp ) then
    4184             : 
    4185             :          ! When l_predict_upwp_vpwp is enabled, the
    4186             :          ! l_explicit_turbulent_adv_wpxp flag must be turned off.
    4187             :          ! Otherwise, explicit turbulent advection would require PDF parameters
    4188             :          ! for u and v to be calculated in PDF closure.  These would be needed
    4189             :          ! to calculate integrated fields such as wp2up, etc.
    4190             :          if ( l_explicit_turbulent_adv_wpxp ) then
    4191             :             write(fstderr,*) "The l_explicit_turbulent_adv_wpxp option" &
    4192             :                              // " is not currently set up for use with the" &
    4193             :                              // " l_predict_upwp_vpwp code."
    4194             :             write(fstderr,*) "Fatal error in check_clubb_settings"
    4195             :             err_code_out = clubb_fatal_error
    4196             :             return
    4197             :          endif ! l_explicit_turbulent_adv_wpxp
    4198             : 
    4199             :          ! When l_predict_upwp_vpwp is enabled, the PDF type must be set to
    4200             :          ! the ADG1 PDF or the new hybrid PDF.  The other PDFs are not currently
    4201             :          ! set up to calculate variables needed for implicit or semi-implicit
    4202             :          ! turbulent advection, such as coef_wp2up_implicit, etc.
    4203             :          if ( ( clubb_config_flags%iiPDF_type /= iiPDF_ADG1 ) &
    4204        1536 :               .and. ( clubb_config_flags%iiPDF_type /= iiPDF_new_hybrid ) ) then
    4205             :             write(fstderr,*) "Currently, only the ADG1 PDF and the new hybrid" &
    4206             :                              // " PDF are set up for use with the" &
    4207           0 :                              // " l_predict_upwp_vpwp code."
    4208           0 :             write(fstderr,*) "Fatal error in check_clubb_settings"
    4209           0 :             err_code_out = clubb_fatal_error
    4210           0 :             return
    4211             :          endif ! iiPDF_type /= iiPDF_ADG1
    4212             : 
    4213             :       endif ! l_predict_upwp_vpwp
    4214             : 
    4215             :       ! The flags l_min_xp2_from_corr_wx and l_enable_relaxed_clipping must
    4216             :       ! have opposite values.
    4217             :       if ( ( clubb_config_flags%l_min_xp2_from_corr_wx ) &
    4218        1536 :          .and. ( clubb_config_flags%l_enable_relaxed_clipping ) ) then
    4219             :          write(fstderr,*) "Invalid configuration: l_min_xp2_from_corr_wx = T " &
    4220           0 :                           // "and l_enable_relaxed_clipping = T"
    4221           0 :          write(fstderr,*) "They must have opposite values"
    4222           0 :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4223           0 :          err_code_out = clubb_fatal_error
    4224           0 :          return
    4225             :       elseif ( ( .not. clubb_config_flags%l_min_xp2_from_corr_wx ) &
    4226        1536 :                .and. ( .not. clubb_config_flags%l_enable_relaxed_clipping ) ) then
    4227             :          write(fstderr,*) "Invalid configuration: l_min_xp2_from_corr_wx = F " &
    4228           0 :                           // "and l_enable_relaxed_clipping = F"
    4229           0 :          write(fstderr,*) "They must have opposite values"
    4230           0 :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4231             :          !err_code_out = clubb_fatal_error
    4232             :          !return
    4233             :       endif
    4234             : 
    4235             :       ! Checking for the code that orders CLUBB's advance_ subroutines
    4236             :       if ( order_xm_wpxp < 1 .or. order_xm_wpxp > 4 ) then
    4237             :          write(fstderr,*) "The variable order_xm_wpxp must have a value " &
    4238             :                           // "between 1 and 4"
    4239             :          write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
    4240             :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4241             :          err_code_out = clubb_fatal_error
    4242             :          return
    4243             :       elseif ( order_xm_wpxp == order_wp2_wp3 &
    4244             :                .or. order_xm_wpxp == order_xp2_xpyp &
    4245             :                .or. order_xm_wpxp == order_windm ) then
    4246             :          write(fstderr,*) "The variable order_xm_wpxp has the same value " &
    4247             :                           // "as another order_ variable.  Please give each " &
    4248             :                           // "order index a unique value."
    4249             :          write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
    4250             :          write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
    4251             :          write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
    4252             :          write(fstderr,*) "order_windm = ", order_windm
    4253             :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4254             :          err_code_out = clubb_fatal_error
    4255             :          return
    4256             :       endif
    4257             : 
    4258             :       if ( order_wp2_wp3 < 1 .or. order_wp2_wp3 > 4 ) then
    4259             :          write(fstderr,*) "The variable order_wp2_wp3 must have a value " &
    4260             :                           // "between 1 and 4"
    4261             :          write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
    4262             :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4263             :          err_code_out = clubb_fatal_error
    4264             :          return
    4265             :       elseif ( order_wp2_wp3 == order_xm_wpxp &
    4266             :                .or. order_wp2_wp3 == order_xp2_xpyp &
    4267             :                .or. order_wp2_wp3 == order_windm ) then
    4268             :          write(fstderr,*) "The variable order_wp2_wp3 has the same value " &
    4269             :                           // "as another order_ variable.  Please give each " &
    4270             :                           // "order index a unique value."
    4271             :          write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
    4272             :          write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
    4273             :          write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
    4274             :          write(fstderr,*) "order_windm = ", order_windm
    4275             :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4276             :          err_code_out = clubb_fatal_error
    4277             :          return
    4278             :       endif
    4279             : 
    4280             :       if ( order_xp2_xpyp < 1 .or. order_xp2_xpyp > 4 ) then
    4281             :          write(fstderr,*) "The variable order_xp2_xpyp must have a value " &
    4282             :                           // "between 1 and 4"
    4283             :          write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
    4284             :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4285             :          err_code_out = clubb_fatal_error
    4286             :          return
    4287             :       elseif ( order_xp2_xpyp == order_wp2_wp3 &
    4288             :                .or. order_xp2_xpyp == order_xm_wpxp &
    4289             :                .or. order_xp2_xpyp == order_windm ) then
    4290             :          write(fstderr,*) "The variable order_xp2_xpyp has the same value " &
    4291             :                           // "as another order_ variable.  Please give each " &
    4292             :                           // "order index a unique value."
    4293             :          write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
    4294             :          write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
    4295             :          write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
    4296             :          write(fstderr,*) "order_windm = ", order_windm
    4297             :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4298             :          err_code_out = clubb_fatal_error
    4299             :          return
    4300             :       endif
    4301             : 
    4302             :       if ( order_windm < 1 .or. order_windm > 4 ) then
    4303             :          write(fstderr,*) "The variable order_windm must have a value " &
    4304             :                           // "between 1 and 4"
    4305             :          write(fstderr,*) "order_windm = ", order_windm
    4306             :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4307             :          err_code_out = clubb_fatal_error
    4308             :          return
    4309             :       elseif ( order_windm == order_wp2_wp3 &
    4310             :                .or. order_windm == order_xp2_xpyp &
    4311             :                .or. order_windm == order_xm_wpxp ) then
    4312             :          write(fstderr,*) "The variable order_windm has the same value " &
    4313             :                           // "as another order_ variable.  Please give each " &
    4314             :                           // "order index a unique value."
    4315             :          write(fstderr,*) "order_windm = ", order_windm
    4316             :          write(fstderr,*) "order_wp2_wp3 = ", order_wp2_wp3
    4317             :          write(fstderr,*) "order_xp2_xpyp = ", order_xp2_xpyp
    4318             :          write(fstderr,*) "order_xm_wpxp = ", order_xm_wpxp
    4319             :          write(fstderr,*) "Fatal error in check_clubb_settings"
    4320             :          err_code_out = clubb_fatal_error
    4321             :          return
    4322             :       endif
    4323             : 
    4324             :       ! Checking that when the l_diag_Lscale_from_tau is enabled, the
    4325             :       ! relevant Cx tunable parameters are all set to a value of 1 (as
    4326             :       ! you're supposed to tune the C_invrs_tau_ parameters instead).
    4327        1536 :       if ( clubb_config_flags%l_diag_Lscale_from_tau ) then
    4328             : 
    4329             :          ! Note: someday when we can successfully run with all these parameters
    4330             :          ! having a value of 1, the "Warning" messages should be removed and the
    4331             :          ! "Fatal error" messages should be uncommented.
    4332             : 
    4333             :          ! C1 must have a value of 1
    4334           0 :          if ( params(iC1) > one .or. params(iC1) < one ) then
    4335             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4336           0 :                              // "enabled, C1 must have a value of 1."
    4337           0 :             write(fstderr,*) "C1 = ", params(iC1)
    4338           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4339             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4340             :             !err_code_out = clubb_fatal_error
    4341             :          endif ! C1 check
    4342             : 
    4343             :          ! C1b must have a value of 1
    4344           0 :          if ( params(iC1b) > one .or. params(iC1b) < one ) then
    4345             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4346           0 :                              // "enabled, C1b must have a value of 1."
    4347           0 :             write(fstderr,*) "C1b = ", params(iC1b)
    4348           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4349             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4350             :             !err_code_out = clubb_fatal_error
    4351             :          endif ! C1b check
    4352             : 
    4353             :          ! C2rt must have a value of 1
    4354           0 :          if ( params(iC2rt) > one .or. params(iC2rt) < one ) then
    4355             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4356           0 :                              // "enabled, C2rt must have a value of 1."
    4357           0 :             write(fstderr,*) "C2rt = ", params(iC2rt)
    4358           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4359             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4360             :             !err_code_out = clubb_fatal_error
    4361             :          endif ! C2rt check
    4362             : 
    4363             :          ! C2thl must have a value of 1
    4364           0 :          if ( params(iC2thl) > one .or. params(iC2thl) < one ) then
    4365             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4366           0 :                              // "enabled, C2thl must have a value of 1."
    4367           0 :             write(fstderr,*) "C2thl = ", params(iC2thl)
    4368           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4369             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4370             :             !err_code_out = clubb_fatal_error
    4371             :          endif ! C2thl check
    4372             : 
    4373             :          ! C2rtthl must have a value of 1
    4374           0 :          if ( params(iC2rtthl) > one .or. params(iC2rtthl) < one ) then
    4375             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4376           0 :                              // "enabled, C2rtthl must have a value of 1."
    4377           0 :             write(fstderr,*) "C2rtthl = ", params(iC2rtthl)
    4378           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4379             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4380             :             !err_code_out = clubb_fatal_error
    4381             :          endif ! C2rtthl check
    4382             : 
    4383             :          ! C6rt must have a value of 1
    4384           0 :          if ( params(iC6rt) > one .or. params(iC6rt) < one ) then
    4385             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4386           0 :                              // "enabled, C6rt must have a value of 1."
    4387           0 :             write(fstderr,*) "C6rt = ", params(iC6rt)
    4388           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4389             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4390             :             !err_code_out = clubb_fatal_error
    4391             :          endif ! C6rt check
    4392             : 
    4393             :          ! C6rtb must have a value of 1
    4394           0 :          if ( params(iC6rtb) > one .or. params(iC6rtb) < one ) then
    4395             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4396           0 :                              // "enabled, C6rtb must have a value of 1."
    4397           0 :             write(fstderr,*) "C6rtb = ", params(iC6rtb)
    4398           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4399             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4400             :             !err_code_out = clubb_fatal_error
    4401             :          endif ! C6rtb check
    4402             : 
    4403             :          ! C6thl must have a value of 1
    4404           0 :          if ( params(iC6thl) > one .or. params(iC6thl) < one ) then
    4405             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4406           0 :                              // "enabled, C6thl must have a value of 1."
    4407           0 :             write(fstderr,*) "C6thl = ", params(iC6thl)
    4408           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4409             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4410             :             !err_code_out = clubb_fatal_error
    4411             :          endif ! C6thl check
    4412             : 
    4413             :          ! C6thlb must have a value of 1
    4414           0 :          if ( params(iC6thlb) > one .or. params(iC6thlb) < one ) then
    4415             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4416           0 :                              // "enabled, C6thlb must have a value of 1."
    4417           0 :             write(fstderr,*) "C6thlb = ", params(iC6thlb)
    4418           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4419             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4420             :             !err_code_out = clubb_fatal_error
    4421             :          endif ! C6thlb check
    4422             : 
    4423             :          ! C14 must have a value of 1
    4424           0 :          if ( params(iC14) > one .or. params(iC14) < one ) then
    4425             :             write(fstderr,*) "When the l_diag_Lscale_from_tau flag is " &
    4426           0 :                              // "enabled, C14 must have a value of 1."
    4427           0 :             write(fstderr,*) "C14 = ", params(iC14)
    4428           0 :             write(fstderr,*) "Warning in check_clubb_settings"
    4429             :             !write(fstderr,*) "Fatal error in check_clubb_settings"
    4430             :             !err_code_out = clubb_fatal_error
    4431             :          endif ! C14 check
    4432             : 
    4433             :       endif ! l_diag_Lscale_from_tau
    4434             : 
    4435        1536 :       if ( l_implemented ) then
    4436             : 
    4437        1536 :         if ( clubb_config_flags%l_rtm_nudge ) then
    4438             :           write(fstderr,*) "l_rtm_nudge must be set to .false. when " &
    4439           0 :                            // "l_implemented = .true."
    4440           0 :           write(fstderr,*) "Fatal error in check_clubb_settings"
    4441           0 :           err_code_out = clubb_fatal_error
    4442             :         end if
    4443             : 
    4444        1536 :         if ( clubb_config_flags%l_uv_nudge ) then
    4445             :           write(fstderr,*) "l_rtm_nudge must be set to .false. when " &
    4446           0 :                            // "l_implemented = .true."
    4447           0 :           write(fstderr,*) "Fatal error in check_clubb_settings"
    4448           0 :           err_code_out = clubb_fatal_error
    4449             :         end if
    4450             : 
    4451        1536 :         if ( thlm_sponge_damp_settings%l_sponge_damping ) then
    4452             :           write(fstderr,*) "thlm_sponge_damp_settings%l_sponge_damping " &
    4453           0 :                            // "must be set to .false. when  l_implemented = .true."
    4454           0 :           write(fstderr,*) "Fatal error in check_clubb_settings"
    4455           0 :           err_code_out = clubb_fatal_error
    4456             :         end if
    4457             : 
    4458        1536 :         if ( rtm_sponge_damp_settings%l_sponge_damping ) then
    4459             :           write(fstderr,*) "rtm_sponge_damp_settings%l_sponge_damping " &
    4460           0 :                            // "must be set to .false. when  l_implemented = .true."
    4461           0 :           write(fstderr,*) "Fatal error in check_clubb_settings"
    4462           0 :           err_code_out = clubb_fatal_error
    4463             :         end if
    4464             : 
    4465        1536 :         if ( uv_sponge_damp_settings%l_sponge_damping ) then
    4466             :           write(fstderr,*) "uv_sponge_damp_settings%l_sponge_damping " &
    4467           0 :                            // "must be set to .false. when  l_implemented = .true."
    4468           0 :           write(fstderr,*) "Fatal error in check_clubb_settings"
    4469           0 :           err_code_out = clubb_fatal_error
    4470             :         end if
    4471             : 
    4472        1536 :         if ( wp2_sponge_damp_settings%l_sponge_damping ) then
    4473             :           write(fstderr,*) "wp2_sponge_damp_settings%l_sponge_damping " &
    4474           0 :                            // "must be set to .false. when  l_implemented = .true."
    4475           0 :           write(fstderr,*) "Fatal error in check_clubb_settings"
    4476           0 :           err_code_out = clubb_fatal_error
    4477             :         end if
    4478             : 
    4479        1536 :         if ( wp3_sponge_damp_settings%l_sponge_damping ) then
    4480             :           write(fstderr,*) "wp3_sponge_damp_settings%l_sponge_damping " &
    4481           0 :                            // "must be set to .false. when  l_implemented = .true."
    4482           0 :           write(fstderr,*) "Fatal error in check_clubb_settings"
    4483           0 :           err_code_out = clubb_fatal_error
    4484             :         end if
    4485             : 
    4486        1536 :         if ( up2_vp2_sponge_damp_settings%l_sponge_damping ) then
    4487             :           write(fstderr,*) "up2_vp2_sponge_damp_settings%l_sponge_damping " &
    4488           0 :                            // "must be set to .false. when  l_implemented = .true."
    4489           0 :           write(fstderr,*) "Fatal error in check_clubb_settings"
    4490           0 :           err_code_out = clubb_fatal_error
    4491             :         end if
    4492             : 
    4493             :       end if
    4494             : 
    4495        1536 :       err_code = err_code_out
    4496             : 
    4497        1536 :       return
    4498             : 
    4499             :     end subroutine check_clubb_settings
    4500             : 
    4501             :     !----------------------------------------------------------------------------
    4502           0 :     subroutine cleanup_clubb_core( gr )
    4503             : 
    4504             :       ! Description:
    4505             :       !   Frees memory used by the model itself.
    4506             :       !
    4507             :       ! References:
    4508             :       !   None
    4509             :       !---------------------------------------------------------------------------
    4510             : 
    4511             :       use grid_class, only: &
    4512             :         cleanup_grid, & ! Procedure
    4513             :         grid            ! Type
    4514             : 
    4515             :       implicit none
    4516             : 
    4517             :       type(grid), target, intent(inout) :: gr
    4518             : 
    4519             :       !----- Begin Code -----
    4520             : 
    4521             :       ! De-allocate the arrays for the grid
    4522           0 :       call cleanup_grid( gr ) ! intent(in)
    4523             : 
    4524           0 :       return
    4525             :     end subroutine cleanup_clubb_core
    4526             : 
    4527             :     !-----------------------------------------------------------------------
    4528     8935056 :     subroutine trapezoidal_rule_zt( nz, ngrdcol, sclr_dim, gr,                   & ! intent(in)
    4529             :                                     l_call_pdf_closure_twice,                    & ! intent(in)
    4530             :                                     stats_metadata,                              & ! intent(in)
    4531     8935056 :                                     wprtp2, wpthlp2,                             & ! intent(inout)
    4532     8935056 :                                     wprtpthlp, cloud_frac, ice_supersat_frac,    & ! intent(inout)
    4533     8935056 :                                     rcm, wp2thvp, wpsclrprtp, wpsclrp2,          & ! intent(inout)
    4534     8935056 :                                     wpsclrpthlp,                                 & ! intent(inout)
    4535     8935056 :                                     wprtp2_zm, wpthlp2_zm,                       & ! intent(inout)
    4536     8935056 :                                     wprtpthlp_zm, cloud_frac_zm,                 & ! intent(inout)
    4537     8935056 :                                     ice_supersat_frac_zm, rcm_zm, wp2thvp_zm,    & ! intent(inout)
    4538     8935056 :                                     wpsclrprtp_zm, wpsclrp2_zm, wpsclrpthlp_zm )   ! intent(inout)
    4539             :                  
    4540             :       !
    4541             :       ! Description:
    4542             :       !   This subroutine takes the output variables on the thermo.
    4543             :       !   grid and either: interpolates them to the momentum grid, or uses the
    4544             :       !   values output from the second call to pdf_closure on momentum levels if
    4545             :       !   l_call_pdf_closure_twice is true.  It then calls the function
    4546             :       !   trapezoid_zt to recompute the variables on the thermo. grid.
    4547             :       !
    4548             :       !   ldgrant June 2009
    4549             :       !
    4550             :       ! Note:
    4551             :       !   The argument variables in the last 5 lines of the subroutine
    4552             :       !   (wprtp2_zm through pdf_params_zm) are declared intent(inout) because
    4553             :       !   if l_call_pdf_closure_twice is true, these variables will already have
    4554             :       !   values from pdf_closure on momentum levels and will not be altered in
    4555             :       !   this subroutine.  However, if l_call_pdf_closure_twice is false, these
    4556             :       !   variables will not have values yet and will be interpolated to
    4557             :       !   momentum levels in this subroutine.
    4558             :       ! References:
    4559             :       !   None
    4560             :       !-----------------------------------------------------------------------
    4561             : 
    4562             :       use grid_class, only: &
    4563             :           grid, & ! Type
    4564             :           zt2zm ! Procedure
    4565             : 
    4566             :       use pdf_parameter_module, only: &
    4567             :           pdf_parameter ! Derived data type
    4568             : 
    4569             :       use clubb_precision, only: &
    4570             :           core_rknd ! Variable(s)
    4571             : 
    4572             :       use stats_variables, only: &
    4573             :           stats_metadata_type
    4574             : 
    4575             :       implicit none
    4576             : 
    4577             :       !------------------------ Input variables ------------------------
    4578             :       integer, intent(in) :: &
    4579             :         nz, &
    4580             :         ngrdcol, &
    4581             :         sclr_dim
    4582             : 
    4583             :       type (grid), target, intent(in) :: &
    4584             :         gr
    4585             : 
    4586             :       logical, intent(in) :: &
    4587             :         l_call_pdf_closure_twice
    4588             : 
    4589             :       type (stats_metadata_type), intent(in) :: &
    4590             :         stats_metadata
    4591             : 
    4592             :       !------------------------ Input/Output variables ------------------------
    4593             :       ! Thermodynamic level variables output from the first call to pdf_closure
    4594             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
    4595             :         wprtp2,             & ! w'rt'^2                   [m kg^2/kg^2]
    4596             :         wpthlp2,            & ! w'thl'^2                  [m K^2/s]
    4597             :         wprtpthlp,          & ! w'rt'thl'                 [m kg K/kg s]
    4598             :         cloud_frac,         & ! Cloud Fraction            [-]
    4599             :         ice_supersat_frac,  & ! Ice Cloud Fraction        [-]
    4600             :         rcm,                & ! Liquid water mixing ratio [kg/kg]
    4601             :         wp2thvp               ! w'^2 th_v'                [m^2 K/s^2]
    4602             : 
    4603             :       real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(inout) :: &
    4604             :         wpsclrprtp,  & ! w'sclr'rt'
    4605             :         wpsclrp2,    & ! w'sclr'^2
    4606             :         wpsclrpthlp    ! w'sclr'thl'
    4607             : 
    4608             :       ! Thermo. level variables brought to momentum levels either by
    4609             :       ! interpolation (in subroutine trapezoidal_rule_zt) or by
    4610             :       ! the second call to pdf_closure (in subroutine advance_clubb_core)
    4611             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
    4612             :         wprtp2_zm,            & ! w'rt'^2 on momentum grid                   [m kg^2/kg^2]
    4613             :         wpthlp2_zm,           & ! w'thl'^2 on momentum grid                  [m K^2/s]
    4614             :         wprtpthlp_zm,         & ! w'rt'thl' on momentum grid                 [m kg K/kg s]
    4615             :         cloud_frac_zm,        & ! Cloud Fraction on momentum grid            [-]
    4616             :         ice_supersat_frac_zm, & ! Ice Cloud Fraction on momentum grid        [-]
    4617             :         rcm_zm,               & ! Liquid water mixing ratio on momentum grid [kg/kg]
    4618             :         wp2thvp_zm              ! w'^2 th_v' on momentum grid                [m^2 K/s^2]
    4619             : 
    4620             :       real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(inout) :: &
    4621             :         wpsclrprtp_zm,  & ! w'sclr'rt' on momentum grid
    4622             :         wpsclrp2_zm,    & ! w'sclr'^2 on momentum grid
    4623             :         wpsclrpthlp_zm    ! w'sclr'thl' on momentum grid
    4624             : 
    4625             :       !------------------------ Local variables ------------------------
    4626             : 
    4627             :       integer :: i, k, sclr
    4628             : 
    4629             :       !----------------------- Begin Code -----------------------------
    4630             : 
    4631             :       ! Store components of pdf_params in the locally declared variables
    4632             :       ! We only apply the trapezoidal rule to these when
    4633             :       ! l_apply_rule_to_pdf_params is true.  This is because when we apply the
    4634             :       ! rule to the final result of pdf_closure rather than the intermediate
    4635             :       ! results it can lead to an inconsistency in how we determine which
    4636             :       ! PDF component a point is in and whether the point is in or out of cloud,
    4637             :       ! which is turn will break the latin hypercube code that samples
    4638             :       ! preferentially in cloud. -dschanen 13 Feb 2012
    4639             : 
    4640             : 
    4641             :       ! If l_call_pdf_closure_twice is true, the _zm variables already have
    4642             :       ! values from the second call to pdf_closure in advance_clubb_core.
    4643             :       ! If it is false, the variables are interpolated to the _zm levels.
    4644     8935056 :       if ( .not. l_call_pdf_closure_twice ) then
    4645             : 
    4646             :         ! Interpolate thermodynamic variables to the momentum grid.
    4647           0 :         wprtp2_zm                   = zt2zm( nz, ngrdcol, gr, wprtp2 )
    4648           0 :         wpthlp2_zm                  = zt2zm( nz, ngrdcol, gr, wpthlp2 )
    4649           0 :         wprtpthlp_zm                = zt2zm( nz, ngrdcol, gr, wprtpthlp )
    4650           0 :         cloud_frac_zm               = zt2zm( nz, ngrdcol, gr, cloud_frac )
    4651           0 :         ice_supersat_frac_zm        = zt2zm( nz, ngrdcol, gr, ice_supersat_frac )
    4652           0 :         rcm_zm                      = zt2zm( nz, ngrdcol, gr, rcm )
    4653           0 :         wp2thvp_zm                  = zt2zm( nz, ngrdcol, gr, wp2thvp )
    4654             : 
    4655             :         ! Since top momentum level is higher than top thermo. level,
    4656             :         ! set variables at top momentum level to 0.
    4657             :         !$acc parallel loop gang vector default(present)
    4658           0 :         do i = 1, ngrdcol
    4659           0 :           wprtp2_zm(i,nz)             = 0.0_core_rknd
    4660           0 :           wpthlp2_zm(i,nz)            = 0.0_core_rknd
    4661           0 :           wprtpthlp_zm(i,nz)          = 0.0_core_rknd
    4662           0 :           cloud_frac_zm(i,nz)         = 0.0_core_rknd
    4663           0 :           ice_supersat_frac_zm(i,nz)  = 0.0_core_rknd
    4664           0 :           rcm_zm(i,nz)                = 0.0_core_rknd
    4665           0 :           wp2thvp_zm(i,nz)            = 0.0_core_rknd
    4666             :         end do
    4667             :         !$acc end parallel loop
    4668             : 
    4669           0 :         do sclr = 1, sclr_dim
    4670           0 :           wpsclrprtp_zm(:,:,sclr)   = zt2zm( nz, ngrdcol, gr, wpsclrprtp(:,:,sclr) )
    4671           0 :           wpsclrp2_zm(:,:,sclr)     = zt2zm( nz, ngrdcol, gr, wpsclrp2(:,:,sclr) )
    4672           0 :           wpsclrpthlp_zm(:,:,sclr)  = zt2zm( nz, ngrdcol, gr, wpsclrpthlp(:,:,sclr) )
    4673             : 
    4674             :           !$acc parallel loop gang vector default(present)
    4675           0 :           do i = 1, ngrdcol
    4676           0 :             wpsclrprtp_zm(i,nz,sclr)  = 0.0_core_rknd
    4677           0 :             wpsclrp2_zm(i,nz,sclr)    = 0.0_core_rknd
    4678           0 :             wpsclrpthlp_zm(i,nz,sclr) = 0.0_core_rknd
    4679             :           end do
    4680             :           !$acc end parallel loop
    4681             :         end do ! i = 1, sclr_dim
    4682             : 
    4683             :       end if ! .not. l_call_pdf_closure_twice
    4684             : 
    4685     8935056 :       if ( stats_metadata%l_stats ) then
    4686             :         ! Use the trapezoidal rule to recompute the variables on the stats_zt level
    4687           0 :         if ( stats_metadata%iwprtp2 > 0 ) then
    4688             :           call calc_trapezoid_zt( nz, ngrdcol, gr, &
    4689             :                                   wprtp2, wprtp2_zm, &
    4690           0 :                                   wprtp2 )
    4691             :         end if
    4692           0 :         if ( stats_metadata%iwpthlp2 > 0 ) then
    4693             :           call calc_trapezoid_zt( nz, ngrdcol, gr, &
    4694             :                                   wpthlp2, wpthlp2_zm, &
    4695           0 :                                   wpthlp2 )
    4696             :         end if
    4697           0 :         if ( stats_metadata%iwprtpthlp > 0 ) then
    4698             :           call calc_trapezoid_zt( nz, ngrdcol, gr, &
    4699             :                                   wprtpthlp, wprtpthlp_zm, &
    4700           0 :                                   wprtpthlp )
    4701             :         end if
    4702             : 
    4703           0 :         do sclr = 1, sclr_dim
    4704           0 :           if ( stats_metadata%iwpsclrprtp(sclr) > 0 ) then
    4705             :             call calc_trapezoid_zt( nz, ngrdcol, gr, &
    4706             :                                     wpsclrprtp(:,:,sclr), wpsclrprtp_zm(:,:,sclr), &
    4707           0 :                                     wpsclrprtp(:,:,sclr) )
    4708             :           end if
    4709           0 :           if ( stats_metadata%iwpsclrpthlp(sclr) > 0 ) then
    4710             :             call calc_trapezoid_zt( nz, ngrdcol, gr, &
    4711             :                                     wpsclrpthlp(:,:,sclr), wpsclrpthlp_zm(:,:,sclr), &
    4712           0 :                                     wpsclrpthlp(:,:,sclr) )
    4713             :           end if
    4714           0 :           if ( stats_metadata%iwpsclrp2(sclr) > 0 ) then
    4715             :             call calc_trapezoid_zt( nz, ngrdcol,  gr, &
    4716             :                                     wpsclrp2(:,:,sclr), wpsclrp2_zm(:,:,sclr), &
    4717           0 :                                     wpsclrp2(:,:,sclr) )
    4718             :           end if
    4719             :           
    4720             :         end do ! i = 1, sclr_dim
    4721             :       end if ! l_stats
    4722             : 
    4723             :       call calc_trapezoid_zt( nz, ngrdcol, gr, &
    4724             :                               cloud_frac, cloud_frac_zm, &
    4725     8935056 :                               cloud_frac )
    4726             :                               
    4727             :       call calc_trapezoid_zt( nz, ngrdcol, gr, &
    4728             :                               ice_supersat_frac, ice_supersat_frac_zm, &
    4729     8935056 :                               ice_supersat_frac )
    4730             :                               
    4731             :       call calc_trapezoid_zt( nz, ngrdcol, gr, &
    4732             :                               rcm, rcm_zm, &
    4733     8935056 :                               rcm )
    4734             : 
    4735             :       call calc_trapezoid_zt( nz, ngrdcol, gr, &
    4736             :                               wp2thvp, wp2thvp_zm, &
    4737     8935056 :                               wp2thvp )
    4738             : 
    4739             :       ! End of trapezoidal rule
    4740             : 
    4741     8935056 :       return
    4742             :     end subroutine trapezoidal_rule_zt
    4743             :     
    4744             :     !-----------------------------------------------------------------------
    4745     8935056 :     subroutine trapezoidal_rule_zm( nz, ngrdcol, gr,                    & ! intent(in)
    4746     8935056 :                                     wpthvp_zt, thlpthvp_zt, rtpthvp_zt, & ! intent(in)
    4747     8935056 :                                     wpthvp, thlpthvp, rtpthvp )           ! intent(inout)
    4748             :       !
    4749             :       ! Description:
    4750             :       !   This subroutine recomputes three variables on the
    4751             :       !   momentum grid from pdf_closure -- wpthvp, thlpthvp, and
    4752             :       !   rtpthvp -- by calling the function trapezoid_zm.  Only these three
    4753             :       !   variables are used in this subroutine because they are the only
    4754             :       !   pdf_closure momentum variables used elsewhere in CLUBB.
    4755             :       !
    4756             :       !   The _zt variables are output from the first call to pdf_closure.
    4757             :       !   The _zm variables are output from the second call to pdf_closure
    4758             :       !   on the momentum levels.
    4759             :       !   This is done before the call to this subroutine.
    4760             :       !
    4761             :       !   ldgrant Feb. 2010
    4762             :       !
    4763             :       !  References:
    4764             :       !    None
    4765             :       !-----------------------------------------------------------------------
    4766             : 
    4767             :       use grid_class, only: grid
    4768             : 
    4769             :       use clubb_precision, only: &
    4770             :         core_rknd ! variable(s)
    4771             : 
    4772             :       implicit none
    4773             : 
    4774             :       ! ----------------------- Input variables -----------------------
    4775             :       integer, intent(in) :: &
    4776             :         nz, &
    4777             :         ngrdcol
    4778             : 
    4779             :       type (grid), target, intent(in) :: gr
    4780             :     
    4781             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    4782             :         wpthvp_zt,   & ! Buoyancy flux (on thermo. grid)  [(K m)/s]
    4783             :         thlpthvp_zt, & ! th_l' th_v' (on thermo. grid)    [K^2]
    4784             :         rtpthvp_zt     ! r_t' th_v' (on thermo. grid)     [(kg K)/kg]
    4785             : 
    4786             :       ! ----------------------- Input/Output variables -----------------------
    4787             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
    4788             :         wpthvp,   & ! Buoyancy flux   [(K m)/s]
    4789             :         thlpthvp, & ! th_l' th_v'     [K^2]
    4790             :         rtpthvp     ! r_t' th_v'      [(kg K)/kg]
    4791             : 
    4792             :       ! ----------------------- Begin Code -----------------------
    4793             : 
    4794             :       ! Use the trapezoidal rule to recompute the variables on the zm level
    4795             :       call calc_trapezoid_zm( nz, ngrdcol, gr, wpthvp, wpthvp_zt,      & ! Intent(in) 
    4796     8935056 :                               wpthvp )                                   ! Intent(out)
    4797             :                          
    4798             :       call calc_trapezoid_zm( nz, ngrdcol, gr, thlpthvp, thlpthvp_zt,  & ! Intent(in)
    4799     8935056 :                               thlpthvp )                                 ! Intent(out)
    4800             :                          
    4801             :       call calc_trapezoid_zm( nz, ngrdcol, gr, rtpthvp, rtpthvp_zt,    & ! Intent(in)
    4802     8935056 :                               rtpthvp )                                  ! Intent(out)
    4803             : 
    4804     8935056 :       return
    4805             :     end subroutine trapezoidal_rule_zm
    4806             : 
    4807             :     !-----------------------------------------------------------------------
    4808    35740224 :     subroutine calc_trapezoid_zt( nz, ngrdcol, gr, &
    4809    35740224 :                                   variable_zt, variable_zm, &
    4810    35740224 :                                   trapezoid_zt )
    4811             :       !
    4812             :       ! Description:
    4813             :       !   Function which uses the trapezoidal rule from calculus
    4814             :       !   to recompute the values for the variables on the thermo. grid which
    4815             :       !   are output from the first call to pdf_closure in module clubb_core.
    4816             :       !
    4817             :       !   ldgrant June 2009
    4818             :       !--------------------------------------------------------------------
    4819             : 
    4820             :       use grid_class, only: grid
    4821             : 
    4822             :       use clubb_precision, only: &
    4823             :         core_rknd ! Variable(s)
    4824             : 
    4825             :       implicit none
    4826             : 
    4827             :       ! ---------------- Input Variables ----------------
    4828             :       integer, intent(in) :: &
    4829             :         nz, &
    4830             :         ngrdcol
    4831             : 
    4832             :       type (grid), target, intent(in) :: gr
    4833             :       
    4834             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    4835             :         variable_zt, & ! Variable on the zt grid
    4836             :         variable_zm    ! Variable on the zm grid
    4837             : 
    4838             :       ! ---------------- Output Variable ----------------
    4839             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    4840             :         trapezoid_zt
    4841             : 
    4842             :       ! ---------------- Local Variables ----------------
    4843             :       integer :: i, k ! Loop index
    4844             : 
    4845             :       ! ---------------- Begin Code ----------------
    4846             : 
    4847             :       ! Boundary condition: trapezoidal rule not valid at zt level 1
    4848             :       !$acc parallel loop gang vector default(present) 
    4849   596778624 :       do i = 1, ngrdcol
    4850   596778624 :         trapezoid_zt(i,1) = variable_zt(i,1)
    4851             :       end do
    4852             :       !$acc end parallel loop
    4853             : 
    4854             :       !$acc parallel loop gang vector collapse(2) default(present)
    4855  3037919040 :       do k = 2, nz
    4856 50165144640 :         do i = 1, ngrdcol
    4857             :           ! Trapezoidal rule from calculus
    4858 94254451200 :           trapezoid_zt(i,k) =  0.5_core_rknd * ( variable_zm(i,k) + variable_zt(i,k) ) &
    4859           0 :                                * ( gr%zm(i,k) - gr%zt(i,k) ) * gr%invrs_dzt(i,k) &
    4860 47127225600 :                                + 0.5_core_rknd * ( variable_zt(i,k) + variable_zm(i,k-1) ) &
    4861 >19151*10^7 :                                  * ( gr%zt(i,k) - gr%zm(i,k-1) ) * gr%invrs_dzt(i,k)
    4862             :         end do
    4863             :       end do ! k = 2, gr%nz
    4864             :       !$acc end parallel loop
    4865             : 
    4866    35740224 :       return
    4867             :     end subroutine calc_trapezoid_zt
    4868             : 
    4869             :     !-----------------------------------------------------------------------
    4870    26805168 :     subroutine calc_trapezoid_zm( nz, ngrdcol, gr, variable_zm, variable_zt, &
    4871    26805168 :                                   trapezoid_zm )
    4872             :       !
    4873             :       ! Description:
    4874             :       !   Function which uses the trapezoidal rule from calculus
    4875             :       !   to recompute the values for the important variables on the momentum
    4876             :       !   grid which are output from pdf_closure in module clubb_core.
    4877             :       !   These momentum variables only include wpthvp, thlpthvp, and rtpthvp.
    4878             :       !
    4879             :       !   ldgrant Feb. 2010
    4880             :       !--------------------------------------------------------------------
    4881             : 
    4882             :       use grid_class, only: grid
    4883             : 
    4884             :       use clubb_precision, only: &
    4885             :           core_rknd ! Variable(s)
    4886             : 
    4887             :       implicit none
    4888             : 
    4889             :       ! -------------------- Input Variables --------------------
    4890             :       integer, intent(in) :: &
    4891             :         nz, &
    4892             :         ngrdcol
    4893             : 
    4894             :       type (grid), target, intent(in) :: gr
    4895             :       
    4896             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    4897             :         variable_zm, & ! Variable on the zm grid
    4898             :         variable_zt    ! Variable on the zt grid
    4899             : 
    4900             :       ! -------------------- Output Variable --------------------
    4901             :       real( kind = core_rknd ), intent(out), dimension(ngrdcol,nz) :: &
    4902             :         trapezoid_zm
    4903             :  
    4904             :       ! -------------------- Local Variables --------------------
    4905             :       integer :: i, k ! Loop index
    4906             : 
    4907             :       ! -------------------- Begin Code --------------------
    4908             : 
    4909             :       ! Boundary conditions: trapezoidal rule not valid at top zm level, nzmax.
    4910             :       ! Trapezoidal rule also not used at zm level 1.
    4911             :       !$acc parallel loop gang vector default(present) 
    4912   447583968 :       do i = 1, ngrdcol
    4913   420778800 :         trapezoid_zm(i,1)  = variable_zm(i,1)
    4914   447583968 :         trapezoid_zm(i,nz) = variable_zm(i,nz)
    4915             :       end do
    4916             :       !$acc end parallel loop
    4917             : 
    4918             :       !$acc parallel loop gang vector collapse(2) default(present)
    4919  2251634112 :       do k = 2, nz-1
    4920 37176274512 :         do i = 1, ngrdcol
    4921             :           ! Trapezoidal rule from calculus
    4922 >10477*10^7 :           trapezoid_zm(i,k) =  0.5_core_rknd * ( variable_zt(i,k+1) + variable_zm(i,k) ) &
    4923           0 :                                * ( gr%zt(i,k+1) - gr%zm(i,k) ) * gr%invrs_dzm(i,k) &
    4924             :                                + 0.5_core_rknd * ( variable_zm(i,k) + variable_zt(i,k) ) &
    4925 >14192*10^7 :                                  * ( gr%zm(i,k) - gr%zt(i,k) ) * gr%invrs_dzm(i,k)
    4926             :         end do
    4927             :       end do 
    4928             :       !$acc end parallel loop
    4929             : 
    4930    26805168 :       return
    4931             :     end subroutine calc_trapezoid_zm
    4932             : 
    4933             :     !-----------------------------------------------------------------------
    4934     8935056 :     subroutine compute_cloud_cover( gr, nz, ngrdcol, &
    4935     8935056 :                                     pdf_params, cloud_frac, rcm, & ! intent(in)
    4936     8935056 :                                     cloud_cover, rcm_in_layer )    ! intent(out)
    4937             :       !
    4938             :       ! Description:
    4939             :       !   Subroutine to compute cloud cover (the amount of sky
    4940             :       !   covered by cloud) and rcm in layer (liquid water mixing ratio in
    4941             :       !   the portion of the grid box filled by cloud).
    4942             :       !
    4943             :       ! References:
    4944             :       !   Definition of 's' comes from:
    4945             :       !   ``The Gaussian Cloud Model Relations'' G. L. Mellor (1977)
    4946             :       !   JAS, Vol. 34, pp. 356--358.
    4947             :       !
    4948             :       ! Notes:
    4949             :       !   Added July 2009
    4950             :       !---------------------------------------------------------------------
    4951             : 
    4952             :       use constants_clubb, only: &
    4953             :           rc_tol, & ! Variable(s)
    4954             :           fstderr, &
    4955             :           unused_var
    4956             : 
    4957             :       use grid_class, only: grid
    4958             : 
    4959             :       use pdf_parameter_module, only: &
    4960             :           pdf_parameter ! Derived data type
    4961             : 
    4962             :       use clubb_precision, only: &
    4963             :           core_rknd ! Variable(s)
    4964             : 
    4965             :       use error_code, only: &
    4966             :         clubb_at_least_debug_level,  & ! Procedure
    4967             :         err_code,                    & ! Error Indicator
    4968             :         clubb_fatal_error              ! Constant
    4969             : 
    4970             :       implicit none
    4971             : 
    4972             :       !------------------------ Input variables ------------------------
    4973             :       integer, intent(in) :: &
    4974             :         ngrdcol,  & ! Number of grid columns
    4975             :         nz          ! Number of vertical level
    4976             : 
    4977             :       type (grid), target, intent(in) :: gr
    4978             : 
    4979             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    4980             :         cloud_frac, & ! Cloud fraction             [-]
    4981             :         rcm           ! Liquid water mixing ratio  [kg/kg]
    4982             : 
    4983             :       type (pdf_parameter), intent(in) :: &
    4984             :         pdf_params    ! PDF Parameters  [units vary]
    4985             : 
    4986             :       !------------------------ Output variables ------------------------
    4987             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    4988             :         cloud_cover,  & ! Cloud cover                               [-]
    4989             :         rcm_in_layer    ! Liquid water mixing ratio in cloud layer  [kg/kg]
    4990             : 
    4991             :       !------------------------ Local variables ------------------------
    4992             :       real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    4993    17870112 :         chi_mean,              & ! Mean extended cloud water mixing ratio of the
    4994             :                                  ! two Gaussian distributions
    4995    17870112 :         vert_cloud_frac_upper, & ! Fraction of cloud in top half of grid box
    4996    17870112 :         vert_cloud_frac_lower, & ! Fraction of cloud in bottom half of grid box
    4997    17870112 :         vert_cloud_frac          ! Fraction of cloud filling the grid box in the vertical
    4998             : 
    4999             :       integer :: i, k
    5000             : 
    5001             :       !------------------------ Begin code ------------------------
    5002             : 
    5003             :       !$acc enter data create( chi_mean, vert_cloud_frac_upper, &
    5004             :       !$acc                    vert_cloud_frac_lower, vert_cloud_frac )
    5005             : 
    5006             :       !$acc parallel loop gang vector collapse(2) default(present)
    5007   768414816 :       do k = 1, nz
    5008 12690480816 :         do i = 1, ngrdcol
    5009             : 
    5010 23844132000 :           chi_mean(i,k) =      pdf_params%mixt_frac(i,k)  * pdf_params%chi_1(i,k) + &
    5011 36525677760 :                       (1.0_core_rknd-pdf_params%mixt_frac(i,k)) * pdf_params%chi_2(i,k)
    5012             :         end do
    5013             :       end do
    5014             :       !$acc end parallel loop
    5015             : 
    5016             :       !$acc parallel loop gang vector collapse(2) default(present) reduction(.or.:err_code)
    5017   750544704 :       do k = 2, nz-1
    5018 12392091504 :         do i = 1, ngrdcol
    5019             : 
    5020 12383156448 :           if ( rcm(i,k) < rc_tol ) then ! No cloud at this level
    5021             : 
    5022 11055071971 :             cloud_cover(i,k)  = cloud_frac(i,k)
    5023 11055071971 :             rcm_in_layer(i,k) = rcm(i,k)
    5024             : 
    5025   586474829 :           else if ( ( rcm(i,k+1) >= rc_tol ) .and. ( rcm(i,k-1) >= rc_tol ) ) then
    5026             :             ! There is cloud above and below,
    5027             :             !   so assume cloud fills grid box from top to bottom
    5028             : 
    5029   398139678 :             cloud_cover(i,k) = cloud_frac(i,k)
    5030   398139678 :             rcm_in_layer(i,k) = rcm(i,k)
    5031             : 
    5032   188335151 :           else if ( ( rcm(i,k+1) < rc_tol ) .or. ( rcm(i,k-1) < rc_tol) ) then
    5033             :             ! Cloud may fail to reach gridbox top or base or both
    5034             : 
    5035             :             ! First let the cloud fill the entire grid box, then overwrite
    5036             :             ! vert_cloud_frac_upper(k) and/or vert_cloud_frac_lower(k)
    5037             :             ! for a cloud top, cloud base, or one-point cloud.
    5038   188335151 :             vert_cloud_frac_upper(i,k) = 0.5_core_rknd
    5039   188335151 :             vert_cloud_frac_lower(i,k) = 0.5_core_rknd
    5040             : 
    5041   188335151 :             if ( rcm(i,k+1) < rc_tol ) then ! Cloud top
    5042             : 
    5043             :               vert_cloud_frac_upper(i,k) = &
    5044           0 :                        ( ( 0.5_core_rknd / gr%invrs_dzm(i,k) ) / ( gr%zm(i,k) - gr%zt(i,k) ) ) &
    5045    99900046 :                        * ( rcm(i,k) / ( rcm(i,k) + abs( chi_mean(i,k+1) ) ) )
    5046             : 
    5047    99900046 :               vert_cloud_frac_upper(i,k) = min( 0.5_core_rknd, vert_cloud_frac_upper(i,k) )
    5048             : 
    5049             :               ! Make the transition in cloudiness more gradual than using
    5050             :               ! the above min statement alone.
    5051             :               vert_cloud_frac_upper(i,k) = vert_cloud_frac_upper(i,k) + &
    5052    99900046 :                 ( ( rcm(i,k+1)/rc_tol )*( 0.5_core_rknd -vert_cloud_frac_upper(i,k) ) )
    5053             : 
    5054             :             else
    5055             : 
    5056             :               vert_cloud_frac_upper(i,k) = 0.5_core_rknd
    5057             : 
    5058             :             end if
    5059             : 
    5060   188335151 :             if ( rcm(i,k-1) < rc_tol ) then ! Cloud base
    5061             : 
    5062             :               vert_cloud_frac_lower(i,k) = &
    5063           0 :                        ( ( 0.5_core_rknd / gr%invrs_dzm(i,k-1) ) / ( gr%zt(i,k) - gr%zm(i,k-1) ) ) &
    5064    95960165 :                        * ( rcm(i,k) / ( rcm(i,k) + abs( chi_mean(i,k-1) ) ) )
    5065             : 
    5066    95960165 :               vert_cloud_frac_lower(i,k) = min( 0.5_core_rknd, vert_cloud_frac_lower(i,k) )
    5067             : 
    5068             :               ! Make the transition in cloudiness more gradual than using
    5069             :               ! the above min statement alone.
    5070             :               vert_cloud_frac_lower(i,k) = vert_cloud_frac_lower(i,k) + &
    5071    95960165 :                 ( ( rcm(i,k-1)/rc_tol )*( 0.5_core_rknd -vert_cloud_frac_lower(i,k) ) )
    5072             : 
    5073             :             else
    5074             : 
    5075    92374986 :               vert_cloud_frac_lower(i,k) = 0.5_core_rknd
    5076             : 
    5077             :             end if
    5078             : 
    5079             :             vert_cloud_frac(i,k) = &
    5080   188335151 :               vert_cloud_frac_upper(i,k) + vert_cloud_frac_lower(i,k)
    5081             : 
    5082             :             vert_cloud_frac(i,k) = &
    5083   188335151 :               max( cloud_frac(i,k), min( 1.0_core_rknd, vert_cloud_frac(i,k) ) )
    5084             : 
    5085   188335151 :             cloud_cover(i,k)  = cloud_frac(i,k) / vert_cloud_frac(i,k)
    5086   188335151 :             rcm_in_layer(i,k) = rcm(i,k) / vert_cloud_frac(i,k)
    5087             : 
    5088             :           else
    5089             : 
    5090             :             ! This case should not be entered
    5091           0 :             cloud_cover(i,k) = unused_var
    5092           0 :             rcm_in_layer(i,k) = unused_var
    5093           0 :             err_code = clubb_fatal_error
    5094             : 
    5095             :           end if ! rcm(k) < rc_tol
    5096             :           
    5097             :         end do
    5098             :       end do ! k = 2, gr%nz-1, 1
    5099             :       !$acc end parallel loop
    5100             : 
    5101             :       !$acc parallel loop gang vector default(present)
    5102   149194656 :       do i = 1, ngrdcol
    5103   140259600 :         cloud_cover(i,1)  = cloud_frac(i,1)
    5104   140259600 :         cloud_cover(i,nz) = cloud_frac(i,nz)
    5105             : 
    5106   140259600 :         rcm_in_layer(i,1)  = rcm(i,1)
    5107   149194656 :         rcm_in_layer(i,nz) = rcm(i,nz)
    5108             :       end do
    5109             :       !$acc end parallel loop
    5110             : 
    5111     8935056 :       if ( clubb_at_least_debug_level( 0 ) ) then
    5112     8935056 :         if ( err_code == clubb_fatal_error ) then
    5113             : 
    5114             :           !$acc update host( pdf_params%mixt_frac, pdf_params%chi_1, pdf_params%chi_2, &
    5115             :           !$acc              cloud_frac, rcm )
    5116             : 
    5117             :           write(fstderr,*)  &
    5118           0 :              "ERROR: compute_cloud_cover entered a conditional case it should not have "
    5119             : 
    5120           0 :           write(fstderr,*) "pdf_params%mixt_frac = ", pdf_params%mixt_frac
    5121           0 :           write(fstderr,*) "pdf_params%chi_1 = ", pdf_params%chi_1
    5122           0 :           write(fstderr,*) "pdf_params%chi_2 = ", pdf_params%chi_2
    5123           0 :           write(fstderr,*) "cloud_frac = ", cloud_frac
    5124           0 :           write(fstderr,*) "rcm = ", rcm
    5125             :         end if
    5126             :       end if 
    5127             : 
    5128             :       !$acc exit data delete( chi_mean, vert_cloud_frac_upper, &
    5129             :       !$acc                   vert_cloud_frac_lower, vert_cloud_frac )
    5130             : 
    5131     8935056 :       return
    5132             : 
    5133             :     end subroutine compute_cloud_cover
    5134             : 
    5135             :     !-----------------------------------------------------------------------
    5136    17870112 :     subroutine clip_rcm ( nz, ngrdcol, rtm, & ! intent(in)
    5137             :                           message,          & ! intent(in)
    5138    17870112 :                           rcm )               ! intent(inout)
    5139             :       !
    5140             :       ! Description:
    5141             :       !   Subroutine that reduces cloud water (rcm) whenever
    5142             :       !   it exceeds total water (rtm = vapor + liquid).
    5143             :       !   This avoids negative values of rvm = water vapor mixing ratio.
    5144             :       !   However, it will not ensure that rcm <= rtm if rtm <= 0.
    5145             :       !
    5146             :       ! References:
    5147             :       !   None
    5148             :       !---------------------------------------------------------------------
    5149             : 
    5150             :       use error_code, only: &
    5151             :         clubb_at_least_debug_level  ! Procedure
    5152             : 
    5153             :       use constants_clubb, only: &
    5154             :         fstderr, & ! Variable(s)
    5155             :         zero_threshold
    5156             : 
    5157             :       use clubb_precision, only: &
    5158             :         core_rknd ! Variable(s)
    5159             : 
    5160             :       implicit none
    5161             : 
    5162             :       ! Input variables
    5163             :       integer, intent(in) :: &
    5164             :         nz, &
    5165             :         ngrdcol
    5166             :     
    5167             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    5168             :         rtm           ! Total water mixing ratio             [kg/kg]
    5169             : 
    5170             :       character(len= * ), intent(in) :: message
    5171             : 
    5172             :       real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
    5173             :         rcm           ! Cloud water mixing ratio  [kg/kg]
    5174             : 
    5175             :       integer :: i, k
    5176             : 
    5177             :       ! ------------ Begin code ---------------
    5178             : 
    5179             :       !$acc data copyin( rtm ) &
    5180             :       !$acc        copy( rcm )
    5181             : 
    5182    17870112 :       if ( clubb_at_least_debug_level( 3 ) ) then
    5183             : 
    5184             :         !$acc update host( rcm, rtm )
    5185             : 
    5186           0 :         do k = 1, nz
    5187           0 :           do i = 1, ngrdcol 
    5188             :             
    5189           0 :             if ( rtm(i,k) < rcm(i,k) ) then
    5190             : 
    5191           0 :               write(fstderr,*) message, ' at k=', k, ' at i=', i, 'rcm(k) = ', rcm(i,k), &
    5192           0 :                 'rtm(k) = ', rtm(i,k), '.',  ' Clipping rcm.'
    5193             : 
    5194             :             end if ! rtm(k) < rcm(k)
    5195             :             
    5196             :           end do
    5197             :         end do
    5198             :       end if ! clubb_at_least_debug_level( 3 )
    5199             : 
    5200             :       ! Vince Larson clipped rcm in order to prevent rvm < 0.  5 Apr 2008.
    5201             :       ! This code won't work unless rtm >= 0 !!!
    5202             :       ! We do not clip rcm_in_layer because rcm_in_layer only influences
    5203             :       ! radiation, and we do not want to bother recomputing it.  6 Aug 2009
    5204             :       !$acc parallel loop gang vector collapse(2) default(present)
    5205  1536829632 :       do k = 1, nz
    5206 25380961632 :         do i = 1, ngrdcol 
    5207 25363091520 :           if ( rtm(i,k) < rcm(i,k) ) then
    5208        3859 :             rcm(i,k) = max( zero_threshold, rtm(i,k) - epsilon( rtm(i,k) ) )
    5209             :           end if ! rtm(k) < rcm(k)
    5210             :         end do
    5211             :       end do
    5212             :       !$acc end parallel loop
    5213             : 
    5214             :       !$acc end data
    5215             : 
    5216    17870112 :       return
    5217             :     end subroutine clip_rcm
    5218             : 
    5219             :     !-----------------------------------------------------------------------------
    5220     8935056 :     subroutine set_Lscale_max( ngrdcol, l_implemented, host_dx, host_dy, &
    5221     8935056 :                                Lscale_max )
    5222             : 
    5223             :       ! Description:
    5224             :       !   This subroutine sets the value of Lscale_max, which is the maximum
    5225             :       !   allowable value of Lscale.  For standard CLUBB, it is set to a very large
    5226             :       !   value so that Lscale will not be limited.  However, when CLUBB is running
    5227             :       !   as part of a host model, the value of Lscale_max is dependent on the size
    5228             :       !   of the host model's horizontal grid spacing.  The smaller the host model's
    5229             :       !   horizontal grid spacing, the smaller the value of Lscale_max.  When Lscale
    5230             :       !   is limited to a small value, the value of time-scale Tau is reduced, which
    5231             :       !   in turn produces greater damping on CLUBB's turbulent parameters.  This
    5232             :       !   is the desired effect on turbulent parameters for a host model with small
    5233             :       !   horizontal grid spacing, for small areas usually contain much less
    5234             :       !   variation in meteorological quantities than large areas.
    5235             : 
    5236             :       ! References:
    5237             :       !   None
    5238             :       !-----------------------------------------------------------------------
    5239             : 
    5240             :       use clubb_precision, only: &
    5241             :         core_rknd ! Variable(s)
    5242             : 
    5243             :       implicit none
    5244             : 
    5245             :       !----------------------- Input Variables -----------------------
    5246             :       integer, intent(in) :: &
    5247             :         ngrdcol
    5248             :       
    5249             :       logical, intent(in) :: &
    5250             :         l_implemented     ! Flag to see if CLUBB is running on it's own,
    5251             :                           ! or if it's implemented as part of a host model.
    5252             : 
    5253             :       real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
    5254             :         host_dx, & ! Host model's east-west horizontal grid spacing     [m]
    5255             :         host_dy    ! Host model's north-south horizontal grid spacing   [m]
    5256             : 
    5257             :       !----------------------- Output Variable -----------------------
    5258             :       real( kind = core_rknd ), dimension(ngrdcol), intent(out) :: &
    5259             :         Lscale_max    ! Maximum allowable value for Lscale   [m]
    5260             : 
    5261             :       !----------------------- Local Variable -----------------------
    5262             :       integer :: i
    5263             : 
    5264             :       !----------------------- Begin Code-----------------------
    5265             : 
    5266             :       ! Determine the maximum allowable value for Lscale (in meters).
    5267     8935056 :       if ( l_implemented ) then
    5268             :         !$acc parallel loop gang vector default(present)
    5269   149194656 :         do i = 1, ngrdcol
    5270   149194656 :           Lscale_max(i) = 0.25_core_rknd * min( host_dx(i), host_dy(i) )
    5271             :         end do
    5272             :         !$acc end parallel loop
    5273             :       else
    5274             :         !$acc parallel loop gang vector default(present)
    5275           0 :         do i = 1, ngrdcol
    5276           0 :           Lscale_max(i) = 1.0e5_core_rknd
    5277             :         end do
    5278             :         !$acc end parallel loop
    5279             :       end if
    5280             : 
    5281     8935056 :       return
    5282             :     end subroutine set_Lscale_max
    5283             : 
    5284             : !===============================================================================
    5285           0 :   subroutine calculate_thlp2_rad &
    5286           0 :                   ( nz, rcm_zm, thlprcp, radht_zm, & ! Intent(in)
    5287             :                     clubb_params,                  & ! Intent(in)
    5288           0 :                     thlp2_forcing )                  ! Intent(inout)
    5289             : 
    5290             :   ! Description:
    5291             :   !   Computes the contribution of radiative cooling to thlp2
    5292             : 
    5293             :   ! References:
    5294             :   !   See clubb:ticket:632
    5295             :   !----------------------------------------------------------------------
    5296             : 
    5297             :     use clubb_precision, only: &
    5298             :         core_rknd                     ! Constant(s)
    5299             : 
    5300             :     use grid_class, only:  &
    5301             :         zt2zm                         ! Procedure
    5302             : 
    5303             :     use constants_clubb, only: &
    5304             :         two, &
    5305             :         rc_tol
    5306             : 
    5307             :     use parameter_indices, only: &
    5308             :         nparams, & ! Variable(s)
    5309             :         ithlp2_rad_coef
    5310             : 
    5311             :     implicit none
    5312             : 
    5313             :   ! Input Variables
    5314             :     integer, intent(in) :: &
    5315             :       nz                    ! Number of vertical levels                      [-]
    5316             : 
    5317             :     real( kind = core_rknd ), dimension(nz), intent(in) :: &
    5318             :       rcm_zm, &             ! Cloud water mixing ratio on momentum grid      [kg/kg]
    5319             :       thlprcp, &            ! thl'rc'                                        [K kg/kg]
    5320             :       radht_zm              ! SW + LW heating rate (on momentum grid)        [K/s]
    5321             : 
    5322             :     real( kind = core_rknd ), dimension(nparams), intent(in) :: &
    5323             :       clubb_params    ! Array of CLUBB's tunable parameters    [units vary]
    5324             : 
    5325             :   ! Input/Output Variables
    5326             :     real( kind = core_rknd ), dimension(nz), intent(inout) :: &
    5327             :       thlp2_forcing         ! <th_l'^2> forcing (momentum levels)            [K^2/s]
    5328             : 
    5329             :   ! Local Variables
    5330             :     integer :: &
    5331             :       k                     ! Loop iterator                                  [-]
    5332             : 
    5333             :   !----------------------------------------------------------------------
    5334             : 
    5335             : 
    5336           0 :     do k = 1, nz
    5337             : 
    5338           0 :        if ( rcm_zm(k) > rc_tol ) then
    5339             : 
    5340             :           thlp2_forcing(k) &
    5341             :           = thlp2_forcing(k) + &
    5342           0 :             clubb_params(ithlp2_rad_coef) * ( two ) * radht_zm(k) / rcm_zm(k) * thlprcp(k)
    5343             : 
    5344             :        end if
    5345             : 
    5346             :     end do
    5347             : 
    5348             : 
    5349           0 :     return
    5350             :   end subroutine calculate_thlp2_rad
    5351             : 
    5352             : 
    5353             :     !-----------------------------------------------------------------------
    5354             : end module advance_clubb_core_module

Generated by: LCOV version 1.14