diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 90fe4700d5..cd7c03e349 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -21,16 +21,16 @@ required = True [clubb] local_path = src/physics/clubb -protocol = git -repo_url = https://github.com/ESCOMP/CLUBB_CESM -tag = clubb_release_b76a124_20200220_c20200320 +protocol = svn +repo_url = https://github.com/larson-group/clubb_release/tags/ +tag = clubb_4ncar_20220311_f51de38/src/CLUBB_core required = True [silhs] local_path = src/physics/silhs -protocol = git -repo_url = https://github.com/ESCOMP/SILHS_CESM -tag = silhs_clubb_release_b76a124_20200220_c20200320 +protocol = svn +repo_url = https://github.com/larson-group/clubb_release/tags/ +tag = clubb_4ncar_20220311_f51de38/src/SILHS required = True [pumas] diff --git a/bld/build-namelist b/bld/build-namelist index 6d260e601d..5023742114 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3080,55 +3080,112 @@ if ($clubb_sgs =~ /$TRUE/io) { } add_default($nl, 'clubb_do_icesuper'); - - add_default($nl, 'clubb_expldiff'); - add_default($nl, 'clubb_rainevap_turb'); + add_default($nl, 'clubb_do_energyfix'); add_default($nl, 'clubb_cloudtop_cooling'); - add_default($nl, 'clubb_timestep'); + add_default($nl, 'clubb_rainevap_turb'); add_default($nl, 'clubb_rnevap_effic'); - add_default($nl, 'clubb_beta'); - add_default($nl, 'clubb_c1'); - add_default($nl, 'clubb_c1b'); - add_default($nl, 'clubb_c11'); - add_default($nl, 'clubb_c11b'); - add_default($nl, 'clubb_c14'); - add_default($nl, 'clubb_C2rt'); - add_default($nl, 'clubb_C2thl'); - add_default($nl, 'clubb_C2rtthl'); - add_default($nl, 'clubb_C4'); - add_default($nl, 'clubb_c6rt'); - add_default($nl, 'clubb_c6rtb'); - add_default($nl, 'clubb_c6rtc'); - add_default($nl, 'clubb_c6thl'); - add_default($nl, 'clubb_c6thlb'); - add_default($nl, 'clubb_c6thlc'); + add_default($nl, 'clubb_timestep'); + add_default($nl, 'clubb_l_diag_Lscale_from_tau'); + + my $clubb_Lscale_from_tau = $nl->get_value('clubb_l_diag_Lscale_from_tau'); + + if($clubb_Lscale_from_tau =~ "true") { + add_default($nl, 'clubb_c1', 'val'=>1.0); + add_default($nl, 'clubb_c1b', 'val'=>1.0); + add_default($nl, 'clubb_C2rt', 'val'=>1.0); + add_default($nl, 'clubb_C2thl', 'val'=>1.0); + add_default($nl, 'clubb_C2rtthl', 'val'=>1.0); + add_default($nl, 'clubb_C4', 'val'=>5.2); + add_default($nl, 'clubb_C_uu_shr', 'val'=>0.1076484659222455); + add_default($nl, 'clubb_C_uu_buoy', 'val'=>0.3); + add_default($nl, 'clubb_c6rt', 'val'=>2.0); + add_default($nl, 'clubb_c6rtb', 'val'=>2.0); + add_default($nl, 'clubb_c6rtc', 'val'=>1.0); + add_default($nl, 'clubb_c6thl', 'val'=>2.0); + add_default($nl, 'clubb_c6thlb', 'val'=>2.0); + add_default($nl, 'clubb_c6thlc', 'val'=>1.0); + add_default($nl, 'clubb_C8', 'val'=>3.440377776099962); + add_default($nl, 'clubb_C8b', 'val'=>0.0); + add_default($nl, 'clubb_c11', 'val'=>0.31057411754034614); + add_default($nl, 'clubb_c11b', 'val'=>0.3250718127387944); + add_default($nl, 'clubb_c14', 'val'=>1.0); + add_default($nl, 'clubb_C_invrs_tau_bkgnd', 'val'=>3.727123755772682); + add_default($nl, 'clubb_C_invrs_tau_sfc', 'val'=>0.12743072568015346); + add_default($nl, 'clubb_C_invrs_tau_shear', 'val'=>0.12502726304767026); + add_default($nl, 'clubb_C_invrs_tau_N2', 'val'=>0.08122667220596895); + add_default($nl, 'clubb_C_invrs_tau_N2_wp2', 'val'=>0.1); + add_default($nl, 'clubb_C_invrs_tau_N2_xp2', 'val'=>0.05); + add_default($nl, 'clubb_C_invrs_tau_N2_wpxp', 'val'=>0.0); + add_default($nl, 'clubb_C_invrs_tau_N2_clear_wp3', 'val'=>1.0); + add_default($nl, 'clubb_gamma_coef', 'val'=>0.5492223674353673); + add_default($nl, 'clubb_gamma_coefb', 'val'=>0.2531868210746816); + add_default($nl, 'clubb_beta', 'val'=>2.27756371212011); + } else { + add_default($nl, 'clubb_c1'); + add_default($nl, 'clubb_c1b'); + add_default($nl, 'clubb_C2rt'); + add_default($nl, 'clubb_C2thl'); + add_default($nl, 'clubb_C2rtthl'); + add_default($nl, 'clubb_C4'); + add_default($nl, 'clubb_C_uu_shr'); + add_default($nl, 'clubb_C_uu_buoy'); + add_default($nl, 'clubb_c6rt'); + add_default($nl, 'clubb_c6rtb'); + add_default($nl, 'clubb_c6rtc'); + add_default($nl, 'clubb_c6thl'); + add_default($nl, 'clubb_c6thlb'); + add_default($nl, 'clubb_c6thlc'); + add_default($nl, 'clubb_C8'); + add_default($nl, 'clubb_C8b'); + add_default($nl, 'clubb_c11'); + add_default($nl, 'clubb_c11b'); + add_default($nl, 'clubb_c14'); + add_default($nl, 'clubb_C_invrs_tau_bkgnd'); + add_default($nl, 'clubb_C_invrs_tau_sfc'); + add_default($nl, 'clubb_C_invrs_tau_shear'); + add_default($nl, 'clubb_C_invrs_tau_N2'); + add_default($nl, 'clubb_C_invrs_tau_N2_wp2'); + add_default($nl, 'clubb_C_invrs_tau_N2_xp2'); + add_default($nl, 'clubb_C_invrs_tau_N2_wpxp'); + add_default($nl, 'clubb_C_invrs_tau_N2_clear_wp3'); + add_default($nl, 'clubb_gamma_coef'); + add_default($nl, 'clubb_gamma_coefb'); + add_default($nl, 'clubb_beta'); + } + add_default($nl, 'clubb_C7'); add_default($nl, 'clubb_C7b'); - add_default($nl, 'clubb_C8'); - add_default($nl, 'clubb_C8b'); + + add_default($nl, 'clubb_C_wp3_pr_turb'); + add_default($nl, 'clubb_c_K1'); + add_default($nl, 'clubb_c_K2'); + add_default($nl, 'clubb_nu2'); + add_default($nl, 'clubb_c_K8'); add_default($nl, 'clubb_c_K9'); add_default($nl, 'clubb_nu9'); add_default($nl, 'clubb_c_K10'); add_default($nl, 'clubb_c_K10h'); add_default($nl, 'clubb_do_liqsupersat'); - add_default($nl, 'clubb_gamma_coef'); - add_default($nl, 'clubb_gamma_coefb'); + add_default($nl, 'clubb_wpxp_L_thresh'); + add_default($nl, 'clubb_lambda0_stability_coef'); add_default($nl, 'clubb_lmin_coef'); add_default($nl, 'clubb_mult_coef'); add_default($nl, 'clubb_Skw_denom_coef'); add_default($nl, 'clubb_skw_max_mag'); - add_default($nl, 'clubb_up2_vp2_factor'); + add_default($nl, 'clubb_up2_sfc_coef'); add_default($nl, 'clubb_C_wp2_splat'); - add_default($nl, 'clubb_wpxp_L_thresh'); add_default($nl, 'clubb_detliq_rad'); add_default($nl, 'clubb_detice_rad'); add_default($nl, 'clubb_detphase_lowtemp'); + add_default($nl, 'clubb_ipdf_call_placement'); add_default($nl, 'clubb_l_brunt_vaisala_freq_moist'); add_default($nl, 'clubb_l_call_pdf_closure_twice'); add_default($nl, 'clubb_l_damp_wp3_Skw_squared'); + add_default($nl, 'clubb_l_lmm_stepping'); + add_default($nl, 'clubb_l_e3sm_config'); add_default($nl, 'clubb_l_lscale_plume_centered'); add_default($nl, 'clubb_l_min_wp2_from_corr_wx'); add_default($nl, 'clubb_l_min_xp2_from_corr_wx'); @@ -3141,11 +3198,18 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_l_use_C7_Richardson'); add_default($nl, 'clubb_l_use_C11_Richardson'); add_default($nl, 'clubb_l_use_cloud_cover'); - add_default($nl, 'clubb_l_use_ice_latent'); add_default($nl, 'clubb_l_use_thvm_in_bv_freq'); add_default($nl, 'clubb_l_vert_avg_closure'); - add_default($nl, 'clubb_l_diag_Lscale_from_tau'); add_default($nl, 'clubb_l_damp_wp2_using_em'); + add_default($nl, 'clubb_l_godunov_upwind_wpxp_ta'); + add_default($nl, 'clubb_l_godunov_upwind_xpyp_ta'); + add_default($nl, 'clubb_l_use_shear_Richardson'); + add_default($nl, 'clubb_l_use_tke_in_wp3_pr_turb_term'); + add_default($nl, 'clubb_l_use_tke_in_wp2_wp3_K_dfsn'); + add_default($nl, 'clubb_l_smooth_Heaviside_tau_wpxp'); + add_default($nl, 'clubb_l_do_expldiff_rtm_thlm'); + + #CLUBB+MF options add_default($nl, 'do_clubb_mf'); add_default($nl, 'do_clubb_mf_diag'); add_default($nl, 'clubb_mf_L0'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 8366f2d9b7..b5ce306c32 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -1823,9 +1823,6 @@ .false. .false. - .false. - .true. - .false. .false. 1.0D0 @@ -1836,12 +1833,17 @@ 150.0D0 75.0D0 + + .false. + 1.0 1.0 1.0 1.0 1.3 5.2 + 0.3 + 0.3 4.0 6.0 1.0 @@ -1856,52 +1858,73 @@ 0.35D0 2.2D0 1.6D0 + 0.4 + 0.75 + 0.125 + 5.0 + 1.25 0.25 20.0 0.5 0.3 .false. 60.0 - 0.308 - 0.280 - 0.270 - 0.32 - 2.4 - 0.04 - 0.1 - 1.0D0 - 0.0 - 4.5 - 2.0 - 0.0 - 8.0D-6 - 25.0D-6 - 238.15D0 - + 1.0 + 0.1 + 0.02 + 0.1 + 0.2 + 0.2 + 0.0 + 0.0 + 0.308 + 0.280 + 0.270 + 0.32 + 2.4 + 0.04 + 0.1 + 1.0D0 + 0.0 + 4.5 + 2.0 + 0.0 + 8.0D-6 + 25.0D-6 + 238.15D0 + 1 + + .true. .false. .true. .false. .false. - .false. - .false. + .true. + .true. .false. .false. .true. .false. .false. + .false. + .false. .true. .false. .false. + .false. .true. - .false. .false. .true. - .false. .false. + .false. + .false. + .false. + .false. + .false. + .false. .true. - 0.2 0.2 0.2 @@ -1911,7 +1934,7 @@ 0.02 0.5 0.5 - 1.0 + 0.5 0.25 20.0 2.0 @@ -1924,7 +1947,7 @@ 1.5 4.0 10.0 - 4.0 + 4.0 0.0 .true. @@ -1943,7 +1966,7 @@ .true. .false. .false. - .true. + .false. .false. @@ -2250,6 +2273,17 @@ 0.0 0.0 + .true. + .false. + .false. + .true. + .true. + .false. + .true. + .true. + .true. + .false. + .true. NONE diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 8a89f7a76f..96a10f616a 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3273,6 +3273,61 @@ Intercept of linear equation that calculates precribed in-cloud ice mixing ratio Intercept of linear equation that calculates precribed in-cloud ice concentration ratio [N_i'^2] / [N_i]^2 [-] + +Enables importance sampling for SILHS subcolumns + + + +Enables calculation of Lscale_vert_avg, used to generate SILHS samples. + + + +Enables straight Monte Carlo sampling, this overrides l_lh_importance_sampling. + + + +Enables the "new" SILHS importance sampling scheme with prescribed probabilities. Requires l_lh_importance_sampling. + + + +Determine starting SILHS first sampling level (k_lh_start) based on maximum within-cloud rcm. If false, and if l_random_k_lh_start is also false, then the SILHS first sampling level is the column maximum of liquid cloud water. + + + +Determine starting SILHS first sampling level (k_lh_start) based on random choice. Overrides l_rcm_in_cloud_k_lh_start if true. + + + +Assumption of maximum vertical overlap when grid-box rcm exceeds cloud threshold. + + + +Produces "instantaneous" variance-covariance microphysical source terms, ignoring discretization effects. + + + +Limit SILHS sample point weights for stability. + + + +Prescribe variance fractions. + + + +Scale sample point weights to sum to num_samples (the "ratio estimate"). + + - -Explicit diffusion on temperature and moisture when CLUBB is on -Default: .false. - + +Option for the placement of the call to CLUBB's PDF closure. The options include: ipdf_pre_advance_fields (1) calls the PDF closure before advancing prognostic fields. ipdf_post_advance_fields (2) calls after advancing prognostic fields, and ipdf_pre_post_advance_fields (3) calls both before and after advancing prognostic fields. +Default: 1 + + Limiting value of C1 when skewness of w (vertical velocity) is small in @@ -3583,6 +3639,16 @@ C4 coefficient in the wp2 return-to-isotropy term. A higher value of C4 tends wp2 more towards the value of subgrid TKE. + +Coefficient in the wp2 (variance of vertical velocity) pressure terms opposing shear production. + + + +Coefficient in the wp2 (variance of vertical velocity) pressure terms opposing buoyancy production. + + Low Skewness in C7 Skw. Function @@ -3605,11 +3671,45 @@ the damping of CLUBB's wp3 when skewness of w (vertical velocity) is large in magnitude. + +Coefficient in the pressure-turbulence term of CLUBB's wp3 predictive equation. + + + +Coefficient of Kh_zm (diffusivity on momentum grid levels) in the wp2 (variance +of vertical velocity) predictive equation. +Default: 0.75 + + + +Coefficient of Kh_zm (diffusivity on momentum grid levels) in the scalar +variance predictive equations (e.g. rtp2, variance of total water). +Default: 0.125 + + + +Constant in the diffusivity term in the scalar variance predictive equations +(e.g. rtp2, variance of total water). +Default: 5.0 + + + +Coefficient of Kh_zt (diffusivity on thermodynamic grid levels) in the wp3 +(third-order moment of vertical velocity) predictive equation. +Default: 1.25 + + Coefficient of Kh_zm (diffusivity on momentum grid levels) in the up2 (variance of the west-east wind component) and vp2 (variance of the south-north wind component) predictive equations. +Default: 0.25 CLUBB tunable parameter - Lscale threshold: damp C6 and C7 (units: m) +Default: 60.0 + +Coefficient of inverse tau term contributed by background constant value (units: none) +Default: 1.0 + + + +Coefficient of inverse tau term contributed by surface log law (units: none) +Default: 0.1 + + + +Coefficient of inverse tau term contributed by vertical wind shear (units: none) +Default: 0.02 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency (units: none) +Default: 0.1 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for wp3_wp2 (units: none) +Default: 0.2 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for xp2_wpxp (units: none) +Default: 0.2 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for xm_wpxp (units: none) +Default: 0.0 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for wp3 (units: none) +Default: 0.0 + + -Low Skw.: gamma coef. Skw. Fnct. +Low Skewness in gamma coefficient Skewness Function (units: none) +Default: Changes depending on grid and physics options - Factor used in calculating the surface values of up2 (variance of the u wind component) and vp2 (variance of the v wind component). Increasing -clubb_up2_vp2_factor increases the values of up2 and vp2 at the surface. +clubb_up2_sfc_coef increases the values of up2 and vp2 at the surface. +Default: 2.0 Coefficient for gustiness near ground. +Default: 0.0 + +Flag to use shear in the calculation of Richardson number. +Default: .false. + + Flag to allow cloud fraction and mean cloud water at adjacent vertical grid levels influence the amount of cloudiness and amount of cloud water in a grid box. - - - -Include the effects of ice latent heating in turbulence terms -Default: .false. +Default: .true. Flag to use mean theta-v in the calculation of Brunt-Vaisala frequency. +Default: .false. Flag that, when it is enabled, automatically enables CLUBB's l_trapezoidal_rule_zt, l_trapezoidal_rule_zm, and l_call_pdf_closure_twice. +Default: .true. + + + +Flag to apply Linear Multistep Method (LMM) stepping in CLUBB. +Default: .false. + + + +Flag to run CLUBB with E3SM settings. +Default: .true. + +Flag to use Total Kenetic Energy (TKE) in eddy diffusion for wp2 and wp3. +Default: .false. + + + +Flag to use Total Kenetic Energy (TKE) formulation for wp3 pr_turb (turbulent +production) term. +Default: .false. + + + +Flag to use smooth Heaviside 'Peskin' in computation of invrs_tau. +Default: .false. + + + +This flag determines whether we want to use an upwind differencing approximation +rather than a centered differencing for turbulent advection terms. It affects +wpxp only. +Default: .false. + + + +This flag determines whether we want to use an upwind differencing approximation +rather than a centered differencing for turbulent advection terms. It affects +xpyp only. +Default: .false. + + Flag to use a dissipation formula of -(2/3)*em/tau_zm, as in Bougeault (1981), in the wp2 (variance of vertical velocity) predictive equation. +Default: .false. + + + +Explicit diffusion on temperature and moisture by CLUBB, in addition to CLUBB's +normal prognostic equations for rtm and thlm. +Default: .false. - + diff --git a/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam index 2c1d851a57..17185beed9 100644 --- a/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam @@ -27,7 +27,8 @@ fincl1 = 'U:A','PS:A','T:A','V:A','OMEGA:A','Z3:A','PRECT:A', 'rtm_tacl', 'rtm_cl', 'rtm_forcing', 'rtm_sdmp','rtm_mc', 'rtm_pd', 'rvm_mc', 'rcm_mc', 'rcm_sd_mg_morr', 'thlm_bt', 'thlm_ma', 'thlm_ta', 'thlm_mfl', 'thlm_tacl', 'thlm_cl', 'thlm_forcing', 'thlm_sdmp','thlm_mc', 'thlm_old', 'thlm_without_ta', 'thlm_mfl_min', 'thlm_mfl_max', 'thlm_enter_mfl', 'thlm_exit_mfl', 'rtm_old', 'rtm_without_ta', 'rtm_mfl_min', 'rtm_mfl_max', 'rtm_enter_mfl', 'rtm_exit_mfl', 'um_bt', 'um_ma', 'um_gf', 'um_cf', 'um_ta', 'um_f', 'um_sdmp', -'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_bp2', +'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_pr_turb', +'wp3_pr_dfsn', 'wp3_pr1', 'wp3_pr2', 'wp3_dp1', 'wp3_cl', 'mixt_frac', 'w_1', 'w_2', 'varnce_w_1', 'varnce_w_2', 'thl_1', 'thl_2', 'varnce_thl_1', 'varnce_thl_2', 'rt_1', 'rt_2', 'varnce_rt_1', 'varnce_rt_2', 'rc_1', 'rc_2', 'rsatl_1', 'rsatl_2', 'cloud_frac_1', 'cloud_frac_2', 'a3_coef_zt', 'wp3_on_wp2_zt', 'chi_1', 'chi_2', 'stdev_chi_1', 'stdev_chi_2', 'stdev_eta_1', 'stdev_eta_2', 'covar_chi_eta_1', 'covar_chi_eta_2', 'corr_chi_eta_1', 'corr_chi_eta_2', 'corr_rt_thl_1', 'crt_1', @@ -57,7 +58,8 @@ clubb_vars_zt ='thlm', 'thvm', 'rtm', 'rcm', 'rvm', 'um', 'vm', 'um_ref','vm_ref 'rtm_tacl', 'rtm_cl', 'rtm_forcing', 'rtm_sdmp','rtm_mc', 'rtm_pd', 'rvm_mc', 'rcm_mc', 'rcm_sd_mg_morr', 'thlm_bt', 'thlm_ma', 'thlm_ta', 'thlm_mfl', 'thlm_tacl', 'thlm_cl', 'thlm_forcing', 'thlm_sdmp','thlm_mc', 'thlm_old', 'thlm_without_ta', 'thlm_mfl_min', 'thlm_mfl_max', 'thlm_enter_mfl', 'thlm_exit_mfl', 'rtm_old', 'rtm_without_ta', 'rtm_mfl_min', 'rtm_mfl_max', 'rtm_enter_mfl', 'rtm_exit_mfl', 'um_bt', 'um_ma', 'um_gf', 'um_cf', 'um_ta', 'um_f', 'um_sdmp', -'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_bp2', +'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_pr_turb', +'wp3_pr_dfsn', 'wp3_pr1', 'wp3_pr2', 'wp3_dp1', 'wp3_cl', 'mixt_frac', 'w_1', 'w_2', 'varnce_w_1', 'varnce_w_2', 'thl_1', 'thl_2', 'varnce_thl_1', 'varnce_thl_2', 'rt_1', 'rt_2', 'varnce_rt_1', 'varnce_rt_2', 'rc_1', 'rc_2', 'rsatl_1', 'rsatl_2', 'cloud_frac_1', 'cloud_frac_2', 'a3_coef_zt', 'wp3_on_wp2_zt', 'chi_1', 'chi_2', 'stdev_chi_1', 'stdev_chi_2', 'stdev_eta_1', 'stdev_eta_2', 'covar_chi_eta_1', 'covar_chi_eta_2', 'corr_chi_eta_1', 'corr_chi_eta_2', 'corr_rt_thl_1', 'crt_1', diff --git a/doc/ChangeLog b/doc/ChangeLog index 1dd6c47042..7fc345f09f 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,10 +1,168 @@ +=============================================================== +Tag name: cam6_3_059 +Originator(s): katec,vlarson,huebleruwm,adamrher +Date: 20 May 2022 +One-line Summary: Bringing in the new CLUBB and SILHS Externals. Fixes #515 #467 #461 #572 +Github PR URLs: + https://github.com/ESCOMP/CAM/pull/545 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update to more recent CLUBB code including the inverse taus science and prognostic momentum improvements. + (https://github.com/ESCOMP/CAM/issues/515) + - Add new CLUBB invrs_tau coefs to be set via namelist (https://github.com/ESCOMP/CAM/issues/467) + - DP_FRAC and SH_FRAC not initialized in clubb_intr (https://github.com/ESCOMP/CAM/issues/461) + - CAM crashes when run with SILHS using SE core (https://github.com/ESCOMP/CAM/issues/572) + +Describe any changes made to build system: + + - Changes the source of the CLUBB and SILHS external repos from NCAR managed github repos to UWM public release + repos using svn to pull only specific source code directories (changes in Externals_CAM.cfg) + +Describe any changes made to the namelist: + +- Add mechanism to set default values for several namelist values based on the value of clubb_Lscale_from_tau + in build-namelist +- Added: clubb_do_energyfix, clubb_l_diag_Lscale_from_tau, clubb_C_wp3_pr_turb, clubb_c_K1, clubb_c_K2, clubb_nu2, + clubb_c_K8, clubb_up2_sfc_coef, clubb_ipdf_call_placement, clubb_l_lmm_stepping, clubb_l_e3sm_config, + clubb_l_godunov_upwind_wpxp_ta, clubb_l_godunov_upwind_xpyp_ta, clubb_l_use_shear_Richardson, + clubb_l_use_tke_in_wp3_pr_turb_term, clubb_l_use_tke_in_wp3_pr_turb_term, clubb_l_use_tke_in_wp2_wp3_K_dfsn, + clubb_l_smooth_Heaviside_tau_wpxp, clubb_l_do_expldiff_rtm_thlm, clubb_l_do_expldiff_rtm_thlm, + clubb_C_invrse_tau_bkgnd, clubb_C_invrs_tau_sfc, clubb_C_invrs_tau_shear, clubb_C_invrs_tau_N2, + clubb_C_invrs_tau_N2_wp2, clubb_C_invrs_tau_N2_xp2, clubb_C_invrs_tau_N2_wpxp, + clubb_C_invrs_tau_N2_clear_wp3, clubb_l_use_tke_in_wp3_pr_turb_term, + clubb_l_use_tke_in_wp2_wp3_K_dfsn, clubb_l_smooth_Heaviside_tau_wpxp +- Removed: clubb_expldiff, clubb_up2_vp2_factor, clubb_l_use_ice_latent +- Updated/fixed descriptions or changed default values for: clubb_C_uu_shr, clubb_C_uu_buoy, clubb_l_min_wp2_from_corr_wx, + clubb_l_min_xp2_from_corr_wx, clubb_c14 (silhs only), clubb_l_damp_wp2_using_em, subcol_silhs_l_lh_importance_sampling, + subcol_silhs_l_Lscale_vert_avg, subcol_silhs_l_lh_straight_mc, subcol_silhs_l_lh_clustered_sampling, + subcol_silhs_l_rcm_in_cloud_k_lh_start, subcol_silhs_l_random_k_lh_start, subcol_silhs_l_max_overlap_in_cloud, + subcol_silhs_l_lh_instant_var_covar_src, subcol_silhs_l_lh_limit_weights, subcol_silhs_l_lh_var_frac, + subcol_silhs_l_lh_normalize_weights, clubb_c_K9, clubb_nu9, clubb_wpxp_L_thresh, clubb_gamma_coef, + clubb_C_wp2_splat, clubb_l_call_pdf_closure_twice, clubb_l_rcm_supersat_adj, clubb_l_trapezoidal_rule_zt, + clubb_l_use_cloud_cover, clubb_l_use_thvm_in_bv_freq, clubb_l_vert_avg_closure, clubb_l_damp_wp2_using_em + + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + No memory or compute time changes large enough to fail a compare test. TPUTCOMP changes between + +9.87% and -17.23% in cheyenne aux_cam test suite. + +Code reviewed by: gold2718, adamrher, huebleruwm, bstephens82, sjsprecious, zarzycki, cacraigucar, vlarson, + peverwhee, nusbaume + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + - Externals_CAM.cfg: Point to new external code for src/physics/clubb and src/physics/silhs + - bld/build-namelist: Add method for setting defaults of many clubb namelist variables based on the value of + clubb_l_diag_Lscale_from_tau. Add default listing for new namelist parameters. + - bld/namelist_files/namelist_defaults_cam.xml: Updates and defaults for new namelist parameters. + - bld/namelist_files/namelist_definition.xml: Updates, typo fixes, better descriptors, and new entries for + new namelist values. + - cime_config/testdefs/testlist_cam.xml: Change mpasa480 test from izumi-intel to cheyenne-intel + - cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam: Change output field wp3_bp2 to wp3_pr_turb + - src/physics/cam/clubb_intr.F90: All of the modifications for the new external, new namelist parameters, + updates to clubb_stats arrays, adding support for b4b restarts in pdf_post_placement, other code + refactoring changes. + NOTE: I attempted to add stat checks to all of the allocate calls in clubb_intr but found two nag + tests failed due to NaN values in state%q after this. This is just completely mystifying, and + likely some kind of compiler issue that may work its way out in the future. + - src/physics/cam/physpkg.F90: Check for use_subcol_microp and add init_state_subcol call for silhs + - src/physics/cam/subcol_SILHS.F90: update namelist variable names, new calls for api updates, some + refactoring, add init state subcol function, more bad configuration checks + - src/physics/cam_dev/physpkg.F90: Check for use_subcol_microp and add init_state_subcol call for silhs + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All tests pass with the exception of the following expected differences: + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - Known/Existing Failure + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) + - Namelist and baseline changes due to new CLUBB code + +izumi/gnu/aux_cam: + All Pass + +cheyenne/intel/aux_cam: + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ld3_Vmct.f09_f09_mg17.HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) + SMS_Ln9_Vmct.f09_f09_mg17.1850_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) + - Expected namelist and baseline answer changes due to new CLUBB code + + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) + - FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_058_caccopy: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_058_caccopy/ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480' does not exist + + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) + - Differences due to new and changed CLUBB namelist variables + +Summarize any changes to answers: + Any compset that invokes CLUBB and/or SILHS code will see answer changes. The new parameterizations are not fully tuned and likely to degrade climate somewhat at this point. + =============================================================== Tag name: cam6_3_058 Originator(s): pel,duda,aherington,neale,jet Date: 16 May 2022 One-line Summary: High priority science updates for mom6 coupled runs and bug fixes for issues #506 #530 #543 #551 #563 Github PR URLs: - https://github.com/ESCOMP/CAM/pull/XXX + https://github.com/ESCOMP/CAM/pull/590 Purpose of changes (include the issue number and title text for each relevant GitHub issue): - Noise in derived quantities in ne30pg3 configuration (https://github.com/ESCOMP/CAM/issues/551) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index fe263a70c7..7183c96696 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -29,12 +29,32 @@ module clubb_intr use zm_conv_intr, only: zmconv_microp #ifdef CLUBB_SGS use clubb_api_module, only: pdf_parameter, implicit_coefs_terms - use clubb_api_module, only: clubb_config_flags_type + use clubb_api_module, only: clubb_config_flags_type, grid, stats, nu_vertical_res_dep + use clubb_api_module, only: nparams use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag use cloud_fraction, only: dp1, dp2 #endif implicit none +#ifdef CLUBB_SGS + ! Variables that contains all the statistics + + type (stats), target, save :: stats_zt(pcols), & ! stats_zt grid + stats_zm(pcols), & ! stats_zm grid + stats_rad_zt(pcols), & ! stats_rad_zt grid + stats_rad_zm(pcols), & ! stats_rad_zm grid + stats_sfc(pcols) ! stats_sfc + +!$omp threadprivate(stats_zt, stats_zm, stats_rad_zt, stats_rad_zm, stats_sfc) + + type(grid), target :: dummy_gr + type(nu_vertical_res_dep), private, save :: dummy_nu_vert_res_dep ! Vertical resolution dependent nu values + real(r8), private, save :: dummy_lmin + +!$omp threadprivate(dummy_gr) + +#endif + private save @@ -46,9 +66,10 @@ module clubb_intr #ifdef CLUBB_SGS ! This utilizes CLUBB specific variables in its interface stats_init_clubb, & - init_clubb_config_flags, & -#endif + stats_zt, stats_zm, stats_sfc, & + stats_rad_zt, stats_rad_zm, & stats_end_timestep_clubb, & +#endif clubb_readnl, & clubb_init_cnst, & clubb_implements_cnst @@ -63,6 +84,7 @@ module clubb_intr #ifdef CLUBB_SGS type(clubb_config_flags_type), public :: clubb_config_flags + real(r8), dimension(nparams), public :: clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) #endif ! ------------ ! @@ -73,7 +95,9 @@ module clubb_intr grid_type = 3, & ! The 2 option specifies stretched thermodynamic levels hydromet_dim = 0 ! The hydromet array in SAM-CLUBB is currently 0 elements - real(r8), parameter, dimension(0) :: & + ! Even though sclr_dim is set to 0, the dimension here is set to 1 to prevent compiler errors + ! See github ticket larson-group/cam#133 for details + real(r8), parameter, dimension(1) :: & sclr_tol = 1.e-8_r8 ! Total water in kg/kg character(len=6) :: saturation_equation @@ -99,6 +123,7 @@ module clubb_intr rtpthlp_const = 0.01_r8 ! Constant to add to rtpthlp when moments are advected real(r8), parameter :: unset_r8 = huge(1.0_r8) + integer, parameter :: unset_i = huge(1) ! Commonly used temperature for the melting temp of ice crystals [K] real(r8), parameter :: meltpt_temp = 268.15_r8 @@ -125,10 +150,25 @@ module clubb_intr real(r8) :: clubb_c11 = unset_r8 real(r8) :: clubb_c11b = unset_r8 real(r8) :: clubb_c14 = unset_r8 + real(r8) :: clubb_C_wp3_pr_turb = unset_r8 + real(r8) :: clubb_c_K1 = unset_r8 + real(r8) :: clubb_c_K2 = unset_r8 + real(r8) :: clubb_nu2 = unset_r8 + real(r8) :: clubb_c_K8 = unset_r8 real(r8) :: clubb_c_K9 = unset_r8 real(r8) :: clubb_nu9 = unset_r8 real(r8) :: clubb_c_K10 = unset_r8 real(r8) :: clubb_c_K10h = unset_r8 + real(r8) :: clubb_C_invrs_tau_bkgnd = unset_r8 + real(r8) :: clubb_C_invrs_tau_sfc = unset_r8 + real(r8) :: clubb_C_invrs_tau_shear = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2 = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_wp2 = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_xp2 = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_wpxp = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_clear_wp3 = unset_r8 + real(r8) :: clubb_C_uu_shr = unset_r8 + real(r8) :: clubb_C_uu_buoy = unset_r8 real(r8) :: clubb_gamma_coef = unset_r8 real(r8) :: clubb_gamma_coefb = unset_r8 real(r8) :: clubb_beta = unset_r8 @@ -137,31 +177,129 @@ module clubb_intr real(r8) :: clubb_mult_coef = unset_r8 real(r8) :: clubb_Skw_denom_coef = unset_r8 real(r8) :: clubb_skw_max_mag = unset_r8 - real(r8) :: clubb_up2_vp2_factor = unset_r8 + real(r8) :: clubb_up2_sfc_coef = unset_r8 real(r8) :: clubb_C_wp2_splat = unset_r8 real(r8) :: clubb_wpxp_L_thresh = unset_r8 real(r8) :: clubb_detliq_rad = unset_r8 real(r8) :: clubb_detice_rad = unset_r8 real(r8) :: clubb_detphase_lowtemp = unset_r8 - logical :: clubb_l_brunt_vaisala_freq_moist = .false. - logical :: clubb_l_call_pdf_closure_twice = .false. - logical :: clubb_l_damp_wp3_Skw_squared = .false. - logical :: clubb_l_min_wp2_from_corr_wx = .false. - logical :: clubb_l_min_xp2_from_corr_wx = .false. - logical :: clubb_l_predict_upwp_vpwp = .false. - logical :: clubb_l_rcm_supersat_adj = .false. - logical :: clubb_l_stability_correct_tau_zm = .false. - logical :: clubb_l_trapezoidal_rule_zt = .false. - logical :: clubb_l_trapezoidal_rule_zm = .false. - logical :: clubb_l_upwind_xpyp_ta = .false. - logical :: clubb_l_use_C7_Richardson = .false. - logical :: clubb_l_use_C11_Richardson = .false. - logical :: clubb_l_use_cloud_cover = .false. - logical :: clubb_l_use_thvm_in_bv_freq = .false. - logical :: clubb_l_vert_avg_closure = .false. - logical :: clubb_l_diag_Lscale_from_tau = .false. - logical :: clubb_l_damp_wp2_using_em = .false. + + integer :: & + clubb_iiPDF_type, & ! Selected option for the two-component normal + ! (double Gaussian) PDF type to use for the w, rt, + ! and theta-l (or w, chi, and eta) portion of + ! CLUBB's multivariate, two-component PDF. + clubb_ipdf_call_placement = unset_i ! Selected option for the placement of the call to + ! CLUBB's PDF. + + logical :: & + clubb_l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The + ! precipitation fraction is automatically set to 1 when this + ! flag is turned off. + clubb_l_predict_upwp_vpwp, & ! Flag to predict and along with and + ! alongside the advancement of , , , + ! , , and in subroutine + ! advance_xm_wpxp. Otherwise, and are still + ! approximated by eddy diffusivity when and are + ! advanced in subroutine advance_windm_edsclrm. + clubb_l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping + ! the overall correlation of w and x (w and rt, as well as w + ! and theta-l) within the limits of -max_mag_correlation_flux + ! to max_mag_correlation_flux. + clubb_l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and + ! thlp2) on keeping the overall correlation of w and x within + ! the limits of -max_mag_correlation_flux to + ! max_mag_correlation_flux. + clubb_l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the + ! turbulent dissipation coefficient, C2. + clubb_l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm + clubb_l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor + clubb_l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 + clubb_l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & + ! sclrpthlp. + clubb_l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtm, thlm, sclrm, um and vm. + clubb_l_uv_nudge, & ! For wind speed nudging. + clubb_l_rtm_nudge, & ! For rtm nudging + clubb_l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. + ! TKE = 1/2 (u'^2 + v'^2 + w'^2) + clubb_l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to + ! compute the varibles that are output from high order + ! closure + clubb_l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the + ! thermodynamic-level variables output from pdf_closure. + clubb_l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three + ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - + ! output from pdf_closure. + clubb_l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call + ! subroutine pdf_closure twice. If true, pdf_closure is + ! called first on thermodynamic levels and then on momentum + ! levels so that each variable is computed on its native + ! level. If false, pdf_closure is only called on + ! thermodynamic levels, and variables which belong on + ! momentum levels are interpolated. + clubb_l_standard_term_ta, & ! Use the standard discretization for the turbulent advection + ! terms. Setting to .false. means that a_1 and a_3 are + ! pulled outside of the derivative in + ! advance_wp2_wp3_module.F90 and in + ! advance_xp2_xpyp_module.F90. + clubb_l_partial_upwind_wp3, & ! Flag to use an "upwind" discretization rather + ! than a centered discretization for the portion + ! of the wp3 turbulent advection term for ADG1 + ! that is linearized in terms of wp3. + ! (Requires ADG1 PDF and clubb_l_standard_term_ta). + clubb_l_godunov_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. + ! It affects wpxp only. + clubb_l_godunov_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. It affects + ! xpyp only. + clubb_l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac + ! and rcm to help increase cloudiness at coarser grid + ! resolutions. + clubb_l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones + clubb_l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors + clubb_l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) + clubb_l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) + clubb_l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability + ! correction + clubb_l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of + ! -(2/3)*em/tau_zm, as in Bougeault (1981) + clubb_l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly + clubb_l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values + clubb_l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the + ! mixing length scale as Lscale = tau * tke + clubb_l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number + clubb_l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number + clubb_l_use_shear_Richardson, & ! Use shear in the calculation of Richardson number + clubb_l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in + ! saturated atmospheres (from Durran and Klemp, 1982) + clubb_l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency + clubb_l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water + clubb_l_lmm_stepping, & ! Apply Linear Multistep Method (LMM) Stepping + clubb_l_e3sm_config, & ! Run model with E3SM settings + clubb_l_vary_convect_depth, & ! Flag used to calculate convective velocity using + ! a variable estimate of layer depth based on the depth + ! over which wpthlp is positive near the ground when true + ! More information can be found by + ! Looking at issue #905 on the clubb repo + clubb_l_use_tke_in_wp3_pr_turb_term,& ! Use TKE formulation for wp3 pr_turb term + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3 + clubb_l_smooth_Heaviside_tau_wpxp, & ! Use smooth Heaviside 'Peskin' in computation of invrs_tau + clubb_l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and + ! rtpthlp + clubb_l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 + clubb_l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz + clubb_l_update_pressure ! Flag for having CLUBB update pressure and exner + ! Constant parameters logical, parameter, private :: & l_implemented = .true., & ! Implemented in a host model (always true) @@ -173,15 +311,10 @@ module clubb_intr logical :: lq(pcnst) logical :: prog_modal_aero logical :: do_rainturb - logical :: do_expldiff logical :: clubb_do_adv logical :: clubb_do_liqsupersat = .false. logical :: clubb_do_energyfix = .true. logical :: history_budget - - logical :: clubb_l_lscale_plume_centered - logical :: clubb_l_use_ice_latent - integer :: history_budget_histfile_num integer :: edsclr_dim ! Number of scalars to transport in CLUBB integer :: offset @@ -212,6 +345,16 @@ module clubb_intr rtpthvp_idx, & ! moisture buoyancy correlation thlpthvp_idx, & ! temperature buoyancy correlation sclrpthvp_idx, & ! passive scalar buoyancy correlation + wp2rtp_idx, & ! w'^2 rt' + wp2thlp_idx, & ! w'^2 thl' + uprcp_idx, & ! < u' r_c' > + vprcp_idx, & ! < v' r_c' > + rc_coef_idx, & ! Coefficient of X'r_c' in Eq. (34) + wp4_idx, & ! w'^4 + wpup2_idx, & ! w'u'^2 + wpvp2_idx, & ! w'v'^2 + wp2up2_idx, & ! w'^2 u'^2 + wp2vp2_idx, & ! w'^2 v'^2 cloud_frac_idx, & ! CLUBB's cloud fraction cld_idx, & ! Cloud fraction concld_idx, & ! Convective cloud fraction @@ -249,6 +392,13 @@ module clubb_intr wpthlp_mc_zt_idx, & rtpthlp_mc_zt_idx + integer :: & ! added pbuf fields for clubb to have restart bfb when ipdf_call_placement=2 + pdf_zm_w_1_idx, & + pdf_zm_w_2_idx, & + pdf_zm_varnce_w_1_idx, & + pdf_zm_varnce_w_2_idx, & + pdf_zm_mixt_frac_idx + integer, public :: & ixthlp2 = 0, & ixwpthlp = 0, & @@ -281,8 +431,10 @@ module clubb_intr #ifdef CLUBB_SGS type(pdf_parameter), target, allocatable, public, protected :: & - pdf_params_chnk(:,:) ! PDF parameters (thermo. levs.) [units vary] - type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:,:) ! PDF parameters on momentum levs. [units vary] + pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary] + + type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] + type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:,:) ! PDF impl. coefs. & expl. terms [units vary] #endif @@ -384,9 +536,19 @@ subroutine clubb_register_cam( ) call pbuf_add_field('RTPTHVP', 'physpkg', dtype_r8, (/pcols,pverp/), rtpthvp_idx) call pbuf_add_field('THLPTHVP', 'physpkg', dtype_r8, (/pcols,pverp/), thlpthvp_idx) call pbuf_add_field('CLOUD_FRAC', 'physpkg', dtype_r8, (/pcols,pverp/), cloud_frac_idx) - call pbuf_add_field('ISS_FRAC', 'physpkg', dtype_r8, (/pcols,pverp/), ice_supersat_idx) + call pbuf_add_field('ISS_FRAC', 'physpkg', dtype_r8, (/pcols,pverp/), ice_supersat_idx) call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pverp/), rcm_idx) call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) + call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pverp/), wp2rtp_idx) + call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pverp/), wp2thlp_idx) + call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,pverp/), uprcp_idx) + call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,pverp/), vprcp_idx) + call pbuf_add_field('RC_COEF', 'global', dtype_r8, (/pcols,pverp/), rc_coef_idx) + call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,pverp/), wp4_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pverp/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pverp/), wpvp2_idx) + call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,pverp/), wp2up2_idx) + call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,pverp/), wp2vp2_idx) ! For SILHS microphysical covariance contributions call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pverp/), rtp2_mc_zt_idx) @@ -395,6 +557,12 @@ subroutine clubb_register_cam( ) call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pverp/), wpthlp_mc_zt_idx) call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pverp/), rtpthlp_mc_zt_idx) + call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_1_idx) + call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_2_idx) + call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_1_idx) + call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_2_idx) + call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_mixt_frac_idx) + #endif end subroutine clubb_register_cam @@ -510,9 +678,14 @@ subroutine clubb_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit use cam_abortutils, only: endrun - use clubb_api_module, only: l_stats, l_output_rad_files - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8 + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8, & + mpi_integer use clubb_mf, only: clubb_mf_readnl + + use clubb_api_module, only: & + set_default_clubb_config_flags_api, & ! Procedure(s) + initialize_clubb_config_flags_type_api, & + l_stats, l_output_rad_files #endif character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -521,33 +694,44 @@ subroutine clubb_readnl(nlfile) character(len=*), parameter :: sub = 'clubb_readnl' - logical :: clubb_history, clubb_rad_history, clubb_cloudtop_cooling, clubb_rainevap_turb, & - clubb_expldiff ! Stats enabled (T/F) + logical :: clubb_history = .false., clubb_rad_history = .false. ! Stats enabled (T/F) + logical :: clubb_cloudtop_cooling = .false., clubb_rainevap_turb = .false. integer :: iunit, read_status, ierr - namelist /clubb_his_nl/ clubb_history, clubb_rad_history - namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, clubb_expldiff, & - clubb_do_adv, clubb_timestep, & - clubb_rnevap_effic,clubb_do_icesuper - namelist /clubb_params_nl/ clubb_c1, clubb_c1b, clubb_c11, clubb_c11b, clubb_c14, clubb_mult_coef, clubb_gamma_coef, & + namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, clubb_do_adv, clubb_timestep, & + clubb_rnevap_effic, clubb_do_icesuper + namelist /clubb_params_nl/ clubb_c1, clubb_c1b, clubb_c11, clubb_c11b, clubb_c14, & + clubb_C_wp3_pr_turb, clubb_mult_coef, clubb_gamma_coef, & clubb_c_K10, clubb_c_K10h, clubb_beta, clubb_C2rt, clubb_C2thl, & - clubb_C2rtthl, clubb_C8, clubb_C8b, clubb_C7, clubb_C7b, clubb_Skw_denom_coef, & + clubb_C2rtthl, clubb_C8, clubb_C8b, clubb_C7, clubb_C7b, clubb_Skw_denom_coef, & clubb_c6rt, clubb_c6rtb, clubb_c6rtc, clubb_c6thl, clubb_c6thlb, clubb_c6thlc, & - clubb_C4, clubb_c_K9, clubb_nu9, clubb_C_wp2_splat, clubb_wpxp_L_thresh, & + clubb_C4, clubb_C_uu_shr, clubb_C_uu_buoy, & + clubb_c_K1, clubb_c_K2, clubb_nu2, clubb_c_K8, & + clubb_c_K9, clubb_nu9, clubb_C_wp2_splat, clubb_wpxp_L_thresh, & clubb_lambda0_stability_coef, clubb_l_lscale_plume_centered, & - clubb_l_use_ice_latent, clubb_do_liqsupersat, clubb_do_energyfix,& + clubb_do_liqsupersat, clubb_do_energyfix,& clubb_lmin_coef,clubb_skw_max_mag, clubb_l_stability_correct_tau_zm, & - clubb_gamma_coefb, clubb_up2_vp2_factor, clubb_detliq_rad, clubb_detice_rad, & - clubb_detphase_lowtemp, & - clubb_l_use_C7_Richardson, clubb_l_use_C11_Richardson, & + clubb_gamma_coefb, clubb_up2_sfc_coef, clubb_detliq_rad, clubb_detice_rad, & + clubb_detphase_lowtemp, clubb_l_do_expldiff_rtm_thlm, & + clubb_C_invrs_tau_bkgnd, clubb_C_invrs_tau_sfc, clubb_C_invrs_tau_shear, & + clubb_C_invrs_tau_N2, clubb_C_invrs_tau_N2_wp2, clubb_C_invrs_tau_N2_xp2, & + clubb_C_invrs_tau_N2_wpxp, clubb_C_invrs_tau_N2_clear_wp3, & + clubb_ipdf_call_placement, clubb_l_predict_upwp_vpwp, & + clubb_l_min_wp2_from_corr_wx, clubb_l_min_xp2_from_corr_wx, & + clubb_l_upwind_xpyp_ta, clubb_l_vert_avg_closure, & + clubb_l_trapezoidal_rule_zt, clubb_l_trapezoidal_rule_zm, & + clubb_l_call_pdf_closure_twice, clubb_l_godunov_upwind_wpxp_ta, & + clubb_l_godunov_upwind_xpyp_ta, clubb_l_use_cloud_cover, & + clubb_l_damp_wp2_using_em, & + clubb_l_diag_Lscale_from_tau, clubb_l_use_C7_Richardson, & + clubb_l_use_C11_Richardson, clubb_l_use_shear_Richardson, & clubb_l_brunt_vaisala_freq_moist, clubb_l_use_thvm_in_bv_freq, & clubb_l_rcm_supersat_adj, clubb_l_damp_wp3_Skw_squared, & - clubb_l_predict_upwp_vpwp, clubb_l_min_wp2_from_corr_wx, & - clubb_l_min_xp2_from_corr_wx, clubb_l_upwind_xpyp_ta, clubb_l_vert_avg_closure, & - clubb_l_trapezoidal_rule_zt, clubb_l_trapezoidal_rule_zm, & - clubb_l_call_pdf_closure_twice, clubb_l_use_cloud_cover, & - clubb_l_diag_Lscale_from_tau, clubb_l_damp_wp2_using_em + clubb_l_lmm_stepping, & + clubb_l_e3sm_config, & + clubb_l_use_tke_in_wp3_pr_turb_term, clubb_l_use_tke_in_wp2_wp3_K_dfsn, & + clubb_l_smooth_Heaviside_tau_wpxp !----- Begin Code ----- @@ -557,10 +741,55 @@ subroutine clubb_readnl(nlfile) l_output_rad_files = .false. ! Initialize to false do_cldcool = .false. ! Initialize to false do_rainturb = .false. ! Initialize to false - do_expldiff = .false. ! Initialize to false - - clubb_l_lscale_plume_centered = .false. ! Initialize to false! - clubb_l_use_ice_latent = .false. ! Initialize to false! + + ! Initialize namelist variables to clubb defaults + call set_default_clubb_config_flags_api( clubb_iiPDF_type, & ! Out + clubb_ipdf_call_placement, & ! Out + clubb_l_use_precip_frac, & ! Out + clubb_l_predict_upwp_vpwp, & ! Out + clubb_l_min_wp2_from_corr_wx, & ! Out + clubb_l_min_xp2_from_corr_wx, & ! Out + clubb_l_C2_cloud_frac, & ! Out + clubb_l_diffuse_rtm_and_thlm, & ! Out + clubb_l_stability_correct_Kh_N2_zm, & ! Out + clubb_l_calc_thlp2_rad, & ! Out + clubb_l_upwind_xpyp_ta, & ! Out + clubb_l_upwind_xm_ma, & ! Out + clubb_l_uv_nudge, & ! Out + clubb_l_rtm_nudge, & ! Out + clubb_l_tke_aniso, & ! Out + clubb_l_vert_avg_closure, & ! Out + clubb_l_trapezoidal_rule_zt, & ! Out + clubb_l_trapezoidal_rule_zm, & ! Out + clubb_l_call_pdf_closure_twice, & ! Out + clubb_l_standard_term_ta, & ! Out + clubb_l_partial_upwind_wp3, & ! Out + clubb_l_godunov_upwind_wpxp_ta, & ! Out + clubb_l_godunov_upwind_xpyp_ta, & ! Out + clubb_l_use_cloud_cover, & ! Out + clubb_l_diagnose_correlations, & ! Out + clubb_l_calc_w_corr, & ! Out + clubb_l_const_Nc_in_cloud, & ! Out + clubb_l_fix_w_chi_eta_correlations, & ! Out + clubb_l_stability_correct_tau_zm, & ! Out + clubb_l_damp_wp2_using_em, & ! Out + clubb_l_do_expldiff_rtm_thlm, & ! Out + clubb_l_Lscale_plume_centered, & ! Out + clubb_l_diag_Lscale_from_tau, & ! Out + clubb_l_use_C7_Richardson, & ! Out + clubb_l_use_C11_Richardson, & ! Out + clubb_l_use_shear_Richardson, & ! Out + clubb_l_brunt_vaisala_freq_moist, & ! Out + clubb_l_use_thvm_in_bv_freq, & ! Out + clubb_l_rcm_supersat_adj, & ! Out + clubb_l_damp_wp3_Skw_squared, & ! Out + clubb_l_prescribed_avg_deltaz, & ! Out + clubb_l_lmm_stepping, & ! Out + clubb_l_e3sm_config, & ! Out + clubb_l_vary_convect_depth, & ! Out + clubb_l_use_tke_in_wp3_pr_turb_term, & ! Out + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Out + clubb_l_smooth_Heaviside_tau_wpxp ) ! Out ! Call CLUBB+MF namelist call clubb_mf_readnl(nlfile) @@ -611,8 +840,6 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_cloudtop_cooling") call mpi_bcast(clubb_rainevap_turb, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rainevap_turb") - call mpi_bcast(clubb_expldiff, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_expldiff") call mpi_bcast(clubb_do_adv, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_adv") call mpi_bcast(clubb_timestep, 1, mpi_real8, mstrid, mpicom, ierr) @@ -630,6 +857,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c11b") call mpi_bcast(clubb_c14, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c14") + call mpi_bcast(clubb_C_wp3_pr_turb, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_wp3_pr_turb") call mpi_bcast(clubb_c6rt, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6rt") call mpi_bcast(clubb_c6rtb, 1, mpi_real8, mstrid, mpicom, ierr) @@ -670,8 +899,20 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C7b") call mpi_bcast(clubb_Skw_denom_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_Skw_denom_coef") - call mpi_bcast(clubb_C4, 1, mpi_real8, mstrid, mpicom, ierr) + call mpi_bcast(clubb_C4, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C4") + call mpi_bcast(clubb_C_uu_shr, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_uu_shr") + call mpi_bcast(clubb_C_uu_buoy, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_uu_buoy") + call mpi_bcast(clubb_c_K1, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K1") + call mpi_bcast(clubb_c_K2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K2") + call mpi_bcast(clubb_nu2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_nu2") + call mpi_bcast(clubb_c_K8, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K8") call mpi_bcast(clubb_c_K9, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K9") call mpi_bcast(clubb_nu9, 1, mpi_real8, mstrid, mpicom, ierr) @@ -682,13 +923,26 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lambda0_stability_coef") call mpi_bcast(clubb_l_lscale_plume_centered,1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lscale_plume_centered") - call mpi_bcast(clubb_l_use_ice_latent, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_ice_latent") call mpi_bcast(clubb_do_liqsupersat, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_liqsupersat") call mpi_bcast(clubb_do_energyfix, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_energyfix") - + call mpi_bcast(clubb_C_invrs_tau_bkgnd, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_bkgnd") + call mpi_bcast(clubb_C_invrs_tau_sfc, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_sfc") + call mpi_bcast(clubb_C_invrs_tau_shear, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_shear") + call mpi_bcast(clubb_C_invrs_tau_N2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2") + call mpi_bcast(clubb_C_invrs_tau_N2_wp2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wp2") + call mpi_bcast(clubb_C_invrs_tau_N2_xp2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_xp2") + call mpi_bcast(clubb_C_invrs_tau_N2_wpxp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wpxp") + call mpi_bcast(clubb_C_invrs_tau_N2_clear_wp3, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_clear_wp3") call mpi_bcast(clubb_lmin_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lmin_coef") call mpi_bcast(clubb_skw_max_mag, 1, mpi_real8, mstrid, mpicom, ierr) @@ -697,8 +951,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_stability_correct_tau_zm") call mpi_bcast(clubb_gamma_coefb, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_gamma_coefb") - call mpi_bcast(clubb_up2_vp2_factor, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_up2_vp2_factor") + call mpi_bcast(clubb_up2_sfc_coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_up2_sfc_coef") call mpi_bcast(clubb_detliq_rad, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detliq_rad") call mpi_bcast(clubb_detice_rad, 1, mpi_real8, mstrid, mpicom, ierr) @@ -710,6 +964,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_C7_Richardson") call mpi_bcast(clubb_l_use_C11_Richardson, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_C11_Richardson") + call mpi_bcast(clubb_l_use_shear_Richardson, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_shear_Richardson") call mpi_bcast(clubb_l_brunt_vaisala_freq_moist, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_brunt_vaisala_freq_moist") call mpi_bcast(clubb_l_use_thvm_in_bv_freq, 1, mpi_logical, mstrid, mpicom, ierr) @@ -726,6 +982,10 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_min_xp2_from_corr_wx") call mpi_bcast(clubb_l_upwind_xpyp_ta, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_upwind_xpyp_ta") + call mpi_bcast(clubb_l_godunov_upwind_wpxp_ta, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_godunov_upwind_wpxp_ta") + call mpi_bcast(clubb_l_godunov_upwind_xpyp_ta, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_godunov_upwind_xpyp_ta") call mpi_bcast(clubb_l_vert_avg_closure, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_vert_avg_closure") call mpi_bcast(clubb_l_trapezoidal_rule_zt, 1, mpi_logical, mstrid, mpicom, ierr) @@ -740,57 +1000,135 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diag_Lscale_from_tau") call mpi_bcast(clubb_l_damp_wp2_using_em, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_damp_wp2_using_em") + call mpi_bcast(clubb_l_do_expldiff_rtm_thlm, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_do_expldiff_rtm_thlm") + call mpi_bcast(clubb_l_lmm_stepping, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lmm_stepping") + call mpi_bcast(clubb_l_e3sm_config, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_e3sm_config") + call mpi_bcast(clubb_l_use_tke_in_wp3_pr_turb_term, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp3_pr_turb_term") + call mpi_bcast(clubb_l_use_tke_in_wp2_wp3_K_dfsn, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp2_wp3_K_dfsn") + call mpi_bcast(clubb_l_smooth_Heaviside_tau_wpxp, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_smooth_Heaviside_tau_wpxp") + call mpi_bcast(clubb_ipdf_call_placement, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_ipdf_call_placement") ! Overwrite defaults if they are true if (clubb_history) l_stats = .true. if (clubb_rad_history) l_output_rad_files = .true. if (clubb_cloudtop_cooling) do_cldcool = .true. if (clubb_rainevap_turb) do_rainturb = .true. - if (clubb_expldiff) do_expldiff = .true. -! Check that all namelists have been set - if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set") - if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set") - - if(clubb_c1 == unset_r8) call endrun(sub//": FATAL: clubb_c1 is not set") - if(clubb_c1b == unset_r8) call endrun(sub//": FATAL: clubb_c1b is not set") - if(clubb_C2rt == unset_r8) call endrun(sub//": FATAL: clubb_C2rt is not set") - if(clubb_C2thl == unset_r8) call endrun(sub//": FATAL: clubb_C2thl is not set") - if(clubb_C2rtthl == unset_r8) call endrun(sub//": FATAL: clubb_C2rtthl is not set") - if(clubb_C4 == unset_r8) call endrun(sub//": FATAL: clubb_C4 is not set") - if(clubb_c6rt == unset_r8) call endrun(sub//": FATAL: clubb_c6rt is not set") - if(clubb_c6rtb == unset_r8) call endrun(sub//": FATAL: clubb_c6rtb is not set") - if(clubb_c6rtc == unset_r8) call endrun(sub//": FATAL: clubb_c6rtc is not set") - if(clubb_c6thl == unset_r8) call endrun(sub//": FATAL: clubb_c6thl is not set") - if(clubb_c6thlb == unset_r8) call endrun(sub//": FATAL: clubb_c6thlb is not set") - if(clubb_c6thlc == unset_r8) call endrun(sub//": FATAL: clubb_c6thlc is not set") - if(clubb_wpxp_L_thresh == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_L_thresh is not set") - if(clubb_C8 == unset_r8) call endrun(sub//": FATAL: clubb_C8 is not set") - if(clubb_C8b == unset_r8) call endrun(sub//": FATAL: clubb_C8b is not set") - if(clubb_C7 == unset_r8) call endrun(sub//": FATAL: clubb_C7 is not set") - if(clubb_C7b == unset_r8) call endrun(sub//": FATAL: clubb_C7b is not set") - if(clubb_c11 == unset_r8) call endrun(sub//": FATAL: clubb_c11 is not set") - if(clubb_c11b == unset_r8) call endrun(sub//": FATAL: clubb_c11b is not set") - if(clubb_c14 == unset_r8) call endrun(sub//": FATAL: clubb_c14 is not set") - if(clubb_c_K9 == unset_r8) call endrun(sub//": FATAL: clubb_c_K9 is not set") - if(clubb_nu9 == unset_r8) call endrun(sub//": FATAL: clubb_nu9 is not set") - if(clubb_c_K10 == unset_r8) call endrun(sub//": FATAL: clubb_c_K10 is not set") - if(clubb_c_K10h == unset_r8) call endrun(sub//": FATAL: clubb_c_K10h is not set") - if(clubb_gamma_coef == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coef is not set") - if(clubb_gamma_coefb == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coefb is not set") - if(clubb_beta == unset_r8) call endrun(sub//": FATAL: clubb_beta is not set") - if(clubb_lambda0_stability_coef == unset_r8) call endrun(sub//": FATAL: clubb_lambda0_stability_coef is not set") - if(clubb_lmin_coef == unset_r8) call endrun(sub//": FATAL: clubb_lmin_coef is not set") - if(clubb_mult_coef == unset_r8) call endrun(sub//": FATAL: clubb_mult_coef is not set") - if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set") - if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set") - if(clubb_up2_vp2_factor == unset_r8) call endrun(sub//": FATAL: clubb_up2_vp2_factor is not set") - if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splatis not set") - if(clubb_detliq_rad == unset_r8) call endrun(sub//": FATAL: clubb_detliq_rad not set") - if(clubb_detice_rad == unset_r8) call endrun(sub//": FATAL: clubb_detice_rad not set") - if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set") - if(clubb_detphase_lowtemp >= meltpt_temp) & - call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") + ! Check that all namelists have been set + if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set") + if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set") + + if(clubb_c1 == unset_r8) call endrun(sub//": FATAL: clubb_c1 is not set") + if(clubb_c1b == unset_r8) call endrun(sub//": FATAL: clubb_c1b is not set") + if(clubb_C2rt == unset_r8) call endrun(sub//": FATAL: clubb_C2rt is not set") + if(clubb_C2thl == unset_r8) call endrun(sub//": FATAL: clubb_C2thl is not set") + if(clubb_C2rtthl == unset_r8) call endrun(sub//": FATAL: clubb_C2rtthl is not set") + if(clubb_C4 == unset_r8) call endrun(sub//": FATAL: clubb_C4 is not set") + if(clubb_C_uu_shr == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_shr is not set") + if(clubb_C_uu_buoy == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_buoy is not set") + if(clubb_c6rt == unset_r8) call endrun(sub//": FATAL: clubb_c6rt is not set") + if(clubb_c6rtb == unset_r8) call endrun(sub//": FATAL: clubb_c6rtb is not set") + if(clubb_c6rtc == unset_r8) call endrun(sub//": FATAL: clubb_c6rtc is not set") + if(clubb_c6thl == unset_r8) call endrun(sub//": FATAL: clubb_c6thl is not set") + if(clubb_c6thlb == unset_r8) call endrun(sub//": FATAL: clubb_c6thlb is not set") + if(clubb_c6thlc == unset_r8) call endrun(sub//": FATAL: clubb_c6thlc is not set") + if(clubb_wpxp_L_thresh == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_L_thresh is not set") + if(clubb_C8 == unset_r8) call endrun(sub//": FATAL: clubb_C8 is not set") + if(clubb_C8b == unset_r8) call endrun(sub//": FATAL: clubb_C8b is not set") + if(clubb_C7 == unset_r8) call endrun(sub//": FATAL: clubb_C7 is not set") + if(clubb_C7b == unset_r8) call endrun(sub//": FATAL: clubb_C7b is not set") + if(clubb_c11 == unset_r8) call endrun(sub//": FATAL: clubb_c11 is not set") + if(clubb_c11b == unset_r8) call endrun(sub//": FATAL: clubb_c11b is not set") + if(clubb_c14 == unset_r8) call endrun(sub//": FATAL: clubb_c14 is not set") + if(clubb_C_wp3_pr_turb == unset_r8) call endrun(sub//": FATAL: clubb_C_wp3_pr_turb is not set") + if(clubb_c_K1 == unset_r8) call endrun(sub//": FATAL: clubb_c_K1 is not set") + if(clubb_c_K2 == unset_r8) call endrun(sub//": FATAL: clubb_c_K2 is not set") + if(clubb_nu2 == unset_r8) call endrun(sub//": FATAL: clubb_nu2 is not set") + if(clubb_c_K8 == unset_r8) call endrun(sub//": FATAL: clubb_c_K8 is not set") + if(clubb_c_K9 == unset_r8) call endrun(sub//": FATAL: clubb_c_K9 is not set") + if(clubb_nu9 == unset_r8) call endrun(sub//": FATAL: clubb_nu9 is not set") + if(clubb_c_K10 == unset_r8) call endrun(sub//": FATAL: clubb_c_K10 is not set") + if(clubb_c_K10h == unset_r8) call endrun(sub//": FATAL: clubb_c_K10h is not set") + if(clubb_C_invrs_tau_bkgnd == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_bkgnd is not set") + if(clubb_C_invrs_tau_sfc == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_sfc is not set") + if(clubb_C_invrs_tau_shear == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_shear is not set") + if(clubb_C_invrs_tau_N2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2 is not set") + if(clubb_C_invrs_tau_N2_wp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wp2 is not set") + if(clubb_C_invrs_tau_N2_xp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_xp2 is not set") + if(clubb_C_invrs_tau_N2_wpxp == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wpxp is not set") + if(clubb_C_invrs_tau_N2_clear_wp3 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_clear_wp3 is not set") + if(clubb_gamma_coef == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coef is not set") + if(clubb_gamma_coefb == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coefb is not set") + if(clubb_beta == unset_r8) call endrun(sub//": FATAL: clubb_beta is not set") + if(clubb_lambda0_stability_coef == unset_r8) call endrun(sub//": FATAL: clubb_lambda0_stability_coef is not set") + if(clubb_lmin_coef == unset_r8) call endrun(sub//": FATAL: clubb_lmin_coef is not set") + if(clubb_mult_coef == unset_r8) call endrun(sub//": FATAL: clubb_mult_coef is not set") + if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set") + if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set") + if(clubb_up2_sfc_coef == unset_r8) call endrun(sub//": FATAL: clubb_up2_sfc_coef is not set") + if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splatis not set") + if(clubb_detliq_rad == unset_r8) call endrun(sub//": FATAL: clubb_detliq_rad not set") + if(clubb_detice_rad == unset_r8) call endrun(sub//": FATAL: clubb_detice_rad not set") + if(clubb_ipdf_call_placement == unset_i) call endrun(sub//": FATAL: clubb_ipdf_call_placement not set") + if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set") + if(clubb_detphase_lowtemp >= meltpt_temp) & + call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") + + call initialize_clubb_config_flags_type_api( clubb_iiPDF_type, & ! In + clubb_ipdf_call_placement, & ! In + clubb_l_use_precip_frac, & ! In + clubb_l_predict_upwp_vpwp, & ! In + clubb_l_min_wp2_from_corr_wx, & ! In + clubb_l_min_xp2_from_corr_wx, & ! In + clubb_l_C2_cloud_frac, & ! In + clubb_l_diffuse_rtm_and_thlm, & ! In + clubb_l_stability_correct_Kh_N2_zm, & ! In + clubb_l_calc_thlp2_rad, & ! In + clubb_l_upwind_xpyp_ta, & ! In + clubb_l_upwind_xm_ma, & ! In + clubb_l_uv_nudge, & ! In + clubb_l_rtm_nudge, & ! In + clubb_l_tke_aniso, & ! In + clubb_l_vert_avg_closure, & ! In + clubb_l_trapezoidal_rule_zt, & ! In + clubb_l_trapezoidal_rule_zm, & ! In + clubb_l_call_pdf_closure_twice, & ! In + clubb_l_standard_term_ta, & ! In + clubb_l_partial_upwind_wp3, & ! In + clubb_l_godunov_upwind_wpxp_ta, & ! In + clubb_l_godunov_upwind_xpyp_ta, & ! In + clubb_l_use_cloud_cover, & ! In + clubb_l_diagnose_correlations, & ! In + clubb_l_calc_w_corr, & ! In + clubb_l_const_Nc_in_cloud, & ! In + clubb_l_fix_w_chi_eta_correlations, & ! In + clubb_l_stability_correct_tau_zm, & ! In + clubb_l_damp_wp2_using_em, & ! In + clubb_l_do_expldiff_rtm_thlm, & ! In + clubb_l_Lscale_plume_centered, & ! In + clubb_l_diag_Lscale_from_tau, & ! In + clubb_l_use_C7_Richardson, & ! In + clubb_l_use_C11_Richardson, & ! In + clubb_l_use_shear_Richardson, & ! In + clubb_l_brunt_vaisala_freq_moist, & ! In + clubb_l_use_thvm_in_bv_freq, & ! In + clubb_l_rcm_supersat_adj, & ! In + clubb_l_damp_wp3_Skw_squared, & ! In + clubb_l_prescribed_avg_deltaz, & ! In + clubb_l_lmm_stepping, & ! In + clubb_l_e3sm_config, & ! In + clubb_l_vary_convect_depth, & ! In + clubb_l_use_tke_in_wp3_pr_turb_term, & ! In + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In + clubb_l_smooth_Heaviside_tau_wpxp, & ! In + clubb_config_flags ) ! Out #endif end subroutine clubb_readnl @@ -824,10 +1162,14 @@ subroutine clubb_ini_cam(pbuf2d) ! These are needed to set parameters use clubb_api_module, only: & - ilambda0_stability_coef, ic_K10, ic_K10h, iC7, iC7b, iC8, iC8b, iC11, iC11b, iC4, & - iC1, iC1b, iC6rt, iC6rtb, iC6rtc, iC6thl, iC6thlb, iC6thlc, iup2_vp2_factor, iwpxp_L_thresh, & - iC14, igamma_coef, igamma_coefb, imult_coef, ilmin_coef, iSkw_denom_coef, ibeta, iskw_max_mag, & - iC2rt, iC2thl, iC2rtthl, ic_K9, inu9, iC_wp2_splat, params_list + core_rknd, em_min, & + ilambda0_stability_coef, ic_K10, ic_K10h, iC7, iC7b, iC8, iC8b, iC11, iC11b, iC4, iC_uu_shr, iC_uu_buoy, & + iC1, iC1b, iC6rt, iC6rtb, iC6rtc, iC6thl, iC6thlb, iC6thlc, iup2_sfc_coef, iwpxp_L_thresh, & + iC14, iC_wp3_pr_turb, igamma_coef, igamma_coefb, imult_coef, ilmin_coef, & + iSkw_denom_coef, ibeta, iskw_max_mag, & + iC_invrs_tau_bkgnd,iC_invrs_tau_sfc,iC_invrs_tau_shear,iC_invrs_tau_N2,iC_invrs_tau_N2_wp2, & + iC_invrs_tau_N2_xp2,iC_invrs_tau_N2_wpxp,iC_invrs_tau_N2_clear_wp3,iC_uu_shr,iC_uu_buoy, & + iC2rt, iC2thl, iC2rtthl, ic_K1, ic_K2, inu2, ic_K8, ic_K9, inu9, iC_wp2_splat, params_list use clubb_api_module, only: & print_clubb_config_flags_api, & @@ -839,15 +1181,11 @@ subroutine clubb_ini_cam(pbuf2d) set_clubb_debug_level_api, & clubb_fatal_error, & ! Error code value to indicate a fatal error nparams, & + set_default_parameters_api, & read_parameters_api, & l_stats, & l_stats_samp, & l_grads, & - stats_zt, & - stats_zm, & - stats_sfc, & - stats_rad_zt, & - stats_rad_zm, & w_tol_sqd, & rt_tol, & thl_tol @@ -878,13 +1216,11 @@ subroutine clubb_ini_cam(pbuf2d) real(kind=time_precision) :: dum1, dum2, dum3 - real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) - ! The similar name to clubb_history is unfortunate... logical :: history_amwg, history_clubb integer :: err_code ! Code for when CLUBB fails - integer :: j, k, l ! Indices + integer :: i, j, k, l ! Indices integer :: ntop_eddy ! Top interface level to which eddy vertical diffusion is applied ( = 1 ) integer :: nbot_eddy ! Bottom interface level to which eddy vertical diffusion is applied ( = pver ) integer :: nmodes, nspec, m @@ -900,7 +1236,30 @@ subroutine clubb_ini_cam(pbuf2d) ! CAM defines zi at the surface to be zero. real(r8), parameter :: sfc_elevation = 0._r8 - integer :: nlev + integer :: nlev, ierr + + real(r8) :: & + C1, C1b, C1c, C2rt, C2thl, C2rtthl, & + C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & + C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & + slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & + coef_spread_DG_means_rt, coef_spread_DG_means_thl, & + gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & + omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & + lambda0_stability_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr, Skw_denom_coef, c_K10, c_K10h, & + thlp2_rad_coef, thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & + Skw_max_mag, xp3_coef_base, xp3_coef_slope, altitude_threshold, & + rtp2_clip_coef, C_invrs_tau_bkgnd, C_invrs_tau_sfc, & + C_invrs_tau_shear, C_invrs_tau_N2, C_invrs_tau_N2_wp2, & + C_invrs_tau_N2_xp2, C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & + C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max !----- Begin Code ----- @@ -912,19 +1271,16 @@ subroutine clubb_ini_cam(pbuf2d) ! Allocate PDF parameters across columns and chunks allocate( & - pdf_params_chnk(pcols,begchunk:endchunk), & - pdf_params_zm_chnk(pcols,begchunk:endchunk), & + pdf_params_chnk(begchunk:endchunk), & + pdf_params_zm_chnk(begchunk:endchunk), & pdf_implicit_coefs_terms_chnk(pcols,begchunk:endchunk) ) - - ! Allocate (in the vertical) and zero PDF parameters - do l = begchunk, endchunk, 1 - do j = 1, pcols, 1 - call init_pdf_params_api( pverp+1-top_lev, pdf_params_chnk(j,l) ) - call init_pdf_params_api( pverp+1-top_lev, pdf_params_zm_chnk(j,l) ) + + do j = 1, pcols, 1 + do l = begchunk, endchunk, 1 call init_pdf_implicit_coefs_terms_api( pverp+1-top_lev, sclr_dim, & pdf_implicit_coefs_terms_chnk(j,l) ) - enddo ! j = 1, pcols, 1 - enddo ! l = begchunk, endchunk, 1 + enddo ! l = begchunk, endchunk, 1 + enddo ! j = 1, pcols, 1 ! ----------------------------------------------------------------- ! ! Determine how many constituents CLUBB will transport. Note that @@ -971,7 +1327,7 @@ subroutine clubb_ini_cam(pbuf2d) ! tendencies to avoid double counted. Else, we apply tendencies. lq(ixnumliq) = .false. edsclr_dim = edsclr_dim-1 - endif + end if ! ----------------------------------------------------------------- ! ! Set the debug level. Level 2 has additional computational expense since @@ -1031,17 +1387,66 @@ subroutine clubb_ini_cam(pbuf2d) ! Define number of tracers for CLUBB to diffuse ! ----------------------------------------------------------------- ! - if (do_expldiff) then + if (clubb_l_do_expldiff_rtm_thlm) then offset = 2 ! diffuse temperature and moisture explicitly edsclr_dim = edsclr_dim + offset - endif + end if ! ----------------------------------------------------------------- ! ! Setup CLUBB core ! ----------------------------------------------------------------- ! - ! Read in parameters for CLUBB. Just read in default values - call read_parameters_api( -99, "", clubb_params ) + ! Read in parameters for CLUBB. Just read in default values + call set_default_parameters_api( & + C1, C1b, C1c, C2rt, C2thl, C2rtthl, & + C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, & + C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & + C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & + slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & + coef_spread_DG_means_rt, coef_spread_DG_means_thl, & + gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & + omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & + lambda0_stability_coef, mult_coef, taumin, taumax, & + Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & + Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & + thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & + Skw_max_mag, xp3_coef_base, xp3_coef_slope, & + altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & + C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & + C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & + C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & + C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max ) + + call read_parameters_api( -99, "", & + C1, C1b, C1c, C2rt, C2thl, C2rtthl, & + C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, & + C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & + C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & + slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & + coef_spread_DG_means_rt, coef_spread_DG_means_thl, & + gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & + omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & + lambda0_stability_coef, mult_coef, taumin, taumax, & + Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & + Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & + thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & + Skw_max_mag, xp3_coef_base, xp3_coef_slope, & + altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & + C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & + C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & + C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & + C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & + clubb_params ) ! Fill in dummy arrays for height. Note that these are overwrote ! at every CLUBB step to physical values. @@ -1055,6 +1460,7 @@ subroutine clubb_ini_cam(pbuf2d) clubb_params(iC11) = clubb_c11 clubb_params(iC11b) = clubb_c11b clubb_params(iC14) = clubb_c14 + clubb_params(iC_wp3_pr_turb) = clubb_C_wp3_pr_turb clubb_params(ic_K10) = clubb_c_K10 clubb_params(imult_coef) = clubb_mult_coef clubb_params(iSkw_denom_coef) = clubb_Skw_denom_coef @@ -1079,36 +1485,25 @@ subroutine clubb_ini_cam(pbuf2d) clubb_params(iC1) = clubb_C1 clubb_params(iC1b) = clubb_C1b clubb_params(igamma_coefb) = clubb_gamma_coefb - clubb_params(iup2_vp2_factor) = clubb_up2_vp2_factor + clubb_params(iup2_sfc_coef) = clubb_up2_sfc_coef clubb_params(iC4) = clubb_C4 + clubb_params(iC_uu_shr) = clubb_C_uu_shr + clubb_params(iC_uu_buoy) = clubb_C_uu_buoy + clubb_params(ic_K1) = clubb_c_K1 + clubb_params(ic_K2) = clubb_c_K2 + clubb_params(inu2) = clubb_nu2 + clubb_params(ic_K8) = clubb_c_K8 clubb_params(ic_K9) = clubb_c_K9 clubb_params(inu9) = clubb_nu9 clubb_params(iC_wp2_splat) = clubb_C_wp2_splat - - call init_clubb_config_flags( clubb_config_flags ) ! In/Out - clubb_config_flags%l_use_C7_Richardson = clubb_l_use_C7_Richardson - clubb_config_flags%l_use_C11_Richardson = clubb_l_use_C11_Richardson - clubb_config_flags%l_brunt_vaisala_freq_moist = clubb_l_brunt_vaisala_freq_moist - clubb_config_flags%l_use_thvm_in_bv_freq = clubb_l_use_thvm_in_bv_freq - clubb_config_flags%l_rcm_supersat_adj = clubb_l_rcm_supersat_adj - clubb_config_flags%l_damp_wp3_Skw_squared = clubb_l_damp_wp3_Skw_squared - clubb_config_flags%l_predict_upwp_vpwp = clubb_l_predict_upwp_vpwp - clubb_config_flags%l_min_wp2_from_corr_wx = clubb_l_min_wp2_from_corr_wx - clubb_config_flags%l_min_xp2_from_corr_wx = clubb_l_min_xp2_from_corr_wx - clubb_config_flags%l_upwind_xpyp_ta = clubb_l_upwind_xpyp_ta - clubb_config_flags%l_vert_avg_closure = clubb_l_vert_avg_closure - clubb_config_flags%l_trapezoidal_rule_zt = clubb_l_trapezoidal_rule_zt - clubb_config_flags%l_trapezoidal_rule_zm = clubb_l_trapezoidal_rule_zm - clubb_config_flags%l_call_pdf_closure_twice = clubb_l_call_pdf_closure_twice - clubb_config_flags%l_use_cloud_cover = clubb_l_use_cloud_cover - clubb_config_flags%l_stability_correct_tau_zm = clubb_l_stability_correct_tau_zm - clubb_config_flags%l_do_expldiff_rtm_thlm = do_expldiff - clubb_config_flags%l_Lscale_plume_centered = clubb_l_lscale_plume_centered - clubb_config_flags%l_use_ice_latent = clubb_l_use_ice_latent - clubb_config_flags%l_diag_Lscale_from_tau = clubb_l_diag_Lscale_from_tau - clubb_config_flags%l_damp_wp2_using_em = clubb_l_damp_wp2_using_em - clubb_config_flags%l_update_pressure = l_update_pressure - + clubb_params(iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd + clubb_params(iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc + clubb_params(iC_invrs_tau_shear) = clubb_C_invrs_tau_shear + clubb_params(iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 + clubb_params(iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 + clubb_params(iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 + clubb_params(iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp + clubb_params(iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 ! Set up CLUBB core. Note that some of these inputs are overwritten ! when clubb_tend_cam is called. The reason is that heights can change @@ -1121,15 +1516,17 @@ subroutine clubb_ini_cam(pbuf2d) sclr_tol, edsclr_dim, clubb_params, & ! In l_host_applies_sfc_fluxes, & ! In saturation_equation, & ! In - l_input_fields, & + l_input_fields, & ! In l_implemented, grid_type, zi_g(2), zi_g(1), zi_g(nlev+1),& ! In zi_g(1:nlev+1), zt_g(1:nlev+1), sfc_elevation, & ! In + clubb_config_flags%iiPDF_type, & ! In + clubb_config_flags%ipdf_call_placement, & ! In clubb_config_flags%l_predict_upwp_vpwp, & ! In - clubb_config_flags%l_use_ice_latent, & ! In + clubb_config_flags%l_min_xp2_from_corr_wx, & ! In clubb_config_flags%l_prescribed_avg_deltaz, & ! In clubb_config_flags%l_damp_wp2_using_em, & ! In clubb_config_flags%l_stability_correct_tau_zm, & ! In - err_code ) + dummy_gr, dummy_lmin, dummy_nu_vert_res_dep, err_code ) ! Out if ( err_code == clubb_fatal_error ) then call endrun('clubb_ini_cam: FATAL ERROR CALLING SETUP_CLUBB_CORE') @@ -1141,10 +1538,11 @@ subroutine clubb_ini_cam(pbuf2d) do j = 1, nparams, 1 write(iulog,*) params_list(j), " = ", clubb_params(j) enddo - endif + end if ! Print configurable CLUBB flags if ( masterproc ) then + write(iulog,'(a,i0,a)') " CLUBB configurable flags " call print_clubb_config_flags_api( iulog, clubb_config_flags ) ! Intent(in) end if @@ -1262,17 +1660,21 @@ subroutine clubb_ini_cam(pbuf2d) if (l_stats) then - call stats_init_clubb( .true., dum1, dum2, & - nlev+1, nlev+1, nlev+1, dum3 ) + do i=1, pcols + call stats_init_clubb( .true., dum1, dum2, & + nlev+1, nlev+1, nlev+1, dum3, & + stats_zt(i), stats_zm(i), stats_sfc(i), & + stats_rad_zt(i), stats_rad_zm(i)) + end do - allocate(out_zt(pcols,pverp,stats_zt%num_output_fields)) - allocate(out_zm(pcols,pverp,stats_zm%num_output_fields)) - allocate(out_sfc(pcols,1,stats_sfc%num_output_fields)) + allocate(out_zt(pcols,pverp,stats_zt(1)%num_output_fields)) + allocate(out_zm(pcols,pverp,stats_zm(1)%num_output_fields)) + allocate(out_sfc(pcols,1,stats_sfc(1)%num_output_fields)) - allocate(out_radzt(pcols,pverp,stats_rad_zt%num_output_fields)) - allocate(out_radzm(pcols,pverp,stats_rad_zm%num_output_fields)) + allocate(out_radzt(pcols,pverp,stats_rad_zt(1)%num_output_fields)) + allocate(out_radzm(pcols,pverp,stats_rad_zm(1)%num_output_fields)) - endif + end if ! ----------------------------------------------------------------- ! ! Make all of this output default, this is not CLUBB history @@ -1389,7 +1791,7 @@ subroutine clubb_ini_cam(pbuf2d) call add_default('RVMTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('UTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('VTEND_CLUBB', history_budget_histfile_num, ' ') - endif + end if ! --------------- ! @@ -1426,6 +1828,17 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8) call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8) call pbuf_set_field(pbuf2d, radf_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2rtp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2thlp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, uprcp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, vprcp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, rc_coef_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp4_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wpup2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wpvp2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2up2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2vp2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, ice_supersat_idx, 0.0_r8) ! Initialize SILHS covariance contributions call pbuf_set_field(pbuf2d, rtp2_mc_zt_idx, 0.0_r8) @@ -1433,7 +1846,14 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, wprtp_mc_zt_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wpthlp_mc_zt_idx, 0.0_r8) call pbuf_set_field(pbuf2d, rtpthlp_mc_zt_idx, 0.0_r8) - endif + + call pbuf_set_field(pbuf2d, pdf_zm_w_1_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_w_2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_1_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_mixt_frac_idx, 0.0_r8) + + end if ! The following is physpkg, so it needs to be initialized every time call pbuf_set_field(pbuf2d, fice_idx, 0.0_r8) @@ -1479,14 +1899,13 @@ subroutine clubb_tend_cam( & use cam_abortutils, only: endrun use cam_logfile, only: iulog use tropopause, only: tropopause_findChemTrop - use time_manager, only: get_nstep + use time_manager, only: get_nstep, is_first_restart_step #ifdef CLUBB_SGS use hb_diff, only: pblintd use scamMOD, only: single_column,scm_clubb_iop_name use clubb_api_module, only: & nparams, & - read_parameters_api, & setup_parameters_api, & time_precision, & advance_clubb_core_api, & @@ -1499,16 +1918,17 @@ subroutine clubb_tend_cam( & l_stats, & stats_tsamp, & stats_tout, & - stats_zt, & - stats_sfc, & - stats_zm, & - stats_rad_zt, & - stats_rad_zm, & l_output_rad_files, & stats_begin_timestep_api, & - hydromet_dim, calculate_thlp2_rad_api, mu, update_xp2_mc_api, & + hydromet_dim, calculate_thlp2_rad_api, update_xp2_mc_api, & sat_mixrat_liq_api, & - fstderr + fstderr, & + ipdf_post_advance_fields, & + copy_single_pdf_params_to_multi, & + copy_multi_pdf_params_to_single, & + pdf_parameter, & + init_pdf_params_api, & + setup_grid_api use clubb_api_module, only: & clubb_fatal_error ! Error code value to indicate a fatal error @@ -1518,6 +1938,8 @@ subroutine clubb_tend_cam( & use macrop_driver, only: liquid_macro_tend use clubb_mf, only: integrate_mf + + use perf_mod #endif @@ -1566,123 +1988,142 @@ subroutine clubb_tend_cam( & integer :: itim_old integer :: ncol, lchnk ! # of columns, and chunk identifier integer :: err_code ! Diagnostic, for if some calculation goes amiss. - integer :: icnt, clubbtop + integer :: icnt logical :: lq2(pcnst) - integer :: iter + integer :: iter, ierr + + integer :: clubbtop(pcols) real(r8) :: frac_limit, ic_limit real(r8) :: dtime ! CLUBB time step [s] - real(r8) :: edsclr_in(pverp+1-top_lev,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] - real(r8) :: wp2_in(pverp+1-top_lev) ! vertical velocity variance (CLUBB) [m^2/s^2] - real(r8) :: wp3_in(pverp+1-top_lev) ! third moment vertical velocity [m^3/s^3] - real(r8) :: wpthlp_in(pverp+1-top_lev) ! turbulent flux of thetal [K m/s] - real(r8) :: wprtp_in(pverp+1-top_lev) ! turbulent flux of total water [kg/kg m/s] - real(r8) :: rtpthlp_in(pverp+1-top_lev) ! covariance of thetal and qt [kg/kg K] - real(r8) :: rtp2_in(pverp+1-top_lev) ! total water variance [kg^2/kg^2] - real(r8) :: thlp2_in(pverp+1-top_lev) ! thetal variance [K^2] - real(r8) :: rtp3_in(pverp+1-top_lev) ! total water 3rd order [kg^3/kg^3] - real(r8) :: thlp3_in(pverp+1-top_lev) ! thetal 3rd order [K^3] - real(r8) :: up2_in(pverp+1-top_lev) ! meridional wind variance [m^2/s^2] - real(r8) :: vp2_in(pverp+1-top_lev) ! zonal wind variance [m^2/s^2] - real(r8) :: up3_in(pverp+1-top_lev) ! meridional wind third-order [m^3/s^3] - real(r8) :: vp3_in(pverp+1-top_lev) ! zonal wind third-order [m^3/s^3] - real(r8) :: upwp_in(pverp+1-top_lev) ! meridional wind flux [m^2/s^2] - real(r8) :: vpwp_in(pverp+1-top_lev) ! zonal wind flux [m^2/s^2] - real(r8) :: wpthvp_in(pverp+1-top_lev) ! w'th_v' (momentum levels) [m/s K] - real(r8) :: wp2thvp_in(pverp+1-top_lev) ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] - real(r8) :: rtpthvp_in(pverp+1-top_lev) ! r_t'th_v' (momentum levels) [kg/kg K] - real(r8) :: thlpthvp_in(pverp+1-top_lev) ! th_l'th_v' (momentum levels) [K^2] - real(r8) :: thlm_in(pverp+1-top_lev) ! liquid water potential temperature (thetal) [K] - real(r8) :: rtm_in(pverp+1-top_lev) ! total water mixing ratio [kg/kg] - real(r8) :: rvm_in(pverp+1-top_lev) ! water vapor mixing ratio [kg/kg] - real(r8) :: um_in(pverp+1-top_lev) ! meridional wind [m/s] - real(r8) :: vm_in(pverp+1-top_lev) ! zonal wind [m/s] - real(r8) :: rho_in(pverp+1-top_lev) ! mid-point density [kg/m^3] - real(r8) :: pre_in(pverp+1-top_lev) ! input for precip evaporation - real(r8) :: rtp2_mc_out(pverp+1-top_lev) ! total water tendency from rain evap - real(r8) :: thlp2_mc_out(pverp+1-top_lev) ! thetal tendency from rain evap - real(r8) :: wprtp_mc_out(pverp+1-top_lev) - real(r8) :: wpthlp_mc_out(pverp+1-top_lev) - real(r8) :: rtpthlp_mc_out(pverp+1-top_lev) - real(r8) :: rcm_inout(pverp+1-top_lev) ! CLUBB output of liquid water mixing ratio [kg/kg] - real(r8) :: rcm_out_zm(pverp+1-top_lev) - real(r8) :: wprcp_out(pverp+1-top_lev) ! CLUBB output of flux of liquid water [kg/kg m/s] - real(r8) :: cloud_frac_inout(pverp+1-top_lev) ! CLUBB output of cloud fraction [fraction] - real(r8) :: rcm_in_layer_out(pverp+1-top_lev) ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] - real(r8) :: cloud_cover_out(pverp+1-top_lev) ! CLUBB output of in-cloud cloud fraction [fraction] - real(r8) :: thlprcp_out(pverp+1-top_lev) - real(r8) :: rho_ds_zm(pverp+1-top_lev) ! Dry, static density on momentum levels [kg/m^3] - real(r8) :: rho_ds_zt(pverp+1-top_lev) ! Dry, static density on thermodynamic levels [kg/m^3] - real(r8) :: invrs_rho_ds_zm(pverp+1-top_lev) ! Inv. dry, static density on momentum levels [m^3/kg] - real(r8) :: invrs_rho_ds_zt(pverp+1-top_lev) ! Inv. dry, static density on thermo. levels [m^3/kg] - real(r8) :: thv_ds_zm(pverp+1-top_lev) ! Dry, base-state theta_v on momentum levels [K] - real(r8) :: thv_ds_zt(pverp+1-top_lev) ! Dry, base-state theta_v on thermo. levels [K] - real(r8) :: rfrzm(pverp+1-top_lev) - real(r8) :: radf(pverp+1-top_lev) - real(r8) :: wprtp_forcing(pverp+1-top_lev) - real(r8) :: wpthlp_forcing(pverp+1-top_lev) - real(r8) :: rtp2_forcing(pverp+1-top_lev) - real(r8) :: thlp2_forcing(pverp+1-top_lev) - real(r8) :: rtpthlp_forcing(pverp+1-top_lev) - real(r8) :: ice_supersat_frac_out(pverp+1-top_lev) - real(r8) :: zt_g(pverp+1-top_lev) ! Thermodynamic grid of CLUBB [m] - real(r8) :: zi_g(pverp+1-top_lev) ! Momentum grid of CLUBB [m] + real(r8) :: edsclr_in(pcols,pverp+1-top_lev,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] + real(r8) :: wp2_in(pcols,pverp+1-top_lev) ! vertical velocity variance (CLUBB) [m^2/s^2] + real(r8) :: wp3_in(pcols,pverp+1-top_lev) ! third moment vertical velocity [m^3/s^3] + real(r8) :: wpthlp_in(pcols,pverp+1-top_lev) ! turbulent flux of thetal [K m/s] + real(r8) :: wprtp_in(pcols,pverp+1-top_lev) ! turbulent flux of total water [kg/kg m/s] + real(r8) :: rtpthlp_in(pcols,pverp+1-top_lev) ! covariance of thetal and qt [kg/kg K] + real(r8) :: rtp2_in(pcols,pverp+1-top_lev) ! total water variance [kg^2/kg^2] + real(r8) :: thlp2_in(pcols,pverp+1-top_lev) ! thetal variance [K^2] + real(r8) :: rtp3_in(pcols,pverp+1-top_lev) ! total water 3rd order [kg^3/kg^3] + real(r8) :: thlp3_in(pcols,pverp+1-top_lev) ! thetal 3rd order [K^3] + real(r8) :: up2_in(pcols,pverp+1-top_lev) ! meridional wind variance [m^2/s^2] + real(r8) :: vp2_in(pcols,pverp+1-top_lev) ! zonal wind variance [m^2/s^2] + real(r8) :: up3_in(pcols,pverp+1-top_lev) ! meridional wind third-order [m^3/s^3] + real(r8) :: vp3_in(pcols,pverp+1-top_lev) ! zonal wind third-order [m^3/s^3] + real(r8) :: upwp_in(pcols,pverp+1-top_lev) ! meridional wind flux [m^2/s^2] + real(r8) :: vpwp_in(pcols,pverp+1-top_lev) ! zonal wind flux [m^2/s^2] + real(r8) :: wpthvp_in(pcols,pverp+1-top_lev) ! w'th_v' (momentum levels) [m/s K] + real(r8) :: wp2thvp_in(pcols,pverp+1-top_lev) ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] + real(r8) :: rtpthvp_in(pcols,pverp+1-top_lev) ! r_t'th_v' (momentum levels) [kg/kg K] + real(r8) :: thlpthvp_in(pcols,pverp+1-top_lev) ! th_l'th_v' (momentum levels) [K^2] + real(r8) :: thlm_in(pcols,pverp+1-top_lev) ! liquid water potential temperature (thetal) [K] + real(r8) :: rtm_in(pcols,pverp+1-top_lev) ! total water mixing ratio [kg/kg] + real(r8) :: rvm_in(pcols,pverp+1-top_lev) ! water vapor mixing ratio [kg/kg] + real(r8) :: um_in(pcols,pverp+1-top_lev) ! meridional wind [m/s] + real(r8) :: vm_in(pcols,pverp+1-top_lev) ! zonal wind [m/s] + real(r8) :: rho_in(pcols,pverp+1-top_lev) ! mid-point density [kg/m^3] + real(r8) :: pre_in(pcols,pverp+1-top_lev) ! input for precip evaporation + real(r8) :: rtp2_mc_out(pcols,pverp+1-top_lev) ! total water tendency from rain evap + real(r8) :: thlp2_mc_out(pcols,pverp+1-top_lev) ! thetal tendency from rain evap + real(r8) :: wprtp_mc_out(pcols,pverp+1-top_lev) + real(r8) :: wpthlp_mc_out(pcols,pverp+1-top_lev) + real(r8) :: rtpthlp_mc_out(pcols,pverp+1-top_lev) + real(r8) :: rcm_inout(pcols,pverp+1-top_lev) ! CLUBB output of liquid water mixing ratio [kg/kg] + real(r8) :: rcm_out_zm(pcols,pverp+1-top_lev) + real(r8) :: wprcp_out(pcols,pverp+1-top_lev) ! CLUBB output of flux of liquid water [kg/kg m/s] + real(r8) :: cloud_frac_inout(pcols,pverp+1-top_lev) ! CLUBB output of cloud fraction [fraction] + real(r8) :: rcm_in_layer_out(pcols,pverp+1-top_lev) ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] + real(r8) :: cloud_cover_out(pcols,pverp+1-top_lev) ! CLUBB output of in-cloud cloud fraction [fraction] + real(r8) :: invrs_tau_zm_out(pcols,pverp+1-top_lev) ! CLUBB output of 1 divided by time-scale [1/s] + real(r8) :: thlprcp_out(pcols,pverp+1-top_lev) + real(r8) :: rho_ds_zm(pcols,pverp+1-top_lev) ! Dry, static density on momentum levels [kg/m^3] + real(r8) :: rho_ds_zt(pcols,pverp+1-top_lev) ! Dry, static density on thermodynamic levels [kg/m^3] + real(r8) :: invrs_rho_ds_zm(pcols,pverp+1-top_lev) ! Inv. dry, static density on momentum levels [m^3/kg] + real(r8) :: invrs_rho_ds_zt(pcols,pverp+1-top_lev) ! Inv. dry, static density on thermo. levels [m^3/kg] + real(r8) :: thv_ds_zm(pcols,pverp+1-top_lev) ! Dry, base-state theta_v on momentum levels [K] + real(r8) :: thv_ds_zt(pcols,pverp+1-top_lev) ! Dry, base-state theta_v on thermo. levels [K] + real(r8) :: rfrzm(pcols,pverp+1-top_lev) + real(r8) :: radf(pcols,pverp+1-top_lev) + real(r8) :: wprtp_forcing(pcols,pverp+1-top_lev) + real(r8) :: wpthlp_forcing(pcols,pverp+1-top_lev) + real(r8) :: rtp2_forcing(pcols,pverp+1-top_lev) + real(r8) :: thlp2_forcing(pcols,pverp+1-top_lev) + real(r8) :: rtpthlp_forcing(pcols,pverp+1-top_lev) + real(r8) :: ice_supersat_frac_inout(pcols,pverp+1-top_lev) + real(r8) :: w_up_in_cloud_out(pcols,pverp+1-top_lev) + real(r8) :: zt_g(pcols,pverp+1-top_lev) ! Thermodynamic grid of CLUBB [m] + real(r8) :: zi_g(pcols,pverp+1-top_lev) ! Momentum grid of CLUBB [m] real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m] real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m] - real(r8) :: fcor ! Coriolis forcing [s^-1] - real(r8) :: sfc_elevation ! Elevation of ground [m AMSL] [m] + real(r8) :: fcor(pcols) ! Coriolis forcing [s^-1] + real(r8) :: sfc_elevation(pcols) ! Elevation of ground [m AMSL] [m] real(r8) :: ubar ! surface wind [m/s] real(r8) :: ustar ! surface stress [m/s] real(r8) :: z0 ! roughness height [m] - real(r8) :: thlm_forcing(pverp+1-top_lev) ! theta_l forcing (thermodynamic levels) [K/s] - real(r8) :: rtm_forcing(pverp+1-top_lev) ! r_t forcing (thermodynamic levels) [(kg/kg)/s] - real(r8) :: um_forcing(pverp+1-top_lev) ! u wind forcing (thermodynamic levels) [m/s/s] - real(r8) :: vm_forcing(pverp+1-top_lev) ! v wind forcing (thermodynamic levels) [m/s/s] - real(r8) :: wm_zm(pverp+1-top_lev) ! w mean wind component on momentum levels [m/s] - real(r8) :: wm_zt(pverp+1-top_lev) ! w mean wind component on thermo. levels [m/s] - real(r8) :: p_in_Pa(pverp+1-top_lev) ! Air pressure (thermodynamic levels) [Pa] - real(r8) :: rho_zt(pverp+1-top_lev) ! Air density on thermo levels [kt/m^3] - real(r8) :: rho_zm(pverp+1-top_lev) ! Air density on momentum levels [kg/m^3] - real(r8) :: exner(pverp+1-top_lev) ! Exner function (thermodynamic levels) [-] - real(r8) :: wpthlp_sfc ! w' theta_l' at surface [(m K)/s] - real(r8) :: wprtp_sfc ! w' r_t' at surface [(kg m)/( kg s)] - real(r8) :: upwp_sfc ! u'w' at surface [m^2/s^2] - real(r8) :: vpwp_sfc ! v'w' at surface [m^2/s^2] - real(r8) :: sclrm_forcing(pverp+1-top_lev,sclr_dim) ! Passive scalar forcing [{units vary}/s] - real(r8) :: wpsclrp_sfc(sclr_dim) ! Scalar flux at surface [{units vary} m/s] - real(r8) :: edsclrm_forcing(pverp+1-top_lev,edsclr_dim)! Eddy passive scalar forcing [{units vary}/s] - real(r8) :: wpedsclrp_sfc(edsclr_dim) ! Eddy-scalar flux at surface [{units vary} m/s] - real(r8) :: sclrm(pverp+1-top_lev,sclr_dim) ! Passive scalar mean (thermo. levels) [units vary] - real(r8) :: wpsclrp(pverp+1-top_lev,sclr_dim)! w'sclr' (momentum levels) [{units vary} m/s] - real(r8) :: sclrp2(pverp+1-top_lev,sclr_dim) ! sclr'^2 (momentum levels) [{units vary}^2] - real(r8) :: sclrp3(pverp+1-top_lev,sclr_dim) ! sclr'^3 (thermo. levels) [{units vary}^3] - real(r8) :: sclrprtp(pverp+1-top_lev,sclr_dim) ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] - real(r8) :: sclrpthlp(pverp+1-top_lev,sclr_dim) ! sclr'thlp' (momentum levels) [{units vary} (K)] - real(r8) :: sclrpthvp_inout(pverp,sclr_dim) ! sclr'th_v' (momentum levels) [{units vary} (K)] - real(r8) :: hydromet(pverp+1-top_lev,hydromet_dim) - real(r8) :: wphydrometp(pverp+1-top_lev,hydromet_dim) - real(r8) :: wp2hmp(pverp+1-top_lev,hydromet_dim) - real(r8) :: rtphmp_zt(pverp+1-top_lev,hydromet_dim) - real(r8) :: thlphmp_zt (pverp+1-top_lev,hydromet_dim) - real(r8) :: bflx22 ! Variable for buoyancy flux for pbl [K m/s] - real(r8) :: khzm_out(pverp+1-top_lev) ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] - real(r8) :: khzt_out(pverp+1-top_lev) ! eddy diffusivity on thermo grids [m^2/s] - real(r8) :: qclvar_out(pverp+1-top_lev) ! cloud water variance [kg^2/kg^2] + real(r8) :: thlm_forcing(pcols,pverp+1-top_lev) ! theta_l forcing (thermodynamic levels) [K/s] + real(r8) :: rtm_forcing(pcols,pverp+1-top_lev) ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + real(r8) :: um_forcing(pcols,pverp+1-top_lev) ! u wind forcing (thermodynamic levels) [m/s/s] + real(r8) :: vm_forcing(pcols,pverp+1-top_lev) ! v wind forcing (thermodynamic levels) [m/s/s] + real(r8) :: rtm_ref(pcols,pverp+1-top_lev) ! Initial profile of rtm [kg/kg] + real(r8) :: thlm_ref(pcols,pverp+1-top_lev) ! Initial profile of thlm [K] + real(r8) :: um_ref(pcols,pverp+1-top_lev) ! Initial profile of um [m/s] + real(r8) :: vm_ref(pcols,pverp+1-top_lev) ! Initial profile of vm [m/s] + real(r8) :: ug(pcols,pverp+1-top_lev) ! U geostrophic wind [m/s] + real(r8) :: vg(pcols,pverp+1-top_lev) ! V geostrophic wind [m/s] + real(r8) :: wm_zm(pcols,pverp+1-top_lev) ! w mean wind component on momentum levels [m/s] + real(r8) :: wm_zt(pcols,pverp+1-top_lev) ! w mean wind component on thermo. levels [m/s] + real(r8) :: p_in_Pa(pcols,pverp+1-top_lev) ! Air pressure (thermodynamic levels) [Pa] + real(r8) :: rho_zt(pcols,pverp+1-top_lev) ! Air density on thermo levels [kt/m^3] + real(r8) :: rho_zm(pcols,pverp+1-top_lev) ! Air density on momentum levels [kg/m^3] + real(r8) :: exner(pcols,pverp+1-top_lev) ! Exner function (thermodynamic levels) [-] + real(r8) :: wpthlp_sfc(pcols) ! w' theta_l' at surface [(m K)/s] + real(r8) :: wprtp_sfc(pcols) ! w' r_t' at surface [(kg m)/( kg s)] + real(r8) :: upwp_sfc(pcols) ! u'w' at surface [m^2/s^2] + real(r8) :: vpwp_sfc(pcols) ! v'w' at surface [m^2/s^2] + real(r8) :: sclrm_forcing(pcols,pverp+1-top_lev,sclr_dim) ! Passive scalar forcing [{units vary}/s] + real(r8) :: wpsclrp_sfc(pcols,sclr_dim) ! Scalar flux at surface [{units vary} m/s] + real(r8) :: edsclrm_forcing(pcols,pverp+1-top_lev,edsclr_dim)! Eddy passive scalar forcing [{units vary}/s] + real(r8) :: wpedsclrp_sfc(pcols,edsclr_dim) ! Eddy-scalar flux at surface [{units vary} m/s] + real(r8) :: sclrm(pcols,pverp+1-top_lev,sclr_dim) ! Passive scalar mean (thermo. levels) [units vary] + real(r8) :: wpsclrp(pcols,pverp+1-top_lev,sclr_dim)! w'sclr' (momentum levels) [{units vary} m/s] + real(r8) :: sclrp2(pcols,pverp+1-top_lev,sclr_dim) ! sclr'^2 (momentum levels) [{units vary}^2] + real(r8) :: sclrp3(pcols,pverp+1-top_lev,sclr_dim) ! sclr'^3 (thermo. levels) [{units vary}^3] + real(r8) :: sclrprtp(pcols,pverp+1-top_lev,sclr_dim) ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] + real(r8) :: sclrpthlp(pcols,pverp+1-top_lev,sclr_dim) ! sclr'thlp' (momentum levels) [{units vary} (K)] + real(r8) :: sclrpthvp_inout(pcols,pverp,sclr_dim) ! sclr'th_v' (momentum levels) [{units vary} (K)] + real(r8) :: wp2rtp_inout(pcols,pverp+1-top_lev) ! w'^2 rt' (thermodynamic levels) + real(r8) :: wp2thlp_inout(pcols,pverp+1-top_lev) ! w'^2 thl' (thermodynamic levels) + real(r8) :: uprcp_inout(pcols,pverp+1-top_lev) ! < u' r_c' > (momentum levels) + real(r8) :: vprcp_inout(pcols,pverp+1-top_lev) ! < v' r_c' > (momentum levels) + real(r8) :: rc_coef_inout(pcols,pverp+1-top_lev) ! Coef. of X'r_c' in Eq. (34) (t-levs.) + real(r8) :: wp4_inout(pcols,pverp+1-top_lev) ! w'^4 (momentum levels + real(r8) :: wpup2_inout(pcols,pverp+1-top_lev) ! w'u'^2 (thermodynamic levels) + real(r8) :: wpvp2_inout(pcols,pverp+1-top_lev) ! w'v'^2 (thermodynamic levels) + real(r8) :: wp2up2_inout(pcols,pverp+1-top_lev) ! w'^2 u'^2 (momentum levels) + real(r8) :: wp2vp2_inout(pcols,pverp+1-top_lev) ! w'^2 v'^2 (momentum levels) + real(r8) :: hydromet(pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: wphydrometp(pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: wp2hmp(pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: rtphmp_zt(pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: thlphmp_zt (pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: bflx22(pcols) ! Variable for buoyancy flux for pbl [K m/s] + real(r8) :: khzm_out(pcols,pverp+1-top_lev) ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] + real(r8) :: khzt_out(pcols,pverp+1-top_lev) ! eddy diffusivity on thermo grids [m^2/s] + real(r8) :: qclvar_out(pcols,pverp+1-top_lev) ! cloud water variance [kg^2/kg^2] real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2] - real(r8) :: zo ! roughness height [m] - real(r8) :: dz_g(pver) ! thickness of layer [m] + real(r8) :: zo(pcols) ! roughness height [m] + real(r8) :: dz_g(pcols,pver) ! thickness of layer [m] real(r8) :: relvarmax - real(r8) :: se_upper_a, se_upper_b, se_upper_diss - real(r8) :: tw_upper_a, tw_upper_b, tw_upper_diss + real(r8) :: se_upper_a(pcols), se_upper_b(pcols), se_upper_diss(pcols) + real(r8) :: tw_upper_a(pcols), tw_upper_b(pcols), tw_upper_diss(pcols) real(r8) :: grid_dx(pcols), grid_dy(pcols) ! CAM grid [m] - real(r8) :: host_dx, host_dy ! CAM grid [m] ! Variables below are needed to compute energy integrals for conservation real(r8) :: ke_a(pcols), ke_b(pcols), te_a(pcols), te_b(pcols) real(r8) :: wv_a(pcols), wv_b(pcols), wl_b(pcols), wl_a(pcols) - real(r8) :: se_dis, se_a(pcols), se_b(pcols), clubb_s(pver) + real(r8) :: se_dis(pcols), se_a(pcols), se_b(pcols), clubb_s(pcols,pver) real(r8) :: inv_exner_clubb(pcols,pverp) ! Inverse exner function consistent with CLUBB [-] real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2] @@ -1695,18 +2136,18 @@ subroutine clubb_tend_cam( & real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2] real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3] real(r8) :: thv(pcols,pver) ! virtual potential temperature [K] - real(r8) :: edsclr_out(pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] + real(r8) :: edsclr_out(pcols,pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] real(r8) :: rcm_in_layer(pcols,pverp) ! CLUBB in-cloud liquid water mixing ratio [kg/kg] real(r8) :: cloud_cover(pcols,pverp) ! CLUBB in-cloud cloud fraction [fraction] real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg] real(r8) :: wpthvp_diag(pcols,pverp) ! CLUBB buoyancy flux [W/m^2] real(r8) :: rvm(pcols,pverp) real(r8) :: pdfp_rtp2(pcols, pverp) ! Calculated R-tot variance from pdf_params [kg^2/kg^2] - real(r8) :: rtp2_zt(pverp+1-top_lev) ! CLUBB R-tot variance on thermo levs + real(r8) :: rtp2_zt(pcols,pverp+1-top_lev) ! CLUBB R-tot variance on thermo levs real(r8) :: rtp2_zt_out(pcols, pverp) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] - real(r8) :: thl2_zt(pverp+1-top_lev) ! CLUBB Theta-l variance on thermo levs [K^2] + real(r8) :: thl2_zt(pcols,pverp+1-top_lev) ! CLUBB Theta-l variance on thermo levs [K^2] real(r8) :: thl2_zt_out(pcols, pverp) ! CLUBB Theta-l variance on thermo levs - real(r8) :: wp2_zt(pverp+1-top_lev) ! CLUBB W variance on theromo levs [m^2/s^2] + real(r8) :: wp2_zt(pcols,pverp+1-top_lev) ! CLUBB W variance on theromo levs [m^2/s^2] real(r8) :: wp2_zt_out(pcols, pverp) real(r8) :: dlf_liq_out(pcols, pverp) ! Detrained liquid water from ZM [kg/kg/s] real(r8) :: dlf_ice_out(pcols, pverp) ! Detrained ice water from ZM [kg/kg/s] @@ -1724,20 +2165,20 @@ subroutine clubb_tend_cam( & real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3] real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s] real(r8) :: latsub - real(r8) :: qrl_clubb(pverp+1-top_lev) - real(r8) :: qrl_zm(pverp+1-top_lev) - real(r8) :: thlp2_rad_out(pverp+1-top_lev) + real(r8) :: qrl_clubb(pcols,pverp+1-top_lev) + real(r8) :: qrl_zm(pcols,pverp+1-top_lev) + real(r8) :: thlp2_rad_out(pcols,pverp+1-top_lev) real(r8) :: apply_const, rtm_test real(r8) :: dl_rad, di_rad, dt_low - real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) - real(r8), dimension(sclr_dim) :: sclr_tol ! Tolerance on passive scalar [units vary] - character(len=200) :: temp1, sub ! Strings needed for CLUBB output real(kind=time_precision) :: time_elapsed ! time keep track of stats [s] integer :: stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] - real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing, rtm_integral_vtend, rtm_integral_ltend + real(r8) :: rtm_integral_vtend(pcols), & + rtm_integral_ltend(pcols) + + real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing ! --------------- ! ! Pointers ! @@ -1763,6 +2204,21 @@ subroutine clubb_tend_cam( & real(r8), pointer, dimension(:,:) :: rtpthvp ! r_t'th_v' (momentum levels) [kg/kg K] real(r8), pointer, dimension(:,:) :: thlpthvp ! th_l'th_v' (momentum levels) [K^2] real(r8), pointer, dimension(:,:) :: cloud_frac ! Cloud fraction (thermodynamic levels) [K^2] + real(r8), pointer, dimension(:,:) :: pdf_zm_w_1 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_w_2 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: wp2rtp ! w'^2 rt' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2thlp ! w'^2 thl' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: uprcp ! < u' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: vprcp ! < v' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: rc_coef ! Coef. of X'r_c' in Eq. (34) (t-levs.) + real(r8), pointer, dimension(:,:) :: wp4 ! w'^4 (momentum levels + real(r8), pointer, dimension(:,:) :: wpup2 ! w'u'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wpvp2 ! w'v'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2up2 ! w'^2 u'^2 (momentum levels) + real(r8), pointer, dimension(:,:) :: wp2vp2 ! w'^2 v'^2 (momentum levels) real(r8), pointer, dimension(:,:) :: thlm ! mean temperature [K] real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio [kg/kg] real(r8), pointer, dimension(:,:) :: rcm ! CLUBB cloud water mixing ratio [kg/kg] @@ -1820,7 +2276,7 @@ subroutine clubb_tend_cam( & real(r8) :: rhmaxi(pcols) integer :: troplev(pcols) logical :: lqice(pcnst) - logical :: apply_to_surface + logical :: apply_to_surface(pcols) ! MF outputs to outfld real(r8), dimension(pcols,pverp) :: mf_dry_a_output, mf_moist_a_output, & @@ -1836,7 +2292,7 @@ subroutine clubb_tend_cam( & s_awu_output, s_awv_output, & mf_thlflx_output, mf_qtflx_output ! MF Plume - real(r8), dimension(pverp) :: mf_dry_a, mf_moist_a, & + real(r8), dimension(pcols,pverp) :: mf_dry_a, mf_moist_a, & mf_dry_w, mf_moist_w, & mf_dry_qt, mf_moist_qt, & mf_dry_thl, mf_moist_thl, & @@ -1849,7 +2305,7 @@ subroutine clubb_tend_cam( & s_awu, s_awv, & mf_thlflx, mf_qtflx ! MF local vars - real(r8), dimension(pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid + real(r8), dimension(pcols,pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid dzt, invrs_dzt, & ! thermodynamic grid invrs_exner_zt,& ! thermodynamic grid kappa_zt, qc_zt, & ! thermodynamic grid @@ -1858,12 +2314,19 @@ subroutine clubb_tend_cam( & real(r8) :: temp2d(pcols,pver), temp2dp(pcols,pverp) ! temporary array for holding scaled outputs - integer :: nlev intrinsic :: max character(len=*), parameter :: subr='clubb_tend_cam' + + type(pdf_parameter) :: pdf_params_single_col + + type(grid) :: gr(pcols) + integer :: begin_height, end_height + + type(nu_vertical_res_dep) :: nu_vert_res_dep(pcols) ! Vertical resolution dependent nu values + real(r8) :: lmin(pcols) #endif det_s(:) = 0.0_r8 @@ -1878,6 +2341,8 @@ subroutine clubb_tend_cam( & !-----------------------------------------------------------------------------------------------! !-----------------------------------------------------------------------------------------------! + call t_startf("clubb_tend_cam") + nlev = pver + 1 - top_lev rtp2_zt_out = 0._r8 @@ -1897,7 +2362,7 @@ subroutine clubb_tend_cam( & apply_const = 1._r8 ! Initialize to one, only if CLUBB's moments are advected else apply_const = 0._r8 ! Never want this if CLUBB's moments are not advected - endif + end if ! Get indicees for cloud and ice mass and cloud and ice number @@ -1922,7 +2387,7 @@ subroutine clubb_tend_cam( & if (clubb_do_liqsupersat) then call pbuf_get_field(pbuf, npccn_idx, npccn) - endif + end if ! Determine number of columns and which chunk computation is to be performed on @@ -1933,7 +2398,6 @@ subroutine clubb_tend_cam( & itim_old = pbuf_old_tim_idx() ! Establish associations between pointers and physics buffer fields - call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) @@ -1957,6 +2421,23 @@ subroutine clubb_tend_cam( & call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp) call pbuf_get_field(pbuf, rcm_idx, rcm) call pbuf_get_field(pbuf, cloud_frac_idx, cloud_frac) + + call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_1_idx, pdf_zm_varnce_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_2_idx, pdf_zm_varnce_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_mixt_frac_idx, pdf_zm_mixt_frac, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + + call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp) + call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp) + call pbuf_get_field(pbuf, uprcp_idx, uprcp) + call pbuf_get_field(pbuf, vprcp_idx, vprcp) + call pbuf_get_field(pbuf, rc_coef_idx, rc_coef) + call pbuf_get_field(pbuf, wp4_idx, wp4) + call pbuf_get_field(pbuf, wpup2_idx, wpup2) + call pbuf_get_field(pbuf, wpvp2_idx, wpvp2) + call pbuf_get_field(pbuf, wp2up2_idx, wp2up2) + call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2) call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) @@ -1995,12 +2476,21 @@ subroutine clubb_tend_cam( & call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) + + ! Allocate arrays in the single column versions of pdf_params + call init_pdf_params_api( pverp+1-top_lev, 1, pdf_params_single_col ) + + ! Allocate pdf_params only if they aren't allocated already. + if ( .not. allocated(pdf_params_chnk(lchnk)%mixt_frac) ) then + call init_pdf_params_api( pverp+1-top_lev, ncol, pdf_params_chnk(lchnk) ) + call init_pdf_params_api( pverp+1-top_lev, ncol, pdf_params_zm_chnk(lchnk) ) + end if ! Initialize the apply_const variable (note special logic is due to eularian backstepping) if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) == 0._r8))) then apply_const = 0._r8 ! On first time through do not remove constant ! from moments since it has not been added yet - endif + end if ! Set the ztodt timestep in pbuf for SILHS ztodtptr(:) = 1.0_r8*hdtime @@ -2064,7 +2554,7 @@ subroutine clubb_tend_cam( & call outfld( 'QITENDICE', qitend, pcols, lchnk ) call outfld( 'NITENDICE', initend, pcols, lchnk ) - endif + end if ! Determine CLUBB time step and make it sub-step friendly @@ -2083,7 +2573,7 @@ subroutine clubb_tend_cam( & if (dtime > hdtime) then dtime = hdtime - endif + end if ! Now check to see if CLUBB time step divides evenly into ! the host model time step. If not, force it to divide evenly. @@ -2096,14 +2586,14 @@ subroutine clubb_tend_cam( & do while (dtime > clubb_timestep) dtime = dtime/2._r8 end do - endif + end if ! If resulting host model time step and CLUBB time step do not divide evenly ! into each other, have model throw a fit. if (mod(hdtime,dtime) .ne. 0) then call endrun(subr//': CLUBB time step and HOST time step NOT compatible') - endif + end if ! determine number of timesteps CLUBB core should be advanced, ! host time step divided by CLUBB time step @@ -2111,9 +2601,9 @@ subroutine clubb_tend_cam( & ! Initialize forcings for transported scalars to zero - sclrm_forcing(:,:) = 0._r8 - edsclrm_forcing(:,:) = 0._r8 - sclrm(:,:) = 0._r8 + sclrm_forcing(:,:,:) = 0._r8 + edsclrm_forcing(:,:,:) = 0._r8 + sclrm(:,:,:) = 0._r8 ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent @@ -2128,7 +2618,6 @@ subroutine clubb_tend_cam( & ! At each CLUBB call, initialize mean momentum and thermo CLUBB state ! from the CAM state - do k=1,pver ! loop over levels do i=1,ncol ! loop over columns @@ -2155,8 +2644,8 @@ subroutine clubb_tend_cam( & wp3(i,k) = state1%q(i,k,ixwp3) - (wp3_const*apply_const) up2(i,k) = state1%q(i,k,ixup2) vp2(i,k) = state1%q(i,k,ixvp2) - endif - endif + end if + end if enddo enddo @@ -2168,8 +2657,8 @@ subroutine clubb_tend_cam( & apply_const = 1._r8 else apply_const = 0._r8 - endif - endif + end if + end if rtm(1:ncol,pverp) = rtm(1:ncol,pver) um(1:ncol,pverp) = state1%u(1:ncol,pver) @@ -2186,7 +2675,7 @@ subroutine clubb_tend_cam( & wp3(1:ncol,pverp)=wp3(1:ncol,pver) up2(1:ncol,pverp)=up2(1:ncol,pver) vp2(1:ncol,pverp)=vp2(1:ncol,pver) - endif + end if ! Compute virtual potential temperature, which is needed for CLUBB do k=1,pver @@ -2224,792 +2713,1047 @@ subroutine clubb_tend_cam( & s_awv_output(:,:) = 0._r8 mf_thlflx_output(:,:) = 0._r8 mf_qtflx_output(:,:) = 0._r8 + + call t_startf("clubb_tend_cam_i_loop") + + ! Determine Coriolis force at given latitude. This is never used + ! when CLUBB is implemented in a host model, therefore just set + ! to zero. + fcor(:) = 0._r8 + + ! Define the CLUBB momentum grid (in height, units of m) + do k=1, nlev+1 + do i=1, ncol + zi_g(i,k) = state1%zi(i,pverp-k+1)-state1%zi(i,pver+1) + end do + end do - ! Loop over all columns in lchnk to advance CLUBB core - do i=1,ncol ! loop over columns - - ! Determine Coriolis force at given latitude. This is never used - ! when CLUBB is implemented in a host model, therefore just set - ! to zero. - fcor = 0._r8 + ! Define the CLUBB thermodynamic grid (in units of m) + do k=1, nlev + do i=1, ncol + zt_g(i,k+1) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1) + end do + end do - ! Define the CLUBB momentum grid (in height, units of m) - do k=1,nlev+1 - zi_g(k) = state1%zi(i,pverp-k+1)-state1%zi(i,pver+1) - enddo + do k=1, pver + do i=1, ncol + dz_g(i,k) = state1%zi(i,k)-state1%zi(i,k+1) ! compute thickness + end do + end do + + ! Thermodynamic ghost point is below surface + do i=1, ncol + zt_g(i,1) = -1._r8*zt_g(i,2) + end do + + do i=1, ncol + ! Set the elevation of the surface + sfc_elevation(i) = state1%zi(i,pver+1) + end do - ! Define the CLUBB thermodynamic grid (in units of m) - do k=1,nlev - zt_g(k+1) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1) + ! Compute thermodynamic stuff needed for CLUBB on thermo levels. + ! Inputs for the momentum levels are set below setup_clubb core + do k=1,nlev + do i=1, ncol + p_in_Pa(i,k+1) = state1%pmid(i,pver-k+1) ! Pressure profile + exner(i,k+1) = 1._r8/inv_exner_clubb(i,pver-k+1) + rho_ds_zt(i,k+1) = (1._r8/gravit)*(state1%pdel(i,pver-k+1)/dz_g(i,pver-k+1)) + invrs_rho_ds_zt(i,k+1) = 1._r8/(rho_ds_zt(i,k+1)) ! Inverse ds rho at thermo + rho_in(i,k+1) = rho_ds_zt(i,k+1) ! rho on thermo + thv_ds_zt(i,k+1) = thv(i,pver-k+1) ! thetav on thermo + rfrzm(i,k+1) = state1%q(i,pver-k+1,ixcldice) + radf(i,k+1) = radf_clubb(i,pver-k+1) + qrl_clubb(i,k+1) = qrl(i,pver-k+1)/(cpairv(i,k,lchnk)*state1%pdel(i,pver-k+1)) + end do + end do + + ! Compute mean w wind on thermo grid, convert from omega to w + do k=1,nlev + do i=1,ncol + wm_zt(i,k+1) = -1._r8*state1%omega(i,pver-k+1)/(rho_in(i,k+1)*gravit) end do + end do - do k=1,pver - dz_g(k) = state1%zi(i,k)-state1%zi(i,k+1) ! compute thickness - enddo - - ! Thermodynamic ghost point is below surface - zt_g(1) = -1._r8*zt_g(2) + ! Below computes the same stuff for the ghost point. May or may + ! not be needed, just to be safe to avoid NaN's + do i=1, ncol + rho_ds_zt(i,1) = rho_ds_zt(i,2) + invrs_rho_ds_zt(i,1) = invrs_rho_ds_zt(i,2) + rho_in(i,1) = rho_ds_zt(i,2) + thv_ds_zt(i,1) = thv_ds_zt(i,2) + rho_zt(i,:) = rho_in(i,:) + p_in_Pa(i,1) = p_in_Pa(i,2) + exner(i,1) = exner(i,2) + rfrzm(i,1) = rfrzm(i,2) + radf(i,1) = radf(i,2) + qrl_clubb(i,1) = qrl_clubb(i,2) + wm_zt(i,1) = 0._r8 + end do + + + ! ------------------------------------------------- ! + ! Begin case specific code for SCAM cases. ! + ! This section of code block is NOT called in ! + ! global simulations ! + ! ------------------------------------------------- ! + if (single_column) then + + ! Initialize zo if variable ustar is used + if (cam_in%landfrac(1) >= 0.5_r8) then + zo(1) = 0.035_r8 + else + zo(1) = 0.0001_r8 + end if - ! Set the elevation of the surface - sfc_elevation = state1%zi(i,pver+1) - - ! Set the grid size - host_dx = grid_dx(i) - host_dy = grid_dy(i) + ! Compute surface wind (ubar) + ubar = sqrt(um(1,pver)**2+vm(1,pver)**2) + if (ubar < 0.25_r8) ubar = 0.25_r8 + + ! Below denotes case specifics for surface momentum + ! and thermodynamic fluxes, depending on the case - ! Compute thermodynamic stuff needed for CLUBB on thermo levels. - ! Inputs for the momentum levels are set below setup_clubb core - do k=1,nlev - p_in_Pa(k+1) = state1%pmid(i,pver-k+1) ! Pressure profile - exner(k+1) = 1._r8/inv_exner_clubb(i,pver-k+1) - rho_ds_zt(k+1) = (1._r8/gravit)*(state1%pdel(i,pver-k+1)/dz_g(pver-k+1)) - invrs_rho_ds_zt(k+1) = 1._r8/(rho_ds_zt(k+1)) ! Inverse ds rho at thermo - rho_in(k+1) = rho_ds_zt(k+1) ! rho on thermo - thv_ds_zt(k+1) = thv(i,pver-k+1) ! thetav on thermo - rfrzm(k+1) = state1%q(i,pver-k+1,ixcldice) - radf(k+1) = radf_clubb(i,pver-k+1) - qrl_clubb(k+1) = qrl(i,pver-k+1)/(cpairv(i,k,lchnk)*state1%pdel(i,pver-k+1)) - enddo + ! Define ustar (based on case, if not variable) + ustar = 0.25_r8 ! Initialize ustar in case no case + + if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then + ustar = 0.28_r8 + end if + + if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then + ustar = 0.30_r8 + end if + + if(trim(scm_clubb_iop_name) == 'RICO_3day') then + ustar = 0.28_r8 + end if - ! Below computes the same stuff for the ghost point. May or may - ! not be needed, just to be safe to avoid NaN's - rho_ds_zt(1) = rho_ds_zt(2) - invrs_rho_ds_zt(1) = invrs_rho_ds_zt(2) - rho_in(1) = rho_ds_zt(2) - thv_ds_zt(1) = thv_ds_zt(2) - rho_zt(:) = rho_in(:) - p_in_Pa(1) = p_in_Pa(2) - exner(1) = exner(2) - rfrzm(1) = rfrzm(2) - radf(1) = radf(2) - qrl_clubb(1) = qrl_clubb(2) - - ! Compute mean w wind on thermo grid, convert from omega to w - wm_zt(1) = 0._r8 - do k=1,nlev - wm_zt(k+1) = -1._r8*state1%omega(i,pver-k+1)/(rho_in(k+1)*gravit) - enddo - - ! ------------------------------------------------- ! - ! Begin case specific code for SCAM cases. ! - ! This section of code block NOT called in ! - ! global simulations ! - ! ------------------------------------------------- ! + if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. & + trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & + trim(scm_clubb_iop_name) == 'ARM_CC') then + + bflx22(1) = (gravit/theta0)*wpthlp_sfc(1) + ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1)) + end if + + ! Compute the surface momentum fluxes, if this is a SCAM simulation + upwp_sfc(1) = -um(1,pver)*ustar**2/ubar + vpwp_sfc(1) = -vm(1,pver)*ustar**2/ubar + + end if - if (single_column) then + ! Define surface sources for transported variables for diffusion, will + ! be zero as these tendencies are done in vertical_diffusion + do ixind=1,edsclr_dim + do i=1,ncol + wpedsclrp_sfc(i,ixind) = 0._r8 + end do + end do + + ! Set stats output and increment equal to CLUBB and host dt + stats_tsamp = dtime + stats_tout = hdtime + + stats_nsamp = nint(stats_tsamp/dtime) + stats_nout = nint(stats_tout/dtime) + + ! Heights need to be set at each timestep. Therefore, recall + ! setup_grid and setup_parameters for this. + + ! Set-up CLUBB core at each CLUBB call because heights can change + ! Important note: do not make any calls that use CLUBB grid-height + ! operators (such as zt2zm_api, etc.) until AFTER the + ! call to setup_grid_heights_api. + do i=1,ncol + call setup_grid_api( nlev+1, sfc_elevation(i), l_implemented, & ! intent(in) + grid_type, zi_g(i,2), zi_g(i,1), zi_g(i,nlev+1), & ! intent(in) + zi_g(i,:), zt_g(i,:), & ! intent(in) + gr(i), begin_height, end_height ) ! intent(out) + end do - ! Initialize zo if variable ustar is used + do i=1,ncol + call setup_parameters_api( zi_g(i,2), clubb_params, nlev+1, grid_type, & + zi_g(i,:), zt_g(i,:), & + clubb_config_flags%l_prescribed_avg_deltaz, & + lmin(i), nu_vert_res_dep(i), err_code ) + if ( err_code == clubb_fatal_error ) then + call endrun(subr//': Fatal error in CLUBB setup_parameters') + end if + end do - if (cam_in%landfrac(i) >= 0.5_r8) then - zo = 0.035_r8 - else - zo = 0.0001_r8 - endif + ! Define forcings from CAM to CLUBB as zero for momentum and thermo, + ! forcings already applied through CAM + thlm_forcing(:,:) = 0._r8 + rtm_forcing(:,:) = 0._r8 + um_forcing(:,:) = 0._r8 + vm_forcing(:,:) = 0._r8 - ! Compute surface wind (ubar) - ubar = sqrt(um(i,pver)**2+vm(i,pver)**2) - if (ubar < 0.25_r8) ubar = 0.25_r8 - - ! Below denotes case specifics for surface momentum - ! and thermodynamic fluxes, depending on the case - ! Define ustar (based on case, if not variable) - ustar = 0.25_r8 ! Initialize ustar in case no case - - if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then - ustar = 0.28_r8 - endif + rtm_ref(:,:) = 0.0_r8 + thlm_ref(:,:) = 0.0_r8 + um_ref(:,:) = 0.0_r8 + vm_ref(:,:) = 0.0_r8 + ug(:,:) = 0.0_r8 + vg(:,:) = 0.0_r8 - if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then - ustar = 0.30_r8 - endif + ! Add forcings for SILHS covariance contributions + rtp2_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rtp2_mc_zt(1:ncol,:) ) + thlp2_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, thlp2_mc_zt(1:ncol,:) ) + wprtp_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, wprtp_mc_zt(1:ncol,:) ) + wpthlp_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, wpthlp_mc_zt(1:ncol,:) ) + rtpthlp_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rtpthlp_mc_zt(1:ncol,:) ) + + ! Zero out SILHS covariance contribution terms + rtp2_mc_zt(:,:) = 0.0_r8 + thlp2_mc_zt(:,:) = 0.0_r8 + wprtp_mc_zt(:,:) = 0.0_r8 + wpthlp_mc_zt(:,:) = 0.0_r8 + rtpthlp_mc_zt(:,:) = 0.0_r8 - if(trim(scm_clubb_iop_name) == 'RICO_3day') then - ustar = 0.28_r8 - endif - if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. & - trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & - trim(scm_clubb_iop_name) == 'ARM_CC') then - - bflx22 = (gravit/theta0)*wpthlp_sfc - ustar = diag_ustar(zt_g(2),bflx22,ubar,zo) - endif - - ! Compute the surface momentum fluxes, if this is a SCAM simulation - upwp_sfc = -um(i,pver)*ustar**2/ubar - vpwp_sfc = -vm(i,pver)*ustar**2/ubar + ! Compute some inputs from the thermodynamic grid + ! to the momentum grid + rho_ds_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rho_ds_zt(1:ncol,:)) + rho_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rho_zt(1:ncol,:)) + invrs_rho_ds_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, invrs_rho_ds_zt(1:ncol,:)) + thv_ds_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, thv_ds_zt(1:ncol,:)) + wm_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, wm_zt(1:ncol,:)) + + ! Surface fluxes provided by host model + do i=1,ncol + wpthlp_sfc(i) = cam_in%shf(i)/(cpair*rho_ds_zm(i,1)) ! Sensible heat flux + wprtp_sfc(i) = cam_in%cflx(i,1)/rho_ds_zm(i,1) ! Moisture flux (check rho) + upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,1) ! Surface meridional momentum flux + vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,1) ! Surface zonal momentum flux + end do - endif + ! Need to flip arrays around for CLUBB core + do k=1,nlev+1 + do i=1,ncol + um_in(i,k) = um(i,pverp-k+1) + vm_in(i,k) = vm(i,pverp-k+1) + upwp_in(i,k) = upwp(i,pverp-k+1) + vpwp_in(i,k) = vpwp(i,pverp-k+1) + wpthvp_in(i,k) = wpthvp(i,pverp-k+1) + wp2thvp_in(i,k) = wp2thvp(i,pverp-k+1) + rtpthvp_in(i,k) = rtpthvp(i,pverp-k+1) + thlpthvp_in(i,k)= thlpthvp(i,pverp-k+1) + up2_in(i,k) = up2(i,pverp-k+1) + vp2_in(i,k) = vp2(i,pverp-k+1) + up3_in(i,k) = up3(i,pverp-k+1) + vp3_in(i,k) = vp3(i,pverp-k+1) + wp2_in(i,k) = wp2(i,pverp-k+1) + wp3_in(i,k) = wp3(i,pverp-k+1) + rtp2_in(i,k) = rtp2(i,pverp-k+1) + thlp2_in(i,k) = thlp2(i,pverp-k+1) + rtp3_in(i,k) = rtp3(i,pverp-k+1) + thlp3_in(i,k) = thlp3(i,pverp-k+1) + thlm_in(i,k) = thlm(i,pverp-k+1) + rtm_in(i,k) = rtm(i,pverp-k+1) + rvm_in(i,k) = rvm(i,pverp-k+1) + wprtp_in(i,k) = wprtp(i,pverp-k+1) + wpthlp_in(i,k) = wpthlp(i,pverp-k+1) + rtpthlp_in(i,k) = rtpthlp(i,pverp-k+1) + rcm_inout(i,k) = rcm(i,pverp-k+1) + cloud_frac_inout(i,k) = cloud_frac(i,pverp-k+1) + + ! We only need to copy pdf_params from pbuf if this is a restart and + ! we're calling pdf_closure at the end of advance_clubb_core + if ( is_first_restart_step() & + .and. clubb_config_flags%ipdf_call_placement .eq. ipdf_post_advance_fields ) then + pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac(i,pverp-k+1) + end if + + sclrpthvp_inout(i,k,:) = 0._r8 + wp2rtp_inout(i,k) = wp2rtp(i,pverp-k+1) + wp2thlp_inout(i,k) = wp2thlp(i,pverp-k+1) + uprcp_inout(i,k) = uprcp(i,pverp-k+1) + vprcp_inout(i,k) = vprcp(i,pverp-k+1) + rc_coef_inout(i,k) = rc_coef(i,pverp-k+1) + wp4_inout(i,k) = wp4(i,pverp-k+1) + wpup2_inout(i,k) = wpup2(i,pverp-k+1) + wpvp2_inout(i,k) = wpvp2(i,pverp-k+1) + wp2up2_inout(i,k) = wp2up2(i,pverp-k+1) + wp2vp2_inout(i,k) = wp2vp2(i,pverp-k+1) + ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,pverp-k+1) + end do + end do + + do k=2,nlev+1 + do i=1,ncol + pre_in(i,k) = prer_evap(i,pverp-k+1) + end do + end do + + do i=1,ncol + pre_in(i,1) = pre_in(i,2) + end do + + ! Initialize these to prevent crashing behavior + do k=1,nlev+1 + do i=1,ncol + wprcp_out(i,k) = 0._r8 + rcm_in_layer_out(i,k) = 0._r8 + cloud_cover_out(i,k) = 0._r8 + edsclr_in(i,k,:) = 0._r8 + khzm_out(i,k) = 0._r8 + khzt_out(i,k) = 0._r8 + end do + end do - ! Define surface sources for transported variables for diffusion, will - ! be zero as these tendencies are done in vertical_diffusion - do ixind=1,edsclr_dim - wpedsclrp_sfc(ixind) = 0._r8 - enddo + ! higher order scalar stuff, put to zero + do ixind=1, sclr_dim + do k=1, nlev+1 + do i=1, ncol + sclrm(i,k,ixind) = 0._r8 + wpsclrp(i,k,ixind) = 0._r8 + sclrp2(i,k,ixind) = 0._r8 + sclrp3(i,k,ixind) = 0._r8 + sclrprtp(i,k,ixind) = 0._r8 + sclrpthlp(i,k,ixind) = 0._r8 + wpsclrp_sfc(i,ixind) = 0._r8 + end do + end do + end do + + do ixind=1, hydromet_dim + do k=1, nlev+1 + do i=1, ncol + hydromet(i,k,ixind) = 0._r8 + wphydrometp(i,k,ixind) = 0._r8 + wp2hmp(i,k,ixind) = 0._r8 + rtphmp_zt(i,k,ixind) = 0._r8 + thlphmp_zt(i,k,ixind) = 0._r8 + end do + end do + end do - ! Set stats output and increment equal to CLUBB and host dt - stats_tsamp = dtime - stats_tout = hdtime - - ! Heights need to be set at each timestep. Therefore, recall - ! setup_grid and setup_parameters for this. - - ! Read in parameters for CLUBB. Just read in default values - call read_parameters_api( -99, "", clubb_params ) - - ! Set-up CLUBB core at each CLUBB call because heights can change - ! Important note: do not make any calls that use CLUBB grid-height - ! operators (such as zt2zm_api, etc.) until AFTER the - ! call to setup_grid_heights_api. - call setup_grid_heights_api(l_implemented, grid_type, zi_g(2), & - zi_g(1), zi_g, zt_g) - - call setup_parameters_api( zi_g(2), clubb_params, nlev+1, grid_type, & - zi_g, zt_g, & - clubb_config_flags%l_prescribed_avg_deltaz, & - err_code ) - - ! Define forcings from CAM to CLUBB as zero for momentum and thermo, - ! forcings already applied through CAM - thlm_forcing = 0._r8 - rtm_forcing = 0._r8 - um_forcing = 0._r8 - vm_forcing = 0._r8 - - wprtp_forcing = 0._r8 - wpthlp_forcing = 0._r8 - rtp2_forcing = 0._r8 - thlp2_forcing = 0._r8 - rtpthlp_forcing = 0._r8 - - ice_supersat_frac_out = 0._r8 - - ! Add forcings for SILHS covariance contributions - rtp2_forcing = rtp2_forcing + zt2zm_api( rtp2_mc_zt(i,:) ) - thlp2_forcing = thlp2_forcing + zt2zm_api( thlp2_mc_zt(i,:) ) - wprtp_forcing = wprtp_forcing + zt2zm_api( wprtp_mc_zt(i,:) ) - wpthlp_forcing = wpthlp_forcing + zt2zm_api( wpthlp_mc_zt(i,:) ) - rtpthlp_forcing = rtpthlp_forcing + zt2zm_api( rtpthlp_mc_zt(i,:) ) - - ! Zero out SILHS covariance contribution terms - rtp2_mc_zt(i,:) = 0.0_r8 - thlp2_mc_zt(i,:) = 0.0_r8 - wprtp_mc_zt(i,:) = 0.0_r8 - wpthlp_mc_zt(i,:) = 0.0_r8 - rtpthlp_mc_zt(i,:) = 0.0_r8 - - ! Compute some inputs from the thermodynamic grid - ! to the momentum grid - rho_ds_zm = zt2zm_api(rho_ds_zt) - rho_zm = zt2zm_api(rho_zt) - invrs_rho_ds_zm = zt2zm_api(invrs_rho_ds_zt) - thv_ds_zm = zt2zm_api(thv_ds_zt) - wm_zm = zt2zm_api(wm_zt) - - ! Surface fluxes provided by host model - wpthlp_sfc = cam_in%shf(i)/(cpair*rho_ds_zm(1)) ! Sensible heat flux - wprtp_sfc = cam_in%cflx(i,1)/rho_ds_zm(1) ! Moisture flux (check rho) - upwp_sfc = cam_in%wsx(i)/rho_ds_zm(1) ! Surface meridional momentum flux - vpwp_sfc = cam_in%wsy(i)/rho_ds_zm(1) ! Surface zonal momentum flux + ! pressure,exner on momentum grid needed for mass flux calc. + if (do_clubb_mf) then - ! Need to flip arrays around for CLUBB core - do k=1,nlev+1 - um_in(k) = um(i,pverp-k+1) - vm_in(k) = vm(i,pverp-k+1) - upwp_in(k) = upwp(i,pverp-k+1) - vpwp_in(k) = vpwp(i,pverp-k+1) - wpthvp_in(k) = wpthvp(i,pverp-k+1) - wp2thvp_in(k) = wp2thvp(i,pverp-k+1) - rtpthvp_in(k) = rtpthvp(i,pverp-k+1) - thlpthvp_in(k)= thlpthvp(i,pverp-k+1) - up2_in(k) = up2(i,pverp-k+1) - vp2_in(k) = vp2(i,pverp-k+1) - up3_in(k) = up3(i,pverp-k+1) - vp3_in(k) = vp3(i,pverp-k+1) - wp2_in(k) = wp2(i,pverp-k+1) - wp3_in(k) = wp3(i,pverp-k+1) - rtp2_in(k) = rtp2(i,pverp-k+1) - thlp2_in(k) = thlp2(i,pverp-k+1) - rtp3_in(k) = rtp3(i,pverp-k+1) - thlp3_in(k) = thlp3(i,pverp-k+1) - thlm_in(k) = thlm(i,pverp-k+1) - rtm_in(k) = rtm(i,pverp-k+1) - rvm_in(k) = rvm(i,pverp-k+1) - wprtp_in(k) = wprtp(i,pverp-k+1) - wpthlp_in(k) = wpthlp(i,pverp-k+1) - rtpthlp_in(k) = rtpthlp(i,pverp-k+1) - rcm_inout(k) = rcm(i,pverp-k+1) - cloud_frac_inout(k) = cloud_frac(i,pverp-k+1) - sclrpthvp_inout(k,:) = 0._r8 - - if (k .ne. 1) then - pre_in(k) = prer_evap(i,pverp-k+1) - endif - - ! Initialize these to prevent crashing behavior - wprcp_out(k) = 0._r8 - rcm_in_layer_out(k) = 0._r8 - cloud_cover_out(k) = 0._r8 - edsclr_in(k,:) = 0._r8 - khzm_out(k) = 0._r8 - khzt_out(k) = 0._r8 - - ! higher order scalar stuff, put to zero - sclrm(k,:) = 0._r8 - wpsclrp(k,:) = 0._r8 - sclrp2(k,:) = 0._r8 - sclrp3(k,:) = 0._r8 - sclrprtp(k,:) = 0._r8 - sclrpthlp(k,:) = 0._r8 - wpsclrp_sfc(:) = 0._r8 - hydromet(k,:) = 0._r8 - wphydrometp(k,:) = 0._r8 - wp2hmp(k,:) = 0._r8 - rtphmp_zt(k,:) = 0._r8 - thlphmp_zt(k,:) = 0._r8 - - enddo - pre_in(1) = pre_in(2) + do k=1,pver + do i=1,ncol + kappa_zt(i,k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) + qc_zt(i,k+1) = state1%q(i,pver-k+1,ixcldliq) + invrs_exner_zt(i,k+1) = inv_exner_clubb(i,pver-k+1) + end do + end do + + do i=1,ncol + kappa_zt(i,1) = kappa_zt(i,2) + qc_zt(i,1) = qc_zt(i,2) + invrs_exner_zt(i,1) = invrs_exner_zt(i,2) + end do - ! pressure,exner on momentum grid needed for mass flux calc. - if (do_clubb_mf) then - do k=1,pver - kappa_zt(k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) - qc_zt(k+1) = state1%q(i,pver-k+1,ixcldliq) - invrs_exner_zt(k+1) = inv_exner_clubb(i,pver-k+1) - enddo - kappa_zt(1) = kappa_zt(2) - qc_zt(1) = qc_zt(2) - invrs_exner_zt(1) = invrs_exner_zt(2) - - kappa_zm = zt2zm_api(kappa_zt) - do k=1,pverp - p_in_Pa_zm(k) = state1%pint(i,pverp-k+1) - invrs_exner_zm(k) = 1._r8/((p_in_Pa_zm(k)/p0_clubb)**(kappa_zm(k))) - enddo - end if - - if (clubb_do_adv) then - if (macmic_it == 1) then - wp2_in=zt2zm_api(wp2_in) - wpthlp_in=zt2zm_api(wpthlp_in) - wprtp_in=zt2zm_api(wprtp_in) - up2_in=zt2zm_api(up2_in) - vp2_in=zt2zm_api(vp2_in) - thlp2_in=zt2zm_api(thlp2_in) - rtp2_in=zt2zm_api(rtp2_in) - rtpthlp_in=zt2zm_api(rtpthlp_in) - - do k=1,nlev+1 - thlp2_in(k)=max(thl_tol**2,thlp2_in(k)) - rtp2_in(k)=max(rt_tol**2,rtp2_in(k)) - wp2_in(k)=max(w_tol_sqd,wp2_in(k)) - up2_in(k)=max(w_tol_sqd,up2_in(k)) - vp2_in(k)=max(w_tol_sqd,vp2_in(k)) - enddo - endif - endif - - ! Do the same for tracers - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - do k=1,nlev - edsclr_in(k+1,icnt) = state1%q(i,pver-k+1,ixind) - enddo - edsclr_in(1,icnt) = edsclr_in(2,icnt) - end if - enddo + kappa_zm(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, kappa_zt(1:ncol,:)) - if (do_expldiff) then - do k=1,nlev - edsclr_in(k+1,icnt+1) = thlm(i,pver-k+1) - edsclr_in(k+1,icnt+2) = rtm(i,pver-k+1) - enddo + do k=1,pverp + do i=1,ncol + p_in_Pa_zm(i,k) = state1%pint(i,pverp-k+1) + invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k))) + end do + end do + + end if + + + if (clubb_do_adv) then + if (macmic_it == 1) then - edsclr_in(1,icnt+1) = edsclr_in(2,icnt+1) - edsclr_in(1,icnt+2) = edsclr_in(2,icnt+2) - endif + wp2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, wp2_in(1:ncol,:)) + wpthlp_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, wpthlp_in(1:ncol,:)) + wprtp_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, wprtp_in(1:ncol,:)) + up2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, up2_in(1:ncol,:)) + vp2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, vp2_in(1:ncol,:)) + thlp2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, thlp2_in(1:ncol,:)) + rtp2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, rtp2_in(1:ncol,:)) + rtpthlp_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, rtpthlp_in(1:ncol,:)) + + do k=1,nlev+1 + do i=1,ncol + thlp2_in(i,k) = max(thl_tol**2,thlp2_in(i,k)) + rtp2_in(i,k) = max(rt_tol**2,rtp2_in(i,k)) + wp2_in(i,k) = max(w_tol_sqd,wp2_in(i,k)) + up2_in(i,k) = max(w_tol_sqd,up2_in(i,k)) + vp2_in(i,k) = max(w_tol_sqd,vp2_in(i,k)) + end do + end do + + end if + end if - stats_nsamp = nint(stats_tsamp/dtime) - stats_nout = nint(stats_tout/dtime) + ! Do the same for tracers + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + + icnt = icnt+1 + + do k=1,nlev + do i=1,ncol + edsclr_in(i,k+1,icnt) = state1%q(i,pver-k+1,ixind) + end do + end do + + do i=1,ncol + edsclr_in(i,1,icnt) = edsclr_in(i,2,icnt) + end do + + end if + end do - do t=1,nadv ! do needed number of "sub" timesteps for each CAM step - ! Increment the statistics then being stats timestep - if (l_stats) then - call stats_begin_timestep_api(t, stats_nsamp, stats_nout) - endif - - !####################################################################### - !###################### CALL MF DIAGNOSTIC PLUMES ###################### - !####################################################################### - if (do_clubb_mf) then + if (clubb_l_do_expldiff_rtm_thlm) then + do k=1,nlev + do i=1, ncol + edsclr_in(i,k+1,icnt+1) = thlm(i,pver-k+1) + edsclr_in(i,k+1,icnt+2) = rtm(i,pver-k+1) + end do + end do + + do i=1, ncol + edsclr_in(i,1,icnt+1) = edsclr_in(i,2,icnt+1) + edsclr_in(i,1,icnt+2) = edsclr_in(i,2,icnt+2) + end do + + end if + + + do t=1,nadv ! do needed number of "sub" timesteps for each CAM step + + ! Increment the statistics then being stats timestep + if (l_stats) then + call stats_begin_timestep_api(t, stats_nsamp, stats_nout) + end if - do k=2,pverp - dzt(k) = zi_g(k) - zi_g(k-1) - enddo - dzt(1) = dzt(2) - invrs_dzt = 1._r8/dzt - - rtm_zm_in = zt2zm_api( rtm_in ) - thlm_zm_in = zt2zm_api( thlm_in ) - - call integrate_mf( pverp, dzt, zi_g, p_in_Pa_zm, invrs_exner_zm, & ! input - p_in_Pa, invrs_exner_zt, & ! input - um_in, vm_in, thlm_in, rtm_in, thv_ds_zt, & ! input - thlm_zm_in, rtm_zm_in, & ! input - wpthlp_sfc, wprtp_sfc, pblh(i), & ! input - mf_dry_a, mf_moist_a, & ! output - plume diagnostics - mf_dry_w, mf_moist_w, & ! output - plume diagnostics - mf_dry_qt, mf_moist_qt, & ! output - plume diagnostics - mf_dry_thl,mf_moist_thl, & ! output - plume diagnostics - mf_dry_u, mf_moist_u, & ! output - plume diagnostics - mf_dry_v, mf_moist_v, & ! output - plume diagnostics - mf_moist_qc, & ! output - plume diagnostics - s_ae, s_aw, & ! output - plume diagnostics - s_awthl, s_awqt, & ! output - plume diagnostics - s_awql, s_awqi, & ! output - plume diagnostics - s_awu, s_awv, & ! output - plume diagnostics - mf_thlflx, mf_qtflx ) ! output - variables needed for solver - - ! pass MF turbulent advection term as CLUBB explicit forcing term - rtm_forcing(1) = 0._r8 - thlm_forcing(1)= 0._r8 - do k=2,pverp - rtm_forcing(k) = rtm_forcing(k) - invrs_rho_ds_zt(k) * invrs_dzt(k) * & - ((rho_ds_zm(k) * mf_qtflx(k)) - (rho_ds_zm(k-1) * mf_qtflx(k-1))) + !####################################################################### + !###################### CALL MF DIAGNOSTIC PLUMES ###################### + !####################################################################### + if (do_clubb_mf) then + + do k=2,pverp + do i=1, ncol + dzt(i,k) = zi_g(i,k) - zi_g(i,k-1) + end do + end do + + do i=1, ncol + dzt(i,1) = dzt(i,2) + invrs_dzt(i,:) = 1._r8/dzt(i,:) + end do + + rtm_zm_in(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rtm_in(1:ncol,:) ) + thlm_zm_in(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, thlm_in(1:ncol,:) ) + + do i=1, ncol + call integrate_mf( pverp, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv_ds_zt(i,:), & ! input + thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input + wpthlp_sfc(i), wprtp_sfc(i), pblh(i), & ! input + mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics + mf_dry_w(i,:), mf_moist_w(i,:), & ! output - plume diagnostics + mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - plume diagnostics + mf_dry_thl(i,:), mf_moist_thl(i,:), & ! output - plume diagnostics + mf_dry_u(i,:), mf_moist_u(i,:), & ! output - plume diagnostics + mf_dry_v(i,:), mf_moist_v(i,:), & ! output - plume diagnostics + mf_moist_qc(i,:), & ! output - plume diagnostics + s_ae(i,:), s_aw(i,:), & ! output - plume diagnostics + s_awthl(i,:), s_awqt(i,:), & ! output - plume diagnostics + s_awql(i,:), s_awqi(i,:), & ! output - plume diagnostics + s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics + mf_thlflx(i,:), mf_qtflx(i,:) ) ! output - variables needed for solver + end do + + ! pass MF turbulent advection term as CLUBB explicit forcing term + do i=1, ncol + rtm_forcing(i,1) = 0._r8 + thlm_forcing(i,1)= 0._r8 + end do + + do k=2,pverp + do i=1, ncol + rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & + ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k-1) * mf_qtflx(i,k-1))) - thlm_forcing(k) = thlm_forcing(k) - invrs_rho_ds_zt(k) * invrs_dzt(k) * & - ((rho_ds_zm(k) * mf_thlflx(k)) - (rho_ds_zm(k-1) * mf_thlflx(k-1))) - end do + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & + ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k-1) * mf_thlflx(i,k-1))) + end do + end do - end if + end if + + ! Arrays are allocated as if they have pcols grid columns, but there can be less. + ! Only pass clubb_core the number of columns (ncol) with valid data. + ! Advance CLUBB CORE one timestep in the future + call advance_clubb_core_api( gr(:ncol), pverp+1-top_lev, ncol, & + l_implemented, dtime, fcor(:ncol), sfc_elevation(:ncol), hydromet_dim, & + thlm_forcing(:ncol,:), rtm_forcing(:ncol,:), um_forcing(:ncol,:), vm_forcing(:ncol,:), & + sclrm_forcing(:ncol,:,:), edsclrm_forcing(:ncol,:,:), wprtp_forcing(:ncol,:), & + wpthlp_forcing(:ncol,:), rtp2_forcing(:ncol,:), thlp2_forcing(:ncol,:), & + rtpthlp_forcing(:ncol,:), wm_zm(:ncol,:), wm_zt(:ncol,:), & + wpthlp_sfc(:ncol), wprtp_sfc(:ncol), upwp_sfc(:ncol), vpwp_sfc(:ncol), & + wpsclrp_sfc(:ncol,:), wpedsclrp_sfc(:ncol,:), & + rtm_ref(:ncol,:), thlm_ref(:ncol,:), um_ref(:ncol,:), vm_ref(:ncol,:), ug(:ncol,:), vg(:ncol,:), & + p_in_Pa(:ncol,:), rho_zm(:ncol,:), rho_in(:ncol,:), exner(:ncol,:), & + rho_ds_zm(:ncol,:), rho_ds_zt(:ncol,:), invrs_rho_ds_zm(:ncol,:), & + invrs_rho_ds_zt(:ncol,:), thv_ds_zm(:ncol,:), thv_ds_zt(:ncol,:), hydromet(:ncol,:,:), & + rfrzm(:ncol,:), radf(:ncol,:), & + wphydrometp(:ncol,:,:), wp2hmp(:ncol,:,:), rtphmp_zt(:ncol,:,:), thlphmp_zt(:ncol,:,:), & + grid_dx(:ncol), grid_dy(:ncol), & + clubb_params, nu_vert_res_dep(:ncol), lmin(:ncol), & + clubb_config_flags, & + stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & + um_in(:ncol,:), vm_in(:ncol,:), upwp_in(:ncol,:), vpwp_in(:ncol,:), up2_in(:ncol,:), vp2_in(:ncol,:), up3_in(:ncol,:), vp3_in(:ncol,:), & + thlm_in(:ncol,:), rtm_in(:ncol,:), wprtp_in(:ncol,:), wpthlp_in(:ncol,:), & + wp2_in(:ncol,:), wp3_in(:ncol,:), rtp2_in(:ncol,:), rtp3_in(:ncol,:), thlp2_in(:ncol,:), thlp3_in(:ncol,:), rtpthlp_in(:ncol,:), & + sclrm(:ncol,:,:), & + sclrp2(:ncol,:,:), sclrp3(:ncol,:,:), sclrprtp(:ncol,:,:), sclrpthlp(:ncol,:,:), & + wpsclrp(:ncol,:,:), edsclr_in(:ncol,:,:), err_code, & + rcm_inout(:ncol,:), cloud_frac_inout(:ncol,:), & + wpthvp_in(:ncol,:), wp2thvp_in(:ncol,:), rtpthvp_in(:ncol,:), thlpthvp_in(:ncol,:), & + sclrpthvp_inout(:ncol,:,:), & + wp2rtp_inout(:ncol,:), wp2thlp_inout(:ncol,:), uprcp_inout(:ncol,:), & + vprcp_inout(:ncol,:), rc_coef_inout(:ncol,:), & + wp4_inout(:ncol,:), wpup2_inout(:ncol,:), wpvp2_inout(:ncol,:), & + wp2up2_inout(:ncol,:), wp2vp2_inout(:ncol,:), ice_supersat_frac_inout(:ncol,:), & + pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & + pdf_implicit_coefs_terms_chnk(:ncol,lchnk), & + khzm_out(:ncol,:), khzt_out(:ncol,:), & + qclvar_out(:ncol,:), thlprcp_out(:ncol,:), & + wprcp_out(:ncol,:), w_up_in_cloud_out(:ncol,:), & + rcm_in_layer_out(:ncol,:), cloud_cover_out(:ncol,:), invrs_tau_zm_out(:ncol,:) ) + + + ! Note that CLUBB does not produce an error code specific to any column, and + ! one value only for the entire chunk + if ( err_code == clubb_fatal_error ) then + write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep() + write(fstderr,*) "LAT Range: ", state1%lat(1), " -- ", state1%lat(ncol) + write(fstderr,*) "LON: Range:", state1%lon(1), " -- ", state1%lon(ncol) + call endrun(subr//': Fatal error in CLUBB library') + end if + + if (do_rainturb) then + + do i=1, ncol + rvm_in(i,:) = rtm_in(i,:) - rcm_inout(i,:) + end do + + do i=1, ncol + + call copy_multi_pdf_params_to_single( pdf_params_chnk(lchnk), i, & + pdf_params_single_col) + + + call update_xp2_mc_api( gr(i), nlev+1, dtime, cloud_frac_inout(i,:), & + rcm_inout(i,:), rvm_in(i,:), thlm_in(i,:), wm_zt(i,:), exner(i,:), pre_in(i,:), pdf_params_single_col, & + rtp2_mc_out(i,:), thlp2_mc_out(i,:), & + wprtp_mc_out(i,:), wpthlp_mc_out(i,:), & + rtpthlp_mc_out(i,:)) + end do + + do i=1, ncol - ! Advance CLUBB CORE one timestep in the future - call advance_clubb_core_api & - ( l_implemented, dtime, fcor, sfc_elevation, hydromet_dim, & - thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & - sclrm_forcing, edsclrm_forcing, wprtp_forcing, & - wpthlp_forcing, rtp2_forcing, thlp2_forcing, & - rtpthlp_forcing, wm_zm, wm_zt, & - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & - wpsclrp_sfc, wpedsclrp_sfc, & - p_in_Pa, rho_zm, rho_in, exner, & - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, hydromet, & - rfrzm, radf, & - wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & - host_dx, host_dy, & - clubb_config_flags, & - um_in, vm_in, upwp_in, vpwp_in, up2_in, vp2_in, up3_in, vp3_in, & - thlm_in, rtm_in, wprtp_in, wpthlp_in, & - wp2_in, wp3_in, rtp2_in, rtp3_in, thlp2_in, thlp3_in, rtpthlp_in, & - sclrm, & - sclrp2, sclrp3, sclrprtp, sclrpthlp, & - wpsclrp, edsclr_in, err_code, & - rcm_inout, cloud_frac_inout, & - wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & - sclrpthvp_inout, & - pdf_params_chnk(i,lchnk), pdf_params_zm_chnk(i,lchnk), & - pdf_implicit_coefs_terms_chnk(i,lchnk), & - khzm_out, khzt_out, & - qclvar_out, thlprcp_out, & - wprcp_out, ice_supersat_frac_out, & - rcm_in_layer_out, cloud_cover_out) - - if ( err_code == clubb_fatal_error ) then - write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep(), "LAT: ", state1%lat(i), " LON: ", state1%lon(i) - call endrun(subr//': Fatal error in CLUBB library') - end if + dum1 = (1._r8 - cam_in%landfrac(i)) + ! update turbulent moments based on rain evaporation + rtp2_in(i,:) = rtp2_in(i,:) + clubb_rnevap_effic * dum1 * rtp2_mc_out(i,:) * dtime + thlp2_in(i,:) = thlp2_in(i,:) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,:) * dtime + wprtp_in(i,:) = wprtp_in(i,:) + clubb_rnevap_effic * dum1 * wprtp_mc_out(i,:) * dtime + wpthlp_in(i,:) = wpthlp_in(i,:) + clubb_rnevap_effic * dum1 * wpthlp_mc_out(i,:) * dtime + + end do + + end if + - if (do_rainturb) then - rvm_in = rtm_in - rcm_inout - call update_xp2_mc_api(nlev+1, dtime, cloud_frac_inout, & - rcm_inout, rvm_in, thlm_in, wm_zt, exner, pre_in, pdf_params_chnk(i,lchnk), & - rtp2_mc_out, thlp2_mc_out, & - wprtp_mc_out, wpthlp_mc_out, & - rtpthlp_mc_out) - - dum1 = (1._r8 - cam_in%landfrac(i)) - - ! update turbulent moments based on rain evaporation - rtp2_in = rtp2_in + clubb_rnevap_effic * dum1 * rtp2_mc_out * dtime - thlp2_in = thlp2_in + clubb_rnevap_effic * dum1 * thlp2_mc_out * dtime - wprtp_in = wprtp_in + clubb_rnevap_effic * dum1 * wprtp_mc_out * dtime - wpthlp_in = wpthlp_in + clubb_rnevap_effic * dum1 * wpthlp_mc_out * dtime - endif - - if (do_cldcool) then - - rcm_out_zm = zt2zm_api(rcm_inout) - qrl_zm = zt2zm_api(qrl_clubb) - thlp2_rad_out(:) = 0._r8 - call calculate_thlp2_rad_api(nlev+1, rcm_out_zm, thlprcp_out, qrl_zm, thlp2_rad_out) - thlp2_in = thlp2_in + thlp2_rad_out * dtime - thlp2_in = max(thl_tol**2,thlp2_in) - endif - - ! Check to see if stats should be output, here stats are read into - ! output arrays to make them conformable to CAM output - if (l_stats) call stats_end_timestep_clubb(i,out_zt,out_zm,& - out_radzt,out_radzm,out_sfc) - - enddo ! end time loop - - if (clubb_do_adv) then - if (macmic_it == cld_macmic_num_steps) then - wp2_in=zm2zt_api(wp2_in) - wpthlp_in=zm2zt_api(wpthlp_in) - wprtp_in=zm2zt_api(wprtp_in) - up2_in=zm2zt_api(up2_in) - vp2_in=zm2zt_api(vp2_in) - thlp2_in=zm2zt_api(thlp2_in) - rtp2_in=zm2zt_api(rtp2_in) - rtpthlp_in=zm2zt_api(rtpthlp_in) - - do k=1,nlev+1 - thlp2_in(k)=max(thl_tol**2,thlp2_in(k)) - rtp2_in(k)=max(rt_tol**2,rtp2_in(k)) - wp2_in(k)=max(w_tol_sqd,wp2_in(k)) - up2_in(k)=max(w_tol_sqd,up2_in(k)) - vp2_in(k)=max(w_tol_sqd,vp2_in(k)) - enddo - endif - endif - - ! Convert RTP2 and THLP2 to thermo grid for output - rtp2_zt = zm2zt_api(rtp2_in) - thl2_zt = zm2zt_api(thlp2_in) - wp2_zt = zm2zt_api(wp2_in) + if (do_cldcool) then + + rcm_out_zm(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, rcm_inout(1:ncol,:)) + qrl_zm(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, qrl_clubb(1:ncol,:)) + thlp2_rad_out(:,:) = 0._r8 + + do i=1, ncol + call calculate_thlp2_rad_api(nlev+1, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params, & + thlp2_rad_out(i,:)) + end do + + do i=1, ncol + thlp2_in(i,:) = thlp2_in(i,:) + thlp2_rad_out(i,:) * dtime + thlp2_in(i,:) = max(thl_tol**2,thlp2_in(i,:)) + end do + + end if + + ! Check to see if stats should be output, here stats are read into + ! output arrays to make them conformable to CAM output + if (l_stats) then + do i=1, ncol + call stats_end_timestep_clubb(i, stats_zt(i), stats_zm(i), stats_rad_zt(i), stats_rad_zm(i), stats_sfc(i), & + out_zt, out_zm, out_radzt, out_radzm, out_sfc) + end do + end if - ! Arrays need to be "flipped" to CAM grid + enddo ! end time loop - do k=1,nlev+1 - - um(i,pverp-k+1) = um_in(k) - vm(i,pverp-k+1) = vm_in(k) - upwp(i,pverp-k+1) = upwp_in(k) - vpwp(i,pverp-k+1) = vpwp_in(k) - wpthvp(i,pverp-k+1) = wpthvp_in(k) - wp2thvp(i,pverp-k+1) = wp2thvp_in(k) - rtpthvp(i,pverp-k+1) = rtpthvp_in(k) - thlpthvp(i,pverp-k+1) = thlpthvp_in(k) - up2(i,pverp-k+1) = up2_in(k) - vp2(i,pverp-k+1) = vp2_in(k) - up3(i,pverp-k+1) = up3_in(k) - vp3(i,pverp-k+1) = vp3_in(k) - thlm(i,pverp-k+1) = thlm_in(k) - rtm(i,pverp-k+1) = rtm_in(k) - wprtp(i,pverp-k+1) = wprtp_in(k) - wpthlp(i,pverp-k+1) = wpthlp_in(k) - wp2(i,pverp-k+1) = wp2_in(k) - wp3(i,pverp-k+1) = wp3_in(k) - rtp2(i,pverp-k+1) = rtp2_in(k) - thlp2(i,pverp-k+1) = thlp2_in(k) - rtp3(i,pverp-k+1) = rtp3_in(k) - thlp3(i,pverp-k+1) = thlp3_in(k) - rtpthlp(i,pverp-k+1) = rtpthlp_in(k) - rcm(i,pverp-k+1) = rcm_inout(k) - ice_supersat_frac(i,pverp-k+1) = ice_supersat_frac_out(k) - wprcp(i,pverp-k+1) = wprcp_out(k) - cloud_frac(i,pverp-k+1) = min(cloud_frac_inout(k),1._r8) - rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(k) - cloud_cover(i,pverp-k+1) = min(cloud_cover_out(k),1._r8) - zt_out(i,pverp-k+1) = zt_g(k) - zi_out(i,pverp-k+1) = zi_g(k) - khzm(i,pverp-k+1) = khzm_out(k) - qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(k)) - wm_zt_out(i,pverp-k+1) = wm_zt(k) - - rtp2_zt_out(i,pverp-k+1) = rtp2_zt(k) - thl2_zt_out(i,pverp-k+1) = thl2_zt(k) - wp2_zt_out(i,pverp-k+1) = wp2_zt(k) - - mean_rt & - = pdf_params_chnk(i,lchnk)%mixt_frac(k) & - * pdf_params_chnk(i,lchnk)%rt_1(k) & - + ( 1.0_r8 - pdf_params_chnk(i,lchnk)%mixt_frac(k) ) & - * pdf_params_chnk(i,lchnk)%rt_2(k) - - pdfp_rtp2(i,pverp-k+1) & - = pdf_params_chnk(i,lchnk)%mixt_frac(k) & - * ( ( pdf_params_chnk(i,lchnk)%rt_1(k) - mean_rt )**2 & - + pdf_params_chnk(i,lchnk)%varnce_rt_1(k) ) & - + ( 1.0_r8 - pdf_params_chnk(i,lchnk)%mixt_frac(k) ) & - * ( ( pdf_params_chnk(i,lchnk)%rt_2(k) - mean_rt )**2 & - + pdf_params_chnk(i,lchnk)%varnce_rt_2(k) ) - - do ixind=1,edsclr_dim - edsclr_out(pverp-k+1,ixind) = edsclr_in(k,ixind) - enddo + if (clubb_do_adv) then + if (macmic_it == cld_macmic_num_steps) then + + wp2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, wp2_in(1:ncol,:)) + wpthlp_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, wpthlp_in(1:ncol,:)) + wprtp_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, wprtp_in(1:ncol,:)) + up2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, up2_in(1:ncol,:)) + vp2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, vp2_in(1:ncol,:)) + thlp2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, thlp2_in(1:ncol,:)) + rtp2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, rtp2_in(1:ncol,:)) + rtpthlp_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, rtpthlp_in(1:ncol,:)) + + do k=1,nlev+1 + do i=1, ncol + thlp2_in(i,k) = max(thl_tol**2, thlp2_in(i,k)) + rtp2_in(i,k) = max(rt_tol**2, rtp2_in(i,k)) + wp2_in(i,k) = max(w_tol_sqd, wp2_in(i,k)) + up2_in(i,k) = max(w_tol_sqd, up2_in(i,k)) + vp2_in(i,k) = max(w_tol_sqd, vp2_in(i,k)) + end do + end do + + end if + end if + + ! Convert RTP2 and THLP2 to thermo grid for output + rtp2_zt(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, rtp2_in(1:ncol,:)) + thl2_zt(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, thlp2_in(1:ncol,:)) + wp2_zt(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, wp2_in(1:ncol,:)) + + ! Arrays need to be "flipped" to CAM grid + do k=1, nlev+1 + do i=1, ncol + um(i,pverp-k+1) = um_in(i,k) + vm(i,pverp-k+1) = vm_in(i,k) + upwp(i,pverp-k+1) = upwp_in(i,k) + vpwp(i,pverp-k+1) = vpwp_in(i,k) + wpthvp(i,pverp-k+1) = wpthvp_in(i,k) + wp2thvp(i,pverp-k+1) = wp2thvp_in(i,k) + rtpthvp(i,pverp-k+1) = rtpthvp_in(i,k) + thlpthvp(i,pverp-k+1) = thlpthvp_in(i,k) + up2(i,pverp-k+1) = up2_in(i,k) + vp2(i,pverp-k+1) = vp2_in(i,k) + up3(i,pverp-k+1) = up3_in(i,k) + vp3(i,pverp-k+1) = vp3_in(i,k) + thlm(i,pverp-k+1) = thlm_in(i,k) + rtm(i,pverp-k+1) = rtm_in(i,k) + wprtp(i,pverp-k+1) = wprtp_in(i,k) + wpthlp(i,pverp-k+1) = wpthlp_in(i,k) + wp2(i,pverp-k+1) = wp2_in(i,k) + wp3(i,pverp-k+1) = wp3_in(i,k) + rtp2(i,pverp-k+1) = rtp2_in(i,k) + thlp2(i,pverp-k+1) = thlp2_in(i,k) + rtp3(i,pverp-k+1) = rtp3_in(i,k) + thlp3(i,pverp-k+1) = thlp3_in(i,k) + rtpthlp(i,pverp-k+1) = rtpthlp_in(i,k) + rcm(i,pverp-k+1) = rcm_inout(i,k) + wprcp(i,pverp-k+1) = wprcp_out(i,k) + cloud_frac(i,pverp-k+1) = min(cloud_frac_inout(i,k),1._r8) + pdf_zm_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_1(i,k) + pdf_zm_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_2(i,k) + pdf_zm_varnce_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) + pdf_zm_varnce_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) + pdf_zm_mixt_frac(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) + rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(i,k) + cloud_cover(i,pverp-k+1) = min(cloud_cover_out(i,k),1._r8) + zt_out(i,pverp-k+1) = zt_g(i,k) + zi_out(i,pverp-k+1) = zi_g(i,k) + khzm(i,pverp-k+1) = khzm_out(i,k) + qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(i,k)) + wm_zt_out(i,pverp-k+1) = wm_zt(i,k) + wp2rtp(i,pverp-k+1) = wp2rtp_inout(i,k) + wp2thlp(i,pverp-k+1) = wp2thlp_inout(i,k) + uprcp(i,pverp-k+1) = uprcp_inout(i,k) + vprcp(i,pverp-k+1) = vprcp_inout(i,k) + rc_coef(i,pverp-k+1) = rc_coef_inout(i,k) + wp4(i,pverp-k+1) = wp4_inout(i,k) + wpup2(i,pverp-k+1) = wpup2_inout(i,k) + wpvp2(i,pverp-k+1) = wpvp2_inout(i,k) + wp2up2(i,pverp-k+1) = wp2up2_inout(i,k) + wp2vp2(i,pverp-k+1) = wp2vp2_inout(i,k) + ice_supersat_frac(i,pverp-k+1) = ice_supersat_frac_inout(i,k) + + rtp2_zt_out(i,pverp-k+1) = rtp2_zt(i,k) + thl2_zt_out(i,pverp-k+1) = thl2_zt(i,k) + wp2_zt_out(i,pverp-k+1) = wp2_zt(i,k) + + end do + end do - if (do_clubb_mf) then - mf_dry_a_output(i,pverp-k+1) = mf_dry_a(k) - mf_moist_a_output(i,pverp-k+1) = mf_moist_a(k) - mf_dry_w_output(i,pverp-k+1) = mf_dry_w(k) - mf_moist_w_output(i,pverp-k+1) = mf_moist_w(k) - mf_dry_qt_output(i,pverp-k+1) = mf_dry_qt(k) - mf_moist_qt_output(i,pverp-k+1) = mf_moist_qt(k) - mf_dry_thl_output(i,pverp-k+1) = mf_dry_thl(k) - mf_moist_thl_output(i,pverp-k+1) = mf_moist_thl(k) - mf_dry_u_output(i,pverp-k+1) = mf_dry_u(k) - mf_moist_u_output(i,pverp-k+1) = mf_moist_u(k) - mf_dry_v_output(i,pverp-k+1) = mf_dry_v(k) - mf_moist_v_output(i,pverp-k+1) = mf_moist_v(k) - mf_moist_qc_output(i,pverp-k+1) = mf_moist_qc(k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(k) - s_ae_output(i,pverp-k+1) = s_ae(k) - s_aw_output(i,pverp-k+1) = s_aw(k) - s_awthl_output(i,pverp-k+1) = s_awthl(k) - s_awqt_output(i,pverp-k+1) = s_awqt(k) - s_awql_output(i,pverp-k+1) = s_awql(k) - s_awqi_output(i,pverp-k+1) = s_awqi(k) - s_awu_output(i,pverp-k+1) = s_awu(k) - s_awv_output(i,pverp-k+1) = s_awv(k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(k) - end if + do k=1, nlev+1 + do i=1, ncol + + mean_rt = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + * pdf_params_chnk(lchnk)%rt_1(i,k) & + + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & + * pdf_params_chnk(lchnk)%rt_2(i,k) + + pdfp_rtp2(i,pverp-k+1) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & + + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & + * ( ( pdf_params_chnk(lchnk)%rt_2(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) ) + end do + end do - enddo + do ixind=1,edsclr_dim + do k=1, nlev+1 + do i=1, ncol + edsclr_out(i,pverp-k+1,ixind) = edsclr_in(i,k,ixind) + end do + end do + end do + + if (do_clubb_mf) then + do k=1, nlev+1 + do i=1, ncol + mf_dry_a_output(i,pverp-k+1) = mf_dry_a(i,k) + mf_moist_a_output(i,pverp-k+1) = mf_moist_a(i,k) + mf_dry_w_output(i,pverp-k+1) = mf_dry_w(i,k) + mf_moist_w_output(i,pverp-k+1) = mf_moist_w(i,k) + mf_dry_qt_output(i,pverp-k+1) = mf_dry_qt(i,k) + mf_moist_qt_output(i,pverp-k+1) = mf_moist_qt(i,k) + mf_dry_thl_output(i,pverp-k+1) = mf_dry_thl(i,k) + mf_moist_thl_output(i,pverp-k+1) = mf_moist_thl(i,k) + mf_dry_u_output(i,pverp-k+1) = mf_dry_u(i,k) + mf_moist_u_output(i,pverp-k+1) = mf_moist_u(i,k) + mf_dry_v_output(i,pverp-k+1) = mf_dry_v(i,k) + mf_moist_v_output(i,pverp-k+1) = mf_moist_v(i,k) + mf_moist_qc_output(i,pverp-k+1) = mf_moist_qc(i,k) + mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) + mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) + s_ae_output(i,pverp-k+1) = s_ae(i,k) + s_aw_output(i,pverp-k+1) = s_aw(i,k) + s_awthl_output(i,pverp-k+1) = s_awthl(i,k) + s_awqt_output(i,pverp-k+1) = s_awqt(i,k) + s_awql_output(i,pverp-k+1) = s_awql(i,k) + s_awqi_output(i,pverp-k+1) = s_awqi(i,k) + s_awu_output(i,pverp-k+1) = s_awu(i,k) + s_awv_output(i,pverp-k+1) = s_awv(i,k) + mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) + mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) + end do + end do + end if ! Values to use above top_lev, for variables that have not already been ! set up there. These are mostly fill values that should not actually be ! used in the run, but may end up in diagnostic output. - upwp(i,:top_lev-1) = 0._r8 - vpwp(i,:top_lev-1) = 0._r8 - rcm(i,:top_lev-1) = 0._r8 - wprcp(i,:top_lev-1) = 0._r8 - cloud_frac(i,:top_lev-1) = 0._r8 - rcm_in_layer(i,:top_lev-1) = 0._r8 - zt_out(i,:top_lev-1) = 0._r8 - zi_out(i,:top_lev-1) = 0._r8 - khzm(i,:top_lev-1) = 0._r8 - qclvar(i,:top_lev-1) = 2._r8 - - - - ! enforce zero tracer tendencies above the top_lev level -- no change - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - edsclr_out(:top_lev-1,icnt) = state1%q(i,:top_lev-1,ixind) - end if - enddo + do k=1, top_lev-1 + do i=1, ncol + upwp(i,k) = 0._r8 + vpwp(i,k) = 0._r8 + rcm(i,k) = 0._r8 + wprcp(i,k) = 0._r8 + cloud_frac(i,k) = 0._r8 + rcm_in_layer(i,k) = 0._r8 + zt_out(i,k) = 0._r8 + zi_out(i,k) = 0._r8 + khzm(i,k) = 0._r8 + qclvar(i,k) = 2._r8 + end do + end do - ! Fill up arrays needed for McICA. Note we do not want the ghost point, - ! thus why the second loop is needed. - - zi_out(i,1) = 0._r8 - - ! Section below is concentrated on energy fixing for conservation. - ! There are two steps to this process. The first is to remove any tendencies - ! CLUBB may have produced above where it is active due to roundoff. - ! The second is to provider a fixer because CLUBB and CAM's thermodynamic - ! variables are different. - - ! Initialize clubbtop with the chemistry topopause top, to prevent CLUBB from - ! firing up in the stratosphere - clubbtop = troplev(i) - do while ((rtp2(i,clubbtop) <= 1.e-15_r8 .and. rcm(i,clubbtop) == 0._r8) .and. clubbtop < pver-1) - clubbtop = clubbtop + 1 - enddo - - ! Compute static energy using CLUBB's variables - do k=1,pver - clubb_s(k) = cpairv(i,k,lchnk) * thlm(i,k) / inv_exner_clubb(i,k) & - + latvap * rcm(i,k) & - + gravit * state1%zm(i,k) + state1%phis(i) - enddo + ! enforce zero tracer tendencies above the top_lev level -- no change + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + + do i=1, ncol + edsclr_out(i,:top_lev-1,icnt) = state1%q(i,:top_lev-1,ixind) + end do + + end if + end do + + ! Fill up arrays needed for McICA. Note we do not want the ghost point, + ! thus why the second loop is needed. + zi_out(:,1) = 0._r8 + + ! Section below is concentrated on energy fixing for conservation. + ! There are two steps to this process. The first is to remove any tendencies + ! CLUBB may have produced above where it is active due to roundoff. + ! The second is to provider a fixer because CLUBB and CAM's thermodynamic + ! variables are different. + + ! Initialize clubbtop with the chemistry topopause top, to prevent CLUBB from + ! firing up in the stratosphere + do i=1, ncol + clubbtop(i) = troplev(i) + do while ((rtp2(i,clubbtop(i)) <= 1.e-15_r8 .and. rcm(i,clubbtop(i)) == 0._r8) .and. clubbtop(i) < pver-1) + clubbtop(i) = clubbtop(i) + 1 + end do + end do - ! Compute integrals above layer where CLUBB is active - se_upper_a = 0._r8 ! energy in layers above where CLUBB is active AFTER CLUBB is called - se_upper_b = 0._r8 ! energy in layers above where CLUBB is active BEFORE CLUBB is called - tw_upper_a = 0._r8 ! total water in layers above where CLUBB is active AFTER CLUBB is called - tw_upper_b = 0._r8 ! total water in layers above where CLUBB is active BEFORE CLUBB is called - do k=1,clubbtop - se_upper_a = se_upper_a + (clubb_s(k)+0.5_r8*(um(i,k)**2+vm(i,k)**2)+(latvap+latice)* & - (rtm(i,k)-rcm(i,k))+(latice)*rcm(i,k))*state1%pdel(i,k)/gravit - se_upper_b = se_upper_b + (state1%s(i,k)+0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)+(latvap+latice)* & - state1%q(i,k,ixq)+(latice)*state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit - tw_upper_a = tw_upper_a + rtm(i,k)*state1%pdel(i,k)/gravit - tw_upper_b = tw_upper_b + (state1%q(i,k,ixq)+state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit - enddo + ! Compute static energy using CLUBB's variables + do k=1,pver + do i=1, ncol + clubb_s(i,k) = cpairv(i,k,lchnk) * thlm(i,k) / inv_exner_clubb(i,k) & + + latvap * rcm(i,k) & + + gravit * state1%zm(i,k) + state1%phis(i) + end do + end do + + + ! Compute integrals above layer where CLUBB is active + se_upper_a(:) = 0._r8 ! energy in layers above where CLUBB is active AFTER CLUBB is called + se_upper_b(:) = 0._r8 ! energy in layers above where CLUBB is active BEFORE CLUBB is called + tw_upper_a(:) = 0._r8 ! total water in layers above where CLUBB is active AFTER CLUBB is called + tw_upper_b(:) = 0._r8 ! total water in layers above where CLUBB is active BEFORE CLUBB is called + + do i=1, ncol + do k=1, clubbtop(i) + + se_upper_a(i) = se_upper_a(i) + (clubb_s(i,k)+0.5_r8*(um(i,k)**2+vm(i,k)**2) & + +(latvap+latice)*(rtm(i,k)-rcm(i,k)) & + +(latice)*rcm(i,k))*state1%pdel(i,k)/gravit + + se_upper_b(i) = se_upper_b(i) + (state1%s(i,k)+0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2) & + + (latvap+latice)*state1%q(i,k,ixq) & + + (latice)*state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit + + tw_upper_a(i) = tw_upper_a(i) + rtm(i,k)*state1%pdel(i,k)/gravit + + tw_upper_b(i) = tw_upper_b(i) + (state1%q(i,k,ixq) & + +state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit + end do + end do - ! Compute the disbalance of total energy and water in upper levels, - ! divide by the thickness in the lower atmosphere where we will - ! evenly distribute this disbalance - se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) - tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) + ! Compute the disbalance of total energy and water in upper levels, + ! divide by the thickness in the lower atmosphere where we will + ! evenly distribute this disbalance + do i=1, ncol + se_upper_diss(i) = (se_upper_a(i) - se_upper_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop(i)+1)) + tw_upper_diss(i) = (tw_upper_a(i) - tw_upper_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop(i)+1)) + end do - ! Perform a test to see if there will be any negative RTM errors - ! in the column. If so, apply the disbalance to the surface - apply_to_surface = .false. - if (tw_upper_diss < 0._r8) then - do k=clubbtop+1,pver - rtm_test = (rtm(i,k) + tw_upper_diss*gravit) - rcm(i,k) + ! Perform a test to see if there will be any negative RTM errors + ! in the column. If so, apply the disbalance to the surface + do i=1, ncol + apply_to_surface(i) = .false. + if (tw_upper_diss(i) < 0._r8) then + do k=clubbtop(i)+1,pver + rtm_test = (rtm(i,k) + tw_upper_diss(i)*gravit) - rcm(i,k) if (rtm_test < 0._r8) then - apply_to_surface = .true. - endif - enddo - endif + apply_to_surface(i) = .true. + end if + end do + end if + end do - if (apply_to_surface) then - tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver)) - se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver)) - rtm(i,pver) = rtm(i,pver) + tw_upper_diss*gravit - if (apply_to_heat) clubb_s(pver) = clubb_s(pver) + se_upper_diss*gravit + do i=1, ncol + + if (apply_to_surface(i)) then + + tw_upper_diss(i) = (tw_upper_a(i) - tw_upper_b(i))/(state1%pint(i,pverp)-state1%pint(i,pver)) + se_upper_diss(i) = (se_upper_a(i) - se_upper_b(i))/(state1%pint(i,pverp)-state1%pint(i,pver)) + rtm(i,pver) = rtm(i,pver) + tw_upper_diss(i)*gravit + + if (apply_to_heat) then + clubb_s(i,pver) = clubb_s(i,pver) + se_upper_diss(i)*gravit + end if + else + ! Apply the disbalances above to layers where CLUBB is active - do k=clubbtop+1,pver - rtm(i,k) = rtm(i,k) + tw_upper_diss*gravit - if (apply_to_heat) clubb_s(k) = clubb_s(k) + se_upper_diss*gravit - enddo - endif + do k=clubbtop(i)+1, pver + rtm(i,k) = rtm(i,k) + tw_upper_diss(i)*gravit + + if (apply_to_heat) then + clubb_s(i,k) = clubb_s(i,k) + se_upper_diss(i)*gravit + end if + end do + + end if + + end do ! Essentially "zero" out tendencies in the layers above where CLUBB is active - do k=1,clubbtop - if (apply_to_heat) clubb_s(k) = state1%s(i,k) + do i=1, ncol + do k=1, clubbtop(i) + if (apply_to_heat) clubb_s(i,k) = state1%s(i,k) rcm(i,k) = state1%q(i,k,ixcldliq) rtm(i,k) = state1%q(i,k,ixq) + rcm(i,k) - enddo - - ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water - ! after CLUBB is called. This is for energy conservation purposes. - se_a = 0._r8 - ke_a = 0._r8 - wv_a = 0._r8 - wl_a = 0._r8 + end do + end do + + ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water + ! after CLUBB is called. This is for energy conservation purposes. + se_a(:) = 0._r8 + ke_a(:) = 0._r8 + wv_a(:) = 0._r8 + wl_a(:) = 0._r8 + + do k=1,pver + do i=1, ncol + se_a(i) = se_a(i) + clubb_s(i,k)*state1%pdel(i,k)/gravit + ke_a(i) = ke_a(i) + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)/gravit + wv_a(i) = wv_a(i) + (rtm(i,k)-rcm(i,k))*state1%pdel(i,k)/gravit + wl_a(i) = wl_a(i) + (rcm(i,k))*state1%pdel(i,k)/gravit + end do + end do + + ! Do the same as above, but for before CLUBB was called. + se_b(:) = 0._r8 + ke_b(:) = 0._r8 + wv_b(:) = 0._r8 + wl_b(:) = 0._r8 + + do k=1, pver + do i=1, ncol + se_b(i) = se_b(i) + state1%s(i,k)*state1%pdel(i,k)/gravit + ke_b(i) = ke_b(i) + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)/gravit + wv_b(i) = wv_b(i) + state1%q(i,k,ixq)*state1%pdel(i,k)/gravit + wl_b(i) = wl_b(i) + state1%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit + end do + end do - ! Do the same as above, but for before CLUBB was called. - se_b = 0._r8 - ke_b = 0._r8 - wv_b = 0._r8 - wl_b = 0._r8 - do k=1,pver - se_a(i) = se_a(i) + clubb_s(k)*state1%pdel(i,k)/gravit - ke_a(i) = ke_a(i) + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)/gravit - wv_a(i) = wv_a(i) + (rtm(i,k)-rcm(i,k))*state1%pdel(i,k)/gravit - wl_a(i) = wl_a(i) + (rcm(i,k))*state1%pdel(i,k)/gravit - - se_b(i) = se_b(i) + state1%s(i,k)*state1%pdel(i,k)/gravit - ke_b(i) = ke_b(i) + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)/gravit - wv_b(i) = wv_b(i) + state1%q(i,k,ixq)*state1%pdel(i,k)/gravit - wl_b(i) = wl_b(i) + state1%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit - enddo + do i=1, ncol ! Based on these integrals, compute the total energy before and after CLUBB call - te_a(i) = se_a(i) + ke_a(i) + (latvap+latice)*wv_a(i)+latice*wl_a(i) - te_b(i) = se_b(i) + ke_b(i) + (latvap+latice)*wv_b(i)+latice*wl_b(i) + te_a(i) = se_a(i) + ke_a(i) + (latvap+latice) * wv_a(i) + latice * wl_a(i) + te_b(i) = se_b(i) + ke_b(i) + (latvap+latice) * wv_b(i) + latice * wl_b(i) ! Take into account the surface fluxes of heat and moisture ! Use correct qflux from cam_in, not lhf/latvap as was done previously - te_b(i) = te_b(i)+(cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice))*hdtime + te_b(i) = te_b(i) + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime ! Compute the disbalance of total energy, over depth where CLUBB is active - se_dis = (te_a(i) - te_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) - - ! Fix the total energy coming out of CLUBB so it achieves enery conservation. - ! Apply this fixer throughout the column evenly, but only at layers where - ! CLUBB is active. - ! - ! NOTE: The energy fixer seems to cause the climate to change significantly - ! when using specified dynamics, so allow this to be turned off via a namelist - ! variable. - if (clubb_do_energyfix) then - do k=clubbtop+1,pver - clubb_s(k) = clubb_s(k) - se_dis*gravit - enddo - endif - - ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point - ! for all variables and therefore is never called in this loop - rtm_integral_vtend = 0._r8 - rtm_integral_ltend = 0._r8 - do k=1,pver - - ptend_loc%u(i,k) = (um(i,k)-state1%u(i,k))/hdtime ! east-west wind - ptend_loc%v(i,k) = (vm(i,k)-state1%v(i,k))/hdtime ! north-south wind - ptend_loc%q(i,k,ixq) = (rtm(i,k)-rcm(i,k)-state1%q(i,k,ixq))/hdtime ! water vapor - ptend_loc%q(i,k,ixcldliq) = (rcm(i,k)-state1%q(i,k,ixcldliq))/hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = (clubb_s(k)-state1%s(i,k))/hdtime ! Tendency of static energy - - rtm_integral_ltend = rtm_integral_ltend + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit - rtm_integral_vtend = rtm_integral_vtend + ptend_loc%q(i,k,ixq)*state1%pdel(i,k)/gravit - - if (clubb_do_adv) then - if (macmic_it == cld_macmic_num_steps) then - - ! Here add a constant to moments which can be either positive or - ! negative. This is to prevent clipping when dynamics tries to - ! make all constituents positive - wp3(i,k) = wp3(i,k) + wp3_const - rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const - wpthlp(i,k) = wpthlp(i,k) + wpthlp_const - wprtp(i,k) = wprtp(i,k) + wprtp_const - - ptend_loc%q(i,k,ixthlp2)=(thlp2(i,k)-state1%q(i,k,ixthlp2))/hdtime ! THLP Variance - ptend_loc%q(i,k,ixrtp2)=(rtp2(i,k)-state1%q(i,k,ixrtp2))/hdtime ! RTP Variance - ptend_loc%q(i,k,ixrtpthlp)=(rtpthlp(i,k)-state1%q(i,k,ixrtpthlp))/hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp)=(wpthlp(i,k)-state1%q(i,k,ixwpthlp))/hdtime ! WPTHLP - ptend_loc%q(i,k,ixwprtp)=(wprtp(i,k)-state1%q(i,k,ixwprtp))/hdtime ! WPRTP - ptend_loc%q(i,k,ixwp2)=(wp2(i,k)-state1%q(i,k,ixwp2))/hdtime ! WP2 - ptend_loc%q(i,k,ixwp3)=(wp3(i,k)-state1%q(i,k,ixwp3))/hdtime ! WP3 - ptend_loc%q(i,k,ixup2)=(up2(i,k)-state1%q(i,k,ixup2))/hdtime ! UP2 - ptend_loc%q(i,k,ixvp2)=(vp2(i,k)-state1%q(i,k,ixvp2))/hdtime ! VP2 - else - ptend_loc%q(i,k,ixthlp2)=0._r8 - ptend_loc%q(i,k,ixrtp2)=0._r8 - ptend_loc%q(i,k,ixrtpthlp)=0._r8 - ptend_loc%q(i,k,ixwpthlp)=0._r8 - ptend_loc%q(i,k,ixwprtp)=0._r8 - ptend_loc%q(i,k,ixwp2)=0._r8 - ptend_loc%q(i,k,ixwp3)=0._r8 - ptend_loc%q(i,k,ixup2)=0._r8 - ptend_loc%q(i,k,ixvp2)=0._r8 - endif - - endif - - ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. - ! Loading up this array doesn't mean the tendencies are applied. - ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed - - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.& - (ixind /= ixthlp2) .and. (ixind /= ixrtp2) .and.& - (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.& - (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& - (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then - ptend_loc%q(i,k,ixind) = (edsclr_out(k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents - end if - end if - enddo + se_dis(i) = (te_a(i) - te_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop(i)+1)) + end do - enddo + ! Fix the total energy coming out of CLUBB so it achieves energy conservation. + ! Apply this fixer throughout the column evenly, but only at layers where + ! CLUBB is active. + ! + ! NOTE: The energy fixer seems to cause the climate to change significantly + ! when using specified dynamics, so allow this to be turned off via a namelist + ! variable. + if (clubb_do_energyfix) then + do i=1, ncol + do k=clubbtop(i)+1,pver + clubb_s(i,k) = clubb_s(i,k) - se_dis(i)*gravit + end do + end do + end if + + ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point + ! for all variables and therefore is never called in this loop + rtm_integral_vtend(:) = 0._r8 + rtm_integral_ltend(:) = 0._r8 + + do k=1, pver + do i=1, ncol - enddo ! end column loop + ptend_loc%u(i,k) = (um(i,k) - state1%u(i,k)) / hdtime ! east-west wind + ptend_loc%v(i,k) = (vm(i,k) - state1%v(i,k)) / hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = (rtm(i,k) - rcm(i,k)-state1%q(i,k,ixq)) / hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = (rcm(i,k) - state1%q(i,k,ixcldliq)) / hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) / hdtime ! Tendency of static energy - call outfld('KVH_CLUBB', khzm, pcols, lchnk) + rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit + rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k)/gravit - ! Add constant to ghost point so that output is not corrupted - if (clubb_do_adv) then + end do + end do + + + if (clubb_do_adv) then + if (macmic_it == cld_macmic_num_steps) then + + do k=1, pver + do i=1, ncol + + ! Here add a constant to moments which can be either positive or + ! negative. This is to prevent clipping when dynamics tries to + ! make all constituents positive + wp3(i,k) = wp3(i,k) + wp3_const + rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const + wpthlp(i,k) = wpthlp(i,k) + wpthlp_const + wprtp(i,k) = wprtp(i,k) + wprtp_const + + ptend_loc%q(i,k,ixthlp2) = (thlp2(i,k) - state1%q(i,k,ixthlp2)) / hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2) = (rtp2(i,k) - state1%q(i,k,ixrtp2)) / hdtime ! RTP Variance + ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp(i,k) - state1%q(i,k,ixrtpthlp)) / hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) / hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp) = (wprtp(i,k) - state1%q(i,k,ixwprtp)) / hdtime ! WPRTP + ptend_loc%q(i,k,ixwp2) = (wp2(i,k) - state1%q(i,k,ixwp2)) / hdtime ! WP2 + ptend_loc%q(i,k,ixwp3) = (wp3(i,k) - state1%q(i,k,ixwp3)) / hdtime ! WP3 + ptend_loc%q(i,k,ixup2) = (up2(i,k) - state1%q(i,k,ixup2)) / hdtime ! UP2 + ptend_loc%q(i,k,ixvp2) = (vp2(i,k) - state1%q(i,k,ixvp2)) / hdtime ! VP2 + + end do + end do + + else + + do k=1, pver + do i=1, ncol + ptend_loc%q(i,k,ixthlp2) = 0._r8 + ptend_loc%q(i,k,ixrtp2) = 0._r8 + ptend_loc%q(i,k,ixrtpthlp) = 0._r8 + ptend_loc%q(i,k,ixwpthlp) = 0._r8 + ptend_loc%q(i,k,ixwprtp) = 0._r8 + ptend_loc%q(i,k,ixwp2) = 0._r8 + ptend_loc%q(i,k,ixwp3) = 0._r8 + ptend_loc%q(i,k,ixup2) = 0._r8 + ptend_loc%q(i,k,ixvp2) = 0._r8 + end do + end do + + end if + end if + + + ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. + ! Loading up this array doesn't mean the tendencies are applied. + ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.& + (ixind /= ixthlp2) .and. (ixind /= ixrtp2) .and.& + (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.& + (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& + (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then + + do k=1, pver + do i=1, ncol + ptend_loc%q(i,k,ixind) = (edsclr_out(i,k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents + end do + end do + + end if + end if + end do + + call t_stopf("clubb_tend_cam_i_loop") + + call outfld('KVH_CLUBB', khzm, pcols, lchnk) + + ! Add constant to ghost point so that output is not corrupted + if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then - wp3(:,pverp) = wp3(:,pverp) + wp3_const - rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const - wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const - wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const - endif - endif + wp3(:,pverp) = wp3(:,pverp) + wp3_const + rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const + wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const + wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const + end if + end if cmeliq(:,:) = ptend_loc%q(:,:,ixcldliq) @@ -3134,7 +3878,7 @@ subroutine clubb_tend_cam( & dum1 = 1.0_r8 else dum1 = ( meltpt_temp - state1%t(i,k) ) / ( meltpt_temp - dt_low ) - endif + end if if (zmconv_microp) then ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 ) @@ -3205,14 +3949,14 @@ subroutine clubb_tend_cam( & relvarmax = 2.0_r8 else relvarmax = 10.0_r8 - endif + end if relvar(:,:) = relvarmax ! default if (deep_scheme .ne. 'CLUBB_SGS') then where (rcm(:ncol,:pver) /= 0 .and. qclvar(:ncol,:pver) /= 0) & relvar(:ncol,:pver) = min(relvarmax,max(0.001_r8,rcm(:ncol,:pver)**2/qclvar(:ncol,:pver))) - endif + end if ! ------------------------------------------------- ! ! Optional Accretion enhancement factor ! @@ -3282,8 +4026,9 @@ subroutine clubb_tend_cam( & ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! ! --------------------------------------------------------------------------------- ! - deepcu(:,pver) = 0.0_r8 - shalcu(:,pver) = 0.0_r8 + ! Initialize cloud fraction + deepcu(:,:) = 0.0_r8 + shalcu(:,:) = 0.0_r8 do k=1,pver-1 do i=1,ncol @@ -3296,7 +4041,7 @@ subroutine clubb_tend_cam( & if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then deepcu(i,k) = 0._r8 - endif + end if ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation @@ -3317,8 +4062,8 @@ subroutine clubb_tend_cam( & deepcu(:,:) = 0.0_r8 concld(:,:) = 0.0_r8 - endif - endif + end if + end if ! --------------------------------------------------------------------------------- ! ! COMPUTE THE ICE CLOUD FRACTION PORTION ! @@ -3353,7 +4098,7 @@ subroutine clubb_tend_cam( & call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol,& qsatfac_out=qsatfac(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) - endif + end if enddo ! --------------------------------------------------------------------------------- ! @@ -3398,7 +4143,7 @@ subroutine clubb_tend_cam( & enddo ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth) - rrho(1:ncol) = (1._r8/gravit)*(state1%pdel(1:ncol,pver)/dz_g(pver)) + rrho(1:ncol) = (1._r8/gravit)*(state1%pdel(1:ncol,pver)/dz_g(1:ncol,pver)) call calc_ustar( ncol, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver), cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), & rrho(1:ncol), ustar2(1:ncol)) ! use correct qflux from coupler @@ -3517,39 +4262,41 @@ subroutine clubb_tend_cam( & ! Output CLUBB history here if (l_stats) then - do i=1,stats_zt%num_output_fields + do j=1,stats_zt(1)%num_output_fields - temp1 = trim(stats_zt%file%var(i)%name) + temp1 = trim(stats_zt(1)%file%grid_avg_var(j)%name) sub = temp1 if (len(temp1) > 16) sub = temp1(1:16) - call outfld(trim(sub), out_zt(:,:,i), pcols, lchnk ) + call outfld(trim(sub), out_zt(:,:,j), pcols, lchnk ) enddo - do i=1,stats_zm%num_output_fields + do j=1,stats_zm(1)%num_output_fields - temp1 = trim(stats_zm%file%var(i)%name) + temp1 = trim(stats_zm(1)%file%grid_avg_var(j)%name) sub = temp1 if (len(temp1) > 16) sub = temp1(1:16) - call outfld(trim(sub),out_zm(:,:,i), pcols, lchnk) + call outfld(trim(sub),out_zm(:,:,j), pcols, lchnk) enddo if (l_output_rad_files) then - do i=1,stats_rad_zt%num_output_fields - call outfld(trim(stats_rad_zt%file%var(i)%name), out_radzt(:,:,i), pcols, lchnk) + do j=1,stats_rad_zt(1)%num_output_fields + call outfld(trim(stats_rad_zt(1)%file%grid_avg_var(j)%name), out_radzt(:,:,j), pcols, lchnk) enddo - do i=1,stats_rad_zm%num_output_fields - call outfld(trim(stats_rad_zm%file%var(i)%name), out_radzm(:,:,i), pcols, lchnk) + do j=1,stats_rad_zm(1)%num_output_fields + call outfld(trim(stats_rad_zm(1)%file%grid_avg_var(j)%name), out_radzm(:,:,j), pcols, lchnk) enddo - endif + end if - do i=1,stats_sfc%num_output_fields - call outfld(trim(stats_sfc%file%var(i)%name), out_sfc(:,:,i), pcols, lchnk) + do j=1,stats_sfc(1)%num_output_fields + call outfld(trim(stats_sfc(1)%file%grid_avg_var(j)%name), out_sfc(:,:,j), pcols, lchnk) enddo - endif + end if + + call t_stopf("clubb_tend_cam") return #endif @@ -3676,7 +4423,7 @@ real(r8) function diag_ustar( z, bflx, wnd, z0 ) ustar = wnd*vonk/(lnz - psi1) end if - endif + end if end do end if @@ -3697,7 +4444,9 @@ end function diag_ustar #ifdef CLUBB_SGS subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & - nnzp, nnrad_zt,nnrad_zm, delt ) + nnzp, nnrad_zt,nnrad_zm, delt, & + stats_zt, stats_zm, stats_sfc, & + stats_rad_zt, stats_rad_zm) ! ! Description: Initializes the statistics saving functionality of ! the CLUBB model. This is for purpose of CAM-CLUBB interface. Here @@ -3708,7 +4457,6 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & use clubb_api_module, only: & - stats_zt, & ! Variables ztscr01, & ztscr02, & ztscr03, & @@ -3732,7 +4480,6 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ztscr21 use clubb_api_module, only: & - stats_zm, & zmscr01, & zmscr02, & zmscr03, & @@ -3750,9 +4497,6 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & zmscr15, & zmscr16, & zmscr17, & - stats_rad_zt, & - stats_rad_zm, & - stats_sfc, & l_stats, & l_output_rad_files, & stats_tsamp, & @@ -3790,6 +4534,13 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count] real(kind=time_precision), intent(in) :: delt ! Timestep (dtmain in CLUBB) [s] + + ! Output Variables + type (stats), intent(out) :: stats_zt, & ! stats_zt grid + stats_zm, & ! stats_zm grid + stats_rad_zt, & ! stats_rad_zt grid + stats_rad_zm, & ! stats_rad_zm grid + stats_sfc ! stats_sfc ! Local Variables @@ -3813,7 +4564,8 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Local Variables - logical :: l_error + logical :: l_error, & + first_call = .false. character(len=200) :: temp1, sub @@ -3885,7 +4637,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & 'model.in file.' write(fstderr,*) 'stats_tsamp = ', stats_tsamp write(fstderr,*) 'delt = ', delt - endif + end if ! Initialize zt (mass points) @@ -3903,7 +4655,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_zt." write(fstderr,*) "nvarmax_zt = ", nvarmax_zt call endrun ("stats_init_clubb: number of zt statistical variables exceeds limit") - endif + end if stats_zt%num_output_fields = ntot stats_zt%kk = nnzp @@ -3913,35 +4665,37 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & allocate( stats_zt%accum_field_values( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) allocate( stats_zt%accum_num_samples( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) allocate( stats_zt%l_in_update( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) + call stats_zero( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, & stats_zt%accum_num_samples, stats_zt%l_in_update ) - allocate( stats_zt%file%var( stats_zt%num_output_fields ) ) + allocate( stats_zt%file%grid_avg_var( stats_zt%num_output_fields ) ) allocate( stats_zt%file%z( stats_zt%kk ) ) - ! Allocate scratch space + first_call = (.not. allocated(ztscr01)) - allocate( ztscr01(stats_zt%kk) ) - allocate( ztscr02(stats_zt%kk) ) - allocate( ztscr03(stats_zt%kk) ) - allocate( ztscr04(stats_zt%kk) ) - allocate( ztscr05(stats_zt%kk) ) - allocate( ztscr06(stats_zt%kk) ) - allocate( ztscr07(stats_zt%kk) ) - allocate( ztscr08(stats_zt%kk) ) - allocate( ztscr09(stats_zt%kk) ) - allocate( ztscr10(stats_zt%kk) ) - allocate( ztscr11(stats_zt%kk) ) - allocate( ztscr12(stats_zt%kk) ) - allocate( ztscr13(stats_zt%kk) ) - allocate( ztscr14(stats_zt%kk) ) - allocate( ztscr15(stats_zt%kk) ) - allocate( ztscr16(stats_zt%kk) ) - allocate( ztscr17(stats_zt%kk) ) - allocate( ztscr18(stats_zt%kk) ) - allocate( ztscr19(stats_zt%kk) ) - allocate( ztscr20(stats_zt%kk) ) - allocate( ztscr21(stats_zt%kk) ) + ! Allocate scratch space + if (first_call) allocate( ztscr01(stats_zt%kk) ) + if (first_call) allocate( ztscr02(stats_zt%kk) ) + if (first_call) allocate( ztscr03(stats_zt%kk) ) + if (first_call) allocate( ztscr04(stats_zt%kk) ) + if (first_call) allocate( ztscr05(stats_zt%kk) ) + if (first_call) allocate( ztscr06(stats_zt%kk) ) + if (first_call) allocate( ztscr07(stats_zt%kk) ) + if (first_call) allocate( ztscr08(stats_zt%kk) ) + if (first_call) allocate( ztscr09(stats_zt%kk) ) + if (first_call) allocate( ztscr10(stats_zt%kk) ) + if (first_call) allocate( ztscr11(stats_zt%kk) ) + if (first_call) allocate( ztscr12(stats_zt%kk) ) + if (first_call) allocate( ztscr13(stats_zt%kk) ) + if (first_call) allocate( ztscr14(stats_zt%kk) ) + if (first_call) allocate( ztscr15(stats_zt%kk) ) + if (first_call) allocate( ztscr16(stats_zt%kk) ) + if (first_call) allocate( ztscr17(stats_zt%kk) ) + if (first_call) allocate( ztscr18(stats_zt%kk) ) + if (first_call) allocate( ztscr19(stats_zt%kk) ) + if (first_call) allocate( ztscr20(stats_zt%kk) ) + if (first_call) allocate( ztscr21(stats_zt%kk) ) ztscr01 = 0.0_r8 ztscr02 = 0.0_r8 @@ -3966,8 +4720,10 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ztscr21 = 0.0_r8 ! Default initialization for array indices for zt - - call stats_init_zt_api( clubb_vars_zt, l_error ) + if (first_call) then + call stats_init_zt_api( clubb_vars_zt, l_error, & + stats_zt ) + end if ! Initialize zm (momentum points) @@ -3985,7 +4741,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_zm." write(fstderr,*) "nvarmax_zm = ", nvarmax_zm call endrun ("stats_init_clubb: number of zm statistical variables exceeds limit") - endif + end if stats_zm%num_output_fields = ntot stats_zm%kk = nnzp @@ -3995,31 +4751,32 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & allocate( stats_zm%accum_field_values( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) allocate( stats_zm%accum_num_samples( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) allocate( stats_zm%l_in_update( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) + call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, & stats_zm%accum_num_samples, stats_zm%l_in_update ) - allocate( stats_zm%file%var( stats_zm%num_output_fields ) ) + allocate( stats_zm%file%grid_avg_var( stats_zm%num_output_fields ) ) allocate( stats_zm%file%z( stats_zm%kk ) ) ! Allocate scratch space - allocate( zmscr01(stats_zm%kk) ) - allocate( zmscr02(stats_zm%kk) ) - allocate( zmscr03(stats_zm%kk) ) - allocate( zmscr04(stats_zm%kk) ) - allocate( zmscr05(stats_zm%kk) ) - allocate( zmscr06(stats_zm%kk) ) - allocate( zmscr07(stats_zm%kk) ) - allocate( zmscr08(stats_zm%kk) ) - allocate( zmscr09(stats_zm%kk) ) - allocate( zmscr10(stats_zm%kk) ) - allocate( zmscr11(stats_zm%kk) ) - allocate( zmscr12(stats_zm%kk) ) - allocate( zmscr13(stats_zm%kk) ) - allocate( zmscr14(stats_zm%kk) ) - allocate( zmscr15(stats_zm%kk) ) - allocate( zmscr16(stats_zm%kk) ) - allocate( zmscr17(stats_zm%kk) ) + if (first_call) allocate( zmscr01(stats_zm%kk) ) + if (first_call) allocate( zmscr02(stats_zm%kk) ) + if (first_call) allocate( zmscr03(stats_zm%kk) ) + if (first_call) allocate( zmscr04(stats_zm%kk) ) + if (first_call) allocate( zmscr05(stats_zm%kk) ) + if (first_call) allocate( zmscr06(stats_zm%kk) ) + if (first_call) allocate( zmscr07(stats_zm%kk) ) + if (first_call) allocate( zmscr08(stats_zm%kk) ) + if (first_call) allocate( zmscr09(stats_zm%kk) ) + if (first_call) allocate( zmscr10(stats_zm%kk) ) + if (first_call) allocate( zmscr11(stats_zm%kk) ) + if (first_call) allocate( zmscr12(stats_zm%kk) ) + if (first_call) allocate( zmscr13(stats_zm%kk) ) + if (first_call) allocate( zmscr14(stats_zm%kk) ) + if (first_call) allocate( zmscr15(stats_zm%kk) ) + if (first_call) allocate( zmscr16(stats_zm%kk) ) + if (first_call) allocate( zmscr17(stats_zm%kk) ) zmscr01 = 0.0_r8 zmscr02 = 0.0_r8 @@ -4039,7 +4796,10 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & zmscr16 = 0.0_r8 zmscr17 = 0.0_r8 - call stats_init_zm_api( clubb_vars_zm, l_error ) + if (first_call) then + call stats_init_zm_api( clubb_vars_zm, l_error, & + stats_zm ) + end if ! Initialize rad_zt (radiation points) @@ -4059,7 +4819,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_rad_zt." write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt call endrun ("stats_init_clubb: number of rad_zt statistical variables exceeds limit") - endif + end if stats_rad_zt%num_output_fields = ntot stats_rad_zt%kk = nnrad_zt @@ -4073,10 +4833,11 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update ) - allocate( stats_rad_zt%file%var( stats_rad_zt%num_output_fields ) ) + allocate( stats_rad_zt%file%grid_avg_var( stats_rad_zt%num_output_fields ) ) allocate( stats_rad_zt%file%z( stats_rad_zt%kk ) ) - call stats_init_rad_zt_api( clubb_vars_rad_zt, l_error ) + call stats_init_rad_zt_api( clubb_vars_rad_zt, l_error, & + stats_rad_zt ) ! Initialize rad_zm (radiation points) @@ -4094,7 +4855,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_rad_zm." write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm call endrun ("stats_init_clubb: number of rad_zm statistical variables exceeds limit") - endif + end if stats_rad_zm%num_output_fields = ntot stats_rad_zm%kk = nnrad_zm @@ -4108,10 +4869,11 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & stats_rad_zm%accum_num_samples, stats_rad_zm%l_in_update ) - allocate( stats_rad_zm%file%var( stats_rad_zm%num_output_fields ) ) + allocate( stats_rad_zm%file%grid_avg_var( stats_rad_zm%num_output_fields ) ) allocate( stats_rad_zm%file%z( stats_rad_zm%kk ) ) - call stats_init_rad_zm_api( clubb_vars_rad_zm, l_error ) + call stats_init_rad_zm_api( clubb_vars_rad_zm, l_error, & + stats_rad_zm ) end if ! l_output_rad_files @@ -4131,7 +4893,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_sfc." write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc call endrun ("stats_init_clubb: number of sfc statistical variables exceeds limit") - endif + end if stats_sfc%num_output_fields = ntot stats_sfc%kk = 1 @@ -4145,57 +4907,62 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call stats_zero( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, & stats_sfc%accum_num_samples, stats_sfc%l_in_update ) - allocate( stats_sfc%file%var( stats_sfc%num_output_fields ) ) + allocate( stats_sfc%file%grid_avg_var( stats_sfc%num_output_fields ) ) allocate( stats_sfc%file%z( stats_sfc%kk ) ) - call stats_init_sfc_api( clubb_vars_sfc, l_error ) + if (first_call) then + call stats_init_sfc_api( clubb_vars_sfc, l_error, & + stats_sfc ) + end if ! Check for errors if ( l_error ) then call endrun ('stats_init: errors found') - endif + end if ! Now call add fields - do i = 1, stats_zt%num_output_fields - - temp1 = trim(stats_zt%file%var(i)%name) - sub = temp1 - if (len(temp1) > 16) sub = temp1(1:16) - -!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical - call addfld(trim(sub),(/ 'ilev' /),& - 'A',trim(stats_zt%file%var(i)%units),trim(stats_zt%file%var(i)%description)) - enddo - - do i = 1, stats_zm%num_output_fields - - temp1 = trim(stats_zm%file%var(i)%name) - sub = temp1 - if (len(temp1) > 16) sub = temp1(1:16) - -!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical - call addfld(trim(sub),(/ 'ilev' /),& - 'A',trim(stats_zm%file%var(i)%units),trim(stats_zm%file%var(i)%description)) - enddo + if (first_call) then + + do i = 1, stats_zt%num_output_fields + + temp1 = trim(stats_zt%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > 16) sub = temp1(1:16) + + call addfld(trim(sub),(/ 'ilev' /),& + 'A',trim(stats_zt%file%grid_avg_var(i)%units),trim(stats_zt%file%grid_avg_var(i)%description)) + enddo + + do i = 1, stats_zm%num_output_fields + + temp1 = trim(stats_zm%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > 16) sub = temp1(1:16) + + call addfld(trim(sub),(/ 'ilev' /),& + 'A',trim(stats_zm%file%grid_avg_var(i)%units),trim(stats_zm%file%grid_avg_var(i)%description)) + enddo - if (l_output_rad_files) then -!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical - do i = 1, stats_rad_zt%num_output_fields - call addfld(trim(stats_rad_zt%file%var(i)%name),(/ 'ilev' /),& - 'A',trim(stats_rad_zt%file%var(i)%units),trim(stats_rad_zt%file%var(i)%description)) - enddo - - do i = 1, stats_rad_zm%num_output_fields - call addfld(trim(stats_rad_zm%file%var(i)%name),(/ 'ilev' /),& - 'A',trim(stats_rad_zm%file%var(i)%units),trim(stats_rad_zm%file%var(i)%description)) - enddo - endif - - do i = 1, stats_sfc%num_output_fields - call addfld(trim(stats_sfc%file%var(i)%name),horiz_only,& - 'A',trim(stats_sfc%file%var(i)%units),trim(stats_sfc%file%var(i)%description)) - enddo + if (l_output_rad_files) then + + do i = 1, stats_rad_zt%num_output_fields + call addfld(trim(stats_rad_zt%file%grid_avg_var(i)%name),(/ 'ilev' /),& + 'A',trim(stats_rad_zt%file%grid_avg_var(i)%units),trim(stats_rad_zt%file%grid_avg_var(i)%description)) + enddo + + do i = 1, stats_rad_zm%num_output_fields + call addfld(trim(stats_rad_zm%file%grid_avg_var(i)%name),(/ 'ilev' /),& + 'A',trim(stats_rad_zm%file%grid_avg_var(i)%units),trim(stats_rad_zm%file%grid_avg_var(i)%description)) + enddo + end if + + do i = 1, stats_sfc%num_output_fields + call addfld(trim(stats_sfc%file%grid_avg_var(i)%name),horiz_only,& + 'A',trim(stats_sfc%file%grid_avg_var(i)%units),trim(stats_sfc%file%grid_avg_var(i)%description)) + enddo + + end if return @@ -4207,26 +4974,21 @@ end subroutine stats_init_clubb ! ! ! =============================================================================== ! - +#ifdef CLUBB_SGS + subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, stats_rad_zm, stats_sfc, & + out_zt, out_zm, out_radzt, out_radzm, out_sfc) !----------------------------------------------------------------------- - subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out_sfc) - ! Description: Called when the stats timestep has ended. This subroutine ! is responsible for calling statistics to be written to the output ! format. !----------------------------------------------------------------------- -#ifdef CLUBB_SGS + use shr_infnan_mod, only: is_nan => shr_infnan_isnan use clubb_api_module, only: & fstderr, & ! Constant(s) - stats_zt, & ! Variable(s) - stats_zm, & - stats_rad_zt, & - stats_rad_zm, & - stats_sfc, & l_stats_last, & stats_tsamp, & stats_tout, & @@ -4237,18 +4999,22 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out implicit none - -#endif - integer :: thecol + ! Input Variables + type (stats), intent(inout) :: stats_zt, & ! stats_zt grid + stats_zm, & ! stats_zm grid + stats_rad_zt, & ! stats_rad_zt grid + stats_rad_zm, & ! stats_rad_zm grid + stats_sfc ! stats_sfc + + ! Inout variables real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) real(r8), intent(inout) :: out_zm(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pverp,stats_rad_zt%num_output_fields) real(r8), intent(inout) :: out_radzm(:,:,:) ! (pcols,pverp,rad_zm%num_output_fields) real(r8), intent(inout) :: out_sfc(:,:,:) ! (pcols,1,sfc%num_output_fields) -#ifdef CLUBB_SGS ! Local Variables integer :: i, k @@ -4310,7 +5076,7 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out out_radzt(thecol,:top_lev-1,:) = 0.0_r8 out_radzm(thecol,:top_lev-1,:) = 0.0_r8 - endif ! l_output_rad_files + end if ! l_output_rad_files do i = 1, stats_sfc%num_output_fields out_sfc(thecol,1,i) = stats_sfc%accum_field_values(1,1,1,i) @@ -4333,10 +5099,8 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out return -#endif - end subroutine stats_end_timestep_clubb - +#endif ! =============================================================================== ! ! ! @@ -4459,208 +5223,5 @@ subroutine grid_size(state, grid_dx, grid_dy) end subroutine grid_size #endif - -#ifdef CLUBB_SGS - subroutine init_clubb_config_flags( clubb_config_flags_in ) -!------------------------------------------------------------------------------- -! Description: -! Initializes the public module variable 'clubb_config_flags' of type -! 'clubb_config_flags_type' on first call and only on first call. -! References: -! None -!------------------------------------------------------------------------------- - use clubb_api_module, only: & - clubb_config_flags_type, & ! Type - set_default_clubb_config_flags_api, & ! Procedure(s) - initialize_clubb_config_flags_type_api - - implicit none - - ! Input/Output Variables - type(clubb_config_flags_type), intent(inout) :: clubb_config_flags_in - - ! Local Variables - logical :: & - l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The - ! precipitation fraction is automatically set to 1 when this - ! flag is turned off. - l_predict_upwp_vpwp, & ! Flag to predict and along with and - ! alongside the advancement of , , , - ! , , and in subroutine - ! advance_xm_wpxp. Otherwise, and are still - ! approximated by eddy diffusivity when and are - ! advanced in subroutine advance_windm_edsclrm. - l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping - ! the overall correlation of w and x (w and rt, as well as w - ! and theta-l) within the limits of -max_mag_correlation_flux - ! to max_mag_correlation_flux. - l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and - ! thlp2) on keeping the overall correlation of w and x within - ! the limits of -max_mag_correlation_flux to - ! max_mag_correlation_flux. - l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the - ! turbulent dissipation coefficient, C2. - l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm - l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor - l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 - l_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects wprtp, wpthlp, & wpsclrp. - l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & - ! sclrpthlp. - l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtm, thlm, sclrm, um and vm. - l_uv_nudge, & ! For wind speed nudging. - l_rtm_nudge, & ! For rtm nudging - l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. - ! TKE = 1/2 (u'^2 + v'^2 + w'^2) - l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to - ! compute the varibles that are output from high order - ! closure - l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the - ! thermodynamic-level variables output from pdf_closure. - l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three - ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - - ! output from pdf_closure. - l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call - ! subroutine pdf_closure twice. If true, pdf_closure is - ! called first on thermodynamic levels and then on momentum - ! levels so that each variable is computed on its native - ! level. If false, pdf_closure is only called on - ! thermodynamic levels, and variables which belong on - ! momentum levels are interpolated. - l_standard_term_ta, & ! Use the standard discretization for the turbulent advection - ! terms. Setting to .false. means that a_1 and a_3 are - ! pulled outside of the derivative in - ! advance_wp2_wp3_module.F90 and in - ! advance_xp2_xpyp_module.F90. - l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac - ! and rcm to help increase cloudiness at coarser grid - ! resolutions. - l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones - l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors - l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) - l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) - l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability - ! correction - l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of - ! -(2/3)*em/tau_zm, as in Bougeault (1981) - l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly - l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values - l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the - ! mixing length scale as Lscale = tau * tke - l_use_ice_latent, & ! Includes the effects of ice latent heating in turbulence - ! terms - l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number - l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number - l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in - ! saturated atmospheres (from Durran and Klemp, 1982) - l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency - l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water - l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and - ! rtpthlp - l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 - l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz - l_update_pressure ! Flag for having CLUBB update pressure and exner - - logical, save :: first_call = .true. - - if (first_call) then - - call set_default_clubb_config_flags_api( l_use_precip_frac, & ! Out - l_predict_upwp_vpwp, & ! Out - l_min_wp2_from_corr_wx, & ! Out - l_min_xp2_from_corr_wx, & ! Out - l_C2_cloud_frac, & ! Out - l_diffuse_rtm_and_thlm, & ! Out - l_stability_correct_Kh_N2_zm, & ! Out - l_calc_thlp2_rad, & ! Out - l_upwind_wpxp_ta, & ! Out - l_upwind_xpyp_ta, & ! Out - l_upwind_xm_ma, & ! Out - l_uv_nudge, & ! Out - l_rtm_nudge, & ! Out - l_tke_aniso, & ! Out - l_vert_avg_closure, & ! Out - l_trapezoidal_rule_zt, & ! Out - l_trapezoidal_rule_zm, & ! Out - l_call_pdf_closure_twice, & ! Out - l_standard_term_ta, & ! Out - l_use_cloud_cover, & ! Out - l_diagnose_correlations, & ! Out - l_calc_w_corr, & ! Out - l_const_Nc_in_cloud, & ! Out - l_fix_w_chi_eta_correlations, & ! Out - l_stability_correct_tau_zm, & ! Out - l_damp_wp2_using_em, & ! Out - l_do_expldiff_rtm_thlm, & ! Out - l_Lscale_plume_centered, & ! Out - l_diag_Lscale_from_tau, & ! Out - l_use_ice_latent, & ! Out - l_use_C7_Richardson, & ! Out - l_use_C11_Richardson, & ! Out - l_brunt_vaisala_freq_moist, & ! Out - l_use_thvm_in_bv_freq, & ! Out - l_rcm_supersat_adj, & ! Out - l_single_C2_Skw, & ! Out - l_damp_wp3_Skw_squared, & ! Out - l_prescribed_avg_deltaz, & ! Out - l_update_pressure ) ! Out - - call initialize_clubb_config_flags_type_api( l_use_precip_frac, & ! In - l_predict_upwp_vpwp, & ! In - l_min_wp2_from_corr_wx, & ! In - l_min_xp2_from_corr_wx, & ! In - l_C2_cloud_frac, & ! In - l_diffuse_rtm_and_thlm, & ! In - l_stability_correct_Kh_N2_zm, & ! In - l_calc_thlp2_rad, & ! In - l_upwind_wpxp_ta, & ! In - l_upwind_xpyp_ta, & ! In - l_upwind_xm_ma, & ! In - l_uv_nudge, & ! In - l_rtm_nudge, & ! In - l_tke_aniso, & ! In - l_vert_avg_closure, & ! In - l_trapezoidal_rule_zt, & ! In - l_trapezoidal_rule_zm, & ! In - l_call_pdf_closure_twice, & ! In - l_standard_term_ta, & ! In - l_use_cloud_cover, & ! In - l_diagnose_correlations, & ! In - l_calc_w_corr, & ! In - l_const_Nc_in_cloud, & ! In - l_fix_w_chi_eta_correlations, & ! In - l_stability_correct_tau_zm, & ! In - l_damp_wp2_using_em, & ! In - l_do_expldiff_rtm_thlm, & ! In - l_Lscale_plume_centered, & ! In - l_diag_Lscale_from_tau, & ! In - l_use_ice_latent, & ! In - l_use_C7_Richardson, & ! In - l_use_C11_Richardson, & ! In - l_brunt_vaisala_freq_moist, & ! In - l_use_thvm_in_bv_freq, & ! In - l_rcm_supersat_adj, & ! In - l_single_C2_Skw, & ! In - l_damp_wp3_Skw_squared, & ! In - l_prescribed_avg_deltaz, & ! In - l_update_pressure, & ! In - clubb_config_flags_in ) ! Out - - first_call = .false. - - end if - - return - - end subroutine init_clubb_config_flags -#endif end module clubb_intr diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 7ffb3318c4..1eb55ba4e4 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -2009,7 +2009,7 @@ subroutine tphysbc (ztodt, state, & use subcol, only: subcol_gen, subcol_ptend_avg use subcol_utils, only: subcol_ptend_copy, is_subcol_on use qneg_module, only: qneg3 - use subcol_SILHS, only: subcol_SILHS_var_covar_driver + use subcol_SILHS, only: subcol_SILHS_var_covar_driver, init_state_subcol use subcol_SILHS, only: subcol_SILHS_fill_holes_conserv use subcol_SILHS, only: subcol_SILHS_hydromet_conc_tend_lim use micro_pumas_cam, only: massless_droplet_destroyer @@ -2544,12 +2544,17 @@ subroutine tphysbc (ztodt, state, & ! Calculate cloud microphysics !=================================================== + if (is_subcol_on() .neqv. use_subcol_microp ) then + call endrun("Error calculating cloud microphysics: is_subcol_on() != use_subcol_microp") + end if + if (is_subcol_on()) then ! Allocate sub-column structures. call physics_state_alloc(state_sc, lchnk, psubcols*pcols) call physics_tend_alloc(tend_sc, psubcols*pcols) ! Generate sub-columns using the requested scheme + if (trim(subcol_scheme) == 'SILHS') call init_state_subcol(state, tend, state_sc, tend_sc) call subcol_gen(state, tend, state_sc, tend_sc, pbuf) !Initialize check energy for subcolumns diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 5c335c932d..87f2561cc6 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -9,23 +9,31 @@ module subcol_SILHS use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 use physics_types, only: physics_state, physics_tend, physics_ptend - use ppgrid, only: pcols, psubcols, pver, pverp + use ppgrid, only: pcols, psubcols, pver, pverp, begchunk, endchunk use constituents, only: pcnst, cnst_get_ind use cam_abortutils, only: endrun use cam_logfile, only: iulog use cam_history, only: addfld, add_default, outfld, horiz_only + use ref_pres, only: top_lev => trop_cloud_top_lev #ifdef CLUBB_SGS #ifdef SILHS - use clubb_intr, only: pdf_params_chnk + use clubb_intr, only: & + clubb_config_flags, & + clubb_params, & + stats_zt, stats_zm, stats_sfc, & + pdf_params_chnk + use clubb_api_module, only: & hmp2_ip_on_hmm2_ip_slope_type, & - hmp2_ip_on_hmm2_ip_intrcpt_type + hmp2_ip_on_hmm2_ip_intrcpt_type, & + precipitation_fractions, & + stats use silhs_api_module, only: & silhs_config_flags_type #endif #endif - use physconst, only: cpair, gravit, latvap, latice, rair + use physconst, only: cpair, gravit, latvap, latice, rair, rga, cappa implicit none private @@ -39,14 +47,17 @@ module subcol_SILHS public :: subcol_SILHS_var_covar_driver public :: subcol_SILHS_fill_holes_conserv public :: subcol_SILHS_hydromet_conc_tend_lim + public :: init_state_subcol private :: fill_holes_sedimentation private :: fill_holes_same_phase_vert #ifdef SILHS - private :: Abs_Temp_profile - private :: StaticEng_profile ! Calc subcol mean ! Calc subcol variance private :: meansc private :: stdsc + + type (stats), target :: stats_lh_zt, & + stats_lh_sfc + !$omp threadprivate(stats_lh_zt, stats_lh_sfc) #endif !----- @@ -128,11 +139,13 @@ end subroutine subcol_register_SILHS subroutine subcol_readnl_SILHS(nlfile) #ifdef CLUBB_SGS #ifdef SILHS - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: masterproc, masterprocid, mpicom - use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8 - use clubb_api_module,only: core_rknd + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, masterprocid, mpicom + use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8, iam + use clubb_api_module, only: core_rknd + use silhs_api_module, only: set_default_silhs_config_flags_api, & + initialize_silhs_config_flags_type_api, & + print_silhs_config_flags_api #endif #endif character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -141,6 +154,23 @@ subroutine subcol_readnl_SILHS(nlfile) integer :: unitn, ierr #ifdef CLUBB_SGS #ifdef SILHS + + integer :: & + cluster_allocation_strategy + + logical :: & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + namelist /subcol_SILHS_nl/ subcol_SILHS_weight, & subcol_SILHS_numsubcol, & subcol_SILHS_corr_file_path, & @@ -158,6 +188,18 @@ subroutine subcol_readnl_SILHS(nlfile) ! subcol_SILHS_c8, subcol_SILHS_c11, subcol_SILHS_c11b, & ! subcol_SILHS_gamma_coef, subcol_SILHS_mult_coef, subcol_SILHS_mu + namelist /silhs_config_flags_nl/ subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + !----------------------------------------------------------------------------- ! Set defaults @@ -166,8 +208,7 @@ subroutine subcol_readnl_SILHS(nlfile) subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni = 0.5_core_rknd if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'subcol_SILHS_nl', status=ierr) if (ierr == 0) then read(unitn, subcol_SILHS_nl, iostat=ierr) @@ -176,9 +217,53 @@ subroutine subcol_readnl_SILHS(nlfile) end if end if close(unitn) - call freeunit(unitn) end if + ! Set default silhs_config_flags entires + call set_default_silhs_config_flags_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights ) + + ! Get silhs_config_flags entries from namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'silhs_config_flags_nl', status=ierr) + if (ierr == 0) then + read(unitn, silhs_config_flags_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('silhs_config_flags_nl: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Save silhs_config_flags entries into module variable silhs_config_flags + call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights, & + silhs_config_flags ) + + ! Print the SILHS configurable flags + call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) + #ifdef SPMD ! Broadcast namelist variables call mpi_bcast(subcol_SILHS_weight, 1, mpi_logical, masterprocid, mpicom, ierr) @@ -214,6 +299,17 @@ subroutine subcol_readnl_SILHS(nlfile) ! call mpi_bcast(subcol_SILHS_gamma_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mult_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mu, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_importance_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_Lscale_vert_avg, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_straight_mc, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_clustered_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_rcm_in_cloud_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_random_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_max_overlap_in_cloud, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_instant_var_covar_src, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_limit_weights, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_var_frac, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_normalize_weights, 1, mpi_logical, masterprocid, mpicom, ierr) ! SPMD #endif @@ -234,7 +330,6 @@ subroutine subcol_init_SILHS(pbuf2d) use physics_buffer, only: physics_buffer_desc, pbuf_get_field, & dtype_r8, pbuf_get_index - use units, only: getunit, freeunit #ifdef CLUBB_SGS #ifdef SILHS use clubb_api_module, only: core_rknd, & @@ -244,15 +339,6 @@ subroutine subcol_init_SILHS(pbuf2d) Ncnp2_on_Ncnm2, & set_clubb_debug_level_api - use silhs_api_module, only: set_default_silhs_config_flags_api, & - initialize_silhs_config_flags_type_api, & - print_silhs_config_flags_api - - use spmd_utils, only: iam - - use clubb_intr, only: init_clubb_config_flags, & - clubb_config_flags - #endif #endif @@ -280,22 +366,7 @@ subroutine subcol_init_SILHS(pbuf2d) iiNi, & ! Hydrometeor array index for ice concentration, Ni iiNg ! Hydrometeor array index for graupel concentration, Ng - integer :: & - cluster_allocation_strategy - - logical :: & - l_lh_importance_sampling, & - l_Lscale_vert_avg, & - l_lh_straight_mc, & - l_lh_clustered_sampling, & - l_rcm_in_cloud_k_lh_start, & - l_random_k_lh_start, & - l_max_overlap_in_cloud, & - l_lh_instant_var_covar_src, & - l_lh_limit_weights, & - l_lh_var_frac, & - l_lh_normalize_weights - + integer :: l ! Loop variable ! Set CLUBB's debug level ! This is called in module clubb_intr; no need to do it here. @@ -304,45 +375,13 @@ subroutine subcol_init_SILHS(pbuf2d) !------------------------------- ! CLUBB-SILHS Parameters (global module variables) !------------------------------- - call set_default_silhs_config_flags_api( cluster_allocation_strategy, & - l_lh_importance_sampling, & - l_Lscale_vert_avg, & - l_lh_straight_mc, & - l_lh_clustered_sampling, & - l_rcm_in_cloud_k_lh_start, & - l_random_k_lh_start, & - l_max_overlap_in_cloud, & - l_lh_instant_var_covar_src, & - l_lh_limit_weights, & - l_lh_var_frac, & - l_lh_normalize_weights ) - - call init_clubb_config_flags( clubb_config_flags ) ! In/Out clubb_config_flags%l_fix_w_chi_eta_correlations = .true. - l_lh_importance_sampling = .true. clubb_config_flags%l_diagnose_correlations = .false. clubb_config_flags%l_calc_w_corr = .false. ! l_prescribed_avg_deltaz = .false. clubb_config_flags%l_use_cloud_cover = .false. clubb_config_flags%l_const_Nc_in_cloud = .true. - call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & - l_lh_importance_sampling, & - l_Lscale_vert_avg, & - l_lh_straight_mc, & - l_lh_clustered_sampling, & - l_rcm_in_cloud_k_lh_start, & - l_random_k_lh_start, & - l_max_overlap_in_cloud, & - l_lh_instant_var_covar_src, & - l_lh_limit_weights, & - l_lh_var_frac, & - l_lh_normalize_weights, & - silhs_config_flags ) - - ! Print the SILHS configurable flags - call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) - ! Values from the namelist docldfracscaling = subcol_SILHS_use_clear_col @@ -359,7 +398,6 @@ subroutine subcol_init_SILHS(pbuf2d) ! mu = subcol_SILHS_mu !call set_clubb_debug_level( 0 ) !#KTCtodo: Add a namelist variable to set debug level - ! Get constituent indices call cnst_get_ind('Q', ixq) @@ -435,17 +473,12 @@ subroutine subcol_init_SILHS(pbuf2d) corr_file_path_cloud = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//cloud_file_ext corr_file_path_below = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//below_file_ext - iunit = getunit() - - call setup_corr_varnce_array_api( corr_file_path_cloud, corr_file_path_below, & - iunit, & + getnewunit(iunit), & clubb_config_flags%l_fix_w_chi_eta_correlations ) - call freeunit(iunit) !------------------------------- ! Register output fields from SILHS - ! #KTCtodo: Remove these from the default output list !------------------------------- call addfld('SILHS_NCLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & 'Subcolumn Cloud Number Concentration', flag_xyfill=.true., fill_value=1.e30_r8) @@ -526,7 +559,28 @@ subroutine subcol_init_SILHS(pbuf2d) #endif #endif end subroutine subcol_init_SILHS - +!==============================================================! + subroutine init_state_subcol(state, tend, state_sc, tend_sc) + + use ppgrid, only : pver, pverp, pcols + + use subcol_utils, only : subcol_set_subcols + + implicit none + + type(physics_state), intent(inout) :: state + type(physics_tend), intent(inout) :: tend + type(physics_state), intent(inout) :: state_sc ! sub-column state + type(physics_tend), intent(inout) :: tend_sc ! sub-column tend + + integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct + + numsubcol_arr(:) = 0 ! Start over each chunk + numsubcol_arr(:state%ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns + call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) + + end subroutine init_state_subcol +!==================================================================! subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !------------------------------- ! This is where the subcolumns are created, and the call to @@ -537,10 +591,9 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) use physics_buffer, only : physics_buffer_desc, pbuf_get_index, & pbuf_get_field - use ppgrid, only : pver, pverp, pcols - use ref_pres, only : top_lev => trop_cloud_top_lev use time_manager, only : get_nstep use subcol_utils, only : subcol_set_subcols, subcol_set_weight + use subcol_pack_mod, only : subcol_pack use phys_control, only : phys_getopts use spmd_utils, only : masterproc use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RHOFW @@ -555,7 +608,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) hydromet_pdf_parameter, & - zm2zt_api, setup_grid_heights_api, gr, & + zm2zt_api, setup_grid_heights_api, & iirr, iiNr, iirs, iiri, & iirg, iiNs, & @@ -577,13 +630,16 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) genrand_intg, genrand_init_api, & nparams, ic_K, & - read_parameters_api + read_parameters_api, & + Cp, Lv, & + grid, setup_grid_api, & + init_precip_fracs_api use silhs_api_module, only : generate_silhs_sample_api, & ! Ncn_to_Nc, & clip_transform_silhs_output_api, & - est_kessler_microphys_api + est_kessler_microphys_api, & + vert_decorr_coef - use clubb_intr, only: clubb_config_flags #endif #endif @@ -610,14 +666,14 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) integer :: i, j, k, ngrdcol, ncol, lchnk, stncol integer :: begin_height, end_height ! Output from setup_grid call - real(r8) :: sfc_elevation ! Surface elevation - real(r8), dimension(pverp-top_lev+1) :: zt_g, zi_g ! Thermo & Momentum grids for clubb + real(r8) :: sfc_elevation(state%ngrdcol) ! Surface elevation + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: zt_g, zi_g ! Thermo & Momentum grids for clubb + real(r8), dimension(pverp) :: scfrac ! cloud fraction based on sc distributions real(r8) :: msc, std, maxcldfrac, maxsccldfrac real(r8) :: scale = 1.0_r8 - real(r8), dimension(nparams) :: clubb_params ! Adjustable CLUBB parameters - real(r8) :: c_K ! CLUBB parameter c_K (for eddy diffusivity) integer( kind = genrand_intg ) :: & @@ -627,19 +683,21 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Required for set_up_pdf_params_incl_hydromet !---------------- - real(r8), dimension(pverp-top_lev+1) :: cld_frac_in ! Cloud fraction - type(hydromet_pdf_parameter), dimension(pverp-top_lev+1) :: & - hydromet_pdf_params ! Hydrometeor PDF parameters - real(r8), dimension(:,:,:), allocatable :: & ! Correlation matrix for pdf components - corr_array_1, corr_array_2 - real(r8), dimension(:,:), allocatable :: & - mu_x_1, mu_x_2, & ! Mean array for PDF components - sigma_x_1, sigma_x_2 ! Std dev arr for PDF components - real(r8), dimension(:,:,:), allocatable :: & ! Transposed corr cholesky mtx - corr_cholesky_mtx_1, corr_cholesky_mtx_2 - real(r8), dimension(pverp-top_lev+1) :: Nc_in_cloud - real(r8), dimension(pverp-top_lev+1) :: ice_supersat_frac_in - real(r8), dimension(pverp-top_lev+1,hydromet_dim) :: hydrometp2 + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: cld_frac_in ! Cloud fraction + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & + corr_array_1, corr_array_2 ! Correlation matrix for pdf components + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim) :: & + mu_x_1, mu_x_2, & ! Mean array for PDF components + sigma_x_1, sigma_x_2 ! Std dev arr for PDF components + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & + corr_cholesky_mtx_1, corr_cholesky_mtx_2 ! Transposed corr cholesky mtx + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: Nc_in_cloud + real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: ice_supersat_frac_in + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, hydromet_dim) :: hydrometp2 !---------------- @@ -647,21 +705,21 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- integer :: iter ! CLUBB iteration integer :: num_subcols ! Number of subcolumns - integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct integer, parameter :: sequence_length = 1 ! Number of timesteps btn subcol calls - real(r8), dimension(pverp-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs - real(r8), dimension(pver) :: dz_g ! thickness of layer - real(r8), dimension(pverp-top_lev+1) :: delta_zm ! Difference in u wind altitudes - real(r8), dimension(pverp-top_lev+1) :: invs_dzm ! 1/delta_zm - real(r8), dimension(pverp-top_lev+1) :: rcm_in ! Cld water mixing ratio on CLUBB levs - real(r8), dimension(pverp-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species - real(r8), dimension(pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux - real(r8), dimension(pverp-top_lev+1) :: Ncm ! Mean cloud droplet concentration, - - real(r8), dimension(pverp-top_lev+1) :: tke ! TKE - real(r8), dimension(pverp-top_lev+1) :: khzm ! Eddy diffusivity coef - real(r8), dimension(pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels - real(r8), dimension(pverp-top_lev+1) :: Lscale ! CLUBB's length scale + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs + real(r8), dimension(state%ngrdcol,pver) :: dz_g ! thickness of layer + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: delta_zm ! Difference in u wind altitudes + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: rcm_in ! Cld water mixing ratio on CLUBB levs + real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species + real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Ncm ! Mean cloud droplet concentration, + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: tke ! TKE + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: khzm ! Eddy diffusivity coef + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale ! CLUBB's length scale logical, parameter :: & l_calc_weights_all_levs = .false. ! .false. if all time steps use the same @@ -670,29 +728,29 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) l_calc_weights_all_levs_itime, & ! .true. if we calculate sample weights separately at all ! grid levels at the current time step l_rad_itime ! .true. if we calculate radiation at the current time step - + !--------------- !Output from generate_silhs_sample !-------------- - real(r8), allocatable, dimension(:,:,:) :: X_nl_all_levs ! Sample transformed to normal-lognormal - real(r8), allocatable, dimension(:,:) :: lh_sample_point_weights ! Subcolumn weights - integer, allocatable, dimension(:,:) :: X_mixt_comp_all_levs ! Which Mixture Component - - real(r8), allocatable, dimension(:,:) :: rc_all_points ! Calculate RCM from LH output - real(r8), allocatable, dimension(:,:) :: rain_all_pts ! Calculate Rain from LH output - real(r8), allocatable, dimension(:,:) :: nrain_all_pts ! Calculate Rain Conc from LH - real(r8), allocatable, dimension(:,:) :: snow_all_pts ! Calculate Snow from LH output - real(r8), allocatable, dimension(:,:) :: nsnow_all_pts ! Calculate Snow Conc from LH - real(r8), allocatable, dimension(:,:) :: w_all_points ! Calculate W from LH output - ! real(r8), allocatable, dimension(:,:) :: RVM_lh_out ! Vapor mixing ratio sent away - real(r8), allocatable, dimension(:,:) :: ice_all_pts ! Calculate Cld Ice from LH output - real(r8), allocatable, dimension(:,:) :: nice_all_pts ! Calculate Num cld ice from LH - real(r8), allocatable, dimension(:,:) :: nclw_all_pts ! Calculate Num cld wat from LH + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1,pdf_dim) :: X_nl_all_levs ! Sample transformed to normal-lognormal + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: lh_sample_point_weights ! Subcolumn weights + integer, dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: X_mixt_comp_all_levs ! Which Mixture Component + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1, subcol_SILHS_numsubcol) :: & + rc_all_points, & ! Calculate RCM from LH output + rain_all_pts, & ! Calculate Rain from LH output + nrain_all_pts, & ! Calculate Rain Conc from LH + snow_all_pts, & ! Calculate Snow from LH output + nsnow_all_pts, & ! Calculate Snow Conc from LH + w_all_points, & ! Calculate W from LH output + ice_all_pts, & ! Calculate Cld Ice from LH output + nice_all_pts, & ! Calculate Num cld ice from LH + nclw_all_pts ! Calculate Num cld wat from LH !---------------- ! Output from clip_transform_silhs_output_api !---------------- - real( kind = core_rknd ), dimension(:,:), allocatable :: & + real( kind = core_rknd ), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: & lh_rt_clipped, & ! rt generated from silhs sample points lh_thl_clipped, & ! thl generated from silhs sample points lh_rc_clipped, & ! rc generated from silhs sample points @@ -748,13 +806,13 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Output from Est_Kessler_microphys !---------------- - real(r8), dimension(pverp-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion - real(r8), dimension(pverp-top_lev+1) :: AKm ! Exact Kessler autoconversion - real(r8), dimension(pverp-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler - real(r8), dimension(pverp-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler - real(r8), dimension(pverp-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm - real(r8), dimension(pverp-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc - real(r8), dimension(pverp-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm ! Exact Kessler autoconversion + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water real(r8), dimension(pcols,pverp) :: lh_AKm_out, AKm_out !---------------- @@ -766,7 +824,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), dimension(pcols, pver) :: invs_exner ! inverse exner sent to conversion codw ! pcols for output to history real(r8) :: eff_rad_coef = 1.0_r8/(4.0_r8/3.0_r8*SHR_CONST_RHOFW*SHR_CONST_PI) - real(r8), dimension(pver) :: eff_rad_prof ! r^3 as calculated from grid mean MR & NC !---------------- ! Pointers @@ -785,10 +842,43 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), pointer, dimension(:,:) :: tke_in ! TKE real(r8), pointer, dimension(:,:) :: khzm_in ! Eddy diffusivity coef + + logical, parameter :: l_est_kessler_microphys = .false. + logical, parameter :: l_outfld_subcol = .false. + + type(grid) :: gr(state%ngrdcol) + + type(precipitation_fractions) :: precip_fracs + + !------------------------------------------------ + ! Begin Code + !------------------------------------------------ + +#ifdef SILHS_OPENACC + if ( l_est_kessler_microphys ) then + call endrun('subcol_gen error: compilation with OpenACC requires l_est_kessler_microphys = .false.') + end if + + if ( subcol_SILHS_constrainmn ) then + call endrun('subcol_gen error: compilation with OpenACC requires subcol_SILHS_constrainmn = .false.') + end if + + if ( subcol_SILHS_weight ) then + call endrun('subcol_gen error: Importance sampling is not enabled for SILHS when using OpenACC. Set subcol_SILHS_weight to false.') + end if +#endif if (.not. allocated(state_sc%lat)) then call endrun('subcol_gen error: state_sc must be allocated before calling subcol_gen') end if + + if( rx_Nc ) then + call endrun('subcol_gen_SILHS: rx_Nc not enabled') + endif + + if (subcol_SILHS_meanice) then + call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') + end if ! Determine num of columns and which chunk we're working on and what timestep ngrdcol = state%ngrdcol @@ -817,9 +907,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call pbuf_get_field(pbuf, tke_idx, tke_in) call pbuf_get_field(pbuf, kvh_idx, khzm_in) - ! Read the clubb parameters in order to extract c_K. - call read_parameters_api( -99, "", clubb_params ) - ! Pull c_K from clubb parameters. c_K = clubb_params(ic_K) @@ -827,9 +914,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Copy state and populate numbers and values of sub-columns !---------------- ztodt = ztodt_ptr(1) - numsubcol_arr(:) = 0 ! Start over each chunk - numsubcol_arr(:ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns - call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) + num_subcols = subcol_SILHS_numsubcol ! The number of vertical grid levels used in CLUBB is pverp, which is originally ! set in the call to setup_clubb_core_api from subroutine clubb_ini_cam. This @@ -838,572 +923,756 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! levels and also uses the gr%nz object. The value of gr%nz needs to be reset ! for SILHS here and then set again for CLUBB in subroutine clubb_tend_cam. gr%nz = pverp - top_lev + 1 + + ! Calculate sample weights separately at all grid levels when + ! radiation is not called + l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs + ! when the weights vary with height. + ! Don't set to true until this is fixed!! - !---------------- - ! Loop over all the active grid columns in the chunk - !---------------- - do i = 1, ngrdcol + + ! Setup the CLUBB vertical grid object. This must be done for each + ! column as the z-distance between hybrid pressure levels can + ! change easily. + ! Define the CLUBB momentum grid (in height, units of m) + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + zi_g(i,k) = state%zi(i,pverp-k+1)-state%zi(i,pverp) + end do + end do + - ! JHDBG: Big suspicion about that code - ! V. Larson: I don't know what happens to arrays allocated with size - ! num_subcols if num_subcols varies with the grid column. - num_subcols = numsubcol_arr(i) - stncol = 0 ! Each grid column needs to know how many subcolumns have gone by - do k = 1, i-1 - ! stncol = stncol + numsubcol_arr(i-1) - ! Eric Raut replaced i-1 with k in line immediately above. - stncol = stncol + numsubcol_arr(k) - enddo - - ! Setup the CLUBB vertical grid object. This must be done for each - ! column as the z-distance between hybrid pressure levels can - ! change easily. - sfc_elevation = state%zi(i,pverp) - ! Define the CLUBB momentum grid (in height, units of m) - do k = 1, pverp-top_lev+1 - zi_g(k) = state%zi(i,pverp-k+1)-sfc_elevation - enddo - ! Define the CLUBB thermodynamic grid (in units of m) - do k = 1, pver-top_lev+1 - zt_g(k+1) = state%zm(i,pver-k+1)-state%zi(i,pverp) - enddo - ! Thermodynamic ghost point is below surface - zt_g(1) = -1._r8*zt_g(2) - ! Calculate the distance between grid levels on the host model grid, - ! using host model grid indices. - do k = top_lev, pver - dz_g(k) = state%zi(i,k)-state%zi(i,k+1) - enddo - ! allocate grid object - call setup_grid_heights_api( l_implemented, grid_type, & - zi_g(2), zi_g(1), zi_g(1:pverp-top_lev+1), & - zt_g(1:pverp-top_lev+1) ) - - ! Inverse delta_zm is required for the 3-level L-scale averaging - do k = 1, pver-top_lev+1 - delta_zm(k+1) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) - invs_dzm(k+1) = 1.0_r8/delta_zm(k+1) - enddo - ! Handle CLUBB sub-sfc ghost point as done in clubb grid_class.F90 - delta_zm(1) = delta_zm(2) - invs_dzm(1) = invs_dzm(2) - - ! Compute dry static density on CLUBB vertical grid - do k = 1, pver-top_lev+1 - rho_ds_zt(k+1) = (1._r8/gravit)*state%pdel(i,pver-k+1)/dz_g(pver-k+1) - enddo - ! CLUBB ghost point under the surface - rho_ds_zt(1) = rho_ds_zt(2) - - ! Set up hydromet array, flipped from CAM vert grid to CLUBB - do k = 1, pver-top_lev+1 - if ( iirr > 0 ) then - ! If ixrain and family are greater than zero, then MG2 is - ! being used, and rain and snow are part of state. Otherwise, - ! diagnostic rain and snow from MG1 are used in hydromet. - if (ixrain > 0) then - hydromet(k+1,iirr) = state%q(i,pver-k+1,ixrain) - else - hydromet(k+1,iirr) = qrain(i,pver-k+1) - endif - endif - if ( iiNr > 0 ) then - if (ixnumrain > 0) then - hydromet(k+1,iiNr) = state%q(i,pver-k+1,ixnumrain) - else - hydromet(k+1,iiNr) = nrain(i,pver-k+1) - endif - endif - if ( iirs > 0 ) then - if (ixsnow > 0) then - hydromet(k+1,iirs) = state%q(i,pver-k+1,ixsnow) - else - hydromet(k+1,iirs) = qsnow(i,pver-k+1) - endif - endif - if ( iiNs > 0 ) then - if (ixnumsnow > 0) then - hydromet(k+1,iiNs) = state%q(i,pver-k+1,ixnumsnow) - else - hydromet(k+1,iiNs) = nsnow(i,pver-k+1) - endif - endif - if ( iiri > 0 ) then - hydromet(k+1,iiri) = state%q(i,pver-k+1,ixcldice) - endif - if ( iiNi > 0 ) then - hydromet(k+1,iiNi) = state%q(i,pver-k+1,ixnumice) - endif - - Ncm(k+1) = state%q(i,pver-k+1,ixnumliq) - - enddo - - do k = 1, hydromet_dim ! ghost point below the surface - hydromet(1,k) = hydromet(2,k) - enddo - - Ncm(1) = Ncm(2) - - do k = top_lev, pver - ! Calculate effective radius cubed, CAM-grid oriented for use in subcolumns - eff_rad_prof(k) = eff_rad_coef*state%q(i,k,ixcldliq)/state%q(i,k,ixnumliq) - ! Test a fixed effective radius - ! eff_rad_prof(k) = 5.12e-16_r8 ! 8 microns - enddo - - ! Allocate arrays for set_up_pdf_params_incl_hydromet - allocate( corr_array_1(pdf_dim, pdf_dim, pverp-top_lev+1) ) - allocate( corr_array_2(pdf_dim, pdf_dim, pverp-top_lev+1) ) - allocate( mu_x_1(pdf_dim, pverp-top_lev+1) ) - allocate( mu_x_2(pdf_dim, pverp-top_lev+1) ) - allocate( sigma_x_1(pdf_dim, pverp-top_lev+1) ) - allocate( sigma_x_2(pdf_dim, pverp-top_lev+1) ) - allocate( corr_cholesky_mtx_1(pdf_dim, pdf_dim, pverp-top_lev+1) ) - allocate( corr_cholesky_mtx_2(pdf_dim, pdf_dim, pverp-top_lev+1) ) - ! Allocate arrays for SILHS output - allocate( lh_sample_point_weights(pverp-top_lev+1,num_subcols) ) - allocate( X_mixt_comp_all_levs(pverp-top_lev+1,num_subcols) ) - allocate( X_nl_all_levs(pverp-top_lev+1,num_subcols,pdf_dim) ) - allocate( lh_rt_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_thl_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_rc_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_rv_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_Nc_clipped(pverp-top_lev+1,num_subcols) ) - ! Allocate arrays for output to either history files or for updating state_sc - allocate( rc_all_points(pverp-top_lev+1, num_subcols) ) - allocate( rain_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nrain_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( snow_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nsnow_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( w_all_points(pverp-top_lev+1, num_subcols) ) - ! allocate( RVM_lh_out(num_subcols, pverp) ) ! This one used only to update state - allocate( ice_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nice_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nclw_all_pts(pverp-top_lev+1, num_subcols) ) + ! Define the CLUBB thermodynamic grid (in units of m) + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + zt_g(i,k+1) = state%zm(i,pver-k+1)-state%zi(i,pverp) + + ! Thermodynamic ghost point is below surface + zt_g(i,1) = -1._r8*zt_g(i,2) + end do + end do + + do i=1, ncol + ! Set the elevation of the surface + sfc_elevation(i) = state%zi(i,pver+1) + end do + + ! Heights need to be set at each timestep. + do i=1, ncol + call setup_grid_api( pverp - top_lev, sfc_elevation(i), l_implemented, & ! intent(in) + grid_type, zi_g(i,2), zi_g(i,1), zi_g(i,pverp - top_lev+1), & ! intent(in) + zi_g(i,:), zt_g(i,:), & ! intent(in) + gr(i), begin_height, end_height ) ! intent(out) + end do - ! Convert from CAM vertical grid to CLUBB - do k = 1, pverp-top_lev+1 - rcm_in(k) = rcm(i,pverp-k+1) - ice_supersat_frac_in(k) = ice_supersat_frac(i,pverp-k+1) - enddo - do k = 1, pver-top_lev+1 - cld_frac_in(k+1) = alst(i,pver-k+1) - enddo - cld_frac_in(1) = cld_frac_in(2) ! Ghost pt below surface - ! Calculate a clubb-specific exner function - ! (This is grid mean, as pressure levels do not change in - ! the subcolumn state) - invs_exner(i,:) = ((state%pmid(i,:)/p0_clubb)**(rair/cpair)) - - ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS - ! Compute Num concentration of cloud nuclei - Nc_in_cloud = Ncm / max( cld_frac_in, cloud_frac_min ) - - ! The variable wphydrometp is only used when l_calc_w_corr is enabled. - ! The l_calc_w_corr flag is turned off by default, so wphydrometp will - ! simply be set to 0 to simplify matters. - wphydrometp = 0.0_r8 + ! Calculate the distance between grid levels on the host model grid, + ! using host model grid indices. + do k = top_lev, pver + do i = 1, ngrdcol + dz_g(i,k) = state%zi(i,k)-state%zi(i,k+1) + end do + end do + + ! Inverse delta_zm is required for the 3-level L-scale averaging + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + delta_zm(i,k+1) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) + + ! Handle CLUBB sub-sfc ghost point as done in clubb grid_class.F90 + delta_zm(i,1) = delta_zm(i,2) + end do + end do + + ! Compute dry static density on CLUBB vertical grid + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + rho_ds_zt(i,k+1) = (rga)*state%pdel(i,pverp-k)/dz_g(i,pverp-k) + + ! CLUBB ghost point under the surface + rho_ds_zt(i,1) = rho_ds_zt(i,2) + end do + end do + + ! Set up hydromet array, flipped from CAM vert grid to CLUBB + if ( iirr > 0 ) then + ! If ixrain and family are greater than zero, then MG2 is + ! being used, and rain and snow are part of state. Otherwise, + ! diagnostic rain and snow from MG1 are used in hydromet. + if (ixrain > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirr) = state%q(i,pver-k+1,ixrain) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirr) = qrain(i,pver-k+1) + end do + end do + endif + endif + + if ( iiNr > 0 ) then + if (ixnumrain > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNr) = state%q(i,pver-k+1,ixnumrain) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNr) = nrain(i,pver-k+1) + end do + end do + endif + endif + + if ( iirs > 0 ) then + if (ixsnow > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirs) = state%q(i,pver-k+1,ixsnow) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirs) = qsnow(i,pver-k+1) + end do + end do + endif + endif + + if ( iiNs > 0 ) then + if (ixnumsnow > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNs) = state%q(i,pver-k+1,ixnumsnow) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNs) = nsnow(i,pver-k+1) + end do + end do + endif + endif + + if ( iiri > 0 ) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiri) = state%q(i,pver-k+1,ixcldice) + end do + end do + endif + + if ( iiNi > 0 ) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNi) = state%q(i,pver-k+1,ixnumice) + end do + end do + endif + + do k = 1, hydromet_dim ! ghost point below the surface + do i = 1, ngrdcol + hydromet(i,1,k) = hydromet(i,2,k) + end do + end do + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + Ncm(i,k+1) = state%q(i,pver-k+1,ixnumliq) + Ncm(i,1) = Ncm(i,2) + end do + end do + + ! Convert from CAM vertical grid to CLUBB + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + rcm_in(i,k) = rcm(i,pverp-k+1) + ice_supersat_frac_in(i,k) = ice_supersat_frac(i,pverp-k+1) + end do + end do + + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + cld_frac_in(i,k+1) = alst(i,pver-k+1) + cld_frac_in(i,1) = cld_frac_in(i,2) ! Ghost pt below surface + end do + end do + + ! Calculate a clubb-specific exner function + ! (This is grid mean, as pressure levels do not change in + ! the subcolumn state) + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) + end do + end do - ! make the call - call setup_pdf_parameters_api( pverp-top_lev+1, pdf_dim, ztodt, & ! In - Nc_in_cloud, rcm_in, cld_frac_in, & ! In - ice_supersat_frac_in, hydromet, wphydrometp, & ! In - corr_array_n_cloud, corr_array_n_below, & ! In - pdf_params_chnk(i,lchnk), l_stats_samp, & ! In - clubb_config_flags%l_use_precip_frac, & ! In - clubb_config_flags%l_predict_upwp_vpwp, & ! In - clubb_config_flags%l_diagnose_correlations, & ! In - clubb_config_flags%l_calc_w_corr, & ! In - clubb_config_flags%l_const_Nc_in_cloud, & ! In - clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In - hydrometp2, & ! Out - mu_x_1, mu_x_2, & ! Out - sigma_x_1, sigma_x_2, & ! Out - corr_array_1, corr_array_2, & ! Out - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out - hydromet_pdf_params ) ! Out - - ! Calculate radiation only once in a while - ! l_rad_itime = (mod( itime, floor(dt_rad/dt_main) ) == 0 .or. itime == 1) - - ! Calculate sample weights separately at all grid levels when - ! radiation is not called - ! l_calc_weights_all_levs_itime = l_calc_weights_all_levs .and. .not. - ! l_rad_itime - l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs - ! when the weights vary with height. - ! Don't set to true until this is fixed!! - - ! In order for Lscale to be used properly, it needs to be passed out of - ! advance_clubb_core, saved to the pbuf, and then pulled out of the - ! pbuf for use here. The profile of Lscale is passed into subroutine - ! generate_silhs_sample_api for use in calculating the vertical - ! correlation coefficient. Rather than output Lscale directly, its - ! value can be calculated from other fields that are already output to - ! pbuf. The equation relating Lscale to eddy diffusivity is: - ! - ! Kh = c_K * Lscale * sqrt( TKE ). - ! - ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted - ! from CLUBB's tunable parameters. The equation for Lscale is: - ! - ! Lscale = Kh / ( c_K * sqrt( TKE ) ). - ! - ! Since Kh and TKE are output on momentum (interface) grid levels, the - ! resulting calculation of Lscale is also found on momentum levels. It - ! needs to be interpolated back to thermodynamic (midpoint) grid levels - ! for further use. - do k = 1, pverp-top_lev+1 - khzm(k) = khzm_in(i,pverp-k+1) - tke(k) = tke_in(i,pverp-k+1) - enddo - Lscale_zm = khzm / ( c_K * sqrt( max( tke, em_min ) ) ) - - ! Interpolate Lscale_zm back to thermodynamic grid levels. - Lscale = max( zm2zt_api( Lscale_zm ), 0.01_r8 ) - - ! Set the seed to the random number generator based on a quantity that - ! will be reproducible for restarts. - lh_seed = int( 1.0e4_r8 * rtm(i,pver), kind = genrand_intg ) - call genrand_init_api( put=lh_seed ) - - ! Let's generate some subcolumns!!!!! - call generate_silhs_sample_api & - ( iter, pdf_dim, num_subcols, sequence_length, pverp-top_lev+1, & ! In - l_calc_weights_all_levs_itime, & ! In - pdf_params_chnk(i,lchnk), delta_zm, rcm_in, Lscale, & ! In - rho_ds_zt, mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In - hydromet_pdf_params, silhs_config_flags, & ! In - clubb_config_flags%l_uv_nudge, & ! In - clubb_config_flags%l_tke_aniso, & ! In - clubb_config_flags%l_standard_term_ta, & ! In - clubb_config_flags%l_single_C2_Skw, & ! In - X_nl_all_levs, X_mixt_comp_all_levs, & ! Out - lh_sample_point_weights) ! Out - - ! Extract clipped variables from subcolumns - call clip_transform_silhs_output_api( pverp-top_lev+1, num_subcols, & ! In - pdf_dim, hydromet_dim, & ! In - X_mixt_comp_all_levs, & ! In - X_nl_all_levs, & ! In - pdf_params_chnk(i,lchnk), & ! In - l_use_Ncn_to_Nc, & ! In - lh_rt_clipped, lh_thl_clipped, & ! Out - lh_rc_clipped, lh_rv_clipped, & ! Out - lh_Nc_clipped ) ! Out - - ! Test subcolumns by comparing to an estimate of kessler autoconversion - call est_kessler_microphys_api & - ( pverp-top_lev+1, num_subcols, pdf_dim, X_nl_all_levs, & - pdf_params_chnk(i,lchnk), & - rcm_in, cld_frac_in, X_mixt_comp_all_levs, lh_sample_point_weights, & - silhs_config_flags%l_lh_importance_sampling, & - lh_AKm, AKm, AKstd, AKstd_cld, AKm_rcm, AKm_rcc, lh_rcm_avg) - - ! Calc column liquid water for output (rcm) - rc_all_points = lh_rc_clipped(:,:) - - if ( iiPDF_rr > 0 ) then - ! Calc subcolumn precipitating liq water for output (rrm) - rain_all_pts = real( X_nl_all_levs(:,:,iiPDF_rr), kind=r8 ) - end if - - if ( iiPDF_Nr > 0 ) then - ! Calc subcolumn number rain conc for output (nrainm) - nrain_all_pts = real( X_nl_all_levs(:,:,iiPDF_Nr), kind=r8 ) - end if + ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS + ! Compute Num concentration of cloud nuclei + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + Nc_in_cloud(i,k) = Ncm(i,k) / max( cld_frac_in(i,k), cloud_frac_min ) + end do + end do - if ( iiPDF_rs > 0 ) then - ! Calc subcolumn precipitating snow for output (rsm) - snow_all_pts = real( X_nl_all_levs(:,:,iiPDF_rs), kind=r8 ) - end if + ! The variable wphydrometp is only used when l_calc_w_corr is enabled. + ! The l_calc_w_corr flag is turned off by default, so wphydrometp will + ! simply be set to 0 to simplify matters. + wphydrometp = 0.0_r8 - if ( iiPDF_Ns > 0 ) then - ! Calc subcolumn precipitating snow conc for output (Nsm) - nsnow_all_pts = real( X_nl_all_levs(:,:,iiPDF_Ns), kind=r8 ) - end if - - if ( iiPDF_ri > 0 ) then - ! Calc subcolumn cloud ice mixing ratio - ice_all_pts = real( X_nl_all_levs(:,:,iiPDF_ri), kind=r8) - end if + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + khzm(i,k) = khzm_in(i,pverp-k+1) + end do + end do + + ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels + call init_precip_fracs_api( pverp-top_lev+1, ngrdcol, & + precip_fracs ) + + call setup_pdf_parameters_api( gr, pverp-top_lev+1, ngrdcol, pdf_dim, ztodt, & ! In + Nc_in_cloud, rcm_in, cld_frac_in, khzm, & ! In + ice_supersat_frac_in, hydromet, wphydrometp, & ! In + corr_array_n_cloud, corr_array_n_below, & ! In + pdf_params_chnk(lchnk), l_stats_samp, & ! In + clubb_params, & ! In + clubb_config_flags%iiPDF_type, & ! In + clubb_config_flags%l_use_precip_frac, & ! In + clubb_config_flags%l_predict_upwp_vpwp, & ! In + clubb_config_flags%l_diagnose_correlations, & ! In + clubb_config_flags%l_calc_w_corr, & ! In + clubb_config_flags%l_const_Nc_in_cloud, & ! In + clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In + stats_zt, stats_zm, stats_sfc, & ! In + hydrometp2, & ! Inout + mu_x_1, mu_x_2, & ! Out + sigma_x_1, sigma_x_2, & ! Out + corr_array_1, corr_array_2, & ! Out + corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out + precip_fracs ) ! Inout + + ! In order for Lscale to be used properly, it needs to be passed out of + ! advance_clubb_core, saved to the pbuf, and then pulled out of the + ! pbuf for use here. The profile of Lscale is passed into subroutine + ! generate_silhs_sample_api for use in calculating the vertical + ! correlation coefficient. Rather than output Lscale directly, its + ! value can be calculated from other fields that are already output to + ! pbuf. The equation relating Lscale to eddy diffusivity is: + ! + ! Kh = c_K * Lscale * sqrt( TKE ). + ! + ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted + ! from CLUBB's tunable parameters. The equation for Lscale is: + ! + ! Lscale = Kh / ( c_K * sqrt( TKE ) ). + ! + ! Since Kh and TKE are output on momentum (interface) grid levels, the + ! resulting calculation of Lscale is also found on momentum levels. It + ! needs to be interpolated back to thermodynamic (midpoint) grid levels + ! for further use. + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + tke(i,k) = tke_in(i,pverp-k+1) + end do + end do + + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale_zm(i,k) = khzm(i,k) / ( c_K * sqrt( max( tke(i,k), em_min ) ) ) + end do + end do - if ( iiPDF_Ni > 0 ) then - ! Calc subcolumn cloud ice number - nice_all_pts = real( X_nl_all_levs(:,:,iiPDF_Ni), kind=r8) - end if + do i = 1, ngrdcol + Lscale(i,1) = Lscale_zm(i,1) + ( Lscale_zm(i,2) - Lscale_zm(i,1) ) & + * ( zt_g(i,1) - zi_g(i,1) ) / ( zi_g(i,2) - zi_g(i,1) ) + end do + + do k = 2, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale(i,k) = Lscale_zm(i,k-1) + ( Lscale_zm(i,k) - Lscale_zm(i,k-1) ) & + * ( zt_g(i,k) - zi_g(i,k-1) ) / ( zi_g(i,k) - zi_g(i,k-1) ) + end do + end do + + do k = 2, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale(i,:) = max( Lscale(i,:), 0.01_r8 ) + end do + end do + + !$acc data create( X_mixt_comp_all_levs, X_nl_all_levs, lh_rc_clipped, lh_Nc_clipped, & + !$acc& lh_sample_point_weights, lh_rt_clipped, lh_rt_clipped, & + !$acc& lh_rv_clipped, lh_thl_clipped, THL_lh_out, & + !$acc& RT_lh_out, RCM_lh_out, NCLW_lh_out, ICE_lh_out, & + !$acc& NICE_lh_out, RVM_lh_out, THL_lh_out, RAIN_lh_out, & + !$acc& NRAIN_lh_out, SNOW_lh_out, NSNOW_lh_out, WM_lh_out, & + !$acc& OMEGA_lh_out ) & + !$acc& copyin( state, state%zm, state%phis, rho_ds_zt, invs_exner ) & + !$acc& copyout( state%t, state%s, state%omega, state_sc%q ) + !$acc& async(1) + + ! Set the seed to the random number generator based on a quantity that + ! will be reproducible for restarts. + lh_seed = int( 1.0e4_r8 * rtm(1,pver), kind = genrand_intg ) + + ! Let's generate some subcolumns!!!!! + call generate_silhs_sample_api( & + iter, pdf_dim, num_subcols, sequence_length, pverp-top_lev+1, ngrdcol, & ! In + l_calc_weights_all_levs_itime, & ! In + pdf_params_chnk(lchnk), delta_zm, rcm_in, Lscale, & ! In + lh_seed, & ! In + rho_ds_zt, & ! In + mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In + corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In + precip_fracs, silhs_config_flags, & ! In + clubb_params, & ! In + clubb_config_flags%l_uv_nudge, & ! In + clubb_config_flags%l_tke_aniso, & ! In + clubb_config_flags%l_standard_term_ta, & ! In + vert_decorr_coef, & ! In + stats_lh_zt, stats_lh_sfc, & ! intent(inout) + X_nl_all_levs, X_mixt_comp_all_levs, & ! Out + lh_sample_point_weights) ! Out + + ! Extract clipped variables from subcolumns + call clip_transform_silhs_output_api( gr, pverp-top_lev+1, ngrdcol, num_subcols, & ! In + pdf_dim, hydromet_dim, & ! In + X_mixt_comp_all_levs, & ! In + X_nl_all_levs, & ! In + pdf_params_chnk(lchnk), & ! In + l_use_Ncn_to_Nc, & ! In + lh_rt_clipped, lh_thl_clipped, & ! Out + lh_rc_clipped, lh_rv_clipped, & ! Out + lh_Nc_clipped ) ! Out + !$acc wait + + if ( l_est_kessler_microphys ) then + call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') + end if - ! Calc subcolumn vert velocity for output (wm) - w_all_points = real( X_nl_all_levs(:,:,iiPDF_w), kind=r8 ) - ! Calc cloud liq water number conc - nclw_all_pts = lh_Nc_clipped(:,:) - ! Calc mean liquid water potential temp for clear air - !call THL_profile(pver, state%t(i,:), invs_exner(i,:), No_cloud, Temp_prof) - - ! Calc effective cloud fraction for testing - eff_cldfrac(:,:) = 0.0_r8 - do k = top_lev, pver - do j=1, num_subcols - - if ( ( rc_all_points(pverp-k+1,j) .gt. qsmall ) & - .or. ( ice_all_pts(pverp-k+1,j) .gt. qsmall ) ) then - eff_cldfrac(i,k) = eff_cldfrac(i,k)+lh_sample_point_weights(pverp-k+1,j) - endif - enddo - - eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) - enddo - - ! Pack precip_frac for output - do k = 2, pverp-top_lev+1 - precip_frac_out(i,pver-k+2) = hydromet_pdf_params(k)%precip_frac - enddo - - ! Pack up weights for output - do j = 1, num_subcols - if (subcol_SILHS_weight) then - weights(stncol+j) = lh_sample_point_weights(2,j) ! Using grid level 2 always won't work - ! if weights vary with height. - else - weights(stncol+j) = 1._r8 - endif - enddo + !------------------------------------------------------------------------- + ! Convert from CLUBB vertical grid to CAM grid + !------------------------------------------------------------------------ + ! This kernel is executed in stream 1: + !$acc parallel loop collapse(3) default(present) async(1) + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + RT_lh_out( num_subcols*(i-1)+j,k ) = lh_rt_clipped(i,j,pverp-k+1) + RCM_lh_out( num_subcols*(i-1)+j,k ) = lh_rc_clipped(i,j,pverp-k+1) + NCLW_lh_out( num_subcols*(i-1)+j,k ) = lh_Nc_clipped(i,j,pverp-k+1) + RVM_lh_out( num_subcols*(i-1)+j,k ) = lh_rv_clipped(i,j,pverp-k+1) + THL_lh_out( num_subcols*(i-1)+j,k ) = lh_thl_clipped(i,j,pverp-k+1) + end do + end do + end do + + ! This kernel is executed in stream 2: + !$acc parallel loop collapse(3) default(present) async(2) + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + ICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) + NICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ni) + RAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rr) + NRAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Nr) + SNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rs) + NSNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ns) + WM_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_w) + end do + end do + end do + + ! This kernel is executed in stream 2 because WM_lh_out comes from stream 2: + !$acc parallel loop collapse(3) default(present) async(2) + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + OMEGA_lh_out( num_subcols*(i-1)+j,k ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k) & + * rho_ds_zt(i,pverp-k+1) * gravit + end do + end do + end do + + if ( l_est_kessler_microphys ) then + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + AKm_out(i,k) = AKm(i,pverp-k+1) + lh_AKm_out(i,k) = lh_AKm(i,pverp-k+1) + end do + end do + end do + end if - ! Convert from CLUBB vertical grid to CAM grid for history output and - ! Updating state variables - do k = top_lev, pverp - do j = 1, num_subcols - RT_lh_out( stncol+j,k ) = lh_rt_clipped(pverp-k+1,j) - RCM_lh_out( stncol+j,k ) = rc_all_points(pverp-k+1,j) - NCLW_lh_out( stncol+j,k ) = nclw_all_pts(pverp-k+1,j) - ICE_lh_out( stncol+j,k ) = ice_all_pts(pverp-k+1,j) - NICE_lh_out( stncol+j,k ) = nice_all_pts(pverp-k+1,j) -! RVM_lh_out(j,k) = RT_lh_out(stncol+j,k)-RCM_lh_out(stncol+j,k)-ICE_lh_out(stncol+j,k) - RVM_lh_out( stncol+j,k ) = lh_rv_clipped(pverp-k+1,j) - THL_lh_out( stncol+j,k ) = lh_thl_clipped(pverp-k+1,j) - RAIN_lh_out( stncol+j,k ) = rain_all_pts(pverp-k+1,j) - NRAIN_lh_out( stncol+j,k ) = nrain_all_pts(pverp-k+1,j) - SNOW_lh_out( stncol+j,k ) = snow_all_pts(pverp-k+1,j) - NSNOW_lh_out( stncol+j,k ) = nsnow_all_pts(pverp-k+1,j) - WM_lh_out( stncol+j,k ) = w_all_points(pverp-k+1,j) - OMEGA_lh_out( stncol+j,k ) = -1._r8*WM_lh_out(stncol+j,k)*rho_ds_zt(pverp-k+1)*gravit - AKm_out(i,k) = AKm(pverp-k+1) - lh_AKm_out(i,k) = lh_AKm(pverp-k+1) - enddo - enddo - - ! Constrain the sample distribution of cloud water and ice to the same mean - ! as the grid to prevent negative condensate errors - if(subcol_SILHS_constrainmn) then - call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) - if ( ixrain > 0 ) & - call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixrain) ) - if ( ixsnow > 0 ) & - call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixsnow) ) - call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) - call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) - call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & + ! Pack up weights + ! Using grid level 2 always won't work if weights vary with height. + call subcol_pack(lchnk, lh_sample_point_weights(:,:,2), weights ) + call subcol_set_weight(lchnk, weights) + + ! Constrain the sample distribution of cloud water and ice to the same mean + ! as the grid to prevent negative condensate errors + if(subcol_SILHS_constrainmn) then + + do i = 1, ngrdcol + + stncol = num_subcols*(i-1) + + call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) + if ( ixrain > 0 ) & + call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixrain) ) + if ( ixsnow > 0 ) & + call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixsnow) ) + call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) + call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) + call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumice) ) + if ( ixnumrain > 0 ) & + call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumrain) ) + if ( ixnumsnow > 0 ) & + call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumsnow) ) + call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumliq) ) + do k = top_lev, pver + ! Look for exceptionally large values of condensate + if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then + ! Clip the large values + where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) + ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 + NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 + end where + ! Recalculate the weighted subcolumn mean + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumice) ) - if ( ixnumrain > 0 ) & - call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixcldice)-tmp_mean + ! Add the difference to each subcolumn + ICE_lh_out(stncol+1:stncol+num_subcols,k) = & + ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + ! Recalculate the weight subcolumn mean for ice num conc + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumrain) ) - if ( ixnumsnow > 0 ) & - call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixnumice)-tmp_mean + ! Add the difference to each subcolumn + if(diff_mean.gt.0.0_r8) then + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + else ! just use the grid mean in each subcolumn + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + state%q(i,k,ixnumice) + end if + ! Test adjusted means for debugging + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumsnow) ) - call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixcldice)-tmp_mean + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumliq) ) - do k = top_lev, pver - ! Look for exceptionally large values of condensate - if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then - ! Clip the large values - where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) - ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 - NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 - end where - ! Recalculate the weighted subcolumn mean - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixcldice)-tmp_mean - ! Add the difference to each subcolumn - ICE_lh_out(stncol+1:stncol+num_subcols,k) = & - ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - ! Recalculate the weight subcolumn mean for ice num conc - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixnumice)-tmp_mean - ! Add the difference to each subcolumn - if(diff_mean.gt.0.0_r8) then - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - else ! just use the grid mean in each subcolumn - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - state%q(i,k,ixnumice) - end if - ! Test adjusted means for debugging - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixcldice)-tmp_mean - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixnumice)-tmp_mean - endif - enddo ! k = top_lev, pver - endif ! subcol_silhs_constrainm - - ! Code to update the state variables for interactive runs - ! Set state variables - do j = 1, numsubcol_arr(i) - - call Abs_Temp_profile( pver-top_lev+1, THL_lh_out(stncol+j,top_lev:pver), & - invs_exner(i,top_lev:pver), RCM_lh_out(stncol+j,top_lev:pver), & - Temp_prof(top_lev:pver) ) - state_sc%t(stncol+j,top_lev:pver) = Temp_prof(top_lev:pver) - call StaticEng_profile( pver-top_lev+1, Temp_prof(top_lev:pver), & - state%zm(i,top_lev:pver), state%phis(i), & - SE_prof(top_lev:pver) ) - state_sc%s(stncol+j,top_lev:pver) = SE_prof(top_lev:pver) - + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixnumice)-tmp_mean + endif + end do ! k = top_lev, pver + end do + endif ! subcol_silhs_constrainm + + + !--------------------------------------------------- + ! Updating state variables + !--------------------------------------------------- + ! Code to update the state variables for interactive runs + ! This kernel is executed in stream 3, but waits for stream 1 + ! because THL_lh_out and RCM_lh_out come from stream 1: + !$acc parallel loop collapse(3) default(present) wait(1) async(3) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + + state_sc%t(num_subcols*(i-1)+j,k) = THL_lh_out(num_subcols*(i-1)+j,k) * invs_exner(i,k) & + + Lv * RCM_lh_out(num_subcols*(i-1)+j,k) / Cp + + state_sc%s(num_subcols*(i-1)+j,k) = cpair * state_sc%t(num_subcols*(i-1)+j,k) & + + gravit * state%zm(i,k) + state%phis(i) + end do + end do + end do + + ! This kernel is executed in stream 4, but waits for stream 1 and 2 + ! because RVM_lh_out is from stream 1 and OMEGA_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(4) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol ! Vertical Velocity is not part of the energy conservation checks, but ! we need to be careful here, because the SILHS output VV is noisy. - state_sc%omega(stncol+j,top_lev:pver) = OMEGA_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixq) = RVM_lh_out(stncol+j,top_lev:pver) - - if( rx_Nc ) then - call endrun('subcol_gen_SILHS: rx_Nc not enabled') - endif - - - if (subcol_SILHS_meanice) then - call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') - state_sc%q(stncol+j,top_lev:pver,ixcldice) = state%q(i,top_lev:pver,ixcldice) - state_sc%q(stncol+j,top_lev:pver,ixnumice) = state%q(i,top_lev:pver,ixnumice) - state_sc%q(stncol+j,top_lev:pver,ixcldliq) = RCM_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = NCLW_lh_out(stncol+j,top_lev:pver) - else - if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp - state_sc%q(stncol+j,top_lev:pver,ixcldliq) = RCM_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixcldice) = ICE_lh_out(stncol+j,top_lev:pver) - if (ixrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixrain) = RAIN_lh_out(stncol+j,top_lev:pver) - if (ixsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixsnow) = SNOW_lh_out(stncol+j,top_lev:pver) - else - state_sc%q(stncol+j,top_lev:pver,ixcldliq) = state%q(i,top_lev:pver,ixcldliq) - state_sc%q(stncol+j,top_lev:pver,ixcldice) = state%q(i,top_lev:pver,ixcldice) - if (ixrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixrain) = state%q(i,top_lev:pver,ixrain) - if (ixsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixsnow) = state%q(i,top_lev:pver,ixsnow) - endif - if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp - state_sc%q(stncol+j,top_lev:pver,ixnumice) = NICE_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = NCLW_lh_out(stncol+j,top_lev:pver) - if (ixnumrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumrain) = NRAIN_lh_out(stncol+j,top_lev:pver) - if (ixnumsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumsnow) = NSNOW_lh_out(stncol+j,top_lev:pver) - else - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = state%q(i,top_lev:pver,ixnumliq) - state_sc%q(stncol+j,top_lev:pver,ixnumice) = state%q(i,top_lev:pver,ixnumice) - if (ixnumrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumrain) = state%q(i,top_lev:pver,ixnumrain) - if (ixnumsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumsnow) = state%q(i,top_lev:pver,ixnumsnow) - endif - endif ! meanice + state_sc%omega(num_subcols*(i-1)+j,k) = OMEGA_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixq) = RVM_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp + + ! This kernel is executed in stream 5, but waits for stream 1 and 2 + ! because RCM_lh_out is from stream 1 and ICE_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(5) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = RCM_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = ICE_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (ixrain > 0) then + ! This kernel is executed in stream 6, but waits for stream 2 + ! because RAIN_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(6) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = RAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + if (ixsnow > 0) then + ! This kernel is executed in stream 7, but waits for stream 2 + ! because SNOW_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(7) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = SNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + else + + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = state%q(i,k,ixcldliq) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = state%q(i,k,ixcldice) + if (ixrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = state%q(i,k,ixrain) + end if + if (ixsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = state%q(i,k,ixsnow) + end if + end do + end do + end do + + endif + + if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp + + ! This kernel is executed in stream 8, but waits for stream 1 and 2 + ! because NCLW_lh_out is from stream 1 and NICE_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(8) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = NICE_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = NCLW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (ixnumrain > 0) then + ! This kernel is executed in stream 9, but waits for stream 2 + ! because NRAIN_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(9) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = NRAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + if (ixnumsnow > 0) then + ! This kernel is executed in stream 10, but waits for stream 2 + ! because NSNOW_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(10) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = NSNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + else + + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = state%q(i,k,ixnumliq) + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = state%q(i,k,ixnumice) + if (ixnumrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = state%q(i,k,ixnumrain) + end if + if (ixnumsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = state%q(i,k,ixnumsnow) + end if + end do + end do + end do + + endif + + ! This kernel is executed in stream 8, because state_sc%q(:,:,ixnumliq) and + ! state_sc%q(:,:,ixnumice) are from stream 8 + !$acc parallel loop collapse(3) default(present) async(8) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol ! Change liq and ice (and rain and snow) num conc zeros to min values (1e-12) - where (state_sc%q(stncol+j,top_lev:pver,ixnumliq) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = min_num_conc - end where - where (state_sc%q(stncol+j,top_lev:pver,ixnumice) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumice) = min_num_conc - end where - if (ixnumrain > 0) then - where(state_sc%q(stncol+j,top_lev:pver,ixnumrain) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumrain) = min_num_conc - end where - endif - if (ixnumsnow > 0) then - where(state_sc%q(stncol+j,top_lev:pver,ixnumsnow) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumsnow) = min_num_conc - end where - endif + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = min_num_conc + end if + + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumice) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = min_num_conc + end if + end do + end do + end do + + if (ixnumrain > 0) then + ! This kernel is executed in stream 9, because state_sc%q(:,:,ixnumrain) is + ! from stream 9 + !$acc parallel loop collapse(3) default(present) async(9) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = min_num_conc + end if + end do + end do + end do + endif + + if (ixnumsnow > 0) then + ! This kernel is executed in stream 10, because state_sc%q(:,:,ixnumsnow) is + ! from stream 10 + !$acc parallel loop collapse(3) default(present) async(10) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = min_num_conc + end if + end do + end do + end do + endif + + if ( l_outfld_subcol ) then + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + do j = 1, num_subcols - enddo - - ! Only use weights if namelist variable turned on - if (subcol_SILHS_weight) call subcol_set_weight(state_sc%lchnk, weights) - - - ! Deallocate the dynamic arrays used - deallocate( lh_sample_point_weights, X_mixt_comp_all_levs, & - X_nl_all_levs, lh_rt_clipped, lh_thl_clipped, lh_rc_clipped, & - lh_rv_clipped, lh_Nc_clipped, & - corr_array_1, corr_array_2, mu_x_1, mu_x_2, sigma_x_1, & - sigma_x_2, corr_cholesky_mtx_1, corr_cholesky_mtx_2 ) - ! deallocate( RVM_lh_out ) - deallocate( rc_all_points, rain_all_pts, nrain_all_pts, snow_all_pts, nsnow_all_pts, ice_all_pts, & - nice_all_pts, nclw_all_pts, w_all_points ) - enddo ! ngrdcol - - call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) - call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) - call outfld( 'RTM_CLUBB', rtm, pcols, lchnk ) - call outfld( 'THLM_CLUBB', thlm, pcols, lchnk ) - call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) - call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) - call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) - call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) - call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) - call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) - call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) - call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) - if ( subcol_SILHS_constrainmn ) then - call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) - call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) - if ( ixsnow > 0 ) then + ! Calc effective cloud fraction for testing + if ( ( lh_rc_clipped(i,j,pverp-k+1) .gt. qsmall ) & + .or. ( X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) .gt. qsmall ) ) then + eff_cldfrac(i,k) = eff_cldfrac(i,k) + lh_sample_point_weights(i,j,pverp-k+1) + else + eff_cldfrac(i,k) = 0.0_r8 + endif + + end do + + eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) + + end do + end do + + ! Pack precip_frac for output + do k = 2, pverp-top_lev+1 + do i = 1, ngrdcol + precip_frac_out(i,pver-k+2) = precip_fracs%precip_frac(i,k) + end do + end do + + call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) + call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) + call outfld( 'RTM_CLUBB', rtm, pcols, lchnk ) + call outfld( 'THLM_CLUBB', thlm, pcols, lchnk ) + call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) + call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) + call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) + call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) + if ( l_est_kessler_microphys ) then + call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) + call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) + end if + call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) + call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) + if ( subcol_SILHS_constrainmn ) then + call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) + call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) + if ( ixsnow > 0 ) then call outfld( 'SILHS_MSC_CLDLIQ', meansc_liq, pcols, lchnk ) call outfld( 'SILHS_STDSC_CLDLIQ', stdsc_liq, pcols, lchnk ) call outfld( 'SILHS_MSC_Q', meansc_vap, pcols, lchnk ) call outfld( 'SILHS_STDSC_Q', stdsc_vap, pcols, lchnk ) - endif ! ixsnow > 0 - endif ! subcol_SILHS_constrainmn - call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) + endif ! ixsnow > 0 + endif ! subcol_SILHS_constrainmn + call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) + call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) + call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) + end if + + !$acc end data + !$acc wait #endif #endif @@ -1443,10 +1712,12 @@ subroutine subcol_SILHS_var_covar_driver & use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field #ifdef CLUBB_SGS #ifdef SILHS - use ref_pres, only: top_lev => trop_cloud_top_lev use subcol_utils, only: subcol_get_weight use subcol_pack_mod, only: subcol_unpack, subcol_get_nsubcol - use clubb_api_module, only: T_in_K2thlm_api + use clubb_api_module, only: T_in_K2thlm_api, & + init_pdf_params_api, & + copy_multi_pdf_params_to_single,& + pdf_parameter use silhs_api_module, only: lh_microphys_var_covar_driver_api #endif #endif @@ -1484,9 +1755,9 @@ subroutine subcol_SILHS_var_covar_driver & real(r8), dimension(pcols,psubcols,pver ) :: exner ! Inputs to lh_microphys_var_covar_driver - real(r8), dimension(pcols,pverp,psubcols) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & + real(r8), dimension(pcols,psubcols,pverp) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & qctend_clubb, qvtend_clubb, thltend_clubb - real(r8), dimension(pcols,pverp-top_lev+1,psubcols) :: height_depndt_weights + real(r8), dimension(pcols,psubcols,pverp-top_lev+1) :: height_depndt_weights ! Outputs from lh_microphys_var_covar_driver real(r8), dimension(:,:), pointer :: rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, & @@ -1499,8 +1770,12 @@ subroutine subcol_SILHS_var_covar_driver & wprtp_mc_zt_idx, & wpthlp_mc_zt_idx, & rtpthlp_mc_zt_idx + + type(pdf_parameter) :: pdf_params_single_col !----- Begin Code ----- + + call init_pdf_params_api( pverp+1-top_lev, 1, pdf_params_single_col ) ! Don't do anything if this option isn't enabled. if ( .not. subcol_SILHS_var_covar_src ) return @@ -1558,8 +1833,8 @@ subroutine subcol_SILHS_var_covar_driver & ! Compute dry static density on CLUBB vertical grid do k = top_lev, pver dz_g(igrdcol,isubcol,k) = zi_all(igrdcol,isubcol,k) - zi_all(igrdcol,isubcol,k+1) ! thickness - rho(igrdcol,isubcol,k) = (1._r8/gravit)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) - enddo + rho(igrdcol,isubcol,k) = (rga)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) + end do ! Compute w from omega w_all(igrdcol,isubcol,top_lev:pver) = -omega_all(igrdcol,isubcol,top_lev:pver) & @@ -1575,7 +1850,7 @@ subroutine subcol_SILHS_var_covar_driver & t_all(igrdcol,isubcol,k) = ( s_all(igrdcol,isubcol,k) & - gravit * zm_all(igrdcol,isubcol,k) & - phis_all(igrdcol,isubcol) ) / cpair - enddo ! k = 1, pver + end do ! k = 1, pver ! This formula is taken from earlier in this file. exner(igrdcol,isubcol,top_lev:pver) & @@ -1590,7 +1865,7 @@ subroutine subcol_SILHS_var_covar_driver & thl_all(igrdcol,isubcol,k) & = T_in_K2thlm_api( t_all(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & rc_all(igrdcol,isubcol,k) ) - enddo ! k = 1, pver + end do ! k = 1, pver ! Add ghost points rt_all (igrdcol,isubcol,pverp) = rt_all (igrdcol,isubcol,pver) @@ -1601,15 +1876,15 @@ subroutine subcol_SILHS_var_covar_driver & thltend(igrdcol,isubcol,pverp) = thltend(igrdcol,isubcol,pver) ! Flip inputs to CLUBB's grid. Note the dimension ordering change. - rt_all_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pverp) ) - thl_all_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pverp) ) - w_all_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pverp) ) - qctend_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pverp) ) - qvtend_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pverp) ) - thltend_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pverp) ) + rt_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pverp) ) + thl_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pverp) ) + w_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pverp) ) + qctend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pverp) ) + qvtend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pverp) ) + thltend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pverp) ) - enddo ! isubcol = 1, nsubcol(igrdcol) - enddo ! igrdcol = 1, ngrdcol + end do ! isubcol = 1, nsubcol(igrdcol) + end do ! igrdcol = 1, ngrdcol ! Obtain weights call subcol_get_weight(lchnk, weights_packed) @@ -1623,16 +1898,22 @@ subroutine subcol_SILHS_var_covar_driver & ! It will have to change once the weights vary with altitude! ! I'm not sure whether the grid will need to be flipped. do k = 1, pverp-top_lev+1 - height_depndt_weights(igrdcol,k,1:ns) = weights(igrdcol,1:ns) + height_depndt_weights(igrdcol,1:ns,k) = weights(igrdcol,1:ns) end do + ! Copy the igrdcol column from the multicolumn pdf_params_chnk to the single column + ! version of pdf_params_single_col since lh_microphys_var_covar_driver_api only + ! works over 1 column currently + call copy_multi_pdf_params_to_single( pdf_params_chnk(lchnk), igrdcol, & + pdf_params_single_col ) + ! Make the call!!!!! call lh_microphys_var_covar_driver_api & - ( pverp-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:pverp-top_lev+1,1:ns), & - pdf_params_chnk(igrdcol,lchnk), & - rt_all_clubb(igrdcol,1:pverp-top_lev+1,1:ns), thl_all_clubb(igrdcol,1:pverp-top_lev+1,1:ns), & - w_all_clubb(igrdcol,1:pverp-top_lev+1,1:ns), qctend_clubb(igrdcol,1:pverp-top_lev+1,1:ns), & - qvtend_clubb(igrdcol,1:pverp-top_lev+1,1:ns), thltend_clubb(igrdcol,1:pverp-top_lev+1,1:ns), & + ( pverp-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:pverp-top_lev+1), & + pdf_params_single_col, & + rt_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thl_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & + w_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), qctend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & + qvtend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thltend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & silhs_config_flags%l_lh_instant_var_covar_src, & rtp2_mc_zt(igrdcol,1:pverp-top_lev+1), thlp2_mc_zt(igrdcol,1:pverp-top_lev+1), & wprtp_mc_zt(igrdcol,1:pverp-top_lev+1), wpthlp_mc_zt(igrdcol,1:pverp-top_lev+1), & @@ -1654,7 +1935,7 @@ subroutine subcol_SILHS_var_covar_driver & rtpthlp_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 endif ! pverp > pverp-top_lev+1 - enddo ! igrdcol = 1, ngrdcol + end do ! igrdcol = 1, ngrdcol #endif #endif @@ -1671,7 +1952,7 @@ real(r8) function meansc(arr_in, w_in, ns) result(val) val = 0 do i=1,ns acc = acc + arr_in(i)*w_in(i) - enddo + end do val = acc/ns end function @@ -1684,28 +1965,11 @@ real(r8) function stdsc(arr_in, w_in, mn_in, ns) result(val) accvar = 0 do i=1,ns accvar = accvar + ((arr_in(i)-mn_in)**2)*w_in(i) - enddo + end do var = accvar/ns val = sqrt(var) end function - subroutine Abs_Temp_profile(nz, LWPT_prof, ex_prof, rcm_prof, ABST_prof) - - use clubb_api_module, only : thlm2T_in_K_api - - integer, intent(in) :: nz ! Num vert levels - real(r8), dimension(nz), intent(in) :: LWPT_prof ! Temp prof in LWPT - real(r8), dimension(nz), intent(in) :: ex_prof ! Profile of Exner func - real(r8), dimension(nz), intent(in) :: rcm_prof ! Profile of Cld Wat MR - real(r8), dimension(nz), intent(out) :: ABST_prof ! Abs Temp prof - integer :: i - - do i=1,nz - ABST_prof(i) = thlm2T_in_K_api(LWPT_prof(i), ex_prof(i), rcm_prof(i)) - enddo - - end subroutine - subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) use clubb_api_module, only : T_in_K2thlm_api @@ -1719,24 +1983,10 @@ subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) do i=1,nz THL_prof(i) = T_in_K2thlm_api(ABST_prof(i), ex_prof(i), rcm_prof(i)) - enddo + end do end subroutine - subroutine StaticEng_profile(nz, ABST_prof, zm_prof, zsfc, s_prof) - integer, intent(in) :: nz - real(r8), dimension(nz), intent(in) :: ABST_prof - real(r8), dimension(nz), intent(in) :: zm_prof - real(r8), intent(in) :: zsfc - real(r8), dimension(nz), intent(out) :: s_prof - integer :: i - - do i=1,nz - s_prof(i) = cpair*(ABST_prof(i)) + gravit*zm_prof(i)+zsfc - enddo - - end subroutine - subroutine subcol_constrainmn( num_subcols, samples, weights, grid_mean, mean_sc, std_sc ) ! Input/Output Variables @@ -2153,24 +2403,24 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) + ptend%q(icol,k,ixcldliq) * dt & + state%q(icol,k,ixcldice) & + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then grand_total_water_column_start(icol) & = grand_total_water_column_start(icol) & + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif if ( ixsnow > 0 ) then grand_total_water_column_start(icol) & = grand_total_water_column_start(icol) & + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver grand_total_water_column_start(icol) & = grand_total_water_column_start(icol) & + prect(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate total energy in each column. ! This calculation is the vertically-integrated total energy in each @@ -2188,19 +2438,19 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + latice * ( state%q(icol,k,ixcldliq) & + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then total_energy_column_start(icol) & = total_energy_column_start(icol) & + latice * ( state%q(icol,k,ixrain) & + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver total_energy_column_start(icol) & = total_energy_column_start(icol) & + latice * precl(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol endif ! l_check_conservation @@ -2810,9 +3060,9 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) endif ! ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) - enddo ! k = top_lev, pver + end do ! k = top_lev, pver - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate the new overall tendencies by adding the sedimentation ! tendencies back onto the new microphysics process tendencies. @@ -2990,24 +3240,24 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) + ptend%q(icol,k,ixcldliq) * dt & + state%q(icol,k,ixcldice) & + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then grand_total_water_column_finish(icol) & = grand_total_water_column_finish(icol) & + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif if ( ixsnow > 0 ) then grand_total_water_column_finish(icol) & = grand_total_water_column_finish(icol) & + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver grand_total_water_column_finish(icol) & = grand_total_water_column_finish(icol) & + prect(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate total energy in each column. ! This calculation is the vertically-integrated total energy in each @@ -3026,19 +3276,19 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + latice * ( state%q(icol,k,ixcldliq) & + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then total_energy_column_finish(icol) & = total_energy_column_finish(icol) & + latice * ( state%q(icol,k,ixrain) & + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver total_energy_column_finish(icol) & = total_energy_column_finish(icol) & + latice * precl(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate the total relative error in each grid column. do icol = 1, ncol @@ -3055,7 +3305,7 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) / min( total_energy_column_finish(icol), & total_energy_column_start(icol) ) - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Print an error message if any total water relative error is found to ! be greater than the threshold. @@ -3070,7 +3320,7 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) "Column-integrated grand total water at finish = ", & grand_total_water_column_finish(icol) endif ! tot_water_rel_err(icol) >= err_thresh - enddo ! icol = 1, ncol + end do ! icol = 1, ncol endif ! any( tot_water_rel_err >= err_thresh ) ! Print an error message if any total energy relative error is found to @@ -3086,7 +3336,7 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) "Column-integrated total energy at finish = ", & total_energy_column_finish(icol) endif ! tot_energy_rel_err(icol) >= err_thresh - enddo ! icol = 1, ncol + end do ! icol = 1, ncol endif ! any( tot_energy_rel_err >= err_thresh ) endif ! l_check_conservation @@ -3224,7 +3474,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & else ! hm_curr < qmin_hm l_pos_hm(k) = .false. endif ! hm_curr >= qmin_hm - enddo ! k = top_lev, pver + end do ! k = top_lev, pver do k = pver, top_lev, -1 @@ -3236,7 +3486,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & ! to be filled. ! The value of the hydrometeor mixing ratio is negative, but ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) / gravit + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga ! Calculate the total hydrometeor mass available from below ! to fill the hole. @@ -3304,7 +3554,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & idx = idx + 1 endif ! idx == pver endif ! sum_pdel >= total_fall_Pa - enddo + end do ! Calculate the available amount of hydrometeor mass to ! fill the hole. @@ -3318,9 +3568,9 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & total_fill_mass & = total_fill_mass & + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm(idx) - enddo ! idx = k+1, pver, 1 + end do ! idx = k+1, pver, 1 ! Contribution to total fill mass from the surface. total_fill_mass & = total_fill_mass + prec(icol) * dt * 1000.0_r8 @@ -3332,7 +3582,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & total_fill_mass & = total_fill_mass & + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm(idx) if ( idx >= lowest_level_idx ) then ! Check if enough mass has been gathered in @@ -3369,7 +3619,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & ! increment and keep going. idx = idx + 1 endif ! idx >= lowest_level_idx - enddo + end do endif ! l_reached_surface endif ! k == pver @@ -3386,9 +3636,9 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & total_fill_mass & = total_fill_mass & + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm(idx) - enddo ! idx = top_lev, k-1, 1 + end do ! idx = top_lev, k-1, 1 endif ! total_fill_mass >= total_hole ! Calculate the ratio of total hole to total fill mass. This @@ -3411,7 +3661,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & + ( hm_curr(idx) - qmin_hm ) & * ( 1.0_r8 - hole_fillmass_ratio ) endif ! l_pos_hm(idx) - enddo ! idx = k+1, lowest_level_idx + end do ! idx = k+1, lowest_level_idx endif ! k < pver if ( l_reached_surface ) then @@ -3435,7 +3685,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & + ( hm_curr(idx) - qmin_hm ) & * ( 1.0_r8 - hole_fillmass_ratio ) endif ! l_pos_hm(idx) - enddo ! idx = top_lev, k-1 + end do ! idx = top_lev, k-1 endif ! l_fill_from_above ! Update the value of the hydrometeor at the level where the @@ -3449,14 +3699,14 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & endif ! .not. l_pos_hm(k) - enddo ! k = pver, top_lev, -1 + end do ! k = pver, top_lev, -1 endif ! any( hm_curr(top_lev:pver) < qmin_hm ) ! Update the value of total microphysics tendency after hole filling. hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt - enddo ! icol = 1, ncol + end do ! icol = 1, ncol return @@ -3617,7 +3867,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & else ! hm_curr_filler < qmin_hm_filler l_pos_hm_filler(k) = .false. endif ! hm_curr_filler >= qmin_hm_filler - enddo ! k = top_lev, pver + end do ! k = top_lev, pver do k = top_lev, pver @@ -3629,7 +3879,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & ! to be filled. ! The value of the hydrometeor mixing ratio is negative, but ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) / gravit + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga ! Calculate the total hydrometeor mass available from the ! filler hydrometeor to fill the hole. @@ -3639,9 +3889,9 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & total_fill_mass & = total_fill_mass & + ( hm_curr_filler(idx) - qmin_hm_filler ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm_filler(idx) - enddo ! idx = top_lev, pver, 1 + end do ! idx = top_lev, pver, 1 ! Calculate the ratio of total hole to total fill mass. This ! should not exceed 1 except as a result of numerical round-off @@ -3661,7 +3911,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & + ( hm_curr_filler(idx) - qmin_hm_filler ) & * ( 1.0_r8 - hole_fillmass_ratio ) endif ! l_pos_hm_filler(idx) - enddo ! idx = top_lev, pver + end do ! idx = top_lev, pver ! Update the value of the hydrometeor at the level where the ! hole was found. Mathematically, as long as the available @@ -3674,7 +3924,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & endif ! .not. l_pos_hm(k) - enddo ! k = top_lev, pver + end do ! k = top_lev, pver endif ! any( hm_curr(top_lev:pver) < qmin_hm ) @@ -3686,7 +3936,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & hm_tend_filler(icol,:) & = hm_tend_filler(icol,:) + ( hm_curr_filler - hm_update_filler ) / dt - enddo ! icol = 1, ncol + end do ! icol = 1, ncol return @@ -3867,9 +4117,9 @@ subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) endif ! ixsnow > 0 .and. ixnumsnow > 0 - enddo ! k = top_lev, pver + end do ! k = top_lev, pver - enddo ! icol = 1, ncol + end do ! icol = 1, ncol return @@ -3877,5 +4127,27 @@ subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) end subroutine subcol_SILHS_hydromet_conc_tend_lim !============================================================================ + + ! Getunit and Freeunit are depreciated in Fortran going forward, so this is a + ! small function to get an unused stream identifier to send to setup_corr_varnce_array_api + ! or any other silhs/clubb functions that require a unit number argument + ! This comes directly from the Fortran wiki + integer function getnewunit(unit) + integer, intent(out), optional :: unit + + integer, parameter :: LUN_MIN=10, LUN_MAX=1000 + logical :: opened + integer :: lun, newunit + + newunit=-1 + do lun=LUN_MIN,LUN_MAX + inquire(unit=lun,opened=opened) + if (.not. opened) then + newunit=lun + exit + end if + end do + if (present(unit)) unit=newunit + end function getnewunit end module subcol_SILHS diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 91d4ad46f3..078a780372 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -1328,7 +1328,7 @@ subroutine tphysac (ztodt, cam_in, & use clubb_intr, only: clubb_tend_cam use subcol, only: subcol_gen, subcol_ptend_avg use subcol_utils, only: subcol_ptend_copy, is_subcol_on - use subcol_SILHS, only: subcol_SILHS_var_covar_driver + use subcol_SILHS, only: subcol_SILHS_var_covar_driver, init_state_subcol use subcol_SILHS, only: subcol_SILHS_fill_holes_conserv use subcol_SILHS, only: subcol_SILHS_hydromet_conc_tend_lim use micro_pumas_cam, only: massless_droplet_destroyer @@ -1674,12 +1674,17 @@ subroutine tphysac (ztodt, cam_in, & ! Calculate cloud microphysics !=================================================== + if (is_subcol_on() .neqv. use_subcol_microp ) then + call endrun("Error calculating cloud microphysics: is_subcol_on() != use_subcol_microp") + end if + if (is_subcol_on()) then ! Allocate sub-column structures. call physics_state_alloc(state_sc, lchnk, psubcols*pcols) call physics_tend_alloc(tend_sc, psubcols*pcols) ! Generate sub-columns using the requested scheme + if (trim(subcol_scheme) == 'SILHS') call init_state_subcol(state, tend, state_sc, tend_sc) call subcol_gen(state, tend, state_sc, tend_sc, pbuf) !Initialize check energy for subcolumns