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