LCOV - code coverage report
Current view: top level - physics/clubb/src/CLUBB_core - pdf_closure_module.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 347 732 47.4 %
Date: 2025-03-13 18:42:46 Functions: 9 11 81.8 %

          Line data    Source code
       1             : !---------------------------------------------------------------------------
       2             : ! $Id$
       3             : !===============================================================================
       4             : module pdf_closure_module
       5             : 
       6             :   ! Options for the two component normal (double Gaussian) PDF type to use for
       7             :   ! the w, rt, and theta-l (or w, chi, and eta) portion of CLUBB's multivariate,
       8             :   ! two-component PDF.
       9             :   use model_flags, only: &
      10             :       iiPDF_ADG1,       & ! ADG1 PDF
      11             :       iiPDF_ADG2,       & ! ADG2 PDF
      12             :       iiPDF_3D_Luhar,   & ! 3D Luhar PDF
      13             :       iiPDF_new,        & ! new PDF
      14             :       iiPDF_TSDADG,     & ! new TSDADG PDF
      15             :       iiPDF_LY93,       & ! Lewellen and Yoh (1993)
      16             :       iiPDF_new_hybrid    ! new hybrid PDF
      17             : 
      18             :   implicit none
      19             : 
      20             :   public :: pdf_closure, &
      21             :             calc_wp4_pdf, &
      22             :             calc_wp2xp_pdf, &
      23             :             calc_wpxp2_pdf, &
      24             :             calc_wpxpyp_pdf, &
      25             :             calc_w_up_in_cloud
      26             : 
      27             :   private ! Set Default Scope
      28             : 
      29             :   contains
      30             : !------------------------------------------------------------------------
      31             : 
      32             :   !#######################################################################
      33             :   !#######################################################################
      34             :   ! If you change the argument list of pdf_closure you also have to
      35             :   ! change the calls to this function in the host models CAM, WRF, SAM
      36             :   ! and GFDL.
      37             :   !#######################################################################
      38             :   !#######################################################################
      39      705888 :   subroutine pdf_closure( nz, ngrdcol,                                &
      40      705888 :                           hydromet_dim, p_in_Pa, exner, thv_ds,       &
      41      705888 :                           wm, wp2, wp3,                               &
      42      705888 :                           Skw, Skthl_in, Skrt_in, Sku_in, Skv_in,     &
      43      705888 :                           rtm, rtp2, wprtp,                           &
      44      705888 :                           thlm, thlp2, wpthlp,                        &
      45      705888 :                           um, up2, upwp,                              &
      46      705888 :                           vm, vp2, vpwp,                              &
      47      705888 :                           rtpthlp,                                    &
      48      705888 :                           sclrm, wpsclrp, sclrp2,                     &
      49      705888 :                           sclrprtp, sclrpthlp, Sksclr_in,             &
      50      705888 :                           gamma_Skw_fnc,                              &
      51             : #ifdef GFDL
      52             :                           RH_crit, do_liquid_only_in_clubb,           & ! h1g, 2010-06-15
      53             : #endif
      54      705888 :                           wphydrometp, wp2hmp,                        &
      55      705888 :                           rtphmp, thlphmp,                            &
      56             :                           clubb_params,                               &
      57             :                           stats_metadata,                             &
      58             :                           iiPDF_type,                                 &
      59      705888 :                           sigma_sqd_w,                                &
      60             :                           pdf_params, pdf_implicit_coefs_terms,       &
      61      705888 :                           wpup2, wpvp2,                               &
      62      705888 :                           wp2up2, wp2vp2, wp4,                        &
      63      705888 :                           wprtp2, wp2rtp,                             &
      64      705888 :                           wpthlp2, wp2thlp, wprtpthlp,                &
      65      705888 :                           cloud_frac, ice_supersat_frac,              &
      66      705888 :                           rcm, wpthvp, wp2thvp, rtpthvp,              &
      67      705888 :                           thlpthvp, wprcp, wp2rcp, rtprcp,            &
      68      705888 :                           thlprcp, rcp2,                              &
      69      705888 :                           uprcp, vprcp,                               &
      70      705888 :                           w_up_in_cloud, w_down_in_cloud,             &
      71      705888 :                           cloudy_updraft_frac, cloudy_downdraft_frac, &
      72      705888 :                           F_w, F_rt, F_thl,                           &
      73      705888 :                           min_F_w, max_F_w,                           &
      74      705888 :                           min_F_rt, max_F_rt,                         &
      75      705888 :                           min_F_thl, max_F_thl,                       &
      76      705888 :                           wpsclrprtp, wpsclrp2, sclrpthvp,            &
      77      705888 :                           wpsclrpthlp, sclrprcp, wp2sclrp,            &
      78      705888 :                           rc_coef                                     )
      79             : 
      80             : 
      81             :     ! Description:
      82             :     ! Subroutine that computes pdf parameters analytically.
      83             :     !
      84             :     ! Based of the original formulation, but with some tweaks
      85             :     ! to remove some of the less realistic assumptions and
      86             :     ! improve transport terms.
      87             : 
      88             :     !   Corrected version that should remove inconsistency
      89             : 
      90             :     ! References:
      91             :     !   The shape of CLUBB's PDF is given by the expression in
      92             :     !   https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:clubb_pdf
      93             : 
      94             :     !   Eqn. 29, 30, 31, 32 & 33  on p. 3547 of
      95             :     !   ``A PDF-Based Model for Boundary Layer Clouds. Part I:
      96             :     !   Method and Model Description'' Golaz, et al. (2002)
      97             :     !   JAS, Vol. 59, pp. 3540--3551.
      98             :     !----------------------------------------------------------------------
      99             : 
     100             :     use grid_class, only: &
     101             :         grid ! Type
     102             : 
     103             :     use constants_clubb, only: &  ! Constants
     104             :         three,          & ! 3
     105             :         one,            & ! 1
     106             :         one_half,       & ! 1/2
     107             :         zero,           & ! 0
     108             :         Cp,             & ! Dry air specific heat at constant p [J/kg/K]
     109             :         Lv,             & ! Latent heat of vaporization         [J/kg]
     110             :         ep1,            & ! (1.0-ep)/ep; ep1 = 0.61             [-]
     111             :         ep2,            & ! 1.0/ep;      ep2 = 1.61             [-]
     112             :         rt_tol,         & ! Tolerance for r_t                   [kg/kg]
     113             :         thl_tol,        & ! Tolerance for th_l                  [K]
     114             :         fstderr,        &
     115             :         zero_threshold, &
     116             :         eps, &
     117             :         w_tol
     118             : 
     119             :     use parameters_model, only: &
     120             :         mixt_frac_max_mag, & ! Variable(s)
     121             :         sclr_dim             ! Number of passive scalar variables
     122             : 
     123             :     use parameter_indices, only: &
     124             :         nparams,                       & ! Variable(s)
     125             :         ibeta,                         &
     126             :         iSkw_denom_coef,               &
     127             :         islope_coef_spread_DG_means_w, &
     128             :         ipdf_component_stdev_factor_w, &
     129             :         icoef_spread_DG_means_rt,      &
     130             :         icoef_spread_DG_means_thl
     131             : 
     132             :     use pdf_parameter_module, only:  &
     133             :         pdf_parameter,        & ! Variable Type
     134             :         implicit_coefs_terms
     135             : 
     136             :     use new_pdf_main, only: &
     137             :         new_pdf_driver    ! Procedure(s)
     138             : 
     139             :     use new_hybrid_pdf_main, only: &
     140             :         new_hybrid_pdf_driver    ! Procedure(s)
     141             : 
     142             :     use adg1_adg2_3d_luhar_pdf, only: &
     143             :         ADG1_pdf_driver,     & ! Procedure(s)
     144             :         ADG2_pdf_driver,     &
     145             :         Luhar_3D_pdf_driver
     146             : 
     147             :     use new_tsdadg_pdf, only: &
     148             :         tsdadg_pdf_driver    ! Procedure(s)
     149             : 
     150             :     use LY93_pdf, only: &
     151             :         LY93_driver    ! Procedure(s)
     152             : 
     153             :     use pdf_utilities, only: &
     154             :         calc_comp_corrs_binormal, & ! Procedure(s)
     155             :         calc_corr_chi_x,          &
     156             :         calc_corr_eta_x
     157             : 
     158             :     use array_index, only: &
     159             :         l_mix_rat_hm  ! Variable(s)
     160             : 
     161             :     use model_flags, only: &
     162             :         l_explicit_turbulent_adv_xpyp ! Variable(s)
     163             : 
     164             :     use numerical_check, only:  & 
     165             :         pdf_closure_check ! Procedure(s)
     166             : 
     167             :     use saturation, only:  & 
     168             :         sat_mixrat_liq, & ! Procedure(s)
     169             :         sat_mixrat_ice
     170             : 
     171             :     use clubb_precision, only: &
     172             :         core_rknd ! Variable(s)
     173             : 
     174             :     use error_code, only: &
     175             :         clubb_at_least_debug_level,  & ! Procedure
     176             :         err_code,                    & ! Error Indicator
     177             :         clubb_fatal_error              ! Constant
     178             : 
     179             :     use stats_variables, only: &
     180             :         stats_metadata_type
     181             : 
     182             :     implicit none
     183             : 
     184             :     !----------------------------- Input Variables -----------------------------
     185             :     integer, intent(in) :: &
     186             :       hydromet_dim, & ! Number of hydrometeor species              [#]
     187             :       nz, &
     188             :       ngrdcol
     189             : 
     190             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  & 
     191             :       p_in_Pa,     & ! Pressure                                   [Pa]
     192             :       exner,       & ! Exner function                             [-]
     193             :       thv_ds,      & ! Dry, base-state theta_v (ref. th_l here)   [K]
     194             :       wm,          & ! mean w-wind component (vertical velocity)  [m/s] 
     195             :       wp2,         & ! w'^2                                       [m^2/s^2] 
     196             :       wp3,         & ! w'^3                                       [m^3/s^3]
     197             :       Skw,         & ! Skewness of w                              [-]
     198             :       Skthl_in,    & ! Skewness of thl                            [-]
     199             :       Skrt_in,     & ! Skewness of rt                             [-]
     200             :       Sku_in,      & ! Skewness of u                              [-]
     201             :       Skv_in,      & ! Skewness of v                              [-]
     202             :       rtm,         & ! Mean total water mixing ratio              [kg/kg]
     203             :       rtp2,        & ! r_t'^2                                     [(kg/kg)^2]
     204             :       wprtp,       & ! w'r_t'                                     [(kg/kg)(m/s)]
     205             :       thlm,        & ! Mean liquid water potential temperature    [K]
     206             :       thlp2,       & ! th_l'^2                                    [K^2]
     207             :       wpthlp,      & ! w'th_l'                                    [K(m/s)]
     208             :       rtpthlp        ! r_t'th_l'                                  [K(kg/kg)]
     209             : 
     210             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
     211             :       um,          & ! Grid-mean eastward wind     [m/s]
     212             :       up2,         & ! u'^2                        [(m/s)^2]
     213             :       upwp,        & ! u'w'                        [(m/s)^2]
     214             :       vm,          & ! Grid-mean northward wind    [m/s]
     215             :       vp2,         & ! v'^2                        [(m/s)^2]
     216             :       vpwp           ! v'w'                        [(m/s)^2]
     217             : 
     218             :     real( kind = core_rknd ), dimension(ngrdcol,nz, sclr_dim), intent(in) ::  & 
     219             :       sclrm,       & ! Mean passive scalar        [units vary]
     220             :       wpsclrp,     & ! w' sclr'                   [units vary]
     221             :       sclrp2,      & ! sclr'^2                    [units vary]
     222             :       sclrprtp,    & ! sclr' r_t'                 [units vary]
     223             :       sclrpthlp,   & ! sclr' th_l'                [units vary]
     224             :       Sksclr_in      ! Skewness of sclr           [-]
     225             : 
     226             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
     227             :       gamma_Skw_fnc    ! Gamma as a function of skewness            [-]
     228             : 
     229             : #ifdef  GFDL
     230             :     ! critial relative humidity for nucleation
     231             :     real( kind = core_rknd ), dimension(ngrdcol, nz, min(1,sclr_dim), 2 ), intent(in) ::  & ! h1g, 2010-06-15
     232             :        RH_crit     ! critical relative humidity for droplet and ice nucleation
     233             : ! ---> h1g, 2012-06-14
     234             :     logical, intent(in)                 ::  do_liquid_only_in_clubb
     235             : ! <--- h1g, 2012-06-14
     236             : #endif
     237             : 
     238             :     real( kind = core_rknd ), dimension(ngrdcol,nz,hydromet_dim), intent(in) :: &
     239             :       wphydrometp, & ! Covariance of w and a hydrometeor    [(m/s) <hm units>]
     240             :       wp2hmp,      & ! Third-order moment:  < w'^2 hm' >    [(m/s)^2 <hm units>]
     241             :       rtphmp,      & ! Covariance of rt and a hydrometeor   [(kg/kg) <hm units>]
     242             :       thlphmp        ! Covariance of thl and a hydrometeor  [K <hm units>]
     243             : 
     244             :     real( kind = core_rknd ), dimension(nparams), intent(in) :: &
     245             :       clubb_params    ! Array of CLUBB's tunable parameters    [units vary]
     246             : 
     247             :     integer, intent(in) :: &
     248             :       iiPDF_type    ! Selected option for the two-component normal (double
     249             :                     ! Gaussian) PDF type to use for the w, rt, and theta-l (or
     250             :                     ! w, chi, and eta) portion of CLUBB's multivariate,
     251             :                     ! two-component PDF.
     252             : 
     253             :     type (stats_metadata_type), intent(in) :: &
     254             :       stats_metadata
     255             : 
     256             :     !----------------------------- InOut Variables -----------------------------
     257             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
     258             :       ! If iiPDF_type == iiPDF_ADG2, this gets overwritten. Therefore,
     259             :       ! intent(inout). Otherwise it should be intent(in)
     260             :       sigma_sqd_w   ! Width of individual w plumes               [-]
     261             : 
     262             :     type(pdf_parameter), intent(inout) :: & 
     263             :       pdf_params     ! pdf paramters         [units vary]
     264             : 
     265             :     type(implicit_coefs_terms), intent(inout) :: &
     266             :       pdf_implicit_coefs_terms    ! Implicit coefs / explicit terms [units vary]
     267             : 
     268             :     !----------------------------- Output Variables -----------------------------
     269             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  & 
     270             :       wpup2,                 & ! w'u'^2                     [m^3/s^3]
     271             :       wpvp2,                 & ! w'v'^2                     [m^3/s^3]
     272             :       wp2up2,                & ! w'^2u'^2                   [m^2/s^4]
     273             :       wp2vp2,                & ! w'^2v'^2                   [m^2/s^4]
     274             :       wp4,                   & ! w'^4                       [m^4/s^4]
     275             :       wprtp2,                & ! w' r_t'                    [(m kg)/(s kg)]
     276             :       wp2rtp,                & ! w'^2 r_t'                  [(m^2 kg)/(s^2 kg)]
     277             :       wpthlp2,               & ! w' th_l'^2                 [(m K^2)/s]
     278             :       wp2thlp,               & ! w'^2 th_l'                 [(m^2 K)/s^2]
     279             :       cloud_frac,            & ! Cloud fraction             [-]
     280             :       ice_supersat_frac,     & ! Ice cloud fracion          [-]
     281             :       rcm,                   & ! Mean liquid water          [kg/kg]
     282             :       wpthvp,                & ! Buoyancy flux              [(K m)/s] 
     283             :       wp2thvp,               & ! w'^2 th_v'                 [(m^2 K)/s^2]
     284             :       rtpthvp,               & ! r_t' th_v'                 [(kg K)/kg]
     285             :       thlpthvp,              & ! th_l' th_v'                [K^2]
     286             :       wprcp,                 & ! w' r_c'                    [(m kg)/(s kg)]
     287             :       wp2rcp,                & ! w'^2 r_c'                  [(m^2 kg)/(s^2 kg)]
     288             :       rtprcp,                & ! r_t' r_c'                  [(kg^2)/(kg^2)]
     289             :       thlprcp,               & ! th_l' r_c'                 [(K kg)/kg]
     290             :       rcp2,                  & ! r_c'^2                     [(kg^2)/(kg^2)]
     291             :       wprtpthlp,             & ! w' r_t' th_l'              [(m kg K)/(s kg)]
     292             :       w_up_in_cloud,         & ! cloudy updraft vel         [m/s]
     293             :       w_down_in_cloud,       & ! cloudy downdraft vel       [m/s]
     294             :       cloudy_updraft_frac,   & ! cloudy updraft fraction    [-]
     295             :       cloudy_downdraft_frac    ! cloudy downdraft fraction  [-]
     296             : 
     297             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  &
     298             :       uprcp,              & ! u' r_c'               [(m kg)/(s kg)]
     299             :       vprcp                 ! v' r_c'               [(m kg)/(s kg)]
     300             : 
     301             :     ! Parameters output only for recording statistics (new PDF).
     302             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
     303             :       F_w,   & ! Parameter for the spread of the PDF component means of w    [-]
     304             :       F_rt,  & ! Parameter for the spread of the PDF component means of rt   [-]
     305             :       F_thl    ! Parameter for the spread of the PDF component means of thl  [-]
     306             : 
     307             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
     308             :       min_F_w,   & ! Minimum allowable value of parameter F_w      [-]
     309             :       max_F_w,   & ! Maximum allowable value of parameter F_w      [-]
     310             :       min_F_rt,  & ! Minimum allowable value of parameter F_rt     [-]
     311             :       max_F_rt,  & ! Maximum allowable value of parameter F_rt     [-]
     312             :       min_F_thl, & ! Minimum allowable value of parameter F_thl    [-]
     313             :       max_F_thl    ! Maximum allowable value of parameter F_thl    [-]
     314             : 
     315             :     ! Output (passive scalar variables)
     316             :     real( kind = core_rknd ), intent(out), dimension(ngrdcol,nz,sclr_dim) ::  & 
     317             :       sclrpthvp, & 
     318             :       sclrprcp, & 
     319             :       wpsclrp2, & 
     320             :       wpsclrprtp, & 
     321             :       wpsclrpthlp, & 
     322             :       wp2sclrp
     323             : 
     324             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
     325             :       rc_coef    ! Coefficient on X'r_c' in X'th_v' equation    [K/(kg/kg)]
     326             : 
     327             :     !----------------------------- Local Variables -----------------------------
     328             : 
     329             :     ! Variables that are stored in derived data type pdf_params.
     330             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  &
     331     1411776 :       u_1,           & ! Mean of eastward wind (1st PDF component)         [m/s]
     332     1411776 :       u_2,           & ! Mean of eastward wind (2nd PDF component)         [m/s]
     333     1411776 :       varnce_u_1,    & ! Variance of u (1st PDF component)             [m^2/s^2]
     334     1411776 :       varnce_u_2,    & ! Variance of u (2nd PDF component)             [m^2/s^2]
     335     1411776 :       v_1,           & ! Mean of northward wind (1st PDF component)        [m/s]
     336     1411776 :       v_2,           & ! Mean of northward wind (2nd PDF component)        [m/s]
     337     1411776 :       varnce_v_1,    & ! Variance of v (1st PDF component)             [m^2/s^2]
     338     1411776 :       varnce_v_2,    & ! Variance of v (2nd PDF component)             [m^2/s^2]
     339     1411776 :       alpha_u,       & ! Factor relating to normalized variance for u        [-]
     340     1411776 :       alpha_v          ! Factor relating to normalized variance for v        [-]
     341             : 
     342             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     343     1411776 :       corr_u_w_1,      & ! Correlation of u and w   (1st PDF component)      [-]
     344     1411776 :       corr_u_w_2,      & ! Correlation of u and w   (2nd PDF component)      [-]
     345     1411776 :       corr_v_w_1,      & ! Correlation of v and w   (1st PDF component)      [-]
     346     1411776 :       corr_v_w_2         ! Correlation of v and w   (2nd PDF component)      [-]
     347             : 
     348             :     ! Note:  alpha coefficients = 0.5 * ( 1 - correlations^2 ).
     349             :     !        These are used to calculate the scalar widths
     350             :     !        varnce_thl_1, varnce_thl_2, varnce_rt_1, and varnce_rt_2 as in
     351             :     !        Eq. (34) of Larson and Golaz (2005)
     352             : 
     353             :     ! Passive scalar local variables
     354             : 
     355             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) ::  & 
     356     1411776 :       sclr1, sclr2,  &
     357     1411776 :       varnce_sclr1, varnce_sclr2, & 
     358     1411776 :       alpha_sclr,  & 
     359     1411776 :       corr_sclr_thl_1, corr_sclr_thl_2, &
     360     1411776 :       corr_sclr_rt_1, corr_sclr_rt_2, &
     361     1411776 :       corr_w_sclr_1, corr_w_sclr_2
     362             : 
     363             :     logical :: &
     364             :       l_scalar_calc, &  ! True if sclr_dim > 0
     365             :       l_calc_ice_supersat_frac ! True if we should calculate ice_supersat_frac
     366             : 
     367             :     ! Quantities needed to predict higher order moments
     368             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  & 
     369     1411776 :       tl1, tl2
     370             : 
     371             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     372     1411776 :       sqrt_wp2, & ! Square root of wp2          [m/s]
     373     1411776 :       Skthl,    & ! Skewness of thl             [-]
     374     1411776 :       Skrt,     & ! Skewness of rt              [-]
     375     1411776 :       Sku,      & ! Skewness of u               [-]
     376     1411776 :       Skv         ! Skewness of v               [-]
     377             : 
     378             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
     379     1411776 :       Sksclr      ! Skewness of rt              [-]
     380             : 
     381             :     ! Thermodynamic quantity
     382             : 
     383             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     384     1411776 :       wprcp_contrib_comp_1,   & ! <w'rc'> contrib. (1st PDF comp.)  [m/s(kg/kg)]
     385     1411776 :       wprcp_contrib_comp_2,   & ! <w'rc'> contrib. (2nd PDF comp.)  [m/s(kg/kg)]
     386     1411776 :       wp2rcp_contrib_comp_1,  & ! <w'^2rc'> contrib. (1st comp) [m^2/s^2(kg/kg)]
     387     1411776 :       wp2rcp_contrib_comp_2,  & ! <w'^2rc'> contrib. (2nd comp) [m^2/s^2(kg/kg)]
     388     1411776 :       rtprcp_contrib_comp_1,  & ! <rt'rc'> contrib. (1st PDF comp.)  [kg^2/kg^2]
     389     1411776 :       rtprcp_contrib_comp_2,  & ! <rt'rc'> contrib. (2nd PDF comp.)  [kg^2/kg^2]
     390     1411776 :       thlprcp_contrib_comp_1, & ! <thl'rc'> contrib. (1st PDF comp.)  [K(kg/kg)]
     391     1411776 :       thlprcp_contrib_comp_2, & ! <thl'rc'> contrib. (2nd PDF comp.)  [K(kg/kg)]
     392     1411776 :       uprcp_contrib_comp_1,   & ! <u'rc'> contrib. (1st PDF comp.)  [m/s(kg/kg)]
     393     1411776 :       uprcp_contrib_comp_2,   & ! <u'rc'> contrib. (2nd PDF comp.)  [m/s(kg/kg)]
     394     1411776 :       vprcp_contrib_comp_1,   & ! <v'rc'> contrib. (1st PDF comp.)  [m/s(kg/kg)]
     395     1411776 :       vprcp_contrib_comp_2      ! <v'rc'> contrib. (2nd PDF comp.)  [m/s(kg/kg)]
     396             : 
     397             :     ! variables for computing ice cloud fraction
     398             :     real( kind = core_rknd), dimension(ngrdcol,nz) :: &
     399     1411776 :       rc_1_ice, rc_2_ice
     400             :     
     401             :     ! To test pdf parameters
     402             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  &
     403     1411776 :       wm_clubb_pdf,    &
     404     1411776 :       rtm_clubb_pdf,   &
     405     1411776 :       thlm_clubb_pdf,  &
     406     1411776 :       wp2_clubb_pdf,   &
     407     1411776 :       rtp2_clubb_pdf,  &
     408     1411776 :       thlp2_clubb_pdf, &
     409     1411776 :       wp3_clubb_pdf,   &
     410     1411776 :       rtp3_clubb_pdf,  &
     411     1411776 :       thlp3_clubb_pdf, &
     412     1411776 :       Skw_clubb_pdf,   &
     413     1411776 :       Skrt_clubb_pdf,  &
     414     1411776 :       Skthl_clubb_pdf, &
     415     1411776 :       rsatl_1, &
     416     1411776 :       rsatl_2
     417             : 
     418             :     real( kind = core_rknd ) :: &
     419             :       beta,                         & ! CLUBB tunable parameter beta
     420             :       Skw_denom_coef,               & ! CLUBB tunable parameter Skw_denom_coef
     421             :       slope_coef_spread_DG_means_w, & ! CLUBB tunable parameter
     422             :       pdf_component_stdev_factor_w, & ! CLUBB tunable parameter
     423             :       coef_spread_DG_means_rt,      & ! CLUBB tunable parameter
     424             :       coef_spread_DG_means_thl        ! CLUBB tunable parameter
     425             : 
     426             :     logical, parameter :: &
     427             :       l_liq_ice_loading_test = .false. ! Temp. flag liq./ice water loading test
     428             : 
     429             :     integer :: k, i, j, hm_idx   ! Indices
     430             : 
     431             : #ifdef GFDL
     432             :     real ( kind = core_rknd ), parameter :: t1_combined = 273.16, &
     433             :                                             t2_combined = 268.16, &
     434             :                                             t3_combined = 238.16 
     435             : #endif
     436             : 
     437             :     !----------------------------- Begin Code -----------------------------
     438             : 
     439             :     !$acc enter data create( u_1, u_2, varnce_u_1, varnce_u_2, v_1, v_2, &
     440             :     !$acc                 varnce_v_1, varnce_v_2, alpha_u, alpha_v, &
     441             :     !$acc                 corr_u_w_1, corr_u_w_2, corr_v_w_1, corr_v_w_2, &
     442             :     !$acc                 tl1, tl2, sqrt_wp2, Skthl, &
     443             :     !$acc                 Skrt, Sku, Skv, wprcp_contrib_comp_1, wprcp_contrib_comp_2, &
     444             :     !$acc                 wp2rcp_contrib_comp_1, wp2rcp_contrib_comp_2, &
     445             :     !$acc                 rtprcp_contrib_comp_1, rtprcp_contrib_comp_2, &
     446             :     !$acc                 thlprcp_contrib_comp_1, thlprcp_contrib_comp_2, &
     447             :     !$acc                 uprcp_contrib_comp_1, uprcp_contrib_comp_2, &
     448             :     !$acc                 vprcp_contrib_comp_1, vprcp_contrib_comp_2, &
     449             :     !$acc                 rc_1_ice, rc_2_ice, rsatl_1, rsatl_2 )
     450             : 
     451             :     !$acc enter data if( sclr_dim > 0 ) &
     452             :     !$acc            create( sclr1, sclr2, varnce_sclr1, varnce_sclr2, & 
     453             :     !$acc                    alpha_sclr, corr_sclr_thl_1, corr_sclr_thl_2, &
     454             :     !$acc                    corr_sclr_rt_1, corr_sclr_rt_2, corr_w_sclr_1, &
     455             :     !$acc                    corr_w_sclr_2, Sksclr )
     456             : 
     457             :     ! Check whether the passive scalars are present.
     458      705888 :     if ( sclr_dim > 0 ) then
     459           0 :       l_scalar_calc = .true.
     460             :     else
     461      705888 :       l_scalar_calc = .false.
     462             :     end if
     463             : 
     464             :     ! Initialize to default values to prevent a runtime error
     465      705888 :     if ( ( iiPDF_type /= iiPDF_ADG1 ) .and. ( iiPDF_type /= iiPDF_ADG2 ) ) then
     466             :       
     467           0 :       do k = 1, nz
     468           0 :         do i = 1, ngrdcol
     469           0 :           pdf_params%alpha_thl(i,k) = one_half
     470           0 :           pdf_params%alpha_rt(i,k) = one_half
     471             :         end do
     472             :       end do
     473             :       
     474             :       ! This allows for skewness to be clipped locally without passing the updated
     475             :       ! value back out.
     476           0 :       do k = 1, nz
     477           0 :         do i = 1, ngrdcol
     478           0 :           Skrt(i,k) = Skrt_in(i,k)
     479           0 :           Skthl(i,k) = Skthl_in(i,k)
     480           0 :           Sku(i,k) = Sku_in(i,k)
     481           0 :           Skv(i,k) = Skv_in(i,k)
     482             :         end do
     483             :       end do
     484             :       
     485           0 :       do j = 1, sclr_dim
     486           0 :         do k = 1, nz
     487           0 :           do i = 1, ngrdcol
     488             :             
     489           0 :             Sksclr(i,k,j) = Sksclr_in(i,k,j)
     490             :             
     491           0 :             if ( l_scalar_calc ) then
     492           0 :                 alpha_sclr(i,k,j) = one_half
     493             :             end if
     494             :             
     495             :           end do
     496             :         end do
     497             :       end do
     498             : 
     499             :     end if
     500             : 
     501             :     ! Initialize to 0 to prevent a runtime error
     502      705888 :     if ( iiPDF_type /= iiPDF_new .and. iiPDF_type /= iiPDF_new_hybrid ) then
     503             :       ! Stats only variables, setting to zero
     504    60706368 :       do k = 1, nz
     505  1002574368 :         do i = 1, ngrdcol
     506   941868000 :           F_w(i,k) = zero
     507   941868000 :           F_rt(i,k) = zero
     508   941868000 :           F_thl(i,k) = zero
     509   941868000 :           min_F_w(i,k) = zero
     510   941868000 :           max_F_w(i,k) = zero
     511   941868000 :           min_F_rt(i,k) = zero
     512   941868000 :           max_F_rt(i,k) = zero
     513   941868000 :           min_F_thl(i,k) = zero
     514  1001868480 :           max_F_thl(i,k) = zero
     515             :         end do
     516             :       end do
     517             :     end if
     518             : 
     519             :     ! Unpack CLUBB's tunable parameters
     520      705888 :     if ( ( iiPDF_type == iiPDF_ADG1 ) .or. ( iiPDF_type == iiPDF_ADG2 ) ) then
     521      705888 :        beta = clubb_params(ibeta)
     522           0 :     elseif ( iiPDF_type == iiPDF_new ) then
     523           0 :        slope_coef_spread_DG_means_w = clubb_params(islope_coef_spread_DG_means_w)
     524           0 :        pdf_component_stdev_factor_w = clubb_params(ipdf_component_stdev_factor_w)
     525           0 :        coef_spread_DG_means_rt = clubb_params(icoef_spread_DG_means_rt)
     526           0 :        coef_spread_DG_means_thl = clubb_params(icoef_spread_DG_means_thl)
     527           0 :     elseif ( iiPDF_type == iiPDF_new_hybrid ) then
     528           0 :        slope_coef_spread_DG_means_w = clubb_params(islope_coef_spread_DG_means_w)
     529           0 :        pdf_component_stdev_factor_w = clubb_params(ipdf_component_stdev_factor_w)
     530             :     end if
     531             :       
     532             : 
     533             :     ! To avoid recomputing
     534             :     !$acc parallel loop gang vector collapse(2) default(present)
     535    60706368 :     do k = 1, nz
     536  1002574368 :       do i = 1, ngrdcol
     537  1001868480 :         sqrt_wp2(i,k) = sqrt( wp2(i,k) )
     538             :       end do
     539             :     end do
     540             :     !$acc end parallel loop
     541             : 
     542             :     ! Select the PDF closure method for the two-component PDF used by CLUBB for
     543             :     ! w, rt, theta-l, and passive scalar variables.
     544             :     ! Calculate the mixture fraction for the multivariate PDF, as well as both
     545             :     ! PDF component means and both PDF component variances for each of w, rt,
     546             :     ! theta-l, and passive scalar variables.
     547             :     if ( iiPDF_type == iiPDF_ADG1 ) then ! use ADG1
     548             :       
     549             :       call ADG1_pdf_driver( nz, ngrdcol,                                        & ! In
     550             :                             wm, rtm, thlm, um, vm,                              & ! In
     551             :                             wp2, rtp2, thlp2, up2, vp2,                         & ! In
     552             :                             Skw, wprtp, wpthlp, upwp, vpwp, sqrt_wp2,           & ! In
     553             :                             sigma_sqd_w, beta, mixt_frac_max_mag,               & ! In
     554             :                             sclrm, sclrp2, wpsclrp, l_scalar_calc,              & ! In
     555             :                             pdf_params%w_1, pdf_params%w_2,                     & ! Out
     556             :                             pdf_params%rt_1, pdf_params%rt_2,                   & ! Out
     557             :                             pdf_params%thl_1, pdf_params%thl_2,                 & ! Out
     558             :                             u_1, u_2, v_1, v_2,                                 & ! Out
     559             :                             pdf_params%varnce_w_1, pdf_params%varnce_w_2,       & ! Out
     560             :                             pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,     & ! Out
     561             :                             pdf_params%varnce_thl_1, pdf_params%varnce_thl_2,   & ! Out
     562             :                             varnce_u_1, varnce_u_2,                             & ! Out
     563             :                             varnce_v_1, varnce_v_2,                             & ! Out
     564             :                             pdf_params%mixt_frac,                               & ! Out
     565             :                             pdf_params%alpha_rt, pdf_params%alpha_thl,          & ! Out
     566             :                             alpha_u, alpha_v,                                   & ! Out
     567             :                             sclr1, sclr2, varnce_sclr1,                         & ! Out
     568      705888 :                             varnce_sclr2, alpha_sclr )                            ! Out
     569             :                             
     570             :     elseif ( iiPDF_type == iiPDF_ADG2 ) then ! use ADG2
     571             :       
     572             :       call ADG2_pdf_driver( nz, ngrdcol,                                      & ! In
     573             :                             wm, rtm, thlm, wp2, rtp2, thlp2,                  & ! In
     574             :                             Skw, wprtp, wpthlp, sqrt_wp2, beta,               & ! In
     575             :                             sclrm, sclrp2, wpsclrp, l_scalar_calc,            & ! In
     576             :                             pdf_params%w_1, pdf_params%w_2,                   & ! Out
     577             :                             pdf_params%rt_1, pdf_params%rt_2,                 & ! Out
     578             :                             pdf_params%thl_1, pdf_params%thl_2,               & ! Out
     579             :                             pdf_params%varnce_w_1, pdf_params%varnce_w_2,     & ! Out
     580             :                             pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,   & ! Out
     581             :                             pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, & ! Out
     582             :                             pdf_params%mixt_frac,                             & ! Out
     583             :                             pdf_params%alpha_rt, pdf_params%alpha_thl,        & ! Out
     584             :                             sigma_sqd_w, sclr1, sclr2,                        & ! Out
     585           0 :                             varnce_sclr1, varnce_sclr2, alpha_sclr )            ! Out
     586             :                             
     587             :     elseif ( iiPDF_type == iiPDF_3D_Luhar ) then ! use 3D Luhar
     588           0 :       do i = 1, ngrdcol
     589             :         call Luhar_3D_pdf_driver( nz, &
     590           0 :                            wm(i,:), rtm(i,:), thlm(i,:), wp2(i,:), rtp2(i,:), thlp2(i,:),                             & ! In
     591           0 :                            Skw(i,:), Skrt(i,:), Skthl(i,:), wprtp(i,:), wpthlp(i,:),                             & ! In
     592           0 :                            pdf_params%w_1(i,:), pdf_params%w_2(i,:),                    & ! Out
     593           0 :                            pdf_params%rt_1(i,:), pdf_params%rt_2(i,:),                  & ! Out
     594           0 :                            pdf_params%thl_1(i,:), pdf_params%thl_2(i,:),                & ! Out
     595           0 :                            pdf_params%varnce_w_1(i,:), pdf_params%varnce_w_2(i,:),      & ! Out
     596           0 :                            pdf_params%varnce_rt_1(i,:), pdf_params%varnce_rt_2(i,:),    & ! Out
     597           0 :                            pdf_params%varnce_thl_1(i,:), pdf_params%varnce_thl_2(i,:),  & ! Out
     598           0 :                            pdf_params%mixt_frac(i,:) )                                    ! Out
     599             :       end do
     600             :     elseif ( iiPDF_type == iiPDF_new ) then ! use new PDF
     601             :       call new_pdf_driver( nz, ngrdcol, wm, rtm, thlm, wp2, rtp2, thlp2, Skw, & ! In
     602             :                            wprtp, wpthlp, rtpthlp,                            & ! In
     603             :                            slope_coef_spread_DG_means_w,                      & ! In
     604             :                            pdf_component_stdev_factor_w,                      & ! In
     605             :                            coef_spread_DG_means_rt,                           & ! In
     606             :                            coef_spread_DG_means_thl,                          & ! In
     607             :                            Skrt, Skthl,                                       & ! In/Out
     608             :                            pdf_params%w_1, pdf_params%w_2,                    & ! Out
     609             :                            pdf_params%rt_1, pdf_params%rt_2,                  & ! Out
     610             :                            pdf_params%thl_1, pdf_params%thl_2,                & ! Out
     611             :                            pdf_params%varnce_w_1, pdf_params%varnce_w_2,      & ! Out
     612             :                            pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,    & ! Out
     613             :                            pdf_params%varnce_thl_1, pdf_params%varnce_thl_2,  & ! Out
     614             :                            pdf_params%mixt_frac,                              & ! Out
     615             :                            pdf_implicit_coefs_terms,                          & ! Out
     616             :                            F_w, F_rt, F_thl, min_F_w, max_F_w,                & ! Out
     617           0 :                            min_F_rt, max_F_rt, min_F_thl, max_F_thl )           ! Out
     618             :     elseif ( iiPDF_type == iiPDF_TSDADG ) then
     619           0 :       do i = 1, ngrdcol
     620             :         call tsdadg_pdf_driver( nz, &
     621           0 :                           wm(i,:), rtm(i,:), thlm(i,:), wp2(i,:), rtp2(i,:), thlp2(i,:),                                & ! In
     622           0 :                           Skw(i,:), Skrt(i,:), Skthl(i,:), wprtp(i,:), wpthlp(i,:),                                & ! In
     623           0 :                           pdf_params%w_1(i,:), pdf_params%w_2(i,:),                       & ! Out
     624           0 :                           pdf_params%rt_1(i,:), pdf_params%rt_2(i,:),                     & ! Out
     625           0 :                           pdf_params%thl_1(i,:), pdf_params%thl_2(i,:),                   & ! Out
     626           0 :                           pdf_params%varnce_w_1(i,:), pdf_params%varnce_w_2(i,:),         & ! Out
     627           0 :                           pdf_params%varnce_rt_1(i,:), pdf_params%varnce_rt_2(i,:),       & ! Out
     628           0 :                           pdf_params%varnce_thl_1(i,:), pdf_params%varnce_thl_2(i,:),     & ! Out
     629           0 :                           pdf_params%mixt_frac(i,:) )                                       ! Out
     630             :       end do
     631             :     elseif ( iiPDF_type == iiPDF_LY93 ) then ! use LY93
     632           0 :       do i = 1, ngrdcol
     633           0 :         call LY93_driver( nz, wm(i,:), rtm(i,:), thlm(i,:), wp2(i,:), rtp2(i,:),                          & ! In
     634           0 :                           thlp2(i,:), Skw(i,:), Skrt(i,:), Skthl(i,:),                           & ! In
     635           0 :                           pdf_params%w_1(i,:), pdf_params%w_2(i,:),                    & ! Out
     636           0 :                           pdf_params%rt_1(i,:), pdf_params%rt_2(i,:),                  & ! Out
     637           0 :                           pdf_params%thl_1(i,:), pdf_params%thl_2(i,:),                & ! Out
     638           0 :                           pdf_params%varnce_w_1(i,:), pdf_params%varnce_w_2(i,:),      & ! Out
     639           0 :                           pdf_params%varnce_rt_1(i,:), pdf_params%varnce_rt_2(i,:),    & ! Out
     640           0 :                           pdf_params%varnce_thl_1(i,:), pdf_params%varnce_thl_2(i,:),  & ! Out
     641           0 :                           pdf_params%mixt_frac(i,:) )                               ! Out
     642             :       end do
     643             :     elseif ( iiPDF_type == iiPDF_new_hybrid ) then ! use new hybrid PDF
     644             :       call new_hybrid_pdf_driver( nz, ngrdcol, wm, rtm, thlm, um, vm, & ! In
     645             :                                   wp2, rtp2, thlp2, up2, vp2,         & ! In
     646             :                                   Skw, wprtp, wpthlp, upwp, vpwp,     & ! In
     647             :                                   sclrm, sclrp2, wpsclrp,             & ! In
     648             :                                   gamma_Skw_fnc,                      & ! In
     649             :                                   slope_coef_spread_DG_means_w,       & ! In
     650             :                                   pdf_component_stdev_factor_w,       & ! In
     651             :                                   Skrt, Skthl, Sku, Skv, Sksclr,      & ! I/O
     652             :                                   pdf_params%w_1, pdf_params%w_2,     & ! Out
     653             :                                   pdf_params%rt_1, pdf_params%rt_2,   & ! Out
     654             :                                   pdf_params%thl_1, pdf_params%thl_2, & ! Out
     655             :                                   u_1, u_2, v_1, v_2,                 & ! Out
     656             :                                   pdf_params%varnce_w_1,              & ! Out
     657             :                                   pdf_params%varnce_w_2,              & ! Out
     658             :                                   pdf_params%varnce_rt_1,             & ! Out
     659             :                                   pdf_params%varnce_rt_2,             & ! Out
     660             :                                   pdf_params%varnce_thl_1,            & ! Out
     661             :                                   pdf_params%varnce_thl_2,            & ! Out
     662             :                                   varnce_u_1, varnce_u_2,             & ! Out
     663             :                                   varnce_v_1, varnce_v_2,             & ! Out
     664             :                                   sclr1, sclr2,                       & ! Out
     665             :                                   varnce_sclr1, varnce_sclr2,         & ! Out
     666             :                                   pdf_params%mixt_frac,               & ! Out
     667             :                                   pdf_implicit_coefs_terms,           & ! Out
     668           0 :                                   F_w, min_F_w, max_F_w )               ! Out
     669             :       
     670             :       ! The calculation of skewness of rt, thl, u, v, and scalars is hard-wired
     671             :       ! for use with the ADG1 code, which contains the variable sigma_sqd_w.
     672             :       ! In order to use an equivalent expression for these skewnesses using the
     673             :       ! new hybrid PDF (without doing more recoding), set the value of
     674             :       ! sigma_sqd_w to 1 - F_w.
     675           0 :       do k = 1, nz
     676           0 :         do i = 1, ngrdcol
     677           0 :           sigma_sqd_w(i,k) = one - F_w(i,k)
     678             :         end do
     679             :       end do
     680             : 
     681             :     end if ! iiPDF_type
     682             :     
     683             :     ! Calculate the PDF component correlations of rt and thl.
     684             :     call calc_comp_corrs_binormal( nz, ngrdcol,                                           & ! In
     685             :                                    rtpthlp, rtm, thlm,                                    & ! In
     686             :                                    pdf_params%rt_1, pdf_params%rt_2,                      & ! In
     687             :                                    pdf_params%thl_1, pdf_params%thl_2,                    & ! In
     688             :                                    pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,        & ! In
     689             :                                    pdf_params%varnce_thl_1, pdf_params%varnce_thl_2,      & ! In
     690             :                                    pdf_params%mixt_frac,                                  & ! In
     691      705888 :                                    pdf_params%corr_rt_thl_1, pdf_params%corr_rt_thl_2 )     ! Out
     692             : 
     693             :     if ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
     694      705888 :          .or. iiPDF_type == iiPDF_new_hybrid ) then
     695             : 
     696             :       ! These PDF types define corr_w_rt_1, corr_w_rt_2, corr_w_thl_1, and
     697             :       ! corr_w_thl_2 to all have a value of 0, so skip the calculation.
     698             :       ! The values of corr_u_w_1, corr_u_w_2, corr_v_w_1, and corr_v_w_2 are
     699             :       ! all defined to be 0, as well.
     700             :       !$acc parallel loop gang vector collapse(2) default(present)
     701    60706368 :       do k = 1, nz
     702  1002574368 :         do i = 1, ngrdcol
     703   941868000 :           pdf_params%corr_w_rt_1(i,k)  = zero
     704   941868000 :           pdf_params%corr_w_rt_2(i,k)  = zero
     705   941868000 :           pdf_params%corr_w_thl_1(i,k) = zero
     706   941868000 :           pdf_params%corr_w_thl_2(i,k) = zero
     707   941868000 :           corr_u_w_1(i,k)   = zero
     708   941868000 :           corr_u_w_2(i,k)   = zero
     709   941868000 :           corr_v_w_1(i,k)   = zero
     710  1001868480 :           corr_v_w_2(i,k)   = zero
     711             :         end do
     712             :       end do
     713             :       !$acc end parallel loop
     714             : 
     715             :     else
     716             : 
     717             :       ! Calculate the PDF component correlations of w and rt.
     718             :       call calc_comp_corrs_binormal( nz, ngrdcol,                                      & ! In
     719             :                                      wprtp, wm, rtm,                                   & ! In
     720             :                                      pdf_params%w_1, pdf_params%w_2,                   & ! In
     721             :                                      pdf_params%rt_1, pdf_params%rt_2,                 & ! In
     722             :                                      pdf_params%varnce_w_1, pdf_params%varnce_w_2,     & ! In
     723             :                                      pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,   & ! In
     724             :                                      pdf_params%mixt_frac,                             & ! In
     725           0 :                                      pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2 )    ! Out
     726             :             
     727             :       ! Calculate the PDF component correlations of w and thl.
     728             :       call calc_comp_corrs_binormal( nz, ngrdcol,                                          & ! In
     729             :                                      wpthlp, wm, thlm,                                     & ! In
     730             :                                      pdf_params%w_1, pdf_params%w_2,                       & ! In
     731             :                                      pdf_params%thl_1, pdf_params%thl_2,                   & ! In
     732             :                                      pdf_params%varnce_w_1, pdf_params%varnce_w_2,         & ! In
     733             :                                      pdf_params%varnce_thl_1, pdf_params%varnce_thl_2,     & ! In
     734             :                                      pdf_params%mixt_frac,                                 & ! In
     735           0 :                                      pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2 )      ! Out
     736             :     end if
     737             :       
     738      705888 :     if ( l_scalar_calc ) then
     739             : 
     740             :       ! Calculate the PDF component correlations of a passive scalar and thl.
     741           0 :       do j = 1, sclr_dim
     742             :         call calc_comp_corrs_binormal( nz, ngrdcol,                                       & ! In
     743             :                                        sclrpthlp(:,:,j), sclrm(:,:,j), thlm,              & ! In
     744             :                                        sclr1(:,:,j), sclr2(:,:,j),                        & ! In
     745             :                                        pdf_params%thl_1, pdf_params%thl_2,                & ! In
     746             :                                        varnce_sclr1(:,:,j), varnce_sclr2(:,:,j),          & ! In
     747             :                                        pdf_params%varnce_thl_1, pdf_params%varnce_thl_2,  & ! In
     748             :                                        pdf_params%mixt_frac,                              & ! In
     749           0 :                                        corr_sclr_thl_1(:,:,j), corr_sclr_thl_2(:,:,j) )     ! Out
     750             :       end do
     751             : 
     752             :       ! Calculate the PDF component correlations of a passive scalar and rt.
     753           0 :       do j = 1, sclr_dim
     754             :         call calc_comp_corrs_binormal( nz, ngrdcol,                                       & ! In
     755             :                                        sclrprtp(:,:,j), sclrm(:,:,j), rtm,                & ! In
     756             :                                        sclr1(:,:,j), sclr2(:,:,j),                        & ! In
     757             :                                        pdf_params%rt_1, pdf_params%rt_2,                  & ! In
     758             :                                        varnce_sclr1(:,:,j), varnce_sclr2(:,:,j),          & ! In
     759             :                                        pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,    & ! In
     760             :                                        pdf_params%mixt_frac,                              & ! In
     761           0 :                                        corr_sclr_rt_1(:,:,j), corr_sclr_rt_2(:,:,j) )       ! Out
     762             :       end do
     763             : 
     764             :       if ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
     765           0 :            .or. iiPDF_type == iiPDF_new_hybrid ) then
     766             : 
     767             :         ! These PDF types define all PDF component correlations involving w
     768             :         ! to have a value of 0, so skip the calculation.
     769             :         !$acc parallel loop gang vector collapse(2) default(present)
     770           0 :         do j = 1, sclr_dim
     771           0 :           do k = 1, nz
     772           0 :             do i = 1, ngrdcol
     773           0 :               corr_w_sclr_1(i,k,j) = zero
     774           0 :               corr_w_sclr_2(i,k,j) = zero
     775             :             end do
     776             :           end do
     777             :         end do
     778             :         !$acc end parallel loop
     779             : 
     780             :       else
     781             : 
     782             :         ! Calculate the PDF component correlations of w and a passive scalar.
     783           0 :         do j = 1, sclr_dim
     784             :           call calc_comp_corrs_binormal( nz, ngrdcol,                                   & ! In
     785             :                                          wpsclrp(:,:,j), wm, sclrm(:,:,j),              & ! In
     786             :                                          pdf_params%w_1, pdf_params%w_2,                & ! In
     787             :                                          sclr1(:,:,j), sclr2(:,:,j),                    & ! In
     788             :                                          pdf_params%varnce_w_1, pdf_params%varnce_w_2,  & ! In
     789             :                                          varnce_sclr1(:,:,j), varnce_sclr2(:,:,j),      & ! In
     790             :                                          pdf_params%mixt_frac,                          & ! In
     791           0 :                                          corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j) )     ! Out
     792             : 
     793             :         end do
     794             :         
     795             :       end if
     796             : 
     797             :     end if
     798             : 
     799             : 
     800             :     ! Compute higher order moments (these are interactive)
     801             :     call calc_wp2xp_pdf( nz, ngrdcol,                                       &
     802             :                          wm, rtm, pdf_params%w_1, pdf_params%w_2,           &
     803             :                          pdf_params%rt_1, pdf_params%rt_2,                  &
     804             :                          pdf_params%varnce_w_1, pdf_params%varnce_w_2,      &
     805             :                          pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,    &
     806             :                          pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2,    &
     807             :                          pdf_params%mixt_frac,                              &
     808      705888 :                          wp2rtp )
     809             : 
     810             :     call calc_wp2xp_pdf( nz, ngrdcol,                                          &
     811             :                          wm, thlm, pdf_params%w_1, pdf_params%w_2,             &
     812             :                          pdf_params%thl_1, pdf_params%thl_2,                   &
     813             :                          pdf_params%varnce_w_1, pdf_params%varnce_w_2,         &
     814             :                          pdf_params%varnce_thl_1, pdf_params%varnce_thl_2,     &
     815             :                          pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2,     &
     816             :                          pdf_params%mixt_frac,                                 &
     817      705888 :                          wp2thlp )
     818             :     
     819             :     ! Compute higher order moments (these may be interactive)
     820             :     call calc_wpxp2_pdf( nz, ngrdcol, &
     821             :                          wm, um, pdf_params%w_1, pdf_params%w_2, &
     822             :                          u_1, u_2, &
     823             :                          pdf_params%varnce_w_1, pdf_params%varnce_w_2,   &
     824             :                          varnce_u_1, varnce_u_2, &
     825             :                          corr_u_w_1, corr_u_w_2, &
     826             :                          pdf_params%mixt_frac, &
     827      705888 :                          wpup2 )
     828             :                          
     829             :     call calc_wpxp2_pdf( nz, ngrdcol, &
     830             :                          wm, vm, pdf_params%w_1, pdf_params%w_2, &
     831             :                          v_1, v_2, &
     832             :                          pdf_params%varnce_w_1, pdf_params%varnce_w_2,   &
     833             :                          varnce_v_1, varnce_v_2, &
     834             :                          corr_v_w_1, corr_v_w_2, &
     835             :                          pdf_params%mixt_frac, &
     836      705888 :                          wpvp2 )
     837             :     
     838             :     call calc_wp2xp2_pdf( nz, ngrdcol, &
     839             :                           wm, um, pdf_params%w_1, pdf_params%w_2, &
     840             :                           u_1, u_2, &
     841             :                           pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
     842             :                           varnce_u_1, varnce_u_2, &
     843             :                           corr_u_w_1, corr_u_w_2, &
     844             :                           pdf_params%mixt_frac, &
     845      705888 :                           wp2up2 )
     846             : 
     847             :     call calc_wp2xp2_pdf( nz, ngrdcol, &
     848             :                           wm, vm, pdf_params%w_1, pdf_params%w_2, &
     849             :                           v_1, v_2, &
     850             :                           pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
     851             :                           varnce_v_1, varnce_v_2, &
     852             :                           corr_v_w_1, corr_v_w_2, &
     853             :                           pdf_params%mixt_frac, &
     854      705888 :                           wp2vp2 )
     855             :                           
     856             :     call calc_wp4_pdf( nz, ngrdcol, &
     857             :                        wm, pdf_params%w_1, pdf_params%w_2, &
     858             :                        pdf_params%varnce_w_1, pdf_params%varnce_w_2,    &
     859             :                        pdf_params%mixt_frac, &
     860      705888 :                        wp4 )
     861             : 
     862      705888 :     if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwprtp2 > 0 ) then
     863             :       call calc_wpxp2_pdf( nz, ngrdcol, &
     864             :                            wm, rtm, pdf_params%w_1, pdf_params%w_2,        &
     865             :                            pdf_params%rt_1, pdf_params%rt_2,               &
     866             :                            pdf_params%varnce_w_1, pdf_params%varnce_w_2,   &
     867             :                            pdf_params%varnce_rt_1, pdf_params%varnce_rt_2, &
     868             :                            pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2, &
     869             :                            pdf_params%mixt_frac, &
     870           0 :                            wprtp2 )
     871             :     end if
     872             : 
     873      705888 :     if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwpthlp2 > 0 ) then
     874             :       call calc_wpxp2_pdf( nz, ngrdcol, &
     875             :                            wm, thlm, pdf_params%w_1, pdf_params%w_2,          &
     876             :                            pdf_params%thl_1, pdf_params%thl_2,                &
     877             :                            pdf_params%varnce_w_1, pdf_params%varnce_w_2,      &
     878             :                            pdf_params%varnce_thl_1, pdf_params%varnce_thl_2,  &
     879             :                            pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2,  &
     880             :                            pdf_params%mixt_frac, &
     881           0 :                            wpthlp2 )
     882             :     end if
     883             : 
     884      705888 :     if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwprtpthlp > 0 ) then
     885             :       
     886             :       call calc_wpxpyp_pdf( nz, ngrdcol, &
     887             :                             wm, rtm, thlm, pdf_params%w_1, pdf_params%w_2,      &
     888             :                             pdf_params%rt_1, pdf_params%rt_2,                   &
     889             :                             pdf_params%thl_1, pdf_params%thl_2,                 &
     890             :                             pdf_params%varnce_w_1, pdf_params%varnce_w_2,       &
     891             :                             pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,     &
     892             :                             pdf_params%varnce_thl_1, pdf_params%varnce_thl_2,   &
     893             :                             pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2,     &
     894             :                             pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2,   &
     895             :                             pdf_params%corr_rt_thl_1, pdf_params%corr_rt_thl_2, &
     896             :                             pdf_params%mixt_frac, &
     897           0 :                             wprtpthlp )
     898             :     end if
     899             : 
     900             : 
     901             :     ! Scalar Addition to higher order moments
     902      705888 :     if ( l_scalar_calc ) then
     903             : 
     904           0 :       do j = 1, sclr_dim
     905             :         call calc_wp2xp_pdf( nz, ngrdcol,                                       &
     906             :                              wm, sclrm(:,:,j), pdf_params%w_1, pdf_params%w_2,  &
     907             :                              sclr1(:,:,j), sclr2(:,:,j),                        &
     908             :                              pdf_params%varnce_w_1, pdf_params%varnce_w_2,      &
     909             :                              varnce_sclr1(:,:,j), varnce_sclr2(:,:,j),          &
     910             :                              corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j),        &
     911             :                              pdf_params%mixt_frac,                              &
     912           0 :                              wp2sclrp(:,:,j) )
     913             :       end do
     914             :       
     915           0 :       do j = 1, sclr_dim 
     916             :         call calc_wpxp2_pdf( nz, ngrdcol, &
     917             :                              wm, sclrm(:,:,j), pdf_params%w_1, pdf_params%w_2, &
     918             :                              sclr1(:,:,j), sclr2(:,:,j),                         &
     919             :                              pdf_params%varnce_w_1, pdf_params%varnce_w_2,   &
     920             :                              varnce_sclr1(:,:,j), varnce_sclr2(:,:,j),           &
     921             :                              corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j),         &
     922             :                              pdf_params%mixt_frac, &
     923           0 :                              wpsclrp2(:,:,j) )
     924             :       end do
     925             :        
     926           0 :       do j = 1, sclr_dim
     927             :         call calc_wpxpyp_pdf( nz, ngrdcol, &
     928             :                               wm, sclrm(:,:,j), rtm, pdf_params%w_1, pdf_params%w_2,  &
     929             :                               sclr1(:,:,j), sclr2(:,:,j),                             &
     930             :                               pdf_params%rt_1, pdf_params%rt_2,                       &
     931             :                               pdf_params%varnce_w_1, pdf_params%varnce_w_2,           &
     932             :                               varnce_sclr1(:,:,j), varnce_sclr2(:,:,j),               &
     933             :                               pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,         &
     934             :                               corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j),             &
     935             :                               pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2,         &
     936             :                               corr_sclr_rt_1(:,:,j), corr_sclr_rt_2(:,:,j),           &
     937             :                               pdf_params%mixt_frac, &
     938           0 :                               wpsclrprtp(:,:,j) )
     939             :       end do
     940             :         
     941           0 :       do j = 1, sclr_dim
     942             :         call calc_wpxpyp_pdf( nz, ngrdcol, &
     943             :                               wm, sclrm(:,:,j), thlm, pdf_params%w_1, pdf_params%w_2,   &
     944             :                               sclr1(:,:,j), sclr2(:,:,j),                               &
     945             :                               pdf_params%thl_1, pdf_params%thl_2,                       &
     946             :                               pdf_params%varnce_w_1, pdf_params%varnce_w_2,             &
     947             :                               varnce_sclr1(:,:,j), varnce_sclr2(:,:,j),                 &
     948             :                               pdf_params%varnce_thl_1, pdf_params%varnce_thl_2,         &
     949             :                               corr_w_sclr_1(:,:,j), corr_w_sclr_2(:,:,j),               &
     950             :                               pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2,         &
     951             :                               corr_sclr_thl_1(:,:,j), corr_sclr_thl_2(:,:,j),           &
     952             :                               pdf_params%mixt_frac, &
     953           0 :                               wpsclrpthlp(:,:,j) )
     954             :       end do
     955             :       
     956             :     end if
     957             : 
     958             :     ! Compute higher order moments that include theta_v.
     959             : 
     960             :     ! First compute some preliminary quantities.
     961             :     ! "1" denotes first Gaussian; "2" denotes 2nd Gaussian
     962             :     ! liq water temp (Sommeria & Deardorff 1977 (SD), eqn. 3)
     963             :     !$acc parallel loop gang vector collapse(2) default(present)
     964    60706368 :     do k = 1, nz
     965  1002574368 :       do i = 1, ngrdcol
     966   941868000 :         tl1(i,k)  = pdf_params%thl_1(i,k)*exner(i,k)
     967  1001868480 :         tl2(i,k)  = pdf_params%thl_2(i,k)*exner(i,k)
     968             :       end do
     969             :     end do
     970             :     !$acc end parallel loop
     971             : 
     972             : #ifdef GFDL
     973             :     if ( sclr_dim > 0  .and.  (.not. do_liquid_only_in_clubb) ) then ! h1g, 2010-06-16 begin mod
     974             : 
     975             :       do i = 1, ngrdcol
     976             :         where ( tl1(i,:) > t1_combined )
     977             :           pdf_params%rsatl_1(i,:) = sat_mixrat_liq( nz, p_in_Pa(i,:), tl1(i,:) )
     978             :         elsewhere ( tl1(i,:) > t2_combined )
     979             :           pdf_params%rsatl_1(i,:) = sat_mixrat_liq( nz, p_in_Pa(i,:), tl1(i,:) ) &
     980             :                     * (tl1(i,:) - t2_combined)/(t1_combined - t2_combined) &
     981             :                     + sat_mixrat_ice( nz, p_in_Pa(i,:), tl1(i,:) ) &
     982             :                       * (t1_combined - tl1(i,:))/(t1_combined - t2_combined)
     983             :         elsewhere ( tl1(i,:) > t3_combined )
     984             :           pdf_params%rsatl_1(i,:) = sat_mixrat_ice( nz, p_in_Pa(i,:), tl1(i,:) ) &
     985             :                     + sat_mixrat_ice( nz, p_in_Pa(i,:), tl1(i,:) ) * (RH_crit(i, :, 1, 1) -one ) &
     986             :                       * ( t2_combined -tl1(i,:))/(t2_combined - t3_combined)
     987             :         elsewhere
     988             :           pdf_params%rsatl_1(i,:) = sat_mixrat_ice( nz, p_in_Pa(i,:), tl1(i,:) ) * RH_crit(i, :, 1, 1)
     989             :         endwhere
     990             : 
     991             :         where ( tl2(i,:) > t1_combined )
     992             :           pdf_params%rsatl_2(i,:) = sat_mixrat_liq( nz, p_in_Pa(i,:), tl2(i,:) )
     993             :         elsewhere ( tl2(i,:) > t2_combined )
     994             :           pdf_params%rsatl_2(i,:) = sat_mixrat_liq( nz, p_in_Pa(i,:), tl2(i,:) ) &
     995             :                     * (tl2(i,:) - t2_combined)/(t1_combined - t2_combined) &
     996             :                     + sat_mixrat_ice( nz, p_in_Pa(i,:), tl2(i,:) ) &
     997             :                       * (t1_combined - tl2(i,:))/(t1_combined - t2_combined)
     998             :         elsewhere ( tl2(i,:) > t3_combined )
     999             :           pdf_params%rsatl_2(i,:) = sat_mixrat_ice( nz, p_in_Pa(i,:), tl2(i,:) ) &
    1000             :                     + sat_mixrat_ice( nz, p_in_Pa(i,:), tl2(i,:) )* (RH_crit(i, :, 1, 2) -one) &
    1001             :                       * ( t2_combined -tl2(i,:))/(t2_combined - t3_combined)
    1002             :         elsewhere
    1003             :           pdf_params%rsatl_2(i,:) = sat_mixrat_ice( nz, p_in_Pa(i,:), tl2(i,:) ) * RH_crit(i, :, 1, 2)
    1004             :         endwhere
    1005             :         
    1006             :       end do
    1007             : 
    1008             :     else ! sclr_dim <= 0  or  do_liquid_only_in_clubb = .T.
    1009             : 
    1010             :       pdf_params%rsatl_1 = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, tl1 )
    1011             :       pdf_params%rsatl_2 = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, tl2 )
    1012             : 
    1013             :     end if !sclr_dim > 0
    1014             :       
    1015             :     ! Determine whether to compute ice_supersat_frac. We do not compute
    1016             :     ! ice_supersat_frac for GFDL (unless do_liquid_only_in_clubb is true),
    1017             :     ! because liquid and ice are both fed into rtm, ruining the calculation.
    1018             :     if (do_liquid_only_in_clubb) then
    1019             :       l_calc_ice_supersat_frac = .true.
    1020             :     else
    1021             :       l_calc_ice_supersat_frac = .false.
    1022             :     end if
    1023             : 
    1024             : #else
    1025      705888 :     rsatl_1 = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, tl1 )
    1026      705888 :     rsatl_2 = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, tl2 ) ! h1g, 2010-06-16 end mod
    1027             : 
    1028             :     !$acc parallel loop gang vector collapse(2) default(present)
    1029    60706368 :     do k = 1, nz
    1030  1002574368 :       do i = 1, ngrdcol
    1031   941868000 :         pdf_params%rsatl_1(i,k) = rsatl_1(i,k)
    1032  1001868480 :         pdf_params%rsatl_2(i,k) = rsatl_2(i,k)
    1033             :       end do
    1034             :     end do
    1035             :     !$acc end parallel loop
    1036             : 
    1037      705888 :     l_calc_ice_supersat_frac = .true.
    1038             : #endif
    1039             : 
    1040             :     call transform_pdf_chi_eta_component( nz, ngrdcol, &
    1041             :                                           tl1, pdf_params%rsatl_1, pdf_params%rt_1, exner,  & ! In
    1042             :                                           pdf_params%varnce_thl_1, pdf_params%varnce_rt_1,  & ! In
    1043             :                                           pdf_params%corr_rt_thl_1, pdf_params%chi_1,       & ! In
    1044             :                                           pdf_params%crt_1, pdf_params%cthl_1,              & ! Out
    1045             :                                           pdf_params%stdev_chi_1, pdf_params%stdev_eta_1,   & ! Out
    1046             :                                           pdf_params%covar_chi_eta_1,                       & ! Out
    1047      705888 :                                           pdf_params%corr_chi_eta_1 )                         ! Out
    1048             :     
    1049             :       
    1050             :     ! Calculate cloud fraction component for pdf 1
    1051             :     call calc_liquid_cloud_frac_component( nz, ngrdcol, &
    1052             :                                            pdf_params%chi_1, pdf_params%stdev_chi_1,    & ! In
    1053      705888 :                                            pdf_params%cloud_frac_1, pdf_params%rc_1 )     ! Out
    1054             : 
    1055             :     ! Calc ice_supersat_frac
    1056             :     if ( l_calc_ice_supersat_frac ) then
    1057             : 
    1058             :       call calc_ice_cloud_frac_component( nz, ngrdcol, &
    1059             :                                           pdf_params%chi_1, pdf_params%stdev_chi_1, &
    1060             :                                           pdf_params%rc_1, pdf_params%cloud_frac_1, &
    1061             :                                           p_in_Pa, tl1, &
    1062             :                                           pdf_params%rsatl_1, pdf_params%crt_1, &
    1063      705888 :                                           pdf_params%ice_supersat_frac_1, rc_1_ice )
    1064             :     end if
    1065             : 
    1066             :     call transform_pdf_chi_eta_component( nz, ngrdcol, &
    1067             :                                           tl2, pdf_params%rsatl_2, pdf_params%rt_2, exner,  & ! In
    1068             :                                           pdf_params%varnce_thl_2, pdf_params%varnce_rt_2,  & ! In
    1069             :                                           pdf_params%corr_rt_thl_2, pdf_params%chi_2,       & ! In
    1070             :                                           pdf_params%crt_2, pdf_params%cthl_2,              & ! Out
    1071             :                                           pdf_params%stdev_chi_2, pdf_params%stdev_eta_2,   & ! Out
    1072             :                                           pdf_params%covar_chi_eta_2,                       & ! Out
    1073      705888 :                                           pdf_params%corr_chi_eta_2 )                         ! Out
    1074             : 
    1075             :       
    1076             :     ! Calculate cloud fraction component for pdf 2
    1077             :     call calc_liquid_cloud_frac_component( nz, ngrdcol, &
    1078             :                                            pdf_params%chi_2, pdf_params%stdev_chi_2,    & ! In
    1079      705888 :                                            pdf_params%cloud_frac_2, pdf_params%rc_2 )     ! Out
    1080             : 
    1081             :     ! Calc ice_supersat_frac
    1082             :     if ( l_calc_ice_supersat_frac ) then
    1083             : 
    1084             :       call calc_ice_cloud_frac_component( nz, ngrdcol, &
    1085             :                                           pdf_params%chi_2, pdf_params%stdev_chi_2, &
    1086             :                                           pdf_params%rc_2, pdf_params%cloud_frac_2, &
    1087             :                                           p_in_Pa, tl2, &
    1088             :                                           pdf_params%rsatl_2, pdf_params%crt_2, &
    1089      705888 :                                           pdf_params%ice_supersat_frac_2, rc_2_ice )
    1090             : 
    1091             :       ! Compute ice cloud fraction, ice_supersat_frac
    1092             :       !$acc parallel loop gang vector collapse(2) default(present)
    1093    60706368 :       do k = 1, nz
    1094  1002574368 :         do i = 1, ngrdcol
    1095  1883736000 :           ice_supersat_frac(i,k) = pdf_params%mixt_frac(i,k) &
    1096           0 :                                    * pdf_params%ice_supersat_frac_1(i,k) &
    1097             :                                    + ( one - pdf_params%mixt_frac(i,k) ) &
    1098  2885604480 :                                      * pdf_params%ice_supersat_frac_2(i,k)
    1099             :         end do
    1100             :       end do
    1101             :       !$acc end parallel loop
    1102             : 
    1103             :     else 
    1104             : 
    1105             :       ! ice_supersat_frac will be garbage if computed as above
    1106             :       !$acc parallel loop gang vector collapse(2) default(present)
    1107             :       do k = 1, nz
    1108             :         do i = 1, ngrdcol
    1109             :           ice_supersat_frac(i,k) = 0.0_core_rknd
    1110             :         end do
    1111             :       end do
    1112             :       !$acc end parallel loop
    1113             : 
    1114             :       if (clubb_at_least_debug_level( 1 )) then
    1115             :           write(fstderr,*) "Warning: ice_supersat_frac has garbage values if &
    1116             :                           & do_liquid_only_in_clubb = .false."
    1117             :       end if
    1118             : 
    1119             :     end if ! l_calc_ice_supersat_frac
    1120             : 
    1121             : 
    1122             :     ! Compute cloud fraction and mean cloud water mixing ratio.
    1123             :     ! Reference:
    1124             :     ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:anl_int_cloud_terms
    1125             :     !$acc parallel loop gang vector collapse(2) default(present)
    1126    60706368 :     do k = 1, nz
    1127  1002574368 :       do i = 1, ngrdcol
    1128  1883736000 :         cloud_frac(i,k) = pdf_params%mixt_frac(i,k) * pdf_params%cloud_frac_1(i,k) &
    1129  2825604000 :                      + ( one - pdf_params%mixt_frac(i,k) ) * pdf_params%cloud_frac_2(i,k)
    1130           0 :         rcm(i,k) = pdf_params%mixt_frac(i,k) * pdf_params%rc_1(i,k) + ( one - pdf_params%mixt_frac(i,k) ) &
    1131   941868000 :                                                                  * pdf_params%rc_2(i,k)
    1132  1001868480 :         rcm(i,k) = max( zero_threshold, rcm(i,k) )
    1133             :       end do
    1134             :     end do
    1135             :     !$acc end parallel loop
    1136             : 
    1137             :     if ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
    1138      705888 :          .or. iiPDF_type == iiPDF_new_hybrid ) then
    1139             : 
    1140             :       ! corr_w_rt and corr_w_thl are zero for these pdf types so
    1141             :       ! corr_w_chi and corr_w_eta are zero as well
    1142             :       !$acc parallel loop gang vector collapse(2) default(present)
    1143    60706368 :       do k = 1, nz
    1144  1002574368 :         do i = 1, ngrdcol
    1145   941868000 :           pdf_params%corr_w_chi_1(i,k) = zero
    1146   941868000 :           pdf_params%corr_w_chi_2(i,k) = zero
    1147   941868000 :           pdf_params%corr_w_eta_1(i,k) = zero
    1148  1001868480 :           pdf_params%corr_w_eta_2(i,k) = zero
    1149             :         end do
    1150             :       end do
    1151             :       !$acc end parallel loop
    1152             : 
    1153             :     else 
    1154             :         
    1155             :       ! Correlation of w and chi for each component.
    1156             :       pdf_params%corr_w_chi_1 &
    1157           0 :       = calc_corr_chi_x( pdf_params%crt_1, pdf_params%cthl_1, &
    1158           0 :                          sqrt(pdf_params%varnce_rt_1), sqrt(pdf_params%varnce_thl_1), &
    1159           0 :                          pdf_params%stdev_chi_1, &
    1160           0 :                          pdf_params%corr_w_rt_1, pdf_params%corr_w_thl_1 )
    1161             : 
    1162             :       pdf_params%corr_w_chi_2 &
    1163           0 :       = calc_corr_chi_x( pdf_params%crt_2, pdf_params%cthl_2, &
    1164           0 :                          sqrt(pdf_params%varnce_rt_2), sqrt(pdf_params%varnce_thl_2), &
    1165           0 :                          pdf_params%stdev_chi_2, pdf_params%corr_w_rt_2, &
    1166           0 :                          pdf_params%corr_w_thl_2 )
    1167             : 
    1168             :       ! Correlation of w and eta for each component.
    1169             :       pdf_params%corr_w_eta_1 &
    1170           0 :       = calc_corr_eta_x( pdf_params%crt_1, pdf_params%cthl_1, &
    1171           0 :                          sqrt(pdf_params%varnce_rt_1), sqrt(pdf_params%varnce_thl_1), &
    1172           0 :                          pdf_params%stdev_eta_1, pdf_params%corr_w_rt_1, &
    1173           0 :                          pdf_params%corr_w_thl_1 )
    1174             : 
    1175             :       pdf_params%corr_w_eta_2 &
    1176           0 :       = calc_corr_eta_x( pdf_params%crt_2, pdf_params%cthl_2, &
    1177           0 :                          sqrt(pdf_params%varnce_rt_2), sqrt(pdf_params%varnce_thl_2), &
    1178           0 :                          pdf_params%stdev_eta_2, pdf_params%corr_w_rt_2, &
    1179           0 :                          pdf_params%corr_w_thl_2 )
    1180             : 
    1181             :     end if
    1182             : 
    1183             :     
    1184             :     ! Compute moments that depend on theta_v
    1185             :     ! 
    1186             :     ! The moments that depend on th_v' are calculated based on an approximated
    1187             :     ! and linearized form of the theta_v equation:
    1188             :     ! 
    1189             :     ! theta_v = theta_l + { (R_v/R_d) - 1 } * thv_ds * r_t
    1190             :     !                   + [ {L_v/(C_p*exner)} - (R_v/R_d) * thv_ds ] * r_c;
    1191             :     ! 
    1192             :     ! and therefore:
    1193             :     ! 
    1194             :     ! th_v' = th_l' + { (R_v/R_d) - 1 } * thv_ds * r_t'
    1195             :     !               + [ {L_v/(C_p*exner)} - (R_v/R_d) * thv_ds ] * r_c';
    1196             :     ! 
    1197             :     ! where thv_ds is used as a reference value to approximate theta_l.
    1198             :     ! 
    1199             :     ! Reference:
    1200             :     ! https://arxiv.org/pdf/1711.03675v1.pdf#nameddest=url:anl_int_buoy_terms
    1201             :     
    1202             :     ! Calculate the contributions to <w'rc'>, <w'^2 rc'>, <rt'rc'>, and
    1203             :     ! <thl'rc'> from the 1st PDF component.
    1204             :     call calc_xprcp_component( nz, ngrdcol,                                          & ! In
    1205             :                                wm, rtm, thlm, um, vm, rcm,                           & ! In
    1206             :                                pdf_params%w_1, pdf_params%rt_1,                      & ! In
    1207             :                                pdf_params%thl_1, u_1, v_1,                           & ! In
    1208             :                                pdf_params%varnce_w_1, pdf_params%chi_1,              & ! In
    1209             :                                pdf_params%stdev_chi_1, pdf_params%stdev_eta_1,       & ! In
    1210             :                                pdf_params%corr_w_chi_1, pdf_params%corr_chi_eta_1,   & ! In
    1211             :                                pdf_params%crt_1, pdf_params%cthl_1,                  & ! In
    1212             :                                pdf_params%rc_1, pdf_params%cloud_frac_1, iiPDF_type, & ! In
    1213             :                                wprcp_contrib_comp_1, wp2rcp_contrib_comp_1,          & ! Out
    1214             :                                rtprcp_contrib_comp_1, thlprcp_contrib_comp_1,        & ! Out
    1215      705888 :                                uprcp_contrib_comp_1, vprcp_contrib_comp_1 )            ! Out
    1216             : 
    1217             :     call calc_xprcp_component( nz, ngrdcol,                                          & ! In 
    1218             :                                wm, rtm, thlm, um, vm, rcm,                           & ! In
    1219             :                                pdf_params%w_2, pdf_params%rt_2,                      & ! In
    1220             :                                pdf_params%thl_2, u_2, v_2,                           & ! In
    1221             :                                pdf_params%varnce_w_2, pdf_params%chi_2,              & ! In
    1222             :                                pdf_params%stdev_chi_2, pdf_params%stdev_eta_2,       & ! In
    1223             :                                pdf_params%corr_w_chi_2, pdf_params%corr_chi_eta_2,   & ! In
    1224             :                                pdf_params%crt_2, pdf_params%cthl_2,                  & ! In
    1225             :                                pdf_params%rc_2, pdf_params%cloud_frac_2, iiPDF_type, & ! In
    1226             :                                wprcp_contrib_comp_2, wp2rcp_contrib_comp_2,          & ! Out
    1227             :                                rtprcp_contrib_comp_2, thlprcp_contrib_comp_2,        & ! Out
    1228      705888 :                                uprcp_contrib_comp_2, vprcp_contrib_comp_2 )            ! Out
    1229             : 
    1230             :     
    1231             :     ! Calculate rc_coef, which is the coefficient on <x'rc'> in the <x'thv'> equation.
    1232             :     !$acc parallel loop gang vector collapse(2) default(present)
    1233    60706368 :     do k = 1, nz
    1234  1002574368 :       do i = 1, ngrdcol
    1235             :         
    1236   941868000 :         rc_coef(i,k) = Lv / ( exner(i,k) * Cp ) - ep2 * thv_ds(i,k)
    1237             : 
    1238             :         ! Calculate <w'rc'>, <w'^2 rc'>, <rt'rc'>, and <thl'rc'>.
    1239           0 :         wprcp(i,k) = pdf_params%mixt_frac(i,k) * wprcp_contrib_comp_1(i,k) &
    1240   941868000 :                      + ( one - pdf_params%mixt_frac(i,k) ) * wprcp_contrib_comp_2(i,k)
    1241             : 
    1242           0 :         wp2rcp(i,k) = pdf_params%mixt_frac(i,k) * wp2rcp_contrib_comp_1(i,k) &
    1243   941868000 :                       + ( one - pdf_params%mixt_frac(i,k) ) * wp2rcp_contrib_comp_2(i,k)
    1244             : 
    1245           0 :         rtprcp(i,k) = pdf_params%mixt_frac(i,k) * rtprcp_contrib_comp_1(i,k) & 
    1246   941868000 :                       + ( one - pdf_params%mixt_frac(i,k) ) * rtprcp_contrib_comp_2(i,k)
    1247             : 
    1248           0 :         thlprcp(i,k) = pdf_params%mixt_frac(i,k) * thlprcp_contrib_comp_1(i,k) &
    1249   941868000 :                        + ( one - pdf_params%mixt_frac(i,k) ) * thlprcp_contrib_comp_2(i,k)
    1250             : 
    1251           0 :         uprcp(i,k) = pdf_params%mixt_frac(i,k) * uprcp_contrib_comp_1(i,k) &
    1252   941868000 :                      + ( one - pdf_params%mixt_frac(i,k) ) * uprcp_contrib_comp_2(i,k)
    1253             : 
    1254           0 :         vprcp(i,k) = pdf_params%mixt_frac(i,k) * vprcp_contrib_comp_1(i,k) &
    1255  1001868480 :                      + ( one - pdf_params%mixt_frac(i,k) ) * vprcp_contrib_comp_2(i,k)
    1256             :       end do
    1257             :     end do
    1258             :     !$acc end parallel loop
    1259             : 
    1260             :     ! Calculate <w'thv'>, <w'^2 thv'>, <rt'thv'>, and <thl'thv'>.
    1261             :     !$acc parallel loop gang vector collapse(2) default(present)
    1262    60706368 :     do k = 1, nz
    1263  1002574368 :       do i = 1, ngrdcol
    1264   941868000 :         wpthvp(i,k)  = wpthlp(i,k)  + ep1 * thv_ds(i,k) * wprtp(i,k)   + rc_coef(i,k) * wprcp(i,k)
    1265   941868000 :         wp2thvp(i,k) = wp2thlp(i,k) + ep1 * thv_ds(i,k) * wp2rtp(i,k)  + rc_coef(i,k) * wp2rcp(i,k)
    1266   941868000 :         rtpthvp(i,k) = rtpthlp(i,k) + ep1 * thv_ds(i,k) * rtp2(i,k)    + rc_coef(i,k) * rtprcp(i,k)
    1267  1001868480 :         thlpthvp(i,k)= thlp2(i,k)   + ep1 * thv_ds(i,k) * rtpthlp(i,k) + rc_coef(i,k) * thlprcp(i,k)
    1268             :       end do
    1269             :     end do
    1270             :     !$acc end parallel loop
    1271             : 
    1272             :     ! Add the precipitation loading term in the <x'thv'> equation.
    1273             :     if ( l_liq_ice_loading_test ) then
    1274             : 
    1275             :        do hm_idx = 1, hydromet_dim, 1
    1276             : 
    1277             :           if ( l_mix_rat_hm(hm_idx) ) then
    1278             :             !$acc parallel loop gang vector collapse(2) default(present)
    1279             :             do k = 1, nz
    1280             :               do i = 1, ngrdcol
    1281             :                 wp2thvp(i,k)  = wp2thvp(i,k)  - thv_ds(i,k) * wp2hmp(i,k,hm_idx)
    1282             :                 wpthvp(i,k)   = wpthvp(i,k)   - thv_ds(i,k) * wphydrometp(i,k,hm_idx)
    1283             :                 thlpthvp(i,k) = thlpthvp(i,k) - thv_ds(i,k) * thlphmp(i,k,hm_idx)
    1284             :                 rtpthvp(i,k)  = rtpthvp(i,k)  - thv_ds(i,k) * rtphmp(i,k,hm_idx)
    1285             :               end do
    1286             :             end do
    1287             :             !$acc end parallel loop
    1288             :           end if
    1289             : 
    1290             :        end do
    1291             : 
    1292             :     end if
    1293             :     
    1294             :     ! Account for subplume correlation of scalar, theta_v.
    1295             :     ! See Eqs. A13, A8 from Larson et al. (2002) ``Small-scale...''
    1296             :     !  where the ``scalar'' in this paper is w.
    1297      705888 :     if ( l_scalar_calc ) then
    1298             : 
    1299             :       !$acc parallel loop gang vector collapse(3) default(present)
    1300           0 :       do j = 1, sclr_dim
    1301           0 :         do k = 1, nz
    1302           0 :           do i = 1, ngrdcol
    1303             :             
    1304           0 :             sclrprcp(i,k,j) &
    1305           0 :             = pdf_params%mixt_frac(i,k) * ( ( sclr1(i,k,j) - sclrm(i,k,j) ) * pdf_params%rc_1(i,k) ) &
    1306             :               + ( one - pdf_params%mixt_frac(i,k) ) * ( ( sclr2(i,k,j) - sclrm(i,k,j) ) &
    1307           0 :                                                         * pdf_params%rc_2(i,k) ) &
    1308           0 :               + pdf_params%mixt_frac(i,k) * corr_sclr_rt_1(i,k,j) * pdf_params%crt_1(i,k) &
    1309           0 :                 * sqrt( varnce_sclr1(i,k,j) * pdf_params%varnce_rt_1(i,k) ) &
    1310           0 :                 * pdf_params%cloud_frac_1(i,k) &
    1311           0 :               + ( one - pdf_params%mixt_frac(i,k) ) * corr_sclr_rt_2(i,k,j) * pdf_params%crt_2(i,k) &
    1312           0 :                 * sqrt( varnce_sclr2(i,k,j) * pdf_params%varnce_rt_2(i,k) ) &
    1313           0 :                 * pdf_params%cloud_frac_2(i,k) & 
    1314           0 :               - pdf_params%mixt_frac(i,k) * corr_sclr_thl_1(i,k,j) * pdf_params%cthl_1(i,k) &
    1315           0 :                 * sqrt( varnce_sclr1(i,k,j) * pdf_params%varnce_thl_1(i,k) ) &
    1316             :                 * pdf_params%cloud_frac_1(i,k) & 
    1317           0 :               - ( one - pdf_params%mixt_frac(i,k) ) * corr_sclr_thl_2(i,k,j) * pdf_params%cthl_2(i,k) &
    1318           0 :                 * sqrt( varnce_sclr2(i,k,j) * pdf_params%varnce_thl_2(i,k) ) &
    1319           0 :                 * pdf_params%cloud_frac_2(i,k)
    1320             : 
    1321             :             sclrpthvp(i,k,j) = sclrpthlp(i,k,j) + ep1*thv_ds(i,k)*sclrprtp(i,k,j) &
    1322           0 :                              + rc_coef(i,k)*sclrprcp(i,k,j)
    1323             :                              
    1324             :           end do
    1325             :         end do
    1326             :       end do ! i=1, sclr_dim
    1327             :       !$acc end parallel loop
    1328             : 
    1329             :     end if ! l_scalar_calc
    1330             : 
    1331             :       
    1332             :     ! Compute variance of liquid water mixing ratio.
    1333             :     ! This is not needed for closure.  Statistical Analysis only.
    1334             : 
    1335             : #ifndef CLUBB_CAM
    1336             :       !  if CLUBB is used in CAM we want this variable computed no matter what
    1337             :       if ( stats_metadata%ircp2 > 0 ) then
    1338             : #endif
    1339             :     !$acc parallel loop gang vector collapse(2) default(present)
    1340    60706368 :     do k = 1,nz
    1341  1002574368 :       do i = 1, ngrdcol
    1342  1883736000 :         rcp2(i,k) = pdf_params%mixt_frac(i,k) &
    1343           0 :                     * ( pdf_params%chi_1(i,k)*pdf_params%rc_1(i,k) &
    1344           0 :                         + pdf_params%cloud_frac_1(i,k)*pdf_params%stdev_chi_1(i,k)**2 ) &
    1345             :                     + ( one-pdf_params%mixt_frac(i,k) ) &
    1346           0 :                       * ( pdf_params%chi_2(i,k)*pdf_params%rc_2(i,k) &
    1347           0 :                           + pdf_params%cloud_frac_2(i,k)*pdf_params%stdev_chi_2(i,k)**2 ) &
    1348  2825604000 :                     - rcm(i,k)**2
    1349  1001868480 :         rcp2(i,k) = max( zero_threshold, rcp2(i,k) )
    1350             :         
    1351             :       end do
    1352             :     end do
    1353             :     !$acc end parallel loop
    1354             : #ifndef CLUBB_CAM
    1355             :       !  if CLUBB is used in CAM we want this variable computed no matter what
    1356             :       end if
    1357             : #endif
    1358             : 
    1359             :     if ( ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
    1360             :            .or. iiPDF_type == iiPDF_new_hybrid ) &
    1361      705888 :          .and. ( stats_metadata%iw_up_in_cloud > 0 .or. stats_metadata%iw_down_in_cloud > 0 ) ) then
    1362             :                  
    1363             :       call calc_w_up_in_cloud( nz, ngrdcol, &                                      ! In
    1364             :                                pdf_params%mixt_frac, &                             ! In
    1365             :                                pdf_params%cloud_frac_1, pdf_params%cloud_frac_2, & ! In
    1366             :                                pdf_params%w_1, pdf_params%w_2, &                   ! In
    1367             :                                pdf_params%varnce_w_1, pdf_params%varnce_w_2, &     ! In
    1368             :                                w_up_in_cloud, w_down_in_cloud, &                   ! Out
    1369           0 :                                cloudy_updraft_frac, cloudy_downdraft_frac )        ! Out
    1370             : 
    1371             :     else
    1372             :       !$acc parallel loop gang vector collapse(2) default(present)
    1373    60706368 :       do k = 1,nz
    1374  1002574368 :         do i = 1, ngrdcol
    1375   941868000 :           w_up_in_cloud(i,k) = zero
    1376  1001868480 :           w_down_in_cloud(i,k) = zero
    1377             :         end do
    1378             :       end do
    1379             :     end if
    1380             : 
    1381             : #ifdef TUNER
    1382             : 
    1383             :     !$acc update host( pdf_params, pdf_params%thl_1, pdf_params%thl_2 )
    1384             : 
    1385             :     ! Check the first levels (and first gridcolumn) for reasonable temperatures
    1386             :     ! greater than 190K and less than 1000K
    1387             :     ! This is necessary because for certain parameter sets we can get floating point errors
    1388             :     do i=1, min( 10, size(pdf_params%thl_1(1,:)) )
    1389             :         if ( pdf_params%thl_1(1,i) < 190. ) then
    1390             :             write(fstderr,*) "Fatal error: pdf_params%thl_1 =", pdf_params%thl_1(1,i), &
    1391             :                              " < 190K at first grid column and grid level i = ", i
    1392             :             err_code = clubb_fatal_error
    1393             :             return
    1394             :         end if
    1395             :         if ( pdf_params%thl_2(1,i) < 190. ) then
    1396             :             write(fstderr,*) "Fatal error: pdf_params%thl_2 =", pdf_params%thl_2(1,i), &
    1397             :                              " < 190K at first grid column and grid level i = ", i
    1398             :             err_code = clubb_fatal_error
    1399             :             return
    1400             :         end if
    1401             :         if ( pdf_params%thl_1(1,i) > 1000. ) then
    1402             :             write(fstderr,*) "Fatal error: pdf_params%thl_1 =", pdf_params%thl_1(1,i), &
    1403             :                              " > 1000K at first grid column and grid level i = ", i
    1404             :             err_code = clubb_fatal_error
    1405             :             return
    1406             :         end if
    1407             :         if ( pdf_params%thl_2(1,i) > 1000. ) then
    1408             :             write(fstderr,*) "Fatal error: pdf_params%thl_2 =", pdf_params%thl_2(1,i), &
    1409             :                              " > 1000K at first grid column and grid level i = ", i
    1410             :             err_code = clubb_fatal_error
    1411             :             return
    1412             :         end if
    1413             :     end do
    1414             : #endif /*TUNER*/
    1415             : 
    1416      705888 :     if ( clubb_at_least_debug_level( 2 ) ) then
    1417             : 
    1418             :       !$acc update host( wp4, wprtp2, wp2rtp, wpthlp2, wp2thlp, cloud_frac, &
    1419             :       !$acc              rcm, wpthvp, wp2thvp, rtpthvp, thlpthvp, wprcp, wp2rcp, &
    1420             :       !$acc              rtprcp, thlprcp, rcp2, wprtpthlp, sclrpthvp, sclrprcp, &
    1421             :       !$acc              wpsclrp2, wpsclrprtp, wpsclrpthlp, wp2sclrp, &
    1422             :       !$acc              pdf_params%w_1, pdf_params%w_2, &
    1423             :       !$acc              pdf_params%varnce_w_1, pdf_params%varnce_w_2, &
    1424             :       !$acc              pdf_params%rt_1, pdf_params%rt_2, &
    1425             :       !$acc              pdf_params%varnce_rt_1, pdf_params%varnce_rt_2,  &
    1426             :       !$acc              pdf_params%thl_1, pdf_params%thl_2, &
    1427             :       !$acc              pdf_params%varnce_thl_1, pdf_params%varnce_thl_2, &
    1428             :       !$acc              pdf_params%corr_w_rt_1, pdf_params%corr_w_rt_2,  &
    1429             :       !$acc              pdf_params%corr_w_thl_1, pdf_params%corr_w_thl_2, &
    1430             :       !$acc              pdf_params%corr_rt_thl_1, pdf_params%corr_rt_thl_2,&
    1431             :       !$acc              pdf_params%alpha_thl, pdf_params%alpha_rt, &
    1432             :       !$acc              pdf_params%crt_1, pdf_params%crt_2, pdf_params%cthl_1, &
    1433             :       !$acc              pdf_params%cthl_2, pdf_params%chi_1, &
    1434             :       !$acc              pdf_params%chi_2, pdf_params%stdev_chi_1, &
    1435             :       !$acc              pdf_params%stdev_chi_2, pdf_params%stdev_eta_1, &
    1436             :       !$acc              pdf_params%stdev_eta_2, pdf_params%covar_chi_eta_1, &
    1437             :       !$acc              pdf_params%covar_chi_eta_2, pdf_params%corr_w_chi_1, &
    1438             :       !$acc              pdf_params%corr_w_chi_2, pdf_params%corr_w_eta_1, &
    1439             :       !$acc              pdf_params%corr_w_eta_2, pdf_params%corr_chi_eta_1, &
    1440             :       !$acc              pdf_params%corr_chi_eta_2, pdf_params%rsatl_1, &
    1441             :       !$acc              pdf_params%rsatl_2, pdf_params%rc_1, pdf_params%rc_2, &
    1442             :       !$acc              pdf_params%cloud_frac_1, pdf_params%cloud_frac_2,  &
    1443             :       !$acc              pdf_params%mixt_frac, pdf_params%ice_supersat_frac_1, &
    1444             :       !$acc              pdf_params%ice_supersat_frac_2 )
    1445             : 
    1446           0 :       do i = 1, ngrdcol
    1447             :           
    1448             :         call pdf_closure_check( & 
    1449           0 :                nz, wp4(i,:), wprtp2(i,:), wp2rtp(i,:), wpthlp2(i,:), & ! intent(in)
    1450           0 :                wp2thlp(i,:), cloud_frac(i,:), rcm(i,:), wpthvp(i,:), wp2thvp(i,:), &  ! intent(in)
    1451           0 :                rtpthvp(i,:), thlpthvp(i,:), wprcp(i,:), wp2rcp(i,:), & ! intent(in)
    1452           0 :                rtprcp(i,:), thlprcp(i,:), rcp2(i,:), wprtpthlp(i,:), & ! intent(in)
    1453           0 :                pdf_params%crt_1(i,:), pdf_params%crt_2(i,:), & ! intent(in)
    1454           0 :                pdf_params%cthl_1(i,:), pdf_params%cthl_2(i,:), & ! intent(in)
    1455             :                pdf_params, & ! intent(in)
    1456           0 :                sclrpthvp(i,:,:), sclrprcp(i,:,:), wpsclrp2(i,:,:), & ! intent(in)
    1457           0 :                wpsclrprtp(i,:,:), wpsclrpthlp(i,:,:), wp2sclrp(i,:,:), & ! intent(in)
    1458           0 :                stats_metadata ) ! intent(in)
    1459             :       end do
    1460             :     end if
    1461             : 
    1462             :     ! Error Reporting
    1463             :     ! Joshua Fasching February 2008
    1464      705888 :     if ( clubb_at_least_debug_level( 2 ) ) then
    1465           0 :       if ( err_code == clubb_fatal_error ) then
    1466             : 
    1467             :         !$acc update host( p_in_Pa, exner, thv_ds, wm, wp2, wp3, sigma_sqd_w, &
    1468             :         !$acc              rtm, rtp2, wprtp, thlm, thlp2, wpthlp, rtpthlp, sclrm, &
    1469             :         !$acc              wpsclrp, sclrp2, sclrprtp, sclrpthlp, ice_supersat_frac )
    1470             : 
    1471           0 :         write(fstderr,*) "Error in pdf_closure_new"
    1472             : 
    1473           0 :         write(fstderr,*) "Intent(in)"
    1474             : 
    1475           0 :         write(fstderr,*) "p_in_Pa = ", p_in_Pa
    1476           0 :         write(fstderr,*) "exner = ", exner
    1477           0 :         write(fstderr,*) "thv_ds = ", thv_ds
    1478           0 :         write(fstderr,*) "wm = ", wm
    1479           0 :         write(fstderr,*) "wp2 = ", wp2
    1480           0 :         write(fstderr,*) "wp3 = ", wp3
    1481           0 :         write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w
    1482           0 :         write(fstderr,*) "rtm = ", rtm
    1483           0 :         write(fstderr,*) "rtp2 = ", rtp2
    1484           0 :         write(fstderr,*) "wprtp = ", wprtp
    1485           0 :         write(fstderr,*) "thlm = ", thlm
    1486           0 :         write(fstderr,*) "thlp2 = ", thlp2
    1487           0 :         write(fstderr,*) "wpthlp = ", wpthlp
    1488           0 :         write(fstderr,*) "rtpthlp = ", rtpthlp
    1489             : 
    1490           0 :         if ( sclr_dim > 0 ) then
    1491           0 :           write(fstderr,*) "sclrm = ", sclrm
    1492           0 :           write(fstderr,*) "wpsclrp = ", wpsclrp
    1493           0 :           write(fstderr,*) "sclrp2 = ", sclrp2
    1494           0 :           write(fstderr,*) "sclrprtp = ", sclrprtp
    1495           0 :           write(fstderr,*) "sclrpthlp = ", sclrpthlp
    1496             :         end if
    1497             : 
    1498           0 :         write(fstderr,*) "Intent(out)"
    1499             : 
    1500           0 :         write(fstderr,*) "wp4 = ", wp4
    1501           0 :         if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwprtp2 > 0 ) then
    1502           0 :           write(fstderr,*) "wprtp2 = ", wprtp2
    1503             :         end if
    1504           0 :         write(fstderr,*) "wp2rtp = ", wp2rtp
    1505           0 :         if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwpthlp2 > 0 ) then
    1506           0 :           write(fstderr,*) "wpthlp2 = ", wpthlp2
    1507             :         end if
    1508           0 :         write(fstderr,*) "cloud_frac = ", cloud_frac
    1509           0 :         write(fstderr,*) "ice_supersat_frac = ", ice_supersat_frac
    1510           0 :         write(fstderr,*) "rcm = ", rcm
    1511           0 :         write(fstderr,*) "wpthvp = ", wpthvp
    1512           0 :         write(fstderr,*) "wp2thvp = ", wp2thvp
    1513           0 :         write(fstderr,*) "rtpthvp = ", rtpthvp
    1514           0 :         write(fstderr,*) "thlpthvp = ", thlpthvp
    1515           0 :         write(fstderr,*) "wprcp = ", wprcp
    1516           0 :         write(fstderr,*) "wp2rcp = ", wp2rcp
    1517           0 :         write(fstderr,*) "rtprcp = ", rtprcp
    1518           0 :         write(fstderr,*) "thlprcp = ", thlprcp
    1519             : #ifndef CLUBB_CAM
    1520             :         !  if CLUBB is used in CAM we want this variable computed no matter what
    1521             :         if ( stats_metadata%ircp2 > 0 ) then
    1522             : #endif
    1523           0 :           write(fstderr,*) "rcp2 = ", rcp2
    1524             : #ifndef CLUBB_CAM
    1525             :         end if
    1526             : #endif
    1527           0 :         if ( l_explicit_turbulent_adv_xpyp .or. stats_metadata%iwprtpthlp > 0 ) then
    1528           0 :           write(fstderr,*) "wprtpthlp = ", wprtpthlp
    1529             :         end if
    1530           0 :         write(fstderr,*) "rcp2 = ", rcp2
    1531           0 :         write(fstderr,*) "wprtpthlp = ", wprtpthlp
    1532           0 :         write(fstderr,*) "pdf_params%w_1 = ", pdf_params%w_1
    1533           0 :         write(fstderr,*) "pdf_params%w_2 = ", pdf_params%w_2
    1534           0 :         write(fstderr,*) "pdf_params%varnce_w_1 = ", pdf_params%varnce_w_1
    1535           0 :         write(fstderr,*) "pdf_params%varnce_w_2 = ", pdf_params%varnce_w_2
    1536           0 :         write(fstderr,*) "pdf_params%rt_1 = ", pdf_params%rt_1
    1537           0 :         write(fstderr,*) "pdf_params%rt_2 = ", pdf_params%rt_2
    1538           0 :         write(fstderr,*) "pdf_params%varnce_rt_1 = ", pdf_params%varnce_rt_1
    1539           0 :         write(fstderr,*) "pdf_params%varnce_rt_2 = ", pdf_params%varnce_rt_2
    1540           0 :         write(fstderr,*) "pdf_params%thl_1 = ", pdf_params%thl_1
    1541           0 :         write(fstderr,*) "pdf_params%thl_2 = ", pdf_params%thl_2
    1542           0 :         write(fstderr,*) "pdf_params%varnce_thl_1 = ", pdf_params%varnce_thl_1
    1543           0 :         write(fstderr,*) "pdf_params%varnce_thl_2 = ", pdf_params%varnce_thl_2
    1544           0 :         write(fstderr,*) "pdf_params%corr_w_rt_1 = ", pdf_params%corr_w_rt_1
    1545           0 :         write(fstderr,*) "pdf_params%corr_w_rt_2 = ", pdf_params%corr_w_rt_2
    1546           0 :         write(fstderr,*) "pdf_params%corr_w_thl_1 = ", pdf_params%corr_w_thl_1
    1547           0 :         write(fstderr,*) "pdf_params%corr_w_thl_2 = ", pdf_params%corr_w_thl_2
    1548           0 :         write(fstderr,*) "pdf_params%corr_rt_thl_1 = ", pdf_params%corr_rt_thl_1
    1549           0 :         write(fstderr,*) "pdf_params%corr_rt_thl_2 = ", pdf_params%corr_rt_thl_2
    1550           0 :         write(fstderr,*) "pdf_params%alpha_thl = ", pdf_params%alpha_thl
    1551           0 :         write(fstderr,*) "pdf_params%alpha_rt = ", pdf_params%alpha_rt
    1552           0 :         write(fstderr,*) "pdf_params%crt_1 = ", pdf_params%crt_1
    1553           0 :         write(fstderr,*) "pdf_params%crt_2 = ", pdf_params%crt_2
    1554           0 :         write(fstderr,*) "pdf_params%cthl_1 = ", pdf_params%cthl_1
    1555           0 :         write(fstderr,*) "pdf_params%cthl_2 = ", pdf_params%cthl_2
    1556           0 :         write(fstderr,*) "pdf_params%chi_1 = ", pdf_params%chi_1
    1557           0 :         write(fstderr,*) "pdf_params%chi_2 = ", pdf_params%chi_2
    1558           0 :         write(fstderr,*) "pdf_params%stdev_chi_1 = ", pdf_params%stdev_chi_1
    1559           0 :         write(fstderr,*) "pdf_params%stdev_chi_2 = ", pdf_params%stdev_chi_2
    1560           0 :         write(fstderr,*) "pdf_params%stdev_eta_1 = ", pdf_params%stdev_eta_1
    1561           0 :         write(fstderr,*) "pdf_params%stdev_eta_2 = ", pdf_params%stdev_eta_2
    1562           0 :         write(fstderr,*) "pdf_params%covar_chi_eta_1 = ", &
    1563           0 :                          pdf_params%covar_chi_eta_1
    1564           0 :         write(fstderr,*) "pdf_params%covar_chi_eta_2 = ", &
    1565           0 :                          pdf_params%covar_chi_eta_2
    1566           0 :         write(fstderr,*) "pdf_params%corr_w_chi_1 = ", pdf_params%corr_w_chi_1
    1567           0 :         write(fstderr,*) "pdf_params%corr_w_chi_2 = ", pdf_params%corr_w_chi_2
    1568           0 :         write(fstderr,*) "pdf_params%corr_w_eta_1 = ", pdf_params%corr_w_eta_1
    1569           0 :         write(fstderr,*) "pdf_params%corr_w_eta_2 = ", pdf_params%corr_w_eta_2
    1570           0 :         write(fstderr,*) "pdf_params%corr_chi_eta_1 = ", &
    1571           0 :                          pdf_params%corr_chi_eta_1
    1572           0 :         write(fstderr,*) "pdf_params%corr_chi_eta_2 = ", &
    1573           0 :                          pdf_params%corr_chi_eta_2
    1574           0 :         write(fstderr,*) "pdf_params%rsatl_1 = ", pdf_params%rsatl_1
    1575           0 :         write(fstderr,*) "pdf_params%rsatl_2 = ", pdf_params%rsatl_2
    1576           0 :         write(fstderr,*) "pdf_params%rc_1 = ", pdf_params%rc_1
    1577           0 :         write(fstderr,*) "pdf_params%rc_2 = ", pdf_params%rc_2
    1578           0 :         write(fstderr,*) "pdf_params%cloud_frac_1 = ", pdf_params%cloud_frac_1
    1579           0 :         write(fstderr,*) "pdf_params%cloud_frac_2 = ", pdf_params%cloud_frac_2
    1580           0 :         write(fstderr,*) "pdf_params%mixt_frac = ", pdf_params%mixt_frac
    1581           0 :         write(fstderr,*) "pdf_params%ice_supersat_frac_1 = ", &
    1582           0 :                          pdf_params%ice_supersat_frac_1
    1583           0 :         write(fstderr,*) "pdf_params%ice_supersat_frac_2 = ", &
    1584           0 :                          pdf_params%ice_supersat_frac_2
    1585             : 
    1586           0 :         if ( sclr_dim > 0 )then
    1587           0 :           write(fstderr,*) "sclrpthvp = ", sclrpthvp
    1588           0 :           write(fstderr,*) "sclrprcp = ", sclrprcp
    1589           0 :           write(fstderr,*) "wpsclrp2 = ", wpsclrp2
    1590           0 :           write(fstderr,*) "wpsclrprtp = ", wpsclrprtp
    1591           0 :           write(fstderr,*) "wpsclrpthlp = ", wpsclrpthlp
    1592           0 :           write(fstderr,*) "wp2sclrp = ", wp2sclrp
    1593             :         end if
    1594             : 
    1595           0 :         return  
    1596             : 
    1597             :       end if ! Fatal error
    1598             :           
    1599           0 :       do i = 1, ngrdcol
    1600             : 
    1601             :         ! Error check pdf parameters and moments to ensure consistency
    1602           0 :         if ( iiPDF_type == iiPDF_3D_Luhar ) then
    1603             : 
    1604             :           ! Means
    1605           0 :           wm_clubb_pdf(i,:) = pdf_params%mixt_frac(i,:) * pdf_params%w_1(i,:) &
    1606           0 :                          + ( one - pdf_params%mixt_frac(i,:) ) * pdf_params%w_2(i,:)
    1607             : 
    1608           0 :           do k = 1, nz, 1
    1609           0 :              if ( abs( ( wm_clubb_pdf(i,k) - wm(i,k) ) &
    1610           0 :                        / max( wm(i,k), eps ) ) > .05_core_rknd ) then
    1611           0 :                 write(fstderr,*) "wm error at thlm = ", thlm(i,k), &
    1612             :                                  ( ( wm_clubb_pdf(i,k) - wm(i,k) ) &
    1613           0 :                                    / max( wm(i,k), eps ) )
    1614             :              end if
    1615             :           end do ! k = 1, nz, 1
    1616             : 
    1617           0 :           rtm_clubb_pdf(i,:) = pdf_params%mixt_frac(i,:) * pdf_params%rt_1(i,:) &
    1618           0 :                           + ( one - pdf_params%mixt_frac(i,:) ) * pdf_params%rt_2(i,:)
    1619             : 
    1620           0 :           do k = 1, nz, 1
    1621           0 :              if ( abs( ( rtm_clubb_pdf(i,k) - rtm(i,k) ) &
    1622           0 :                        / max( rtm(i,k), eps ) ) > .05_core_rknd ) then
    1623           0 :                 write(fstderr,*) "rtm error at thlm = ", thlm(i,k), &
    1624             :                                  ( ( rtm_clubb_pdf(i,k) - rtm(i,k) ) &
    1625           0 :                                    / max( rtm(i,k), eps ) )
    1626             :              end if
    1627             :           end do ! k = 1, nz, 1
    1628             : 
    1629           0 :           thlm_clubb_pdf(i,:) = pdf_params%mixt_frac(i,:) * pdf_params%thl_1(i,:) &
    1630           0 :                            + ( one - pdf_params%mixt_frac(i,:) ) * pdf_params%thl_2(i,:)
    1631             : 
    1632           0 :           do k = 1, nz, 1
    1633           0 :              if ( abs( ( thlm_clubb_pdf(i,k) - thlm(i,k) ) / thlm(i,k) ) &
    1634           0 :                   > .05_core_rknd ) then
    1635           0 :                 write(fstderr,*) "thlm error at thlm = ", thlm(i,k), &
    1636           0 :                                  ( ( thlm_clubb_pdf(i,k) - thlm(i,k) ) / thlm(i,k) )
    1637             :              end if
    1638             :           end do ! k = 1, nz, 1
    1639             : 
    1640             :           ! Variances
    1641           0 :           wp2_clubb_pdf(i,:) = pdf_params%mixt_frac(i,:) &
    1642           0 :                           * ( ( pdf_params%w_1(i,:) - wm(i,:) )**2 + pdf_params%varnce_w_1(i,:) ) &
    1643             :                           + ( one - pdf_params%mixt_frac(i,:) ) &
    1644           0 :                             * ( ( pdf_params%w_2(i,:) - wm(i,:) )**2 + pdf_params%varnce_w_2(i,:) )
    1645             : 
    1646           0 :           do k = 1, nz, 1
    1647           0 :              if ( wp2(i,k) > w_tol**2 ) then
    1648           0 :                 if ( abs( ( wp2_clubb_pdf(i,k) - wp2(i,k) ) / wp2(i,k) ) &
    1649             :                      > .05_core_rknd ) then
    1650           0 :                    write(fstderr,*) "wp2 error at thlm = ", thlm(i,k), &
    1651           0 :                                     ( ( wp2_clubb_pdf(i,k) - wp2(i,k) ) / wp2(i,k) )
    1652             :                 end if
    1653             :              end if
    1654             :           end do ! k = 1, nz, 1
    1655             : 
    1656             :           rtp2_clubb_pdf(i,:) &
    1657           0 :           = pdf_params%mixt_frac(i,:) &
    1658           0 :             * ( ( pdf_params%rt_1(i,:) - rtm(i,:) )**2 + pdf_params%varnce_rt_1(i,:) ) &
    1659             :             + ( one - pdf_params%mixt_frac(i,:) ) &
    1660           0 :               * ( ( pdf_params%rt_2(i,:) - rtm(i,:) )**2 + pdf_params%varnce_rt_2(i,:) )
    1661             : 
    1662           0 :           do k = 1, nz, 1
    1663           0 :              if ( rtp2(i,k) > rt_tol**2 ) then
    1664           0 :                 if ( abs( ( rtp2_clubb_pdf(i,k) - rtp2(i,k) ) / rtp2(i,k) ) &
    1665             :                      > .05_core_rknd ) then
    1666           0 :                    write(fstderr,*) "rtp2 error at thlm = ", thlm(i,k), &
    1667           0 :                    "Error = ", ( ( rtp2_clubb_pdf(i,k) - rtp2(i,k) ) / rtp2(i,k) )
    1668             :                 end if
    1669             :              end if
    1670             :           end do ! k = 1, nz, 1
    1671             : 
    1672             :           thlp2_clubb_pdf(i,:) &
    1673           0 :           = pdf_params%mixt_frac(i,:) &
    1674           0 :             * ( ( pdf_params%thl_1(i,:) - thlm(i,:) )**2 + pdf_params%varnce_thl_1(i,:) ) &
    1675             :             + ( one - pdf_params%mixt_frac(i,:) ) &
    1676           0 :               * ( ( pdf_params%thl_2(i,:) - thlm(i,:) )**2 + pdf_params%varnce_thl_2(i,:) )
    1677             : 
    1678           0 :           do k = 1, nz, 1
    1679           0 :              if( thlp2(i,k) > thl_tol**2 ) then
    1680           0 :                 if ( abs( ( thlp2_clubb_pdf(i,k) - thlp2(i,k) ) / thlp2(i,k) ) &
    1681             :                      > .05_core_rknd ) then
    1682           0 :                    write(fstderr,*) "thlp2 error at thlm = ", thlm(i,k), &
    1683           0 :                    "Error = ", ( ( thlp2_clubb_pdf(i,k) - thlp2(i,k) ) / thlp2(i,k) )
    1684             :                 end if
    1685             :              end if
    1686             :           end do ! k = 1, nz, 1
    1687             : 
    1688             :           ! Third order moments
    1689             :           wp3_clubb_pdf(i,:) &
    1690           0 :           = pdf_params%mixt_frac(i,:) * ( pdf_params%w_1(i,:) - wm(i,:) ) &
    1691           0 :             * ( ( pdf_params%w_1(i,:) - wm(i,:) )**2 + three * pdf_params%varnce_w_1(i,:) ) &
    1692           0 :             + ( one - pdf_params%mixt_frac(i,:) ) * ( pdf_params%w_2(i,:) - wm(i,:) ) &
    1693           0 :               * ( ( pdf_params%w_2(i,:) - wm(i,:) )**2 + three * pdf_params%varnce_w_2(i,:) )
    1694             : 
    1695             :           rtp3_clubb_pdf(i,:) &
    1696           0 :           = pdf_params%mixt_frac(i,:) * ( pdf_params%rt_1(i,:) - rtm(i,:) ) &
    1697           0 :             * ( ( pdf_params%rt_1(i,:) - rtm(i,:) )**2 + three * pdf_params%varnce_rt_1(i,:) ) &
    1698           0 :             + ( one - pdf_params%mixt_frac(i,:) ) * ( pdf_params%rt_2(i,:) - rtm(i,:) ) &
    1699           0 :               * ( ( pdf_params%rt_2(i,:) - rtm(i,:) )**2 + three * pdf_params%varnce_rt_2(i,:) )
    1700             : 
    1701             :           thlp3_clubb_pdf(i,:) &
    1702           0 :           = pdf_params%mixt_frac(i,:) * ( pdf_params%thl_1(i,:) - thlm(i,:) ) &
    1703           0 :             * ( ( pdf_params%thl_1(i,:) - thlm(i,:) )**2 + three * pdf_params%varnce_thl_1(i,:) ) &
    1704           0 :             + ( one - pdf_params%mixt_frac(i,:) ) * ( pdf_params%thl_2(i,:) - thlm(i,:) ) &
    1705           0 :               * ( ( pdf_params%thl_2(i,:) - thlm(i,:) )**2 + three * pdf_params%varnce_thl_2(i,:) )
    1706             : 
    1707             :           ! Skewness
    1708           0 :           Skw_denom_coef = clubb_params(iSkw_denom_coef)
    1709             : 
    1710             :           Skw_clubb_pdf(i,:) &
    1711             :           = wp3_clubb_pdf(i,:) &
    1712           0 :             / ( wp2_clubb_pdf(i,:) + Skw_denom_coef * w_tol**2 )**1.5_core_rknd
    1713             : 
    1714           0 :           do k = 1, nz, 1
    1715           0 :              if ( Skw(i,k) > .05_core_rknd ) then
    1716           0 :                 if( abs( ( Skw_clubb_pdf(i,k) - Skw(i,k) ) / Skw(i,k) ) &
    1717             :                     > .25_core_rknd ) then
    1718           0 :                    write(fstderr,*) "Skw error at thlm = ", thlm(i,k), &
    1719           0 :                    "Error = ", ( ( Skw_clubb_pdf(i,k) - Skw(i,k) ) / Skw(i,k) ), &
    1720           0 :                    Skw_clubb_pdf(i,k), Skw(i,k)
    1721             :                 end if
    1722             :              end if
    1723             :           end do ! k = 1, nz, 1
    1724             : 
    1725             :           Skrt_clubb_pdf(i,:) &
    1726             :           = rtp3_clubb_pdf(i,:) &
    1727           0 :             / ( rtp2_clubb_pdf(i,:) + Skw_denom_coef * rt_tol**2 )**1.5_core_rknd
    1728             : 
    1729           0 :           do k = 1, nz, 1
    1730           0 :              if ( Skrt(i,k) > .05_core_rknd ) then
    1731           0 :                 if( abs( ( Skrt_clubb_pdf(i,k) - Skrt(i,k) ) / Skrt(i,k) ) &
    1732             :                     > .25_core_rknd ) then
    1733           0 :                    write(fstderr,*) "Skrt error at thlm = ", thlm(i,k), &
    1734           0 :                    "Error = ", ( ( Skrt_clubb_pdf(i,k) - Skrt(i,k) ) / Skrt(i,k) ), &
    1735           0 :                    Skrt_clubb_pdf(i,k), Skrt(i,k)
    1736             :                 end if
    1737             :              end if
    1738             :           end do ! k = 1, nz, 1
    1739             : 
    1740             :           Skthl_clubb_pdf(i,:) &
    1741             :           = thlp3_clubb_pdf(i,:) &
    1742           0 :             / ( thlp2_clubb_pdf(i,:) + Skw_denom_coef * thl_tol**2 )**1.5_core_rknd
    1743             : 
    1744           0 :           do k = 1, nz, 1
    1745           0 :              if ( Skthl(i,k) > .05_core_rknd ) then
    1746           0 :                 if ( abs( ( Skthl_clubb_pdf(i,k) - Skthl(i,k) ) / Skthl(i,k) ) &
    1747             :                      > .25_core_rknd ) then
    1748           0 :                    write(fstderr,*) "Skthl error at thlm = ", thlm(i,k), &
    1749           0 :                    "Error = ", ( ( Skthl_clubb_pdf(i,k) - Skthl(i,k) ) / Skthl(i,k) ), &
    1750           0 :                    Skthl_clubb_pdf(i,k), Skthl(i,k)
    1751             :                 end if
    1752             :              end if
    1753             :           end do ! k = 1, nz, 1
    1754             : 
    1755             :         end if ! iiPDF_type == iiPDF_3D_Luhar
    1756             :         
    1757             :       end do
    1758             : 
    1759             :     end if ! clubb_at_least_debug_level
    1760             : 
    1761             :     !$acc exit data delete( u_1, u_2, varnce_u_1, varnce_u_2, v_1, v_2, &
    1762             :     !$acc                   varnce_v_1, varnce_v_2, alpha_u, alpha_v, &
    1763             :     !$acc                   corr_u_w_1, corr_u_w_2, corr_v_w_1, corr_v_w_2, &
    1764             :     !$acc                   tl1, tl2, sqrt_wp2, Skthl, &
    1765             :     !$acc                   Skrt, Sku, Skv, wprcp_contrib_comp_1, wprcp_contrib_comp_2, &
    1766             :     !$acc                   wp2rcp_contrib_comp_1, wp2rcp_contrib_comp_2, &
    1767             :     !$acc                   rtprcp_contrib_comp_1, rtprcp_contrib_comp_2, &
    1768             :     !$acc                   thlprcp_contrib_comp_1, thlprcp_contrib_comp_2, &
    1769             :     !$acc                   uprcp_contrib_comp_1, uprcp_contrib_comp_2, &
    1770             :     !$acc                   vprcp_contrib_comp_1, vprcp_contrib_comp_2, &
    1771             :     !$acc                   rc_1_ice, rc_2_ice, rsatl_1, rsatl_2 )
    1772             : 
    1773             :     !$acc exit data if( sclr_dim > 0 ) &
    1774             :     !$acc           delete( sclr1, sclr2, varnce_sclr1, varnce_sclr2, & 
    1775             :     !$acc                   alpha_sclr, corr_sclr_thl_1, corr_sclr_thl_2, &
    1776             :     !$acc                   corr_sclr_rt_1, corr_sclr_rt_2, corr_w_sclr_1, &
    1777             :     !$acc                   corr_w_sclr_2, Sksclr )
    1778             : 
    1779             :     return
    1780             : 
    1781             :   end subroutine pdf_closure
    1782             : 
    1783             :   !===============================================================================================
    1784     1411776 :   subroutine transform_pdf_chi_eta_component( nz, ngrdcol, &
    1785     1411776 :                                               tl, rsatl, rt, exner,     & ! In
    1786     1411776 :                                               varnce_thl, varnce_rt,    & ! In
    1787     1411776 :                                               corr_rt_thl, chi,         & ! In
    1788     1411776 :                                               crt, cthl,                & ! Out
    1789     1411776 :                                               stdev_chi, stdev_eta,     & ! Out
    1790     1411776 :                                               covar_chi_eta,            & ! Out
    1791     1411776 :                                               corr_chi_eta )              ! Out
    1792             : 
    1793             :     use clubb_precision, only: &
    1794             :         core_rknd ! Variable(s)
    1795             : 
    1796             :     use constants_clubb, only: &
    1797             :         zero, one, two, &
    1798             :         ep, Lv, Rd, Cp, &
    1799             :         chi_tol, &
    1800             :         eta_tol, &
    1801             :         max_mag_correlation
    1802             : 
    1803             :     implicit none
    1804             : 
    1805             :     integer, intent(in) :: &
    1806             :       ngrdcol,  & ! Number of grid columns
    1807             :       nz          ! Number of vertical level
    1808             : 
    1809             :     ! ----------- Input Variables -----------
    1810             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
    1811             :       tl, &
    1812             :       rsatl, &
    1813             :       rt, &
    1814             :       varnce_thl, &
    1815             :       varnce_rt, &
    1816             :       corr_rt_thl, &
    1817             :       exner
    1818             :     
    1819             :     ! ----------- Output Variables -----------
    1820             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  &
    1821             :       chi, &            ! s from Lewellen and Yoh 1993 (LY) eqn. 1
    1822             :       crt, &            ! Coefficients for s'
    1823             :       cthl, &           ! Coefficients for s'
    1824             :       stdev_chi, &      ! Standard deviation of chi for each component.
    1825             :       stdev_eta, &      ! Standard deviation of eta for each component.
    1826             :       covar_chi_eta, &  ! Covariance of chi and eta for each component.
    1827             :       corr_chi_eta      ! Correlation of chi and eta for each component.
    1828             : 
    1829             :     ! ----------- Local Variables -----------
    1830             :     real( kind = core_rknd ) :: &
    1831             :       varnce_rt_term, &
    1832             :       corr_rt_thl_term, &
    1833             :       varnce_thl_term, &
    1834             :       varnce_chi, &
    1835             :       varnce_eta, &
    1836             :       beta, &
    1837             :       invrs_beta_rsatl_p1
    1838             : 
    1839             :     real( kind = core_rknd ), parameter :: &
    1840             :       chi_tol_sqd = chi_tol**2, &
    1841             :       eta_tol_sqd = eta_tol**2, &
    1842             :       Cp_on_Lv = Cp / Lv
    1843             : 
    1844             :     ! Loop variable
    1845             :     integer :: k, i
    1846             : 
    1847             :     ! ----------- Begin Code -----------
    1848             : 
    1849             :     !$acc parallel loop gang vector collapse(2) default(present)
    1850   121412736 :     do k = 1, nz
    1851  2005148736 :       do i = 1, ngrdcol
    1852             : 
    1853             :         ! SD's beta (eqn. 8)
    1854  1883736000 :         beta = ep * Lv**2 / ( Rd * Cp * tl(i,k)**2 )
    1855             : 
    1856  1883736000 :         invrs_beta_rsatl_p1 = one / ( one + beta * rsatl(i,k) )
    1857             : 
    1858             :         ! s from Lewellen and Yoh 1993 (LY) eqn. 1
    1859  1883736000 :         chi(i,k) = ( rt(i,k) - rsatl(i,k) ) * invrs_beta_rsatl_p1
    1860             : 
    1861             :         ! For each normal distribution in the sum of two normal distributions,
    1862             :         ! s' = crt * rt'  +  cthl * thl';
    1863             :         ! therefore, x's' = crt * x'rt'  +  cthl * x'thl'.
    1864             :         ! Larson et al. May, 2001.
    1865  1883736000 :         crt(i,k)  = invrs_beta_rsatl_p1
    1866             :         cthl(i,k) = ( one + beta * rt(i,k) ) * invrs_beta_rsatl_p1**2 &
    1867  2003736960 :                     * Cp_on_Lv * beta * rsatl(i,k) * exner(i,k)
    1868             :                   
    1869             :       end do
    1870             :     end do
    1871             :     !$acc end parallel loop
    1872             : 
    1873             :     ! Calculate covariance, correlation, and standard deviation of 
    1874             :     ! chi and eta for each component
    1875             :     ! Include subplume correlation of qt, thl
    1876             :     !$acc parallel loop gang vector collapse(2) default(present)
    1877   121412736 :     do k = 1, nz
    1878  2005148736 :       do i = 1, ngrdcol
    1879             :        
    1880  1883736000 :         varnce_rt_term = crt(i,k)**2 * varnce_rt(i,k)
    1881  1883736000 :         varnce_thl_term = cthl(i,k)**2 * varnce_thl(i,k)
    1882             : 
    1883  1883736000 :         covar_chi_eta(i,k) = varnce_rt_term - varnce_thl_term
    1884             : 
    1885             :         corr_rt_thl_term = two * corr_rt_thl(i,k) * crt(i,k) * cthl(i,k) &
    1886  1883736000 :                            * sqrt( varnce_rt(i,k) * varnce_thl(i,k) )
    1887             : 
    1888  1883736000 :         varnce_chi = varnce_rt_term - corr_rt_thl_term + varnce_thl_term
    1889  1883736000 :         varnce_eta = varnce_rt_term + corr_rt_thl_term + varnce_thl_term
    1890             : 
    1891             :         ! We need to introduce a threshold value for the variance of chi and eta
    1892  2003736960 :         if ( varnce_chi < chi_tol_sqd .or. varnce_eta < eta_tol_sqd ) then
    1893             : 
    1894    47455623 :             if ( varnce_chi < chi_tol_sqd ) then
    1895    47447583 :                 stdev_chi(i,k) = zero  ! Treat chi as a delta function
    1896             :             else
    1897        8040 :                 stdev_chi(i,k) = sqrt( varnce_chi )
    1898             :             end if
    1899             : 
    1900    47455623 :             if ( varnce_eta < eta_tol_sqd ) then
    1901    47448366 :                 stdev_eta(i,k) = zero  ! Treat eta as a delta function
    1902             :             else
    1903        7257 :                 stdev_eta(i,k) = sqrt( varnce_eta )
    1904             :             end if
    1905             : 
    1906    47455623 :             corr_chi_eta(i,k) = zero
    1907             : 
    1908             :         else
    1909             : 
    1910  1836280377 :             stdev_chi(i,k) = sqrt( varnce_chi )
    1911  1836280377 :             stdev_eta(i,k) = sqrt( varnce_eta )
    1912             : 
    1913  1836280377 :             corr_chi_eta(i,k) = covar_chi_eta(i,k) / ( stdev_chi(i,k) * stdev_eta(i,k) )
    1914             :             corr_chi_eta(i,k) = min( max_mag_correlation, &
    1915  1836280377 :                                    max( -max_mag_correlation, corr_chi_eta(i,k) ) )
    1916             : 
    1917             :         end if
    1918             : 
    1919             :       end do
    1920             :     end do
    1921             :     !$acc end parallel loop
    1922             : 
    1923     1411776 :   end subroutine transform_pdf_chi_eta_component
    1924             :   
    1925             :   !=============================================================================
    1926      705888 :   subroutine calc_wp4_pdf( nz, ngrdcol, &
    1927      705888 :                            wm, w_1, w_2, &
    1928      705888 :                            varnce_w_1, varnce_w_2,    &
    1929      705888 :                            mixt_frac, &
    1930      705888 :                            wp4 )
    1931             : 
    1932             :     ! Description:
    1933             :     ! Calculates <w'^4> by integrating over the PDF of w.  The integral is:
    1934             :     !
    1935             :     ! <w'^4> = INT(-inf:inf) ( w - <w> )^4 P(w) dw;
    1936             :     !
    1937             :     ! where <w> is the overall mean of w and P(w) is a two-component normal
    1938             :     ! distribution of w.  The integrated equation is:
    1939             :     !
    1940             :     ! <w'^4> = mixt_frac * ( 3 * sigma_w_1^4
    1941             :     !                        + 6 * ( mu_w_1 - <w> )^2 * sigma_w_1^2
    1942             :     !                        + ( mu_w_1 - <w> )^4 )
    1943             :     !          + ( 1 - mixt_frac ) * ( 3 * sigma_w_2^4
    1944             :     !                                  + 6 * ( mu_w_2 - <w> )^2 * sigma_w_2^2
    1945             :     !                                  + ( mu_w_2 - <w> )^4 );
    1946             :     !
    1947             :     ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
    1948             :     ! of w in the 2nd PDF component, sigma_w_1 is the standard deviation of w in
    1949             :     ! the 1st PDF component, sigma_w_2 is the standard deviation of w in the 2nd
    1950             :     ! PDF component, and mixt_frac is the mixture fraction, which is the weight
    1951             :     ! of the 1st PDF component.
    1952             : 
    1953             :     ! References:
    1954             :     !-----------------------------------------------------------------------
    1955             : 
    1956             :     use constants_clubb, only: &
    1957             :         six,   & ! Variable(s)
    1958             :         three, &
    1959             :         one
    1960             : 
    1961             :     use clubb_precision, only: &
    1962             :         core_rknd    ! Variable(s)
    1963             : 
    1964             :     implicit none
    1965             : 
    1966             :     integer, intent(in) :: &
    1967             :       ngrdcol,  & ! Number of grid columns
    1968             :       nz          ! Number of vertical level
    1969             : 
    1970             :     ! Input Variables
    1971             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
    1972             :       wm,         & ! Mean of w (overall)                           [m/s]
    1973             :       w_1,        & ! Mean of w (1st PDF component)                 [m/s]
    1974             :       w_2,        & ! Mean of w (2nd PDF component)                 [m/s]
    1975             :       varnce_w_1, & ! Variance of w (1st PDF component)             [m^2/s^2]
    1976             :       varnce_w_2, & ! Variance of w (2nd PDF component)             [m^2/s^2]
    1977             :       mixt_frac     ! Mixture fraction                              [-]
    1978             : 
    1979             :     ! Output Variable
    1980             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  & 
    1981             :       wp4    ! <w'^4>                   [m^4/s^4]
    1982             :       
    1983             :     ! Local Variables
    1984             :     integer :: i, k
    1985             : 
    1986             :     !$acc parallel loop gang vector collapse(2) default(present)
    1987    60706368 :     do k = 1, nz
    1988  1002574368 :       do i = 1, ngrdcol
    1989             : 
    1990             :         ! Calculate <w'^4> by integrating over the PDF.
    1991  1883736000 :         wp4(i,k) = mixt_frac(i,k) * ( three * varnce_w_1(i,k)**2 &
    1992             :                             + six * ( ( w_1(i,k) - wm(i,k) )**2 ) * varnce_w_1(i,k) &
    1993             :                             + ( w_1(i,k) - wm(i,k) )**4 ) & 
    1994             :                    + ( one - mixt_frac(i,k) ) * ( three * varnce_w_2(i,k)**2 &
    1995             :                                         + six * ( (w_2(i,k) - wm(i,k) )**2 )*varnce_w_2(i,k) &
    1996  2885604480 :                                         + ( w_2(i,k) - wm(i,k) )**4 )
    1997             :       end do
    1998             :     end do
    1999             :     !$acc end parallel loop
    2000             : 
    2001      705888 :     return
    2002             : 
    2003             :   end subroutine calc_wp4_pdf
    2004             : 
    2005             :   !=============================================================================
    2006     1411776 :   subroutine calc_wp2xp2_pdf( nz, ngrdcol,             &
    2007     1411776 :                               wm, xm, w_1,             &
    2008     1411776 :                               w_2, x_1, x_2,           &
    2009     1411776 :                               varnce_w_1, varnce_w_2,  &
    2010     1411776 :                               varnce_x_1, varnce_x_2,  &
    2011     1411776 :                               corr_w_x_1, corr_w_x_2,  &
    2012     1411776 :                               mixt_frac, &
    2013     1411776 :                               wp2xp2 )
    2014             : 
    2015             :     ! Description:
    2016             :     ! Calculates <w'^2x'^2> by integrating over the PDF of w and x.  The
    2017             :     ! integral
    2018             :     ! is:
    2019             :     !
    2020             :     ! <w'^2x'^2>
    2021             :     ! = INT(-inf:inf) INT(-inf:inf) ( w - <w> )^2 ( x - <x> )^2 P(w,x) dx dw;
    2022             :     !
    2023             :     ! where <w> is the overall mean of w, <x> is the overall mean of x, and
    2024             :     ! P(w,x) is a two-component bivariate normal distribution of w and x.  The
    2025             :     ! integrated equation is:
    2026             :     !
    2027             :     ! <w'^2x'^2>
    2028             :     !   = mixt_frac
    2029             :     !      * ( ( mu_w_1 - <w> )**2 * ( ( mu_x_1 - <x> )**2 + sigma_x_1^2 )
    2030             :     !      + four * corr_w_x_1 * sigma_w_1 * sigma_x_1 * ( mu_x_1 - <x> ) * (
    2031             :     !      mu_w_1 - <w> )
    2032             :     !      + ( ( mu_x_1 - <x> )**2 + ( 1 + 2*corr_w_x_1**2 ) * sigma_x_1^2 ) *
    2033             :     !      sigma_w_1^2 )
    2034             :     !    + ( one - mixt_frac )
    2035             :     !      * ( ( mu_w_2 - <w> )**2 * ( ( mu_x_2 - <x> )**2 + sigma_x_2^2 )
    2036             :     !      + four * corr_w_x_2 * sigma_w_2 * sigma_x_2 * ( mu_x_2 - <x> ) * (
    2037             :     !      mu_w_2 - <w> )
    2038             :     !      + ( ( mu_x_2 - <x> )**2 + ( 1 + 2*corr_w_x_2**2 ) * sigma_x_2^2 ) *
    2039             :     !      sigma_w_2^2 )
    2040             :     !
    2041             :     ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
    2042             :     ! of w in the 2nd PDF component, mu_x_1 is the mean of x in the 1st PDF
    2043             :     ! component, mu_x_2 is the mean of x in the 2nd PDF component, sigma_w_1 is
    2044             :     ! the standard deviation of w in the 1st PDF component, sigma_w_2 is the
    2045             :     ! standard deviation of w in the 2nd PDF component, sigma_x_1 is the
    2046             :     ! standard deviation of x in the 1st PDF component, sigma_x_2 is the
    2047             :     ! standard deviation of x in the 2nd PDF component, corr_w_x_1 is the
    2048             :     ! correlation of w and x in the 1st PDF component, corr_w_x_2 is the
    2049             :     ! correlation of w and x in the 2nd PDF component, and mixt_frac is the
    2050             :     ! mixture fraction, which is the weight of the 1st PDF component.
    2051             : 
    2052             :     ! References:
    2053             :     !-----------------------------------------------------------------------
    2054             : 
    2055             :     use constants_clubb, only: &
    2056             :         one,   & ! Variable(s)
    2057             :         four
    2058             : 
    2059             :     use clubb_precision, only: &
    2060             :         core_rknd    ! Variable(s)
    2061             : 
    2062             :     implicit none
    2063             : 
    2064             :     integer, intent(in) :: &
    2065             :       ngrdcol,  & ! Number of grid columns
    2066             :       nz          ! Number of vertical level
    2067             : 
    2068             :     ! Input Variables
    2069             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
    2070             :       wm,         & ! Mean of w (overall)                       [m/s]
    2071             :       xm,         & ! Mean of x (overall)                       [units vary]
    2072             :       w_1,        & ! Mean of w (1st PDF component)             [m/s]
    2073             :       w_2,        & ! Mean of w (2nd PDF component)             [m/s]
    2074             :       x_1,        & ! Mean of x (1st PDF component)             [units vary]
    2075             :       x_2,        & ! Mean of x (2nd PDF component)             [units vary]
    2076             :       varnce_w_1, & ! Variance of w (1st PDF component)         [m^2/s^2]
    2077             :       varnce_w_2, & ! Variance of w (2nd PDF component)         [m^2/s^2]
    2078             :       varnce_x_1, & ! Variance of x (1st PDF component)         [(units vary)^2]
    2079             :       varnce_x_2, & ! Variance of x (2nd PDF component)         [(units vary)^2]
    2080             :       corr_w_x_1, & ! Correlation of w and x (1st PDF comp.)    [-]
    2081             :       corr_w_x_2, & ! Correlation of w and x (2nd PDF comp.)    [-]
    2082             :       mixt_frac     ! Mixture fraction                          [-]
    2083             : 
    2084             :     ! Output Variable
    2085             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  &
    2086             :       wp2xp2        ! <w'^2x'^2>                   [m^2/s^2 (units vary)^2]
    2087             :     
    2088             :     ! Local Variable
    2089             :     integer :: i, k
    2090             : 
    2091             :     !$acc parallel loop gang vector collapse(2) default(present)
    2092   121412736 :     do k = 1, nz
    2093  2005148736 :       do i = 1, ngrdcol
    2094             : 
    2095             :         ! Calculate <w'x'^2> by integrating over the PDF.
    2096  3767472000 :         wp2xp2(i,k) = mixt_frac(i,k) &
    2097             :                 * ( ( w_1(i,k) - wm(i,k) )**2 * ( ( x_1(i,k) - xm(i,k) )**2 + varnce_x_1(i,k) ) &
    2098             :                 + four * corr_w_x_1(i,k) * sqrt( varnce_w_1(i,k) * varnce_x_1(i,k) ) &
    2099             :                                          * ( x_1(i,k) - xm(i,k) ) * ( w_1(i,k) - wm(i,k) ) &
    2100             :                 + ( ( x_1(i,k) - xm(i,k) )**2 &
    2101             :                 + ( 1 + 2*corr_w_x_1(i,k)**2 ) * varnce_x_1(i,k) ) * varnce_w_1(i,k) ) &
    2102             :                 + ( one - mixt_frac(i,k) ) &
    2103             :                 * ( ( w_2(i,k) - wm(i,k) )**2 * ( ( x_2(i,k) - xm(i,k) )**2 + varnce_x_2(i,k) ) &
    2104             :                 + four * corr_w_x_2(i,k) * sqrt( varnce_w_2(i,k) * varnce_x_2(i,k) ) &
    2105             :                                          * ( x_2(i,k) - xm(i,k) ) * ( w_2(i,k) - wm(i,k) ) &
    2106             :                 + ( ( x_2(i,k) - xm(i,k) )**2 &
    2107  5771208960 :                 + ( 1 + 2*corr_w_x_2(i,k)**2 ) * varnce_x_2(i,k) ) * varnce_w_2(i,k) )
    2108             :       end do
    2109             :     end do
    2110             :     !$acc end parallel loop
    2111             : 
    2112     1411776 :     return
    2113             : 
    2114             :   end subroutine calc_wp2xp2_pdf
    2115             : 
    2116             :   !=============================================================================
    2117     1411776 :   subroutine calc_wp2xp_pdf( nz, ngrdcol,             &
    2118     1411776 :                              wm, xm, w_1, w_2,        &
    2119     1411776 :                              x_1, x_2,                &
    2120     1411776 :                              varnce_w_1, varnce_w_2,  &
    2121     1411776 :                              varnce_x_1, varnce_x_2,  &
    2122     1411776 :                              corr_w_x_1, corr_w_x_2,  &
    2123     1411776 :                              mixt_frac, &
    2124     1411776 :                              wp2xp ) 
    2125             : 
    2126             :     ! Description:
    2127             :     ! Calculates <w'^2 x'> by integrating over the PDF of w and x.  The integral
    2128             :     ! is:
    2129             :     !
    2130             :     ! <w'^2 x'>
    2131             :     ! = INT(-inf:inf) INT(-inf:inf) ( w - <w> )^2 ( x - <x> ) P(w,x) dx dw;
    2132             :     !
    2133             :     ! where <w> is the overall mean of w, <x> is the overall mean of x, and
    2134             :     ! P(w,x) is a two-component bivariate normal distribution of w and x.  The
    2135             :     ! integrated equation is:
    2136             :     !
    2137             :     ! <w'^2 x'>
    2138             :     ! = mixt_frac * ( ( mu_x_1 - <x> ) * ( ( mu_w_1 - <w> )^2 + sigma_w_1^2 )
    2139             :     !                 + 2 * corr_w_x_1 * sigma_w_1 * sigma_x_1
    2140             :     !                   * ( mu_w_1 - <w> ) )
    2141             :     !   + ( 1 - mixt_frac ) * ( ( mu_x_2 - <x> )
    2142             :     !                           * ( ( mu_w_2 - <w> )^2 + sigma_w_2^2 )
    2143             :     !                           + 2 * corr_w_x_2 * sigma_w_2 * sigma_x_2
    2144             :     !                             * ( mu_w_2 - <w> ) );
    2145             :     !
    2146             :     ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
    2147             :     ! of w in the 2nd PDF component, mu_x_1 is the mean of x in the 1st PDF
    2148             :     ! component, mu_x_2 is the mean of x in the 2nd PDF component, sigma_w_1 is
    2149             :     ! the standard deviation of w in the 1st PDF component, sigma_w_2 is the
    2150             :     ! standard deviation of w in the 2nd PDF component, sigma_x_1 is the
    2151             :     ! standard deviation of x in the 1st PDF component, sigma_x_2 is the
    2152             :     ! standard deviation of x in the 2nd PDF component, corr_w_x_1 is the
    2153             :     ! correlation of w and x in the 1st PDF component, corr_w_x_2 is the
    2154             :     ! correlation of w and x in the 2nd PDF component, and mixt_frac is the
    2155             :     ! mixture fraction, which is the weight of the 1st PDF component.
    2156             : 
    2157             :     ! References:
    2158             :     !-----------------------------------------------------------------------
    2159             : 
    2160             :     use constants_clubb, only: &
    2161             :         two,   & ! Variable(s)
    2162             :         one
    2163             : 
    2164             :     use clubb_precision, only: &
    2165             :         core_rknd    ! Variable(s)
    2166             : 
    2167             :     implicit none
    2168             : 
    2169             :     integer, intent(in) :: &
    2170             :       ngrdcol,  & ! Number of grid columns
    2171             :       nz          ! Number of vertical level
    2172             : 
    2173             :     ! Input Variables
    2174             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
    2175             :       wm,         & ! Mean of w (overall)                       [m/s]
    2176             :       xm,         & ! Mean of x (overall)                       [units vary]
    2177             :       w_1,        & ! Mean of w (1st PDF component)             [m/s]
    2178             :       w_2,        & ! Mean of w (2nd PDF component)             [m/s]
    2179             :       x_1,        & ! Mean of x (1st PDF component)             [units vary]
    2180             :       x_2,        & ! Mean of x (2nd PDF component)             [units vary]
    2181             :       varnce_w_1, & ! Variance of w (1st PDF component)         [m^2/s^2]
    2182             :       varnce_w_2, & ! Variance of w (2nd PDF component)         [m^2/s^2]
    2183             :       varnce_x_1, & ! Variance of x (1st PDF component)         [(units vary)^2]
    2184             :       varnce_x_2, & ! Variance of x (2nd PDF component)         [(units vary)^2]
    2185             :       corr_w_x_1, & ! Correlation of w and x (1st PDF comp.)    [-]
    2186             :       corr_w_x_2, & ! Correlation of w and x (2nd PDF comp.)    [-]
    2187             :       mixt_frac     ! Mixture fraction                          [-]
    2188             : 
    2189             :     ! Output Variable
    2190             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  & 
    2191             :       wp2xp    ! <w'^2 x'>                   [m^2/s^2 (units vary)]
    2192             : 
    2193             :     ! Local Variables
    2194             :     integer :: i, k
    2195             : 
    2196             : 
    2197             :     ! Calculate <w'^2 x'> by integrating over the PDF.
    2198             :     !$acc parallel loop gang vector collapse(2) default(present)
    2199   121412736 :     do k = 1, nz
    2200  2005148736 :       do i = 1, ngrdcol
    2201             :         
    2202  3767472000 :         wp2xp(i,k)  = mixt_frac(i,k) &
    2203             :                    * ( ( ( w_1(i,k) - wm(i,k) )**2 + varnce_w_1(i,k) ) * ( x_1(i,k) - xm(i,k) ) &
    2204             :                        + two * corr_w_x_1(i,k) * sqrt( varnce_w_1(i,k) * varnce_x_1(i,k) ) &
    2205             :                          * ( w_1(i,k) - wm(i,k) ) ) &
    2206             :                    + ( one - mixt_frac(i,k) ) &
    2207             :                      * ( ( ( w_2(i,k) - wm(i,k) )**2 + varnce_w_2(i,k) ) * ( x_2(i,k) - xm(i,k) ) &
    2208             :                          + two * corr_w_x_2(i,k) * sqrt( varnce_w_2(i,k) * varnce_x_2(i,k) ) &
    2209  5771208960 :                            * ( w_2(i,k) - wm(i,k) ) )
    2210             :       end do
    2211             :     end do
    2212             :     !$acc end parallel loop
    2213             : 
    2214     1411776 :     return
    2215             : 
    2216             :   end subroutine calc_wp2xp_pdf
    2217             : 
    2218             :   !=============================================================================
    2219     1411776 :   subroutine calc_wpxp2_pdf( nz, ngrdcol,             &
    2220     1411776 :                              wm, xm, w_1,             &
    2221     1411776 :                              w_2, x_1, x_2,           &
    2222     1411776 :                              varnce_w_1, varnce_w_2,  &
    2223     1411776 :                              varnce_x_1, varnce_x_2,  &
    2224     1411776 :                              corr_w_x_1, corr_w_x_2,  &
    2225     1411776 :                              mixt_frac, &
    2226     1411776 :                              wpxp2 )
    2227             : 
    2228             :     ! Description:
    2229             :     ! Calculates <w'x'^2> by integrating over the PDF of w and x.  The integral
    2230             :     ! is:
    2231             :     !
    2232             :     ! <w'x'^2>
    2233             :     ! = INT(-inf:inf) INT(-inf:inf) ( w - <w> ) ( x - <x> )^2 P(w,x) dx dw;
    2234             :     !
    2235             :     ! where <w> is the overall mean of w, <x> is the overall mean of x, and
    2236             :     ! P(w,x) is a two-component bivariate normal distribution of w and x.  The
    2237             :     ! integrated equation is:
    2238             :     !
    2239             :     ! <w'x'^2>
    2240             :     ! = mixt_frac * ( ( mu_w_1 - <w> ) * ( ( mu_x_1 - <x> )^2 + sigma_x_1^2 )
    2241             :     !                 + 2 * corr_w_x_1 * sigma_w_1 * sigma_x_1
    2242             :     !                   * ( mu_x_1 - <x> ) )
    2243             :     !   + ( 1 - mixt_frac ) * ( ( mu_w_2 - <w> )
    2244             :     !                           * ( ( mu_x_2 - <x> )^2 + sigma_x_2^2 )
    2245             :     !                           + 2 * corr_w_x_2 * sigma_w_2 * sigma_x_2
    2246             :     !                             * ( mu_x_2 - <x> ) );
    2247             :     !
    2248             :     ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
    2249             :     ! of w in the 2nd PDF component, mu_x_1 is the mean of x in the 1st PDF
    2250             :     ! component, mu_x_2 is the mean of x in the 2nd PDF component, sigma_w_1 is
    2251             :     ! the standard deviation of w in the 1st PDF component, sigma_w_2 is the
    2252             :     ! standard deviation of w in the 2nd PDF component, sigma_x_1 is the
    2253             :     ! standard deviation of x in the 1st PDF component, sigma_x_2 is the
    2254             :     ! standard deviation of x in the 2nd PDF component, corr_w_x_1 is the
    2255             :     ! correlation of w and x in the 1st PDF component, corr_w_x_2 is the
    2256             :     ! correlation of w and x in the 2nd PDF component, and mixt_frac is the
    2257             :     ! mixture fraction, which is the weight of the 1st PDF component.
    2258             : 
    2259             :     ! References:
    2260             :     !-----------------------------------------------------------------------
    2261             :     
    2262             :     use constants_clubb, only: &
    2263             :         two,   & ! Variable(s)
    2264             :         one
    2265             : 
    2266             :     use clubb_precision, only: &
    2267             :         core_rknd    ! Variable(s)
    2268             : 
    2269             :     implicit none
    2270             : 
    2271             :     integer, intent(in) :: &
    2272             :       ngrdcol,  & ! Number of grid columns
    2273             :       nz          ! Number of vertical level
    2274             : 
    2275             :     ! Input Variables
    2276             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
    2277             :       wm,         & ! Mean of w (overall)                       [m/s]
    2278             :       xm,         & ! Mean of x (overall)                       [units vary]
    2279             :       w_1,        & ! Mean of w (1st PDF component)             [m/s]
    2280             :       w_2,        & ! Mean of w (2nd PDF component)             [m/s]
    2281             :       x_1,        & ! Mean of x (1st PDF component)             [units vary]
    2282             :       x_2,        & ! Mean of x (2nd PDF component)             [units vary]
    2283             :       varnce_w_1, & ! Variance of w (1st PDF component)         [m^2/s^2]
    2284             :       varnce_w_2, & ! Variance of w (2nd PDF component)         [m^2/s^2]
    2285             :       varnce_x_1, & ! Variance of x (1st PDF component)         [(units vary)^2]
    2286             :       varnce_x_2, & ! Variance of x (2nd PDF component)         [(units vary)^2]
    2287             :       corr_w_x_1, & ! Correlation of w and x (1st PDF comp.)    [-]
    2288             :       corr_w_x_2, & ! Correlation of w and x (2nd PDF comp.)    [-]
    2289             :       mixt_frac     ! Mixture fraction                          [-]
    2290             : 
    2291             :     ! Return Variable
    2292             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) ::  & 
    2293             :       wpxp2    ! <w'x'^2>                   [m/s (units vary)^2]
    2294             :       
    2295             :     ! Local Variables
    2296             :     integer :: i, k
    2297             : 
    2298             :     !$acc parallel loop gang vector collapse(2) default(present)
    2299   121412736 :     do k = 1, nz
    2300  2005148736 :       do i = 1, ngrdcol
    2301             : 
    2302             :         ! Calculate <w'x'^2> by integrating over the PDF.
    2303  3767472000 :         wpxp2(i,k) = mixt_frac(i,k) &
    2304             :                 * ( ( w_1(i,k) - wm(i,k) ) * ( ( x_1(i,k) - xm(i,k) )**2 + varnce_x_1(i,k) ) &
    2305             :                     + two * corr_w_x_1(i,k) * sqrt( varnce_w_1(i,k) * varnce_x_1(i,k) ) &
    2306             :                       * ( x_1(i,k) - xm(i,k) ) ) &
    2307             :                 + ( one - mixt_frac(i,k) ) &
    2308             :                   * ( ( w_2(i,k) - wm(i,k) ) * ( ( x_2(i,k) - xm(i,k) )**2 + varnce_x_2(i,k) ) &
    2309             :                       + two * corr_w_x_2(i,k) * sqrt( varnce_w_2(i,k) * varnce_x_2(i,k) ) &
    2310  5771208960 :                         * ( x_2(i,k) - xm(i,k) ) )
    2311             :       end do
    2312             :     end do
    2313             :     !$acc end parallel loop
    2314             : 
    2315     1411776 :     return
    2316             : 
    2317             :   end subroutine calc_wpxp2_pdf
    2318             : 
    2319             :   !=============================================================================
    2320           0 :   subroutine calc_wpxpyp_pdf( nz, ngrdcol, &
    2321           0 :                               wm, xm, ym, w_1, w_2,   &
    2322           0 :                               x_1, x_2,               &
    2323           0 :                               y_1, y_2,               &
    2324           0 :                               varnce_w_1, varnce_w_2, &
    2325           0 :                               varnce_x_1, varnce_x_2, &
    2326           0 :                               varnce_y_1, varnce_y_2, &
    2327           0 :                               corr_w_x_1, corr_w_x_2, &
    2328           0 :                               corr_w_y_1, corr_w_y_2, &
    2329           0 :                               corr_x_y_1, corr_x_y_2, &
    2330           0 :                               mixt_frac, &
    2331           0 :                               wpxpyp )
    2332             : 
    2333             :     ! Description:
    2334             :     ! Calculates <w'x'y'> by integrating over the PDF of w, x, and y.  The
    2335             :     ! integral is:
    2336             :     !
    2337             :     ! <w'x'y'>
    2338             :     ! = INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
    2339             :     !   ( w - <w> ) ( x - <x> ) ( y - <y> ) P(w,x,y) dy dx dw;
    2340             :     !
    2341             :     ! where <w> is the overall mean of w, <x> is the overall mean of x, <y> is
    2342             :     ! the overall mean of y, and P(w,x,y) is a two-component trivariate normal
    2343             :     ! distribution of w, x, and y.  The integrated equation is:
    2344             :     !
    2345             :     ! <w'x'y'>
    2346             :     ! = mixt_frac 
    2347             :     !   * ( ( mu_w_1 - <w> ) * ( mu_x_1 - <x> ) * ( mu_y_1 - <y> )
    2348             :     !       + corr_x_y_1 * sigma_x_1 * sigma_y_1 * ( mu_w_1 - <w> )
    2349             :     !       + corr_w_y_1 * sigma_w_1 * sigma_y_1 * ( mu_x_1 - <x> )
    2350             :     !       + corr_w_x_1 * sigma_w_1 * sigma_x_1 * ( mu_y_1 - <y> ) )
    2351             :     !   + ( 1 - mixt_frac )
    2352             :     !     * ( ( mu_w_2 - <w> ) * ( mu_x_2 - <x> ) * ( mu_y_2 - <y> )
    2353             :     !         + corr_x_y_2 * sigma_x_2 * sigma_y_2 * ( mu_w_2 - <w> )
    2354             :     !         + corr_w_y_2 * sigma_w_2 * sigma_y_2 * ( mu_x_2 - <x> )
    2355             :     !         + corr_w_x_2 * sigma_w_2 * sigma_x_2 * ( mu_y_2 - <y> ) );
    2356             :     !
    2357             :     ! where mu_w_1 is the mean of w in the 1st PDF component, mu_w_2 is the mean
    2358             :     ! of w in the 2nd PDF component, mu_x_1 is the mean of x in the 1st PDF
    2359             :     ! component, mu_x_2 is the mean of x in the 2nd PDF component, mu_y_1 is the
    2360             :     ! mean of y in the 1st PDF component, mu_y_2 is the mean of y in the 2nd PDF
    2361             :     ! component, sigma_w_1 is the standard deviation of w in the 1st PDF
    2362             :     ! component, sigma_w_2 is the standard deviation of w in the 2nd PDF
    2363             :     ! component, sigma_x_1 is the standard deviation of x in the 1st PDF
    2364             :     ! component, sigma_x_2 is the standard deviation of x in the 2nd PDF
    2365             :     ! component, sigma_y_1 is the standard deviation of y in the 1st PDF
    2366             :     ! component, sigma_y_2 is the standard deviation of y in the 2nd PDF
    2367             :     ! component, corr_w_x_1 is the correlation of w and x in the 1st PDF
    2368             :     ! component, corr_w_x_2 is the correlation of w and x in the 2nd PDF
    2369             :     ! component, corr_w_y_1 is the correlation of w and y in the 1st PDF
    2370             :     ! component, corr_w_y_2 is the correlation of w and y in the 2nd PDF
    2371             :     ! component, corr_x_y_1 is the correlation of x and y in the 1st PDF
    2372             :     ! component, corr_x_y_2 is the correlation of x and y in the 2nd PDF
    2373             :     ! component, and mixt_frac is the mixture fraction, which is the weight of
    2374             :     ! the 1st PDF component.
    2375             : 
    2376             :     ! References:
    2377             :     !-----------------------------------------------------------------------
    2378             : 
    2379             :     use grid_class, only: &
    2380             :         grid ! Type
    2381             : 
    2382             :     use constants_clubb, only: &
    2383             :         one    ! Variable(s)
    2384             : 
    2385             :     use clubb_precision, only: &
    2386             :         core_rknd    ! Variable(s)
    2387             : 
    2388             :     implicit none
    2389             : 
    2390             :     integer, intent(in) :: &
    2391             :       ngrdcol,  & ! Number of grid columns
    2392             :       nz          ! Number of vertical level
    2393             : 
    2394             :     ! Input Variables
    2395             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) ::  &
    2396             :       wm,         & ! Mean of w (overall)                          [m/s]
    2397             :       xm,         & ! Mean of x (overall)                          [x units]
    2398             :       ym,         & ! Mean of y (overall)                          [y units]
    2399             :       w_1,        & ! Mean of w (1st PDF component)                [m/s]
    2400             :       w_2,        & ! Mean of w (2nd PDF component)                [m/s]
    2401             :       x_1,        & ! Mean of x (1st PDF component)                [x units]
    2402             :       x_2,        & ! Mean of x (2nd PDF component)                [x units]
    2403             :       y_1,        & ! Mean of y (1st PDF component)                [y units]
    2404             :       y_2,        & ! Mean of y (2nd PDF component)                [y units]
    2405             :       varnce_w_1, & ! Variance of w (1st PDF component)            [m^2/s^2]
    2406             :       varnce_w_2, & ! Variance of w (2nd PDF component)            [m^2/s^2]
    2407             :       varnce_x_1, & ! Variance of x (1st PDF component)            [(x units)^2]
    2408             :       varnce_x_2, & ! Variance of x (2nd PDF component)            [(x units)^2]
    2409             :       varnce_y_1, & ! Variance of y (1st PDF component)            [(y units)^2]
    2410             :       varnce_y_2, & ! Variance of y (2nd PDF component)            [(y units)^2]
    2411             :       corr_w_x_1, & ! Correlation of w and x (1st PDF component)   [-]
    2412             :       corr_w_x_2, & ! Correlation of w and x (2nd PDF component)   [-]
    2413             :       corr_w_y_1, & ! Correlation of w and y (1st PDF component)   [-]
    2414             :       corr_w_y_2, & ! Correlation of w and y (2nd PDF component)   [-]
    2415             :       corr_x_y_1, & ! Correlation of x and y (1st PDF component)   [-]
    2416             :       corr_x_y_2, & ! Correlation of x and y (2nd PDF component)   [-]
    2417             :       mixt_frac     ! Mixture fraction                             [-]
    2418             : 
    2419             :     ! Output Variable
    2420             :     real( kind = core_rknd ), dimension(ngrdcol,nz) ::  & 
    2421             :       wpxpyp    ! <w'x'y'>                   [m/s (units vary)]
    2422             : 
    2423             :     ! Local Variables
    2424             :     integer :: i, k
    2425             :     
    2426             : 
    2427             :     ! Calculate <w'x'y'> by integrating over the PDF.
    2428             :     !$acc parallel loop gang vector collapse(2) default(present)
    2429           0 :     do k = 1, nz
    2430           0 :       do i = 1, ngrdcol
    2431           0 :         wpxpyp(i,k) &
    2432             :         = mixt_frac(i,k) &
    2433             :           * ( ( w_1(i,k) - wm(i,k) ) * ( x_1(i,k) - xm(i,k) ) * ( y_1(i,k) - ym(i,k) ) &
    2434             :               + corr_x_y_1(i,k)*sqrt( varnce_x_1(i,k)*varnce_y_1(i,k) )*( w_1(i,k)-wm(i,k) ) &
    2435             :               + corr_w_y_1(i,k)*sqrt( varnce_w_1(i,k)*varnce_y_1(i,k) )*( x_1(i,k)-xm(i,k) ) &
    2436             :               + corr_w_x_1(i,k)*sqrt( varnce_w_1(i,k)*varnce_x_1(i,k) )*( y_1(i,k)-ym(i,k) ) ) &
    2437             :           + ( one - mixt_frac(i,k) ) &
    2438             :             * ( ( w_2(i,k) - wm(i,k) )*( x_2(i,k) - xm(i,k) ) * ( y_2(i,k) - ym(i,k) ) &
    2439             :                 + corr_x_y_2(i,k)*sqrt( varnce_x_2(i,k)*varnce_y_2(i,k) )*( w_2(i,k)-wm(i,k) ) &
    2440             :                 + corr_w_y_2(i,k)*sqrt( varnce_w_2(i,k)*varnce_y_2(i,k) )*( x_2(i,k)-xm(i,k) ) &
    2441           0 :                 + corr_w_x_2(i,k)*sqrt( varnce_w_2(i,k)*varnce_x_2(i,k) )*( y_2(i,k)-ym(i,k) ) )
    2442             :       end do
    2443             :     end do
    2444             :     !$acc end parallel loop
    2445             : 
    2446           0 :     return
    2447             : 
    2448             :   end subroutine calc_wpxpyp_pdf
    2449             : 
    2450             :   !=============================================================================
    2451     1411776 :   subroutine calc_liquid_cloud_frac_component( nz, ngrdcol, &
    2452     1411776 :                                                mean_chi, stdev_chi, &
    2453     1411776 :                                                cloud_frac, rc )
    2454             :     ! Description:
    2455             :     ! Calculates the PDF component cloud water mixing ratio, rc_i, and cloud
    2456             :     ! fraction, cloud_frac_i, for the ith PDF component.
    2457             :     !
    2458             :     ! The equation for cloud water mixing ratio, rc, at any point is:
    2459             :     !
    2460             :     ! rc = chi * H(chi);
    2461             :     !
    2462             :     ! and the equation for cloud fraction at a point, fc, is:
    2463             :     !
    2464             :     ! fc = H(chi);
    2465             :     !
    2466             :     ! where where extended liquid water mixing ratio, chi, is equal to cloud
    2467             :     ! water mixing ratio, rc, when positive.  When the atmosphere is saturated
    2468             :     ! at this point, cloud water is found, and rc = chi, while fc = 1.
    2469             :     ! Otherwise, clear air is found at this point, and rc = fc = 0.
    2470             :     !
    2471             :     ! The mean of rc and fc is calculated by integrating over the PDF, such
    2472             :     ! that:
    2473             :     !
    2474             :     ! <rc> = INT(-inf:inf) chi * H(chi) * P(chi) dchi; and
    2475             :     !
    2476             :     ! cloud_frac = <fc> = INT(-inf:inf) H(chi) * P(chi) dchi.
    2477             :     !
    2478             :     ! This can be rewritten as:
    2479             :     !
    2480             :     ! <rc> = INT(0:inf) chi * P(chi) dchi; and
    2481             :     !
    2482             :     ! cloud_frac = <fc> = INT(0:inf) P(chi) dchi;
    2483             :     !
    2484             :     ! and further rewritten as:
    2485             :     !
    2486             :     ! <rc> = SUM(i=1,N) mixt_frac_i INT(0:inf) chi * P_i(chi) dchi; and
    2487             :     !
    2488             :     ! cloud_frac = SUM(i=1,N) mixt_frac_i INT(0:inf) P_i(chi) dchi;
    2489             :     !
    2490             :     ! where N is the number of PDF components.  The equation for mean rc in the
    2491             :     ! ith PDF component is:
    2492             :     !
    2493             :     ! rc_i = INT(0:inf) chi * P_i(chi) dchi;
    2494             :     !
    2495             :     ! and the equation for cloud fraction in the ith PDF component is:
    2496             :     ! 
    2497             :     ! cloud_frac_i = INT(0:inf) P_i(chi) dchi.
    2498             :     !
    2499             :     ! The component values are related to the overall values by:
    2500             :     !
    2501             :     ! <rc> = SUM(i=1,N) mixt_frac_i * rc_i; and
    2502             :     !
    2503             :     ! cloud_frac = SUM(i=1,N) mixt_frac_i * cloud_frac_i.
    2504             : 
    2505             :     ! References:
    2506             :     !----------------------------------------------------------------------
    2507             : 
    2508             :     use constants_clubb, only: &
    2509             :         chi_tol,        & ! Tolerance for pdf parameter chi       [kg/kg]
    2510             :         sqrt_2pi,       & ! sqrt(2*pi)
    2511             :         sqrt_2,         & ! sqrt(2)
    2512             :         one,            & ! 1
    2513             :         one_half,       & ! 1/2
    2514             :         zero,           & ! 0
    2515             :         max_num_stdevs, &
    2516             :         eps
    2517             : 
    2518             :     use clubb_precision, only: &
    2519             :         core_rknd     ! Precision
    2520             : 
    2521             :     implicit none
    2522             : 
    2523             :     integer, intent(in) :: &
    2524             :       ngrdcol,  & ! Number of grid columns
    2525             :       nz          ! Number of vertical level
    2526             : 
    2527             :     !----------- Input Variables -----------
    2528             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    2529             :       mean_chi,  & ! Mean of chi (old s) (ith PDF component)           [kg/kg]
    2530             :       stdev_chi    ! Standard deviation of chi (ith PDF component)     [kg/kg]
    2531             : 
    2532             :     !----------- Output Variables -----------
    2533             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    2534             :       cloud_frac, & ! Cloud fraction (ith PDF component)               [-]
    2535             :       rc            ! Mean cloud water mixing ratio (ith PDF comp.)    [kg/kg]
    2536             : 
    2537             :     !----------- Local Variables -----------
    2538             :     real( kind = core_rknd), parameter :: &
    2539             :       invrs_sqrt_2 = one / sqrt_2, &
    2540             :       invrs_sqrt_2pi = one / sqrt_2pi
    2541             : 
    2542             :     real( kind = core_rknd ) :: &
    2543             :       zeta
    2544             : 
    2545             :     integer :: k, i    ! Vertical loop index
    2546             : 
    2547             :     !----------- Begin Code -----------
    2548             :     !$acc parallel loop gang vector collapse(2) default(present)
    2549   121412736 :     do k = 1, nz
    2550  2005148736 :       do i = 1, ngrdcol
    2551             : 
    2552  3767472000 :         if ( ( abs( mean_chi(i,k) ) <= eps .and. stdev_chi(i,k) <= chi_tol ) &
    2553  5771208960 :                .or. ( mean_chi(i,k) < - max_num_stdevs * stdev_chi(i,k) ) ) then
    2554             : 
    2555             :             ! The mean of chi is at saturation and does not vary in the ith PDF component
    2556  1774142983 :             cloud_frac(i,k) = zero
    2557  1774142983 :             rc(i,k)         = zero
    2558             : 
    2559   109593017 :         elseif ( mean_chi(i,k) > max_num_stdevs * stdev_chi(i,k) ) then
    2560             : 
    2561             :             ! The mean of chi is multiple standard deviations above the saturation point.
    2562             :             ! Thus, all cloud in the ith PDF component.
    2563    18458032 :             cloud_frac(i,k) = one
    2564    18458032 :             rc(i,k)         = mean_chi(i,k)
    2565             : 
    2566             :         else
    2567             : 
    2568             :             ! The mean of chi is within max_num_stdevs of the saturation point.
    2569             :             ! Thus, layer is partly cloudy, requires calculation.
    2570             : 
    2571    91134985 :             zeta = mean_chi(i,k) / stdev_chi(i,k)
    2572             : 
    2573    91134985 :             cloud_frac(i,k) = one_half * ( one + erf( zeta * invrs_sqrt_2 )  )
    2574             : 
    2575             :             rc(i,k) = mean_chi(i,k) * cloud_frac(i,k) &
    2576    91134985 :                       + stdev_chi(i,k) * exp( - one_half * zeta**2 ) * invrs_sqrt_2pi
    2577             : 
    2578             :         end if
    2579             :         
    2580             :       end do
    2581             :     end do
    2582             :     !$acc end parallel loop
    2583             : 
    2584     1411776 :     return
    2585             : 
    2586             :   end subroutine calc_liquid_cloud_frac_component
    2587             : 
    2588             :   !=============================================================================
    2589     1411776 :   subroutine calc_ice_cloud_frac_component( nz, ngrdcol, &
    2590     1411776 :                                             mean_chi, stdev_chi, &
    2591     1411776 :                                             rc_in, cloud_frac, &
    2592     1411776 :                                             p_in_Pa, tl, &
    2593     1411776 :                                             rsatl, crt, &
    2594     1411776 :                                             ice_supersat_frac, rc )
    2595             :   ! Description:
    2596             :   !   A version of the cloud fraction calculation modified to work
    2597             :   !   for layers that are potentially below freezing. If there are
    2598             :   !   no below freezing levels, the ice_supersat_frac calculation is 
    2599             :   !   the same as cloud_frac. 
    2600             :   !
    2601             :   !   For the below freezing levels, the saturation point will be
    2602             :   !   non-zero, thus we need to calculate chi_at_ice_sat.
    2603             :   !
    2604             :   !   The description of the equations are located in the description
    2605             :   !   of calc_liquid_cloud_frac_component.
    2606             :   !----------------------------------------------------------------------
    2607             : 
    2608             :     use constants_clubb, only: &
    2609             :         chi_tol,        & ! Tolerance for pdf parameter chi       [kg/kg]
    2610             :         T_freeze_K,     & ! Freezing point of water             [K]
    2611             :         sqrt_2pi,       & ! sqrt(2*pi)
    2612             :         sqrt_2,         & ! sqrt(2)
    2613             :         one,            & ! 1
    2614             :         one_half,       & ! 1/2
    2615             :         zero,           & ! 0
    2616             :         max_num_stdevs, &
    2617             :         eps
    2618             : 
    2619             :     use clubb_precision, only: &
    2620             :         core_rknd     ! Precision
    2621             : 
    2622             :     use saturation, only:  & 
    2623             :         sat_mixrat_ice
    2624             : 
    2625             :     implicit none
    2626             : 
    2627             :     ! ---------------------- Input Variables ----------------------
    2628             :     integer, intent(in) :: &
    2629             :       ngrdcol,  & ! Number of grid columns
    2630             :       nz          ! Number of vertical level
    2631             : 
    2632             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    2633             :       mean_chi,   & ! Mean of chi (old s) (ith PDF component)           [kg/kg]
    2634             :       stdev_chi,  & ! Standard deviation of chi (ith PDF component)     [kg/kg]
    2635             :       rc_in,      & ! Mean cloud water mixing ratio (ith PDF comp.)     [kg/kg]
    2636             :       cloud_frac, & ! Cloud fraction                                    [-]
    2637             :       p_in_Pa,    & ! Pressure                                          [Pa]
    2638             :       rsatl,      & ! Saturation mixing ratio of liquid                 [kg/kg]
    2639             :       crt,        & ! r_t coef. in chi/eta eqns.                        [-]
    2640             :       tl            ! Quantities needed to predict higher order moments
    2641             :                     ! tl = thl*exner
    2642             : 
    2643             :     ! ---------------------- Output Variables ----------------------
    2644             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    2645             :       ice_supersat_frac,  & ! Ice supersaturation fraction                [-]
    2646             :       rc                    ! Mean cloud ice mixing ratio (ith PDF comp.) [kg/kg]
    2647             : 
    2648             :     ! ---------------------- Local Variables----------------------
    2649             :     real( kind = core_rknd), parameter :: &
    2650             :       invrs_sqrt_2 = one / sqrt_2, &
    2651             :       invrs_sqrt_2pi = one / sqrt_2pi
    2652             : 
    2653             :     real( kind = core_rknd ) :: &
    2654             :       zeta, &
    2655             :       chi_at_ice_sat
    2656             : 
    2657             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    2658     2823552 :       rsat_ice
    2659             : 
    2660             :     integer :: k, i    ! Loop indices
    2661             : 
    2662             :     logical :: &
    2663             :       l_any_below_freezing
    2664             : 
    2665             :     ! ---------------------- Begin Code ----------------------
    2666             : 
    2667     1411776 :     l_any_below_freezing = .false.
    2668             : 
    2669             :     ! If a grid boxes is above freezing, then the calculation is the 
    2670             :     ! same as the cloud_frac calculation
    2671             :     !$acc parallel loop gang vector collapse(2) default(present) &
    2672             :     !$acc          reduction(.or.:l_any_below_freezing)
    2673   121412736 :     do k = 1, nz
    2674  2005148736 :       do i = 1, ngrdcol 
    2675  2003736960 :         if ( tl(i,k) > T_freeze_K ) then
    2676   370783364 :           ice_supersat_frac(i,k) = cloud_frac(i,k)
    2677   370783364 :           rc(i,k)                = rc_in(i,k)
    2678             :         else
    2679             :           l_any_below_freezing = .true.
    2680             :         end if
    2681             :       end do
    2682             :     end do
    2683             :     !$acc end parallel loop
    2684             : 
    2685             :     ! If all grid boxes are above freezing, then the calculation is the 
    2686             :     ! same as the cloud_frac calculation
    2687     1411776 :     if ( .not. l_any_below_freezing ) then
    2688             :       return
    2689             :     end if
    2690             : 
    2691             :     !$acc data create( rsat_ice )
    2692             : 
    2693             :     ! Calculate the saturation mixing ratio of ice
    2694     1411776 :     rsat_ice = sat_mixrat_ice( nz, ngrdcol, p_in_Pa, tl )
    2695             : 
    2696             :     !$acc parallel loop gang vector collapse(2) default(present)
    2697   121412736 :     do k = 1, nz
    2698  2005148736 :       do i = 1, ngrdcol
    2699             : 
    2700  2003736960 :         if ( tl(i,k) <= T_freeze_K ) then
    2701             : 
    2702             :           ! Temperature is freezing, we must compute chi_at_ice_sat and 
    2703             :           ! calculate the new cloud_frac_component
    2704  1512952636 :           chi_at_ice_sat = crt(i,k) * ( rsat_ice(i,k) - rsatl(i,k) ) 
    2705             : 
    2706             :           if ( ( abs( mean_chi(i,k)-chi_at_ice_sat ) <= eps .and. stdev_chi(i,k) <= chi_tol ) &
    2707  1512952636 :            .or. ( mean_chi(i,k)-chi_at_ice_sat < - max_num_stdevs * stdev_chi(i,k) ) ) then
    2708             : 
    2709             :             ! The mean of chi is at saturation and does not vary in the ith PDF component
    2710  1382228998 :             ice_supersat_frac(i,k) = zero
    2711  1382228998 :             rc(i,k)         = zero
    2712             : 
    2713   130723638 :           elseif ( mean_chi(i,k)-chi_at_ice_sat > max_num_stdevs * stdev_chi(i,k) ) then
    2714             : 
    2715             :             ! The mean of chi is multiple standard deviations above the saturation point.
    2716             :             ! Thus, all cloud in the ith PDF component.
    2717    84429422 :             ice_supersat_frac(i,k) = one
    2718    84429422 :             rc(i,k)         = mean_chi(i,k)-chi_at_ice_sat
    2719             : 
    2720             :           else
    2721             : 
    2722             :             ! The mean of chi is within max_num_stdevs of the saturation point.
    2723             :             ! Thus, layer is partly cloudy, requires calculation.
    2724             : 
    2725    46294216 :             zeta = (mean_chi(i,k)-chi_at_ice_sat) / stdev_chi(i,k)
    2726             : 
    2727    46294216 :             ice_supersat_frac(i,k) = one_half * ( one + erf( zeta * invrs_sqrt_2 )  )
    2728             : 
    2729             :             rc(i,k) = (mean_chi(i,k)-chi_at_ice_sat) * ice_supersat_frac(i,k) &
    2730    46294216 :                       + stdev_chi(i,k) * exp( - one_half * zeta**2 ) * invrs_sqrt_2pi
    2731             : 
    2732             :           end if
    2733             : 
    2734             :         end if
    2735             : 
    2736             :       end do
    2737             :     end do
    2738             :     !$acc end parallel loop
    2739             : 
    2740             :     !$acc end data
    2741             : 
    2742             :     return
    2743             : 
    2744             :   end subroutine calc_ice_cloud_frac_component
    2745             : 
    2746             :   !=============================================================================
    2747     1411776 :   subroutine calc_xprcp_component( nz, ngrdcol,                                     & ! In
    2748     1411776 :                                    wm, rtm, thlm, um, vm, rcm,                      & ! In
    2749     1411776 :                                    w_i, rt_i,                                       & ! In
    2750     1411776 :                                    thl_i, u_i, v_i,                                 & ! In
    2751     1411776 :                                    varnce_w_i, chi_i,                               & ! In
    2752     1411776 :                                    stdev_chi_i, stdev_eta_i,                        & ! In
    2753     1411776 :                                    corr_w_chi_i, corr_chi_eta_i,                    & ! In
    2754             : !                                  corr_u_w_i, corr_v_w_i,                          & ! In
    2755     1411776 :                                    crt_i, cthl_i,                                   & ! In
    2756     1411776 :                                    rc_i, cloud_frac_i, iiPDF_type,                  & ! In
    2757     1411776 :                                    wprcp_contrib_comp_i, wp2rcp_contrib_comp_i,     & ! Out
    2758     1411776 :                                    rtprcp_contrib_comp_i, thlprcp_contrib_comp_i,   & ! Out
    2759     1411776 :                                    uprcp_contrib_comp_i, vprcp_contrib_comp_i )       ! Out
    2760             : 
    2761             :     ! Description:
    2762             :     ! Calculates the contribution to <w'rc'>, <w'^2 rc'>, <rt'rc'>, and
    2763             :     ! <thl'rc'> from the ith PDF component.
    2764             :     !
    2765             :     !
    2766             :     ! <w'rc'>
    2767             :     ! -------
    2768             :     !
    2769             :     ! The value of <w'rc'> is calculated by integrating over the PDF:
    2770             :     !
    2771             :     ! <w'rc'>
    2772             :     ! = INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
    2773             :     !   ( w - <w> ) ( rc - <rc> ) P(w,rt,thl) dthl drt dw;
    2774             :     !
    2775             :     ! where <w> is the overall mean of w, <rc> is the overall mean of rc, and
    2776             :     ! P(w,rt,thl) is a two-component trivariate normal distribution of w, rt,
    2777             :     ! and thl.  This equation is rewritten as:
    2778             :     !
    2779             :     ! <w'rc'>
    2780             :     ! = mixt_frac 
    2781             :     !   * INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
    2782             :     !     ( w - <w> ) ( rc - <rc> ) P_1(w,rt,thl) dthl drt dw
    2783             :     !   + ( 1 - mixt_frac )
    2784             :     !     * INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
    2785             :     !       ( w - <w> ) ( rc - <rc> ) P_2(w,rt,thl) dthl drt dw;
    2786             :     !
    2787             :     ! where mixt_frac is the mixture fraction, which is the weight of the 1st
    2788             :     ! PDF component, and where P_1(w,rt,thl) and P_2(w,rt,thl) are the equations
    2789             :     ! for the trivariate normal PDF of w, rt, and thl in the 1st and 2nd PDF
    2790             :     ! components, respectively.  The contribution from the ith PDF component is:
    2791             :     !
    2792             :     ! INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
    2793             :     ! ( w - <w> ) ( rc - <rc> ) P_i(w,rt,thl) dthl drt dw;
    2794             :     !
    2795             :     ! where P_i(w,rt,thl) is the trivariate normal PDF of w, rt, and thl in the
    2796             :     ! ith PDF component.  The PDF undergoes a PDF transformation in each PDF
    2797             :     ! component, which is a change of variables and a translation, stretching,
    2798             :     ! and rotation of the axes.  The PDF becomes a trivariate normal PDF that is
    2799             :     ! written in terms of w, chi, and eta coordinates.  Cloud water mixing
    2800             :     ! ratio, rc, is written in terms of extended liquid water mixing ratio, chi,
    2801             :     ! such that:
    2802             :     !
    2803             :     ! rc = chi H(chi);
    2804             :     !
    2805             :     ! where H(chi) is the Heaviside step function.  The contribution from the
    2806             :     ! ith PDF component to <w'rc'> can be written as:
    2807             :     !
    2808             :     ! INT(-inf:inf) INT(-inf:inf)
    2809             :     ! ( w - <w> ) ( chi H(chi) - <rc> ) P_i(w,chi) dchi dw;
    2810             :     !
    2811             :     ! where P_i(w,chi) is the bivariate normal PDF of w and chi in the ith PDF
    2812             :     ! component.  The solved equation for the <w'rc'> contribution from the ith
    2813             :     ! PDF component (wprcp_contrib_comp_i) is:
    2814             :     !
    2815             :     ! wprcp_contrib_comp_i
    2816             :     ! = INT(-inf:inf) INT(-inf:inf)
    2817             :     !   ( w - <w> ) ( chi H(chi) - <rc> ) P_i(w,chi) dchi dw
    2818             :     ! = ( mu_w_i - <w> )
    2819             :     !   * ( mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
    2820             :     !       + 1/sqrt(2*pi) * sigma_chi_i
    2821             :     !         * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) } - <rc> )
    2822             :     !   + corr_w_chi_i * sigma_w_i * sigma_chi_i
    2823             :     !     * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) );
    2824             :     !
    2825             :     ! where mu_w_i is the mean of w in the ith PDF component, mu_chi_i is the
    2826             :     ! mean of chi in the ith PDF component, sigma_w_i is the standard deviation
    2827             :     ! of w in the ith PDF component, sigma_chi_i is the standard deviation of
    2828             :     ! chi in the ith PDF component, and corr_w_chi_i is the correlation of w and
    2829             :     ! chi in the ith PDF component.
    2830             :     !
    2831             :     ! Special case:  sigma_chi_i = 0.
    2832             :     !
    2833             :     ! In the special case that sigma_chi_i = 0, chi, as well as rc, are constant
    2834             :     ! in the ith PDF component.  The equation becomes:
    2835             :     !
    2836             :     ! wprcp_contrib_comp_i
    2837             :     ! = | ( mu_w_i - <w> ) * ( mu_chi_i - <rc> ); when mu_chi_i > 0;
    2838             :     !   | ( mu_w_i - <w> ) * ( -<rc> ); when mu_chi_i <= 0.
    2839             :     !
    2840             :     !
    2841             :     ! <w'^2 rc'>
    2842             :     ! ----------
    2843             :     !
    2844             :     ! The value of <w'^2 rc'> is calculated by integrating over the PDF:
    2845             :     !
    2846             :     ! <w'^2 rc'>
    2847             :     ! = INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
    2848             :     !   ( w - <w> )^2 ( rc - <rc> ) P(w,rt,thl) dthl drt dw.
    2849             :     !
    2850             :     ! This equation is rewritten as:
    2851             :     !
    2852             :     ! <w'^2 rc'>
    2853             :     ! = mixt_frac 
    2854             :     !   * INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
    2855             :     !     ( w - <w> )^2 ( rc - <rc> ) P_1(w,rt,thl) dthl drt dw
    2856             :     !   + ( 1 - mixt_frac )
    2857             :     !     * INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
    2858             :     !       ( w - <w> )^2 ( rc - <rc> ) P_2(w,rt,thl) dthl drt dw.
    2859             :     !
    2860             :     ! The contribution from the ith PDF component is:
    2861             :     !
    2862             :     ! INT(-inf:inf) INT(-inf:inf) INT(-inf:inf)
    2863             :     ! ( w - <w> )^2 ( rc - <rc> ) P_i(w,rt,thl) dthl drt dw.
    2864             :     !
    2865             :     ! The PDF undergoes a PDF transformation in each PDF component, and becomes
    2866             :     ! a trivariate normal PDF that is written in terms of w, chi, and eta
    2867             :     ! coordinates.  The contribution from the ith PDF component to <w'^2 rc'>
    2868             :     ! can be written as:
    2869             :     !
    2870             :     ! INT(-inf:inf) INT(-inf:inf)
    2871             :     ! ( w - <w> )^2 ( chi H(chi) - <rc> ) P_i(w,chi) dchi dw.
    2872             :     !
    2873             :     ! The solved equation for the <w'^2 rc'> contribution from the ith PDF
    2874             :     ! component (wp2rcp_contrib_comp_i) is:
    2875             :     !
    2876             :     ! wp2rcp_contrib_comp_i
    2877             :     ! = INT(-inf:inf) INT(-inf:inf)
    2878             :     !   ( w - <w> )^2 ( chi H(chi) - <rc> ) P_i(w,chi) dchi dw
    2879             :     ! = ( ( mu_w_i - <w> )^2 + sigma_w_i^2 )
    2880             :     !   * ( mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
    2881             :     !       + 1/sqrt(2*pi) * sigma_chi_i
    2882             :     !         * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) } - <rc> )
    2883             :     !   + ( mu_w_i - <w> ) * corr_w_chi_i * sigma_w_i * sigma_chi_i
    2884             :     !     * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
    2885             :     !   + 1/sqrt(2*pi) * corr_w_chi_i^2 * sigma_w_i^2 * sigma_chi_i
    2886             :     !     * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) }.
    2887             :     !
    2888             :     ! Special case:  sigma_chi_i = 0.
    2889             :     !
    2890             :     ! In the special case that sigma_chi_i = 0, chi, as well as rc, are constant
    2891             :     ! in the ith PDF component.  The equation becomes:
    2892             :     !
    2893             :     ! wp2rcp_contrib_comp_i
    2894             :     ! = | ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * ( mu_chi_i - <rc> );
    2895             :     !   |     when mu_chi_i > 0;
    2896             :     !   | ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * ( -<rc> );
    2897             :     !   |     when mu_chi_i <= 0.
    2898             :     !
    2899             :     !
    2900             :     ! <rt'rc'>
    2901             :     ! --------
    2902             :     !
    2903             :     ! The value of <rt'rc'> is calculated by integrating over the PDF:
    2904             :     !
    2905             :     ! <rt'rc'>
    2906             :     ! = INT(-inf:inf) INT(-inf:inf)
    2907             :     !   ( rt - <rt> ) ( rc - <rc> ) P(rt,thl) dthl drt;
    2908             :     !
    2909             :     ! where <rt> is the overall mean of rt, and where P(rt,thl) is a
    2910             :     ! two-component bivariate normal distribution of rt and thl.  This equation
    2911             :     ! is rewritten as:
    2912             :     !
    2913             :     ! <rt'rc'>
    2914             :     ! = mixt_frac 
    2915             :     !   * INT(-inf:inf) INT(-inf:inf)
    2916             :     !     ( rt - <rt> ) ( rc - <rc> ) P_1(rt,thl) dthl drt
    2917             :     !   + ( 1 - mixt_frac )
    2918             :     !     * INT(-inf:inf) INT(-inf:inf)
    2919             :     !       ( rt - <rt> ) ( rc - <rc> ) P_2(rt,thl) dthl drt;
    2920             :     !
    2921             :     ! where P_1(rt,thl) and P_2(rt,thl) are the equations for the bivariate
    2922             :     ! normal PDF of rt and thl in the 1st and 2nd PDF components, respectively.
    2923             :     ! The contribution from the ith PDF component is:
    2924             :     !
    2925             :     ! INT(-inf:inf) INT(-inf:inf)
    2926             :     ! ( rt - <rt> ) ( rc - <rc> ) P_i(rt,thl) dthl drt;
    2927             :     !
    2928             :     ! where P_i(rt,thl) is the bivariate normal PDF of rt and thl in the ith PDF
    2929             :     ! component.  The PDF undergoes a PDF transformation in each PDF component,
    2930             :     ! and becomes a bivariate normal PDF that is written in terms of chi and
    2931             :     ! eta coordinates.  Total water mixing ratio, rt, is rewritten in terms of
    2932             :     ! chi and eta by:
    2933             :     !
    2934             :     ! rt = mu_rt_i
    2935             :     !      + ( ( eta - mu_eta_i ) + ( chi - mu_chi_i ) ) / ( 2 * crt_i );
    2936             :     !
    2937             :     ! where mu_rt_i is the mean of rt in the ith PDF component, mu_eta_i is the
    2938             :     ! mean of eta in the ith PDF component, and crt_i is a coefficient on rt in
    2939             :     ! the chi/eta transformation equations.  The contribution from the ith PDF
    2940             :     ! component to <rt'rc'> can be written as:
    2941             :     !
    2942             :     ! INT(-inf:inf) INT(-inf:inf)
    2943             :     ! ( mu_rt_i - <rt> + ( eta - mu_eta_i ) / ( 2 * crt_i )
    2944             :     !   + ( chi - mu_chi_i ) / ( 2 * crt_i ) )
    2945             :     ! * ( chi H(chi) - <rc> ) P_i(chi,eta) deta dchi;
    2946             :     !
    2947             :     ! where P_i(chi,eta) is the bivariate normal PDF of chi and eta in the ith
    2948             :     ! PDF component.  The solved equation for the <rt'rc'> contribution from the
    2949             :     ! ith PDF component (rtprcp_contrib_comp_i) is:
    2950             :     !
    2951             :     ! rtprcp_contrib_comp_i
    2952             :     ! = INT(-inf:inf) INT(-inf:inf)
    2953             :     !   ( mu_rt_i - <rt> + ( eta - mu_eta_i ) / ( 2 * crt_i )
    2954             :     !     + ( chi - mu_chi_i ) / ( 2 * crt_i ) )
    2955             :     !   * ( chi H(chi) - <rc> ) P_i(chi,eta) deta dchi
    2956             :     ! = ( mu_rt_i - <rt> )
    2957             :     !   * ( mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
    2958             :     !       + 1/sqrt(2*pi) * sigma_chi_i
    2959             :     !         * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) } - <rc> )
    2960             :     !   + ( corr_chi_eta_i * sigma_eta_i + sigma_chi_i ) / ( 2 * crt_i )
    2961             :     !     * sigma_chi_i
    2962             :     !     * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) );
    2963             :     !
    2964             :     ! where sigma_eta_i is the standard deviation of eta in the ith PDF
    2965             :     ! component and corr_chi_eta_i is the correlation of chi and eta in the ith
    2966             :     ! PDF component.
    2967             :     !
    2968             :     ! Special case:  sigma_chi_i = 0.
    2969             :     !
    2970             :     ! In the special case that sigma_chi_i = 0, chi, as well as rc, are constant
    2971             :     ! in the ith PDF component.  The equation becomes:
    2972             :     !
    2973             :     ! rtprcp_contrib_comp_i
    2974             :     ! = | ( mu_rt_i - <rt> ) * ( mu_chi_i - <rc> ); when mu_chi_i > 0;
    2975             :     !   | ( mu_rt_i - <rt> ) * ( -<rc> ); when mu_chi_i <= 0.
    2976             :     !
    2977             :     !
    2978             :     ! <thl'rc'>
    2979             :     ! ---------
    2980             :     !
    2981             :     ! The value of <thl'rc'> is calculated by integrating over the PDF:
    2982             :     !
    2983             :     ! <thl'rc'>
    2984             :     ! = INT(-inf:inf) INT(-inf:inf)
    2985             :     !   ( thl - <thl> ) ( rc - <rc> ) P(rt,thl) dthl drt;
    2986             :     !
    2987             :     ! where <thl> is the overall mean of thl.  This equation is rewritten as:
    2988             :     !
    2989             :     ! <thl'rc'>
    2990             :     ! = mixt_frac 
    2991             :     !   * INT(-inf:inf) INT(-inf:inf)
    2992             :     !     ( thl - <thl> ) ( rc - <rc> ) P_1(rt,thl) dthl drt
    2993             :     !   + ( 1 - mixt_frac )
    2994             :     !     * INT(-inf:inf) INT(-inf:inf)
    2995             :     !       ( thl - <thl> ) ( rc - <rc> ) P_2(rt,thl) dthl drt.
    2996             :     !
    2997             :     ! The contribution from the ith PDF component is:
    2998             :     !
    2999             :     ! INT(-inf:inf) INT(-inf:inf)
    3000             :     ! ( thl - <thl> ) ( rc - <rc> ) P_i(rt,thl) dthl drt.
    3001             :     !
    3002             :     ! The PDF undergoes a PDF transformation in each PDF component, and becomes
    3003             :     ! a bivariate normal PDF that is written in terms of chi and eta
    3004             :     ! coordinates.  Liquid water potential temperature, thl, is rewritten in
    3005             :     ! terms of chi and eta by:
    3006             :     !
    3007             :     ! thl = mu_thl_i
    3008             :     !       + ( ( eta - mu_eta_i ) - ( chi - mu_chi_i ) ) / ( 2 * cthl_i );
    3009             :     !
    3010             :     ! where mu_thl_i is the mean of thl in the ith PDF component and cthl_i is a
    3011             :     ! coefficient on thl in the chi/eta transformation equations.  The
    3012             :     ! contribution from the ith PDF component to <thl'rc'> can be written as:
    3013             :     !
    3014             :     ! INT(-inf:inf) INT(-inf:inf)
    3015             :     ! ( mu_thl_i - <thl> + ( eta - mu_eta_i ) / ( 2 * cthl_i )
    3016             :     !   - ( chi - mu_chi_i ) / ( 2 * cthl_i ) )
    3017             :     ! * ( chi H(chi) - <rc> ) P_i(chi,eta) deta dchi.
    3018             :     !
    3019             :     ! The solved equation for the <thl'rc'> contribution from the ith PDF
    3020             :     ! component (thlprcp_contrib_comp_i) is:
    3021             :     !
    3022             :     ! thlprcp_contrib_comp_i
    3023             :     ! = INT(-inf:inf) INT(-inf:inf)
    3024             :     !   ( mu_thl_i - <thl> + ( eta - mu_eta_i ) / ( 2 * cthl_i )
    3025             :     !     - ( chi - mu_chi_i ) / ( 2 * cthl_i ) )
    3026             :     !   * ( chi H(chi) - <rc> ) P_i(chi,eta) deta dchi
    3027             :     ! = ( mu_thl_i - <thl> )
    3028             :     !   * ( mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
    3029             :     !       + 1/sqrt(2*pi) * sigma_chi_i
    3030             :     !         * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) } - <rc> )
    3031             :     !   + ( corr_chi_eta_i * sigma_eta_i - sigma_chi_i ) / ( 2 * cthl_i )
    3032             :     !     * sigma_chi_i
    3033             :     !     * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) ).
    3034             :     !
    3035             :     ! Special case:  sigma_chi_i = 0.
    3036             :     !
    3037             :     ! In the special case that sigma_chi_i = 0, chi, as well as rc, are constant
    3038             :     ! in the ith PDF component.  The equation becomes:
    3039             :     !
    3040             :     ! thlprcp_contrib_comp_i
    3041             :     ! = | ( mu_thl_i - <thl> ) * ( mu_chi_i - <rc> ); when mu_chi_i > 0;
    3042             :     !   | ( mu_thl_i - <thl> ) * ( -<rc> ); when mu_chi_i <= 0.
    3043             :     !
    3044             :     !
    3045             :     ! Use equations for PDF component cloud fraction cloud water mixing ratio
    3046             :     ! -----------------------------------------------------------------------
    3047             :     !
    3048             :     ! The equation for cloud fraction in the ith PDF component, fc_i, is:
    3049             :     !
    3050             :     ! fc_i = 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) ).
    3051             :     !
    3052             :     ! In the special case that sigma_chi_i = 0, the equation becomes:
    3053             :     !
    3054             :     ! fc_i = | 1; when mu_chi_i > 0;
    3055             :     !        | 0; when mu_chi_i <= 0.
    3056             :     !
    3057             :     ! The equation for mean cloud water mixing ratio in the ith PDF component,
    3058             :     ! rc_i, is:
    3059             :     !
    3060             :     ! rc_i
    3061             :     ! = mu_chi_i * 1/2 * ( 1 + erf( mu_chi_i / ( sqrt(2) * sigma_chi_i ) ) )
    3062             :     !   + 1/sqrt(2*pi) * sigma_chi_i
    3063             :     !     * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) }
    3064             :     ! = mu_chi_i * fc_i
    3065             :     !   + 1/sqrt(2*pi) * sigma_chi_i
    3066             :     !     * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) }.
    3067             :     !
    3068             :     ! In the special case that sigma_chi_i = 0, the equation becomes:
    3069             :     !
    3070             :     ! rc_i = | mu_chi_i; when mu_chi_i > 0;
    3071             :     !        | 0; when mu_chi_i <= 0.
    3072             :     !
    3073             :     ! The above equations can be substituted into the equations for
    3074             :     ! wprcp_contrib_comp_i, wp2rcp_contrib_comp_i, rtprcp_contrib_comp_i, and
    3075             :     ! thlprcp_contrib_comp_i.  The new equations are:
    3076             :     !
    3077             :     ! wprcp_contrib_comp_i
    3078             :     ! = ( mu_w_i - <w> ) * ( rc_i - <rc> )
    3079             :     !   + corr_w_chi_i * sigma_w_i * sigma_chi_i * fc_i;
    3080             :     !
    3081             :     ! wp2rcp_contrib_comp_i
    3082             :     ! = ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * ( rc_i - <rc> )
    3083             :     !   + 2 * ( mu_w_i - <w> ) * corr_w_chi_i * sigma_w_i * sigma_chi_i * fc_i
    3084             :     !   + 1/sqrt(2*pi) * corr_w_chi_i^2 * sigma_w_i^2 * sigma_chi_i
    3085             :     !     * exp{ - mu_chi_i^2 / ( 2 * sigma_chi_i^2 ) };
    3086             :     !
    3087             :     ! rtprcp_contrib_comp_i
    3088             :     ! = ( mu_rt_i - <rt> ) * ( rc_i - <rc> )
    3089             :     !   + ( corr_chi_eta_i * sigma_eta_i + sigma_chi_i ) / ( 2 * crt_i )
    3090             :     !     * sigma_chi_i * fc_i; and
    3091             :     !
    3092             :     ! thlprcp_contrib_comp_i
    3093             :     ! = ( mu_thl_i - <thl> ) * ( rc_i - <rc> )
    3094             :     !   + ( corr_chi_eta_i * sigma_eta_i - sigma_chi_i ) / ( 2 * cthl_i )
    3095             :     !     * sigma_chi_i * fc_i.
    3096             :     !
    3097             :     ! While the above equations reduce to their listed versions in the special
    3098             :     ! case that sigma_chi_i = 0, those versions are faster to calculate.  When
    3099             :     ! mu_chi_i > 0, they are:
    3100             :     !
    3101             :     ! wprcp_contrib_comp_i = ( mu_w_i - <w> ) * ( mu_chi_i - <rc> );
    3102             :     ! wp2rcp_contrib_comp_i
    3103             :     ! = ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * ( mu_chi_i - <rc> );
    3104             :     ! rtprcp_contrib_comp_i = ( mu_rt_i - <rt> ) * ( mu_chi_i - <rc> ); and
    3105             :     ! thlprcp_contrib_comp_i = ( mu_thl_i - <thl> ) * ( mu_chi_i - <rc> );
    3106             :     !
    3107             :     ! and when mu_chi_i <= 0, they are:
    3108             :     !
    3109             :     ! wprcp_contrib_comp_i = - ( mu_w_i - <w> ) * <rc>;
    3110             :     ! wp2rcp_contrib_comp_i = - ( ( mu_w_i - <w> )^2 + sigma_w_i^2 ) * <rc>;
    3111             :     ! rtprcp_contrib_comp_i = - ( mu_rt_i - <rt> ) * <rc>; and
    3112             :     ! thlprcp_contrib_comp_i = - ( mu_thl_i - <thl> ) * <rc>.
    3113             : 
    3114             :     ! References:
    3115             :     !-----------------------------------------------------------------------
    3116             : 
    3117             :     use grid_class, only: &
    3118             :         grid ! Type
    3119             : 
    3120             :     use constants_clubb, only: &
    3121             :         sqrt_2pi,       & ! Variable(s)
    3122             :         two,            &
    3123             :         zero,           &
    3124             :         chi_tol
    3125             : 
    3126             :     use clubb_precision, only: &
    3127             :         core_rknd    ! Variable(s)
    3128             : 
    3129             :     implicit none
    3130             : 
    3131             :     integer, intent(in) :: &
    3132             :       ngrdcol,  & ! Number of grid columns
    3133             :       nz          ! Number of vertical level
    3134             : 
    3135             :     ! Input Variables
    3136             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    3137             :       wm,             & ! Mean of w (overall)                          [m/s]
    3138             :       rtm,            & ! Mean of rt (overall)                         [kg/kg]
    3139             :       thlm,           & ! Mean of thl (overall)                        [K]
    3140             :       um,             & ! Mean of eastward wind (overall)              [m/s]
    3141             :       vm,             & ! Mean of northward wind (overall)             [m/s]
    3142             :       rcm,            & ! Mean of rc (overall)                         [kg/kg]
    3143             :       w_i,            & ! Mean of w (ith PDF component)                [m/s]
    3144             :       rt_i,           & ! Mean of rt (ith PDF component)               [kg/kg]
    3145             :       thl_i,          & ! Mean of thl (ith PDF component)              [K]
    3146             :       u_i,            & ! Mean of eastward wind (ith PDF component)    [m/s]
    3147             :       v_i,            & ! Mean of northward wind (ith PDF component)   [m/s]
    3148             :       varnce_w_i,     & ! Variance of w (ith PDF component)            [m^2/s^2]
    3149             :       chi_i,          & ! Mean of chi (ith PDF component)              [kg/kg]
    3150             :       stdev_chi_i,    & ! Standard deviation of chi (ith PDF comp.)    [kg/kg]
    3151             :       stdev_eta_i,    & ! Standard deviation of eta (ith PDF comp.)    [kg/kg]
    3152             :       corr_w_chi_i,   & ! Correlation of w and chi (ith PDF component) [-]
    3153             :       corr_chi_eta_i, & ! Correlation of chi and eta (ith PDF comp.)   [-]
    3154             : !     corr_u_w_i,     & ! Correlation of u and w (ith PDF component)   [-]
    3155             : !     corr_v_w_i,     & ! Correlation of v and w (ith PDF component)   [-]
    3156             :       crt_i,          & ! Coef. on rt in chi/eta eqns. (ith PDF comp.) [-]
    3157             :       cthl_i,         & ! Coef. on thl: chi/eta eqns. (ith PDF comp.)  [kg/kg/K]
    3158             :       rc_i,           & ! Mean of rc (ith PDF component)               [kg/kg]
    3159             :       cloud_frac_i      ! Cloud fraction (ith PDF component)           [-]
    3160             : 
    3161             :     integer, intent(in) :: &
    3162             :       iiPDF_type    ! Selected option for the two-component normal (double
    3163             :                     ! Gaussian) PDF type to use for the w, rt, and theta-l (or
    3164             :                     ! w, chi, and eta) portion of CLUBB's multivariate,
    3165             :                     ! two-component PDF.
    3166             : 
    3167             :     ! Output Variables
    3168             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    3169             :       wprcp_contrib_comp_i,   & ! <w'rc'> contrib. (ith PDF comp.)  [m/s(kg/kg)]
    3170             :       wp2rcp_contrib_comp_i,  & ! <w'^2rc'> contrib. (ith comp) [m^2/s^2(kg/kg)]
    3171             :       rtprcp_contrib_comp_i,  & ! <rt'rc'> contrib. (ith PDF comp.)  [kg^2/kg^2]
    3172             :       thlprcp_contrib_comp_i, & ! <thl'rc'> contrib. (ith PDF comp.)  [K(kg/kg)]
    3173             :       uprcp_contrib_comp_i,   & ! <u'rc'> contrib. (ith PDF comp.)  [m/s(kg/kg)]
    3174             :       vprcp_contrib_comp_i      ! <v'rc'> contrib. (ith PDF comp.)  [m/s(kg/kg)]
    3175             :       
    3176             :     ! Local Variables
    3177             :     integer :: i, k
    3178             : 
    3179             :     ! ---------------------- Begin Code ------------------
    3180             :     
    3181             :     ! Changing these conditionals may result in inconsistencies with the conditional
    3182             :     ! statements located in calc_cloud_frac_component
    3183             :     !$acc parallel loop gang vector collapse(2) default(present)
    3184   121412736 :     do k = 1, nz
    3185  2005148736 :       do i = 1, ngrdcol
    3186             : 
    3187  1883736000 :         wprcp_contrib_comp_i(i,k) = ( w_i(i,k) - wm(i,k) ) * ( rc_i(i,k) - rcm(i,k) )
    3188             : 
    3189             :         wp2rcp_contrib_comp_i(i,k) = ( ( w_i(i,k) - wm(i,k) )**2 + varnce_w_i(i,k) ) &
    3190  1883736000 :                                      * ( rc_i(i,k) - rcm(i,k) )
    3191             : 
    3192             :         rtprcp_contrib_comp_i(i,k) = ( rt_i(i,k) - rtm(i,k) ) * ( rc_i(i,k) - rcm(i,k) ) &
    3193             :                                 + ( corr_chi_eta_i(i,k) * stdev_eta_i(i,k) + stdev_chi_i(i,k) ) &
    3194  1883736000 :                                   / ( two * crt_i(i,k) ) * stdev_chi_i(i,k) * cloud_frac_i(i,k)
    3195             : 
    3196             :         thlprcp_contrib_comp_i(i,k) = ( thl_i(i,k) - thlm(i,k) ) * ( rc_i(i,k) - rcm(i,k) ) &
    3197             :                                  + ( corr_chi_eta_i(i,k) * stdev_eta_i(i,k) - stdev_chi_i(i,k) ) &
    3198  1883736000 :                                    / ( two * cthl_i(i,k) ) * stdev_chi_i(i,k) * cloud_frac_i(i,k)
    3199             : 
    3200  1883736000 :         uprcp_contrib_comp_i(i,k) = ( u_i(i,k) - um(i,k) ) * ( rc_i(i,k) - rcm(i,k) )
    3201             : 
    3202  2003736960 :         vprcp_contrib_comp_i(i,k) = ( v_i(i,k) - vm(i,k) ) * ( rc_i(i,k) - rcm(i,k) )
    3203             :         
    3204             :       end do
    3205             :     end do
    3206             :     !$acc end parallel loop
    3207             : 
    3208             :     ! If iiPDF_type isn't iiPDF_ADG1, iiPDF_ADG2, or iiPDF_new_hybrid, so
    3209             :     ! corr_w_chi_i /= 0 (and perhaps corr_u_w_i /= 0).
    3210     1411776 :     if ( .not. ( iiPDF_type == iiPDF_ADG1 .or. iiPDF_type == iiPDF_ADG2 &
    3211             :                  .or. iiPDF_type == iiPDF_new_hybrid ) ) then
    3212             : 
    3213             :         ! Chi varies significantly in the ith PDF component (stdev_chi > chi_tol)
    3214             :         ! and there is some cloud (0 < cloud_frac <= 1)
    3215           0 :         do k = 1, nz
    3216           0 :           do i = 1, ngrdcol
    3217           0 :             if ( stdev_chi_i(i,k) > chi_tol .and. cloud_frac_i(i,k) > zero ) then
    3218             : 
    3219             :               wprcp_contrib_comp_i(i,k) = wprcp_contrib_comp_i(i,k) &
    3220             :                                           + corr_w_chi_i(i,k) * sqrt( varnce_w_i(i,k) ) &
    3221           0 :                                             * stdev_chi_i(i,k) * cloud_frac_i(i,k)
    3222             : 
    3223             :               wp2rcp_contrib_comp_i(i,k) = wp2rcp_contrib_comp_i(i,k) &
    3224             :                                            + two * ( w_i(i,k) - wm(i,k) ) * corr_w_chi_i(i,k) &
    3225             :                                              * sqrt( varnce_w_i(i,k) ) * stdev_chi_i(i,k) &
    3226             :                                              * cloud_frac_i(i,k) &
    3227             :                                            + corr_w_chi_i(i,k)**2 * varnce_w_i(i,k) &
    3228             :                                              * stdev_chi_i(i,k) &
    3229             :                                              * exp( -chi_i(i,k)**2 / ( two*stdev_chi_i(i,k)**2 ) ) &
    3230           0 :                                                / sqrt_2pi
    3231             : 
    3232             :             ! In principle, uprcp_contrib_comp_i might depend on corr_u_w_i here.
    3233             :           end if
    3234             :         end do
    3235             :       end do
    3236             :     end if 
    3237             : 
    3238     1411776 :     return
    3239             : 
    3240             :   end subroutine calc_xprcp_component
    3241             : 
    3242             :   !=============================================================================
    3243           0 :   subroutine calc_w_up_in_cloud( nz, ngrdcol, &
    3244           0 :                                  mixt_frac, cloud_frac_1, cloud_frac_2, &
    3245           0 :                                  w_1, w_2, varnce_w_1, varnce_w_2, &
    3246           0 :                                  w_up_in_cloud, w_down_in_cloud, &
    3247           0 :                                  cloudy_updraft_frac, cloudy_downdraft_frac )
    3248             : 
    3249             :     ! Description:
    3250             :     ! Subroutine that computes the mean cloudy updraft (and also calculates
    3251             :     ! the mean cloudy downdraft).
    3252             :     !
    3253             :     ! In order to activate aerosol, we'd like to feed the activation scheme
    3254             :     ! a vertical velocity that's representative of cloudy updrafts. For skewed
    3255             :     ! layers, like cumulus layers, this might be an improvement over the square
    3256             :     ! root of wp2 that's currently used. At the same time, it would be simpler
    3257             :     ! and less expensive than feeding SILHS samples into the aerosol code
    3258             :     ! (see larson-group/e3sm#19 and larson-group/e3sm#26).
    3259             :     !
    3260             :     ! The formulas are only valid for certain PDFs in CLUBB (ADG1, ADG2,
    3261             :     ! new hybrid), hence we omit calculation if another PDF type is used.
    3262             :     !
    3263             :     ! References: https://www.overleaf.com/project/614a136d47846639af22ae34
    3264             :     !----------------------------------------------------------------------
    3265             : 
    3266             :     use constants_clubb, only: &
    3267             :         sqrt_2pi,       & ! sqrt(2*pi)
    3268             :         sqrt_2,         & ! sqrt(2)
    3269             :         one,            & ! 1
    3270             :         one_half,       & ! 1/2
    3271             :         zero,           & ! 0
    3272             :         max_num_stdevs, &
    3273             :         eps
    3274             : 
    3275             :     use clubb_precision, only: &
    3276             :         core_rknd     ! Precision
    3277             : 
    3278             :     implicit none
    3279             : 
    3280             :     integer, intent(in) :: &
    3281             :       ngrdcol,  & ! Number of grid columns
    3282             :       nz          ! Number of vertical level
    3283             : 
    3284             :     !----------- Input Variables -----------
    3285             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    3286             :       mixt_frac, &      ! mixture fraction                             [-]
    3287             :       cloud_frac_1, &   ! cloud fraction (1st PDF component)           [-]
    3288             :       cloud_frac_2, &   ! cloud fraction (2nd PDF component)           [-]
    3289             :       w_1, &            ! upward velocity (1st PDF component)          [m/s]
    3290             :       w_2, &            ! upward velocity (2nd PDF component)          [m/s]
    3291             :       varnce_w_1, &     ! standard deviation of w (1st PDF component)  [m^2/s^2]
    3292             :       varnce_w_2        ! standard deviation of w (2nd PDF component)  [m^2/s^2]
    3293             : 
    3294             :     !----------- Output Variables -----------
    3295             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
    3296             :       w_up_in_cloud,         & ! mean cloudy updraft speed             [m/s]
    3297             :       w_down_in_cloud,       & ! mean cloudy downdraft speed           [m/s]
    3298             :       cloudy_updraft_frac,   & ! cloudy updraft fraction               [-]
    3299             :       cloudy_downdraft_frac    ! cloudy downdraft fraction             [-]
    3300             : 
    3301             :     !----------- Local Variables -----------
    3302             :     real( kind = core_rknd ) :: &
    3303             :       w_up_1, w_up_2, &        ! integral of w and Heaviside fnc, where w > 0
    3304             :       w_down_1, w_down_2, &    ! integral of w and Heaviside fnc, where w < 0
    3305             :       stdev_w_1, stdev_w_2, &  ! Standard deviation of w
    3306             :       ratio_w_1, &             ! mu_w_1 / ( sqrt(2) * sigma_w_1 )
    3307             :       ratio_w_2, &             ! mu_w_2 / ( sqrt(2) * sigma_w_2 )
    3308             :       erf_ratio_w_1, &         ! erf( ratio_w_1 )
    3309             :       erf_ratio_w_2, &         ! erf( ratio_w_2 )
    3310             :       exp_neg_ratio_w_1_sqd, & ! exp( -ratio_w_1^2 )
    3311             :       exp_neg_ratio_w_2_sqd, & ! exp( -ratio_w_2^2 )
    3312             :       updraft_frac_1, &        ! Fraction of 1st PDF comp. where w > 0
    3313             :       updraft_frac_2, &        ! Fraction of 2nd PDF comp. where w > 0
    3314             :       downdraft_frac_1, &      ! Fraction of 1st PDF comp. where w < 0
    3315             :       downdraft_frac_2         ! Fraction of 2nd PDF comp. where w < 0
    3316             :       
    3317             :     integer :: i, k
    3318             :       
    3319             :     !$acc parallel loop gang vector collapse(2) default(present)
    3320           0 :     do k = 1, nz
    3321           0 :       do i = 1, ngrdcol
    3322             : 
    3323           0 :         stdev_w_1 = sqrt(varnce_w_1(i,k))
    3324           0 :         stdev_w_2 = sqrt(varnce_w_2(i,k))
    3325             : 
    3326             :         ! Calculate quantities in the 1st PDF component.
    3327           0 :         if ( w_1(i,k) > max_num_stdevs * stdev_w_1 ) then
    3328             : 
    3329             :            ! The mean of w in the 1st PDF component is more than
    3330             :            ! max_num_stdevs standard deviations above 0.
    3331             :            ! The entire 1st PDF component is found in an updraft (w > 0).
    3332             :            w_up_1 = w_1(i,k)
    3333             :            updraft_frac_1 = one
    3334             :            w_down_1 = zero
    3335             :            downdraft_frac_1 = zero
    3336             : 
    3337           0 :         elseif ( w_1(i,k) < - max_num_stdevs * stdev_w_1 ) then
    3338             : 
    3339             :            ! The mean of w in the 1st PDF component is more than
    3340             :            ! max_num_stdevs standard deviations below 0.
    3341             :            ! The entire 1st PDF component is found in a downdraft (w < 0).
    3342             :            w_up_1 = zero
    3343             :            updraft_frac_1 = zero
    3344             :            w_down_1 = w_1(i,k)
    3345             :            downdraft_frac_1 = one
    3346             : 
    3347             :         else
    3348             : 
    3349             :            ! The 1st PDF component contains both updraft and downdraft.
    3350           0 :            ratio_w_1 = w_1(i,k) / ( sqrt_2 * max(eps, stdev_w_1) )
    3351           0 :            erf_ratio_w_1 = erf( ratio_w_1 )
    3352           0 :            exp_neg_ratio_w_1_sqd = exp( -ratio_w_1**2 )
    3353             : 
    3354             :            w_up_1 &
    3355             :            = one_half * w_1(i,k) * ( one + erf_ratio_w_1 ) &
    3356           0 :              + ( stdev_w_1 / sqrt_2pi ) * exp_neg_ratio_w_1_sqd
    3357             : 
    3358           0 :            updraft_frac_1 = one_half * ( one + erf_ratio_w_1 )
    3359             : 
    3360             :            w_down_1 &
    3361             :            = one_half * w_1(i,k) * ( one - erf_ratio_w_1 ) &
    3362           0 :              - ( stdev_w_1 / sqrt_2pi ) * exp_neg_ratio_w_1_sqd
    3363             : 
    3364             :            !downdraft_frac_1 = one_half * ( one - erf_ratio_w_1 )
    3365           0 :            downdraft_frac_1 = one - updraft_frac_1
    3366             : 
    3367             :         endif
    3368             : 
    3369             :         ! Calculate quantities in the 2nd PDF component.
    3370           0 :         if ( w_2(i,k) > max_num_stdevs * stdev_w_2 ) then
    3371             : 
    3372             :            ! The mean of w in the 2nd PDF component is more than
    3373             :            ! max_num_stdevs standard deviations above 0.
    3374             :            ! The entire 2nd PDF component is found in an updraft (w > 0).
    3375             :            w_up_2 = w_2(i,k)
    3376             :            updraft_frac_2 = one
    3377             :            w_down_2 = zero
    3378             :            downdraft_frac_2 = zero
    3379             : 
    3380           0 :         elseif ( w_2(i,k) < - max_num_stdevs * stdev_w_2 ) then
    3381             : 
    3382             :            ! The mean of w in the 2nd PDF component is more than
    3383             :            ! max_num_stdevs standard deviations below 0.
    3384             :            ! The entire 2nd PDF component is found in a downdraft (w < 0).
    3385             :            w_up_2 = zero
    3386             :            updraft_frac_2 = zero
    3387             :            w_down_2 = w_2(i,k)
    3388             :            downdraft_frac_2 = one
    3389             : 
    3390             :         else
    3391             : 
    3392             :            ! The 2nd PDF component contains both updraft and downdraft.
    3393           0 :            ratio_w_2 = w_2(i,k) / ( sqrt_2 * max(eps, stdev_w_2) )
    3394           0 :            erf_ratio_w_2 = erf( ratio_w_2 )
    3395           0 :            exp_neg_ratio_w_2_sqd = exp( -ratio_w_2**2 )
    3396             : 
    3397             :            w_up_2 &
    3398             :            = one_half * w_2(i,k) * ( one + erf_ratio_w_2 ) &
    3399           0 :              + ( stdev_w_2 / sqrt_2pi ) * exp_neg_ratio_w_2_sqd
    3400             : 
    3401           0 :            updraft_frac_2 = one_half * ( one + erf_ratio_w_2 )
    3402             : 
    3403             :            w_down_2 &
    3404             :            = one_half * w_2(i,k) * ( one - erf_ratio_w_2 ) &
    3405           0 :              - ( stdev_w_2 / sqrt_2pi ) * exp_neg_ratio_w_2_sqd
    3406             : 
    3407             :            !downdraft_frac_2 = one_half * ( one - erf_ratio_w_2 )
    3408           0 :            downdraft_frac_2 = one - updraft_frac_2
    3409             : 
    3410             :         endif
    3411             : 
    3412             :         ! Calculate the total cloudy updraft fraction.
    3413             :         cloudy_updraft_frac(i,k) &
    3414             :         = mixt_frac(i,k) * cloud_frac_1(i,k) * updraft_frac_1 &
    3415           0 :           + ( one - mixt_frac(i,k) ) * cloud_frac_2(i,k) * updraft_frac_2
    3416             : 
    3417             :         ! Calculate the total cloudy downdraft fraction.
    3418             :         cloudy_downdraft_frac(i,k) &
    3419             :         = mixt_frac(i,k) * cloud_frac_1(i,k) * downdraft_frac_1 &
    3420           0 :           + ( one - mixt_frac(i,k) ) * cloud_frac_2(i,k) * downdraft_frac_2
    3421             : 
    3422             :         ! Calculate the mean vertical velocity found in a cloudy updraft. 
    3423             :         w_up_in_cloud(i,k) &
    3424             :         = ( mixt_frac(i,k) * cloud_frac_1(i,k) * w_up_1 &
    3425             :             + ( one - mixt_frac(i,k) ) * cloud_frac_2(i,k) * w_up_2 ) &
    3426           0 :           / max( eps, cloudy_updraft_frac(i,k) )
    3427             : 
    3428             :         ! Calculate the mean vertical velocity found in a cloudy downdraft. 
    3429             :         w_down_in_cloud(i,k) &
    3430             :         = ( mixt_frac(i,k) * cloud_frac_1(i,k) * w_down_1 &
    3431             :             + ( one - mixt_frac(i,k) ) * cloud_frac_2(i,k) * w_down_2 ) &
    3432           0 :           / max( eps, cloudy_downdraft_frac(i,k) )
    3433             : 
    3434             :       end do
    3435             :     end do
    3436             :     !$acc end parallel loop
    3437             : 
    3438           0 :     return
    3439             : 
    3440             :   end subroutine calc_w_up_in_cloud
    3441             : 
    3442             :   !=============================================================================
    3443             :   function interp_var_array( n_points, nz, k, z_vals, var )
    3444             : 
    3445             :   ! Description:
    3446             :   !   Interpolates a variable to an array of values about a given level
    3447             : 
    3448             :   ! References
    3449             :   !-----------------------------------------------------------------------
    3450             : 
    3451             :     use clubb_precision, only: &
    3452             :         core_rknd           ! Constant
    3453             : 
    3454             :     implicit none
    3455             : 
    3456             :   ! Input Variables
    3457             :     integer, intent(in) :: &
    3458             :       n_points, & ! Number of points to interpolate to (must be odd and >= 3)
    3459             :       nz,       & ! Total number of vertical levels
    3460             :       k           ! Center of interpolation array
    3461             : 
    3462             :     real( kind = core_rknd ), dimension(nz), intent(in) :: &
    3463             :       z_vals, &         ! Height at each vertical level           [m]
    3464             :       var               ! Variable values on grid                 [units vary]
    3465             : 
    3466             :   ! Output Variables
    3467             :     real( kind = core_rknd ), dimension(n_points) :: &
    3468             :       interp_var_array  ! Interpolated values of variable         [units vary]
    3469             : 
    3470             :   ! Local Variables
    3471             :     real( kind = core_rknd ) :: &
    3472             :       dz    ! Distance between vertical levels
    3473             : 
    3474             :     real( kind = core_rknd ) :: &
    3475             :       z_val             ! Height at some sub-grid level
    3476             : 
    3477             :     integer :: &
    3478             :       i, &                      ! Loop iterator
    3479             : 
    3480             :       subgrid_lev_count         ! Number of refined grid points located between
    3481             :                               ! two defined grid levels
    3482             : 
    3483             :   !-----------------------------------------------------------------------
    3484             : 
    3485             :     !----- Begin Code -----
    3486             : 
    3487             :     ! Place a point at each of k-1, k, and k+1.
    3488             :     interp_var_array(1) = var_value_integer_height( nz, k-1, z_vals, var )
    3489             :     interp_var_array((n_points+1)/2) = var_value_integer_height( nz, k, z_vals, var )
    3490             :     interp_var_array(n_points) = var_value_integer_height( nz, k+1, z_vals, var )
    3491             : 
    3492             :     subgrid_lev_count = (n_points - 3) / 2
    3493             : 
    3494             :     ! Lower half
    3495             :     if ( k == 1 ) then
    3496             :       dz = (z_vals(2) - z_vals(1)) / real( subgrid_lev_count+1, kind=core_rknd )
    3497             :     else
    3498             :       dz = (z_vals(k) - z_vals(k-1)) / real( subgrid_lev_count+1, kind=core_rknd )
    3499             :     end if
    3500             :     do i=1, subgrid_lev_count
    3501             :       z_val = z_vals(k) - real( i, kind=core_rknd ) * dz
    3502             :       interp_var_array(1+i) &
    3503             :       = var_subgrid_interp( nz, k, z_vals, var, z_val, l_below=.true. )
    3504             :     end do
    3505             : 
    3506             :     ! Upper half
    3507             :     if ( k == nz ) then
    3508             :       dz = ( z_vals(nz) - z_vals(nz-1) ) / real( subgrid_lev_count+1, kind=core_rknd )
    3509             :     else
    3510             :       dz = ( z_vals(k+1) - z_vals(k) ) / real( subgrid_lev_count+1, kind=core_rknd )
    3511             :     end if
    3512             :     do i=1, (n_points-3)/2
    3513             :       z_val = z_vals(k) + real( i, kind=core_rknd ) * dz
    3514             :       interp_var_array((n_points+1)/2+i) &
    3515             :       = var_subgrid_interp( nz, k, z_vals, var, z_val, l_below=.false. )
    3516             :     end do
    3517             : 
    3518             :     return
    3519             :   end function interp_var_array
    3520             : 
    3521             :   !=============================================================================
    3522             :   function var_value_integer_height( nz, k, z_vals, var_grid_value ) result( var_value )
    3523             : 
    3524             :   ! Description
    3525             :   !   Returns the value of a variable at an integer height between 0 and
    3526             :   !   nz+1 inclusive, using extrapolation when k==0 or k==nz+1
    3527             : 
    3528             :   ! References
    3529             :   !-----------------------------------------------------------------------
    3530             : 
    3531             :     use clubb_precision, only: &
    3532             :         core_rknd       ! Constant
    3533             : 
    3534             :     use interpolation, only: &
    3535             :         mono_cubic_interp  ! Procedure
    3536             : 
    3537             :     implicit none
    3538             : 
    3539             :     ! Input Variables
    3540             :     integer, intent(in) :: &
    3541             :       nz,    & ! Total number of vertical levels
    3542             :       k        ! Level to resolve variable value
    3543             : 
    3544             :     real( kind = core_rknd ), dimension(nz), intent(in) :: &
    3545             :       z_vals,            & ! Height at each vertical level                  [m]
    3546             :       var_grid_value       ! Value of variable at each grid level           [units vary]
    3547             : 
    3548             :     ! Output Variables
    3549             :     real( kind = core_rknd ) :: &
    3550             :       var_value            ! Value of variable at height level              [units vary]
    3551             : 
    3552             :     ! Local Variables
    3553             :     integer :: km1, k00, kp1, kp2
    3554             :   !-----------------------------------------------------------------------
    3555             : 
    3556             :     !----- Begin Code -----
    3557             : 
    3558             :     if ( k >= 1 .and. k <= nz ) then
    3559             :       ! This is the simple case. No extrapolation necessary.
    3560             :       var_value = var_grid_value(k)
    3561             :     else if ( k == 0 ) then
    3562             :       ! Extrapolate below the lower boundary
    3563             :       km1 = nz
    3564             :       k00 = 1
    3565             :       kp1 = 2
    3566             :       kp2 = 3
    3567             :       var_value = mono_cubic_interp( z_vals(1)-(z_vals(2)-z_vals(1)), &
    3568             :                                      km1, k00, kp1, kp2, &
    3569             :                                      z_vals(km1), z_vals(k00), z_vals(kp1), z_vals(kp2), &
    3570             :                                      var_grid_value(km1), var_grid_value(k00), &
    3571             :                                      var_grid_value(kp1), var_grid_value(kp2) )
    3572             :     else if ( k == nz+1 ) then
    3573             :       ! Extrapolate above the upper boundary
    3574             :       km1 = nz
    3575             :       k00 = nz-1
    3576             :       kp1 = nz
    3577             :       kp2 = nz
    3578             :       var_value = mono_cubic_interp( z_vals(nz)+(z_vals(nz)-z_vals(nz-1)), &
    3579             :                                      km1, k00, kp1, kp2, &
    3580             :                                      z_vals(km1), z_vals(k00), z_vals(kp1), z_vals(kp2), &
    3581             :                                      var_grid_value(km1), var_grid_value(k00), &
    3582             :                                      var_grid_value(kp1), var_grid_value(kp2) )
    3583             :     else
    3584             :       ! Invalid height requested
    3585             :       var_value = -999._core_rknd
    3586             :     end if ! k > 1 .and. k < nz
    3587             :     return
    3588             :   end function var_value_integer_height
    3589             : 
    3590             :   !=============================================================================
    3591             :   function var_subgrid_interp( nz, k, z_vals, var, z_interp, l_below ) result( var_value )
    3592             : 
    3593             :   ! Description
    3594             :   !   Interpolates (or extrapolates) a variable to a value between grid
    3595             :   !   levels
    3596             : 
    3597             :   ! References
    3598             :   !-----------------------------------------------------------------------
    3599             : 
    3600             :     use clubb_precision, only: &
    3601             :         core_rknd       ! Constant
    3602             : 
    3603             :     use interpolation, only: &
    3604             :         mono_cubic_interp   ! Procedure
    3605             : 
    3606             :     implicit none
    3607             : 
    3608             :     ! Input Variables
    3609             :     integer, intent(in) :: &
    3610             :       nz, &         ! Number of vertical levels
    3611             :       k             ! Grid level near interpolation target
    3612             : 
    3613             :     real( kind = core_rknd ), dimension(nz), intent(in) :: &
    3614             :       z_vals, &     ! Height at each grid level          [m]
    3615             :       var           ! Variable values at grid levels     [units vary]
    3616             : 
    3617             :     real( kind = core_rknd ), intent(in) :: &
    3618             :       z_interp      ! Interpolation target height        [m]
    3619             : 
    3620             :     logical, intent(in) :: &
    3621             :       l_below       ! True if z_interp < z_vals(k), false otherwise
    3622             : 
    3623             :     ! Output Variable
    3624             :     real( kind = core_rknd ) :: &
    3625             :       var_value     ! Interpolated value of variable     [units vary]
    3626             : 
    3627             :     ! Local Variables
    3628             :     integer :: km1, k00, kp1, kp2 ! Parameters for call to mono_cubic_interp
    3629             :   !----------------------------------------------------------------------
    3630             : 
    3631             :     !----- Begin Code -----
    3632             :     if ( l_below ) then
    3633             : 
    3634             :       if ( k == 1 ) then ! Extrapolation
    3635             :         km1 = nz
    3636             :         k00 = 1
    3637             :         kp1 = 2
    3638             :         kp2 = 3
    3639             :       else if ( k == 2 ) then
    3640             :         km1 = 1
    3641             :         k00 = 1
    3642             :         kp1 = 2
    3643             :         kp2 = 3
    3644             :       else if ( k == nz ) then
    3645             :         km1 = nz-2
    3646             :         k00 = nz-1
    3647             :         kp1 = nz
    3648             :         kp2 = nz
    3649             :       else
    3650             :         km1 = k-2
    3651             :         k00 = k-1
    3652             :         kp1 = k
    3653             :         kp2 = k+1
    3654             :       end if ! k == 1
    3655             : 
    3656             :     else ! .not. l_below
    3657             : 
    3658             :       if ( k == 1 ) then
    3659             :         km1 = 1
    3660             :         k00 = 1
    3661             :         kp1 = 2
    3662             :         kp2 = 3
    3663             :       else if ( k == nz-1 ) then
    3664             :         km1 = nz-2
    3665             :         k00 = nz-1
    3666             :         kp1 = nz
    3667             :         kp2 = nz
    3668             :       else if ( k == nz ) then ! Extrapolation
    3669             :         km1 = nz
    3670             :         k00 = nz-1
    3671             :         kp1 = nz
    3672             :         kp2 = nz
    3673             :       else
    3674             :         km1 = k-1
    3675             :         k00 = k
    3676             :         kp1 = k+1
    3677             :         kp2 = k+2
    3678             :       end if ! k == 1
    3679             : 
    3680             :     end if ! l_below
    3681             : 
    3682             :     ! Now perform the interpolation
    3683             :     var_value = mono_cubic_interp( z_interp, km1, k00, kp1, kp2, &
    3684             :                                    z_vals(km1), z_vals(k00), z_vals(kp1), z_vals(kp2), &
    3685             :                                    var(km1), var(k00), var(kp1), var(kp2) )
    3686             : 
    3687             :     return
    3688             : 
    3689             :   end function var_subgrid_interp
    3690             : 
    3691             :   !=============================================================================
    3692             : 
    3693             : end module pdf_closure_module

Generated by: LCOV version 1.14