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

Generated by: LCOV version 1.14