From 6a8a71ff9ab1261a53d964ded4b1120fe1fbd0a8 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 9 Jun 2026 09:08:01 -0600 Subject: [PATCH 01/63] roundoff merge of clubb-mf, loss of precision comes from order of operations on several variables with latest clubb interface and externals. --- bld/build-namelist | 30 +- bld/namelist_files/namelist_defaults_cam.xml | 31 +- bld/namelist_files/namelist_definition.xml | 149 + src/physics/cam/clubb_intr.F90 | 1326 +++++- src/physics/cam/clubb_mf.F90 | 3893 +++++++++++++++--- 5 files changed, 4614 insertions(+), 815 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index d23e72cfc9..f64f34c446 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3685,15 +3685,39 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_wpxp_Ri_exp'); add_default($nl, 'clubb_z_displace'); + #Turn on HB scheme where CLUBB not active + add_default($nl, 'do_hb_above_clubb'); + #CLUBB+MF options add_default($nl, 'do_clubb_mf'); add_default($nl, 'do_clubb_mf_diag'); + add_default($nl, 'do_clubb_mf_rad'); + add_default($nl, 'do_clubb_mf_precip'); + add_default($nl, 'do_clubb_mf_addtke'); add_default($nl, 'clubb_mf_L0'); add_default($nl, 'clubb_mf_ent0'); + add_default($nl, 'clubb_mf_alphturb'); + add_default($nl, 'clubb_mf_Lopt'); + add_default($nl, 'clubb_mf_a0'); + add_default($nl, 'clubb_mf_b0'); add_default($nl, 'clubb_mf_nup'); - - #Turn on HB scheme where CLUBB not active - add_default($nl, 'do_hb_above_clubb'); + add_default($nl, 'clubb_mf_max_L0'); + add_default($nl, 'clubb_mf_fdd'); + add_default($nl, 'do_clubb_mf_coldpool'); + add_default($nl, 'clubb_mf_ddalph'); + add_default($nl, 'clubb_mf_ddbeta'); + add_default($nl, 'clubb_mf_pwfac'); + add_default($nl, 'clubb_mf_ddexp'); + add_default($nl, 'do_clubb_mf_ustar'); + add_default($nl, 'do_clubb_mf_mixd'); + add_default($nl, 'clubb_mf_up_ndt'); + add_default($nl, 'clubb_mf_cp_ndt'); + add_default($nl, 'do_clubb_mf_rhtke'); + add_default($nl, 'do_clubb_mf_cmt'); + add_default($nl, 'clubb_mf_kseed'); + add_default($nl, 'do_clubb_mf_lscale_perplume'); + add_default($nl, 'do_clubb_mf_coldpool_perplume'); + add_default($nl, 'do_clubb_mf_coldpool_init'); } # Tuning for wet scavenging of modal aerosols diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 16bb399518..743bbffe02 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2354,9 +2354,35 @@ .false. .false. + .false. + .false. + .false. 50.0 - 0.22 + 0.22 + 0.0 + 0 + 2.0 + 0.5 10 + 10.e3 + 0.0 + .false + 2.e2 + 1.0 + 1.0 + 3.0 + 1.0 + .false. + .false. + 1 + 1 + .false. + .false. + .false. + .false. + .false. + 1 + .false. 10 @@ -2469,6 +2495,9 @@ 1 2 1 + + 6 + 6 1.0D0 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 284e89793a..ffc39ac1e8 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4446,6 +4446,24 @@ If .true. add detailed budget terms to output by default. Note that do_clubb_mf Default: .false. + +If .true. turn on Suselj et al 2019 microphysics. +Default: .false. + + + +If .true. couple MF plumes to radiation +Default: .false. + + + +If .true. add MF contribution to TKE pbuf variable +Default: .false. + + Entrainment length scale in meters for individual plumes. Not used if @@ -4453,6 +4471,24 @@ do_clubb_mf=FALSE. Default: 50.0 + +Integer: dynamic entrainment length scale option +Default: 0 + + + +Real: linear coefficient relating ztop/cape to entrainment length scale +Default: 2.0 + + + +Real: expoential coefficient relating ztop/cape to entrainment length scale +Default: 0.5 + + Entrainment efficiency for individual plumes. Not used if @@ -4460,12 +4496,125 @@ do_clubb_mf=FALSE. Default: 0.22 + +Weighting factor for CLUBB TKE on plume entrainment +Default: 0.0 + Real: number of plumes in mass flux ensemble Default: 10 + +Real: limiter on entrainmnet length scale + threshold to diable TKE enhanced entrainmnet +Default: 10.e3 + + + +Fraction of autoconversion partitioned to downdrafts (zero means no downdrafts) +Default: 0.0 + + +If .true. turn on cold pool feedback parameterizations +Default: .false. + + + +Linear enhancement factor to the downdrafts used for the cold pool calculations +Default: 200.0 + + +Exponent enhancement factor to the downdrafts used for the cold pool calculations +Default: 1.0 + + +Enhancement factor for the near surface pressure drag term in downdraft equation +Default: 1.0 + + +Elevation power law exponent for downdrafts velocities in the subcloud layer +Default: 3.0 + + +Factor to increase the ensemble MF plume cloud fractions +Default: 1.0 + + +If .true. use ustar for initializing the plume ensemble +Default: .false. + + + +If .true. use clubbmf mixing depth in place of the PBLH pbuf var +Default: .false. + + + +Real: number of time-steps for running average of the convective height scale +Default: 1 + + + +Real: number of time-steps for running average of cold pool effects +Default: 1 + + + +If .true. use relative humidity thresholds to turn off TKE enhanced entrainment +Default: .false. + + + +If .true. turn on convective momentum transport +Default: .false. + + + +If .true. set unique entrainment length scale for each plume member +Default: .false. + + + +If .true. let cold pool feedback impact plume intialization +Default: .false. + + + +If .true. set cold pool feedback to unique to each plume member +Default: .false. + + + +Real: level position of state used to seed the random number generator +Default: 1 + + + +If .true. turn on elevated convective initiliazation +Default: .false. + + shr_kind_r8 use ppgrid, only: pver, pverp, pcols, begchunk, endchunk use phys_control, only: phys_getopts - use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi, rair, omega + use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi, rair, omega, rhoh2o use air_composition, only: rairv, cpairv - use cam_history_support, only: max_fieldname_len + use cam_history_support, only: max_fieldname_len, fillvalue - use spmd_utils, only: masterproc + use spmd_utils, only: masterproc, iam use constituents, only: pcnst, cnst_add, cnst_ndropmixed use atmos_phys_pbl_utils,only: calc_friction_velocity, calc_kinematic_heat_flux, calc_ideal_gas_rrho, & calc_kinematic_water_vapor_flux, calc_kinematic_buoyancy_flux, calc_obukhov_length @@ -38,7 +38,10 @@ module clubb_intr hm_metadata_type, sclr_idx_type, & nparams - use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag + use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag, clubb_mf_nup, do_clubb_mf_rad, clubb_mf_Lopt, & + clubb_mf_ddalph, clubb_mf_up_ndt, clubb_mf_cp_ndt, do_clubb_mf_cmt, do_clubb_mf_addtke, & + clubb_mf_cldfrac_fac + use cam_history_support, only: add_hist_coord use cloud_fraction, only: dp1, dp2 #endif @@ -57,7 +60,7 @@ module clubb_intr clubb_readnl, clubb_init_cnst, clubb_implements_cnst #ifdef CLUBB_SGS - + ! NOTE: the only reason for anything in this section being set to public is for use with SILHS public :: stats_init_clubb, stats_end_timestep_clubb @@ -141,7 +144,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] @@ -162,11 +165,11 @@ module clubb_intr clubb_l_intr_sfc_flux_smooth = .false. ! Add a locally calculated roughness to upwp and vpwp sfc fluxes logical :: & - clubb_l_ascending_grid = .false. ! Run clubb in ascending mode, which is opposite of the + clubb_l_ascending_grid = .false. ! Run clubb in ascending mode, which is opposite of the ! cam grid the rest of this code uses, thus it requires ! an expensive array flipping step before calling advance_clubb_core. ! This is mainly for testing, it should not significantly change answers - + logical :: lq(pcnst) logical :: do_rainturb logical :: clubb_do_adv @@ -278,7 +281,7 @@ module clubb_intr clubb_grid_adapt_in_time_method = unset_i, & ! Specifier for how the grid density method should ! be constructed if the grid should be adapted over time ! (set to 0 for no adaptation) - clubb_fill_holes_type = unset_i ! Option for which type of hole filler to use in the + clubb_fill_holes_type = unset_i ! Option for which type of hole filler to use in the ! fill_holes_vertical procedure @@ -427,9 +430,13 @@ module clubb_intr vpwp_idx, & ! north-south momentum flux wpthvp_idx, & ! buoyancy flux wp2thvp_idx, & ! second order buoyancy term + thlm_idx, & ! mean thetal + um_idx, & ! mean of east-west wind + vm_idx, & ! mean of north-south wind wp2up_idx, & ! w'^2 u' wp2up_idx, & ! w'^2 u' 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' > @@ -440,6 +447,7 @@ module clubb_intr 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 ast_idx, & ! Stratiform cloud fraction @@ -453,6 +461,7 @@ module clubb_intr pblh_idx, & ! PBL pbuf icwmrdp_idx, & ! In cloud mixing ratio for deep convection tke_idx, & ! turbulent kinetic energy + icwmrsh_idx, & ! In cloud mixing ratio for shallow convection (MF) tpert_idx, & ! temperature perturbation from PBL fice_idx, & ! fice_idx index in physics buffer cmeliq_idx, & ! cmeliq_idx index in physics buffer @@ -461,8 +470,10 @@ module clubb_intr naai_idx, & ! ice number concentration prer_evap_idx, & ! rain evaporation rate qrl_idx, & ! longwave cooling rate + radf_idx, & qsatfac_idx, & ! subgrid cloud water saturation scaling factor ice_supersat_idx, & ! ice cloud fraction for SILHS + ztodt_idx,& ! physics timestep for SILHS clubbtop_idx ! level index for CLUBB top ! For Gravity Wave code @@ -487,7 +498,7 @@ module clubb_intr rtpthlp_mc_zt_idx ! added pbuf fields for clubb to have restart bfb when ipdf_call_placement=2 - integer :: & + integer :: & pdf_zm_w_1_idx, & pdf_zm_w_2_idx, & pdf_zm_varnce_w_1_idx, & @@ -497,6 +508,29 @@ module clubb_intr integer :: & cmfmc_sh_idx = 0 + integer :: & + rcm_macmic_idx, & + cldfrac_macmic_idx, & + wpthlp_macmic_idx, & + wprtp_macmic_idx, & + wpthvp_macmic_idx, & + mf_wpthlp_macmic_idx, & + mf_wprtp_macmic_idx, & + mf_wpthvp_macmic_idx + + integer :: & + prec_sh_idx, & + snow_sh_idx + + integer :: ztopmn_idx + integer :: ztopma_idx + integer :: ztopm1_macmic_idx + integer :: ddcp_idx + integer :: ddcp_macmic_idx + integer :: ddcpmn_idx + integer :: cbm1_idx + integer :: cbm1_macmic_idx + contains ! =============================================================================== ! @@ -521,12 +555,15 @@ subroutine clubb_register_cam( ) use physics_buffer, only: pbuf_add_field, dtype_r8, dtype_i4, dyn_time_lvls use subcol_utils, only: subcol_get_scheme + integer :: cld_macmic_num_steps + !----- Begin Code ----- call phys_getopts( eddy_scheme_out = eddy_scheme, & deep_scheme_out = deep_scheme, & history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num, & - do_hb_above_clubb_out = do_hb_above_clubb) + do_hb_above_clubb_out = do_hb_above_clubb, & + cld_macmic_num_steps_out = cld_macmic_num_steps) subcol_scheme = subcol_get_scheme() @@ -546,7 +583,7 @@ subroutine clubb_register_cam( ) call cnst_add(trim(cnst_names(8)),0._r8,0._r8,0._r8,ixup2,longname='CLUBB 2nd moment u wind',cam_outfld=.false.) call cnst_add(trim(cnst_names(9)),0._r8,0._r8,0._r8,ixvp2,longname='CLUBB 2nd moment v wind',cam_outfld=.false.) end if - + ! Determine number of vertical levels used in clubb, thermo variables are nzt_clubb ! and momentum variables are nzm_clubb nzt_clubb = pver + 1 - top_lev @@ -568,9 +605,10 @@ subroutine clubb_register_cam( ) call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx) call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx) - call pbuf_add_field('FICE', 'physpkg',dtype_r8, (/pcols,pver/), fice_idx) - call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx) - call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx) + call pbuf_add_field('FICE', 'global', dtype_r8, (/pcols,pver/), fice_idx) + call pbuf_add_field('RAD_CLUBB', 'global', dtype_r8, (/pcols,pver/), radf_idx) + call pbuf_add_field('CMELIQ', 'global', dtype_r8, (/pcols,pver/), cmeliq_idx) + call pbuf_add_field('QSATFAC', 'global', dtype_r8, (/pcols,pver/), qsatfac_idx) ! pbuf fields for Gravity Wave scheme call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver /), ttend_clubb_idx ) @@ -602,6 +640,8 @@ subroutine clubb_register_cam( ) call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,nzm_clubb/), vprcp_idx) call pbuf_add_field('RC_COEF_ZM', 'global', dtype_r8, (/pcols,nzm_clubb/), rc_coef_zm_idx) call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,nzm_clubb/), wp4_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wpvp2_idx) call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2up2_idx) call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2vp2_idx) @@ -639,6 +679,33 @@ subroutine clubb_register_cam( ) ! Only in clubb_intr.F90 or SILHS call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), ice_supersat_idx) + call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) + call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), cloud_frac_idx) + + ! these extrra coord vars don't seem to work for interpolate_output=.true. + call add_hist_coord('ncyc', cld_macmic_num_steps, 'macro/micro cycle index') + call add_hist_coord('nens', clubb_mf_nup, 'clubb+mf ensemble size') + + call pbuf_add_field('RCM_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), rcm_macmic_idx) + call pbuf_add_field('CLDFRAC_CLUBB_macmic','physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), cldfrac_macmic_idx) + call pbuf_add_field('WPTHLP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthlp_macmic_idx) + call pbuf_add_field('WPRTP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) + call pbuf_add_field('WPTHVP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) + + if (do_clubb_mf) then + call pbuf_add_field('edmf_thlflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthlp_macmic_idx) + call pbuf_add_field('edmf_qtflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wprtp_macmic_idx) + call pbuf_add_field('edmf_thvflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthvp_macmic_idx) + call pbuf_add_field('ZTOPMN' ,'global' , dtype_r8, (/clubb_mf_up_ndt,pcols,clubb_mf_nup/), ztopmn_idx) + call pbuf_add_field('ZTOPMA' ,'global' , dtype_r8, (/pcols,clubb_mf_nup/), ztopma_idx) + call pbuf_add_field('ZTOP_MACMIC' ,'physpkg', dtype_r8, (/pcols,clubb_mf_nup/), ztopm1_macmic_idx) + call pbuf_add_field('DDCP' ,'global' , dtype_r8, (/pcols,clubb_mf_nup/), ddcp_idx) + call pbuf_add_field('DDCP_MACMIC' ,'physpkg', dtype_r8, (/pcols,clubb_mf_nup/), ddcp_macmic_idx) + call pbuf_add_field('DDCPMN' ,'global' , dtype_r8, (/clubb_mf_cp_ndt,pcols,clubb_mf_nup/), ddcpmn_idx) + call pbuf_add_field('CBM1' ,'global' , dtype_r8, (/pcols/), cbm1_idx) + call pbuf_add_field('CBM1_MACMIC' ,'physpkg', dtype_r8, (/pcols/), cbm1_macmic_idx) + end if + #endif end subroutine clubb_register_cam @@ -1363,73 +1430,73 @@ subroutine clubb_readnl(nlfile) 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_penta_solve_method, & ! In - clubb_tridiag_solve_method, & ! In - clubb_saturation_equation, & ! In - clubb_grid_remap_method, & ! In - clubb_grid_adapt_in_time_method, & ! In - clubb_fill_holes_type, & ! In - clubb_l_use_precip_frac, & ! In - clubb_l_predict_upwp_vpwp, & ! In + call initialize_clubb_config_flags_type_api( clubb_iiPDF_type, & ! In + clubb_ipdf_call_placement, & ! In + clubb_penta_solve_method, & ! In + clubb_tridiag_solve_method, & ! In + clubb_saturation_equation, & ! In + clubb_grid_remap_method, & ! In + clubb_grid_adapt_in_time_method, & ! In + clubb_fill_holes_type, & ! In + clubb_l_use_precip_frac, & ! In + clubb_l_predict_upwp_vpwp, & ! In clubb_l_ho_nontrad_coriolis, & ! In - clubb_l_ho_trad_coriolis, & ! 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_use_wp3_lim_with_smth_Heaviside, & ! In - clubb_l_smooth_Heaviside_tau_wpxp, & ! In - clubb_l_modify_limiters_for_cnvg_test, & ! In - clubb_l_enable_relaxed_clipping, & ! In - clubb_l_linearize_pbl_winds, & ! In - clubb_l_mono_flux_lim_thlm, & ! In - clubb_l_mono_flux_lim_rtm, & ! In - clubb_l_mono_flux_lim_um, & ! In - clubb_l_mono_flux_lim_vm, & ! In - clubb_l_mono_flux_lim_spikefix, & ! In - clubb_l_host_applies_sfc_fluxes, & ! In - clubb_l_wp2_fill_holes_tke, & ! In - clubb_l_add_dycore_grid, & ! In + clubb_l_ho_trad_coriolis, & ! 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_use_wp3_lim_with_smth_Heaviside, & ! In + clubb_l_smooth_Heaviside_tau_wpxp, & ! In + clubb_l_modify_limiters_for_cnvg_test, & ! In + clubb_l_enable_relaxed_clipping, & ! In + clubb_l_linearize_pbl_winds, & ! In + clubb_l_mono_flux_lim_thlm, & ! In + clubb_l_mono_flux_lim_rtm, & ! In + clubb_l_mono_flux_lim_um, & ! In + clubb_l_mono_flux_lim_vm, & ! In + clubb_l_mono_flux_lim_spikefix, & ! In + clubb_l_host_applies_sfc_fluxes, & ! In + clubb_l_wp2_fill_holes_tke, & ! In + clubb_l_add_dycore_grid, & ! In clubb_config_flags ) ! Out #endif @@ -1511,9 +1578,11 @@ subroutine clubb_ini_cam(pbuf_ini) ! The similar name to clubb_history is unfortunate... logical :: history_amwg, history_clubb + integer :: cld_macmic_num_steps + type(err_info_type) :: & err_info ! err_info struct used in CLUBB containing err_code and err_header - + integer :: i, j, k, l ! Indices integer :: nmodes, nspec, m integer :: ixq, ixcldice, ixcldliq, ixnumliq, ixnumice @@ -1570,7 +1639,8 @@ subroutine clubb_ini_cam(pbuf_ini) call phys_getopts(history_amwg_out=history_amwg, & history_clubb_out=history_clubb, & - do_hb_above_clubb_out=do_hb_above_clubb) + do_hb_above_clubb_out=do_hb_above_clubb, & + cld_macmic_num_steps_out=cld_macmic_num_steps) ! Select variables to apply tendencies back to CAM @@ -1623,6 +1693,7 @@ subroutine clubb_ini_cam(pbuf_ini) qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio + icwmrsh_idx = pbuf_get_index('ICWMRSH') ! In-cloud shallow convective mixing ratio (EDMF) sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance prer_evap_idx = pbuf_get_index('PRER_EVAP') @@ -1631,6 +1702,10 @@ subroutine clubb_ini_cam(pbuf_ini) naai_idx = pbuf_get_index('NAAI') npccn_idx = pbuf_get_index('NPCCN') + ! CLUBB+MF + prec_sh_idx = pbuf_get_index('PREC_SH') + snow_sh_idx = pbuf_get_index('SNOW_SH') + ! Scalars aren't in use, set all indices to -1 sclr_idx%iisclr_rt = -1 sclr_idx%iisclr_thl = -1 @@ -1819,6 +1894,8 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ('ELEAK_CLUBB', horiz_only, 'A', 'W/m2', 'CLUBB energy leak', sampled_on_subcycle=.true.) call addfld ('TFIX_CLUBB', horiz_only, 'A', 'K', 'Temperature increment to conserve energy', sampled_on_subcycle=.true.) + call addfld ('TKE_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'CLUBB tke on interface levels', sampled_on_subcycle=.true.) + ! ---------------------------------------------------------------------------- ! ! Below are for detailed analysis of EDMF Scheme ! ! ---------------------------------------------------------------------------- ! @@ -1836,14 +1913,74 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_DRY_V' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft meridional velocity (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_MOIST_V' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft meridional velocity (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_MOIST_QC' , (/ 'ilev' /), 'A', 'kg/kg' , 'Moist updraft condensate mixing ratio (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_precc' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft precipitation rate (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_S_AE' , (/ 'ilev' /), 'A', 'fraction', '1 minus sum of a_i*w_i (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_S_AW' , (/ 'ilev' /), 'A', 'm/s' , 'Sum of a_i*w_i (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AWW' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*w_i (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_S_AWTHL' , (/ 'ilev' /), 'A', 'K m/s' , 'Sum of a_i*w_i*thl_i (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_S_AWQT' , (/ 'ilev' /), 'A', 'kgm/kgs' , 'Sum of a_i*w_i*q_ti (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AWTH' , (/ 'ilev' /), 'A', 'K m/s' , 'Sum of a_i*w_i*th_i (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_S_AWQV' , (/ 'ilev' /), 'A', 'kgm/kgs' , 'Sum of a_i*w_i*q_vi (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_S_AWU' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*u_i (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_S_AWV' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*v_i (EDMF)', sampled_on_subcycle=.true.) - call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'W/m2' , 'thl flux (EDMF)', sampled_on_subcycle=.true.) - call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'W/m2' , 'qt flux (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_thlforcup', (/ 'lev' /), 'A', 'K/s' , 'thl updraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtforcup' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt updraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlforcdn', (/ 'lev' /), 'A', 'K/s' , 'thl downdraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtforcdn' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt downdraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlforc' , (/ 'lev' /), 'A', 'K/s' , 'thl forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtforc' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflxup' , (/ 'ilev' /), 'A', 'K m/s' , 'thl updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflxup' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflxdn' , (/ 'ilev' /), 'A', 'K m/s' , 'thl downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflxdn' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'K m/s' , 'thl flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thvflx' , (/ 'ilev' /), 'A', 'K m/s' , 'thv flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_uflxup' , (/ 'ilev' /), 'A', 'm2/s2' , 'u updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_vflxup' , (/ 'ilev' /), 'A', 'm2/s2' , 'v updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_uflxdn' , (/ 'ilev' /), 'A', 'm2/s2' , 'u downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_vflxdn' , (/ 'ilev' /), 'A', 'm2/s2' , 'v downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_uflx' , (/ 'ilev' /), 'A', 'm2/s2' , 'u flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_vflx' , (/ 'ilev' /), 'A', 'm2/s2' , 'v flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_sqtup' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Plume updraft microphysics tendency (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_sqtdn' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Plume downdraft microphysics tendency (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_rcm' , (/ 'ilev' /), 'A', 'kg/kg' , 'grid mean cloud (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_cloudfrac', (/ 'lev' /), 'A', 'fraction', 'grid mean cloud fraction (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_ent' , (/ 'lev' /), 'A', '1/m' , 'ensemble mean entrainment (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_ztop' , horiz_only, 'A', 'm' , 'edmf ztop', flag_xyfill=.True., sampled_on_subcycle=.true.) + call addfld ( 'edmf_ddcp' , horiz_only, 'A', 'm/s' , 'edmf ddcp', flag_xyfill=.True., sampled_on_subcycle=.true.) + call addfld ( 'edmf_L0' , horiz_only, 'A', 'm' , 'edmf dynamic L0', flag_xyfill=.True., sampled_on_subcycle=.true.) + call addfld ( 'edmf_freq' , horiz_only, 'A', 'unitless', 'edmf frequency mf is active', flag_xyfill=.True., sampled_on_subcycle=.true.) + call addfld ( 'edmf_cfl' , horiz_only, 'A', 'unitless', 'max flux cfl number (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_cape' , horiz_only, 'A', 'J/kg' , 'ensemble mean CAPE (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upa' , (/ 'ilev', 'nens' /), 'A', 'fraction', 'Plume updraft area fraction (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upw' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume updraft vertical velocity (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upmf' , (/ 'ilev', 'nens' /), 'A', 'kg/m2/s' , 'Plume updraft mass flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upqt' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume updraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upthl' , (/ 'ilev', 'nens' /), 'A', 'K' , 'Plume updraft liquid potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upthv' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume updraft virtual potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upth' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume updraft potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upqc' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume updraft condensate mixing ratio (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upent' , (/ 'ilev', 'nens' /), 'A', '1/m' , 'Plume updraft entrainment rate (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_updet' , (/ 'ilev', 'nens' /), 'A', '1/m' , 'Plume updraft dettrainment rate (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upbuoy' , (/ 'ilev', 'nens' /), 'A', 'm/s2' , 'Plume updraft buoyancy (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_dnw' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume downdraft vertical velocity (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_dnthl' , (/ 'ilev', 'nens' /), 'A', 'K' , 'Plume downdraft liquid potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_dnqt' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume downdraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true. ) + end if + + call addfld ('RCM_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'kg/kg' , 'RCM CLUBB at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('CLDFRAC_CLUBB_macmic', (/ 'ilev', 'ncyc' /), 'A', 'fraction', 'CLDFRAC CLUBB at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('WPTHLP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Heat Flux at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('WPRTP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Moisture Flux at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('WPTHVP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Buoyancy Flux at macro/micro substep', sampled_on_subcycle=.true.) + + if (do_clubb_mf) then + call addfld( 'PRECSH', horiz_only, 'A', 'm/s', 'Shallow Convection precipitation rate' ) + call addfld( 'SNOWSH', horiz_only, 'A', 'm/s', 'CLUBB-MF Snow precipitation rate' ) + call addfld ( 'edmf_thlflx_macmic', (/ 'ilev', 'ncyc' /), 'A', 'K m/s' , 'thl flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thvflx_macmic', (/ 'ilev', 'ncyc' /), 'A', 'K m/s' , 'thv flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflx_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'kg/kg m/s' , 'qt flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) end if if ( trim(subcol_scheme) /= 'SILHS' ) then @@ -1934,6 +2071,8 @@ subroutine clubb_ini_cam(pbuf_ini) end if if (do_clubb_mf_diag) then + call add_default('PRECSH', 1, ' ') + call add_default('SNOWSH', 1, ' ') call add_default( 'edmf_DRY_A' , 1, ' ') call add_default( 'edmf_MOIST_A' , 1, ' ') call add_default( 'edmf_DRY_W' , 1, ' ') @@ -1947,14 +2086,51 @@ subroutine clubb_ini_cam(pbuf_ini) call add_default( 'edmf_DRY_V' , 1, ' ') call add_default( 'edmf_MOIST_V' , 1, ' ') call add_default( 'edmf_MOIST_QC' , 1, ' ') + call add_default( 'edmf_precc' , 1, ' ') call add_default( 'edmf_S_AE' , 1, ' ') call add_default( 'edmf_S_AW' , 1, ' ') + call add_default( 'edmf_S_AWW' , 1, ' ') + call add_default( 'edmf_S_AWTH' , 1, ' ') call add_default( 'edmf_S_AWTHL' , 1, ' ') call add_default( 'edmf_S_AWQT' , 1, ' ') call add_default( 'edmf_S_AWU' , 1, ' ') call add_default( 'edmf_S_AWV' , 1, ' ') + call add_default( 'edmf_thlflxup' , 1, ' ') + call add_default( 'edmf_qtflxup' , 1, ' ') + call add_default( 'edmf_thlflxdn' , 1, ' ') + call add_default( 'edmf_qtflxdn' , 1, ' ') call add_default( 'edmf_thlflx' , 1, ' ') + call add_default( 'edmf_thvflx' , 1, ' ') + call add_default( 'edmf_uflxup' , 1, ' ') + call add_default( 'edmf_vflxup' , 1, ' ') + call add_default( 'edmf_uflxdn' , 1, ' ') + call add_default( 'edmf_vflxdn' , 1, ' ') + call add_default( 'edmf_uflx' , 1, ' ') + call add_default( 'edmf_vflx' , 1, ' ') call add_default( 'edmf_qtflx' , 1, ' ') + + call add_default( 'edmf_thlforcup', 1, ' ') + call add_default( 'edmf_qtforcup' , 1, ' ') + call add_default( 'edmf_thlforcdn', 1, ' ') + call add_default( 'edmf_qtforcdn' , 1, ' ') + + call add_default( 'edmf_thlforc' , 1, ' ') + call add_default( 'edmf_qtforc' , 1, ' ') + call add_default( 'edmf_sqtup' , 1, ' ') + call add_default( 'edmf_sqtdn' , 1, ' ') + call add_default( 'edmf_rcm' , 1, ' ') + call add_default( 'edmf_cloudfrac', 1, ' ') + call add_default( 'edmf_ent' , 1, ' ') + call add_default( 'edmf_ztop' , 1, ' ') + call add_default( 'edmf_ddcp' , 1, ' ') + call add_default( 'edmf_L0' , 1, ' ') + call add_default( 'edmf_freq' , 1, ' ') + call add_default( 'edmf_cape' , 1, ' ') + call add_default( 'edmf_cfl' , 1, ' ') + + call add_default( 'edmf_thlflx_macmic' , 1, ' ') + call add_default( 'edmf_qtflx_macmic' , 1, ' ') + call add_default( 'edmf_thvflx_macmic' , 1, ' ') end if if (history_budget) then @@ -2001,6 +2177,7 @@ subroutine clubb_ini_cam(pbuf_ini) call pbuf_set_field(pbuf_ini, thlpthvp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, tke_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, kvh_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, radf_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, wp2rtp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, wp2thlp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, uprcp_idx, 0.0_r8) @@ -2013,6 +2190,17 @@ subroutine clubb_ini_cam(pbuf_ini) call pbuf_set_field(pbuf_ini, wp2vp2_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, ice_supersat_idx, 0.0_r8) + if (do_clubb_mf) then + call pbuf_set_field(pbuf_ini, ztopmn_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ztopma_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ztopm1_macmic_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ddcp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ddcp_macmic_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ddcpmn_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, cbm1_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, cbm1_macmic_idx, 0.0_r8) + end if + ! Initialize SILHS covariance contributions call pbuf_set_field(pbuf_ini, rtp2_mc_zt_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, thlp2_mc_zt_idx, 0.0_r8) @@ -2086,6 +2274,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & use time_manager, only: get_nstep, is_first_restart_step use perf_mod, only: t_startf, t_stopf + use wv_saturation, only: qsat + use interpolate_data,only: vertinterp + #ifdef CLUBB_SGS use holtslag_boville_diff, only: hb_pbl_dependent_coefficients_run use spmd_utils, only: iam @@ -2112,6 +2303,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & init_pdf_params_api, & init_pdf_implicit_coefs_terms_api, & setup_grid_api, & + ic_K, & cleanup_grid_api, & iiPDF_new, & iiPDF_new_hybrid @@ -2194,12 +2386,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wp2thlp_pbuf ! w'^2 thl' (thermodynamic levels) real(r8), pointer, dimension(:,:) :: uprcp_pbuf ! < u' r_c' > (momentum levels) real(r8), pointer, dimension(:,:) :: vprcp_pbuf ! < v' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: rc_coef_pbuf ! Coef. of X'r_c' in Eq. (34) (t-levs.) real(r8), pointer, dimension(:,:) :: rc_coef_zm_pbuf ! Coef. of X'r_c' in Eq. (34) (t-levs.) real(r8), pointer, dimension(:,:) :: wp4_pbuf ! w'^4 (momentum levels real(r8), pointer, dimension(:,:) :: wpup2_pbuf ! w'u'^2 (thermodynamic levels) real(r8), pointer, dimension(:,:) :: wpvp2_pbuf ! w'v'^2 (thermodynamic levels) real(r8), pointer, dimension(:,:) :: wp2up2_pbuf ! w'^2 u'^2 (momentum levels) real(r8), pointer, dimension(:,:) :: wp2vp2_pbuf ! w'^2 v'^2 (momentum levels) + real(r8), pointer, dimension(:) :: ztodtptr_pbuf ! timestep to send to SILHS real(r8), pointer, dimension(:,:) :: cld_pbuf ! cloud fraction [fraction] real(r8), pointer, dimension(:,:) :: concld_pbuf ! convective cloud fraction [fraction] real(r8), pointer, dimension(:,:) :: ast_pbuf ! stratiform cloud fraction [fraction] @@ -2213,6 +2407,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:) :: pblh_pbuf ! planetary boundary layer height [m] real(r8), pointer, dimension(:,:) :: tke_pbuf ! turbulent kinetic energy [m^2/s^2] real(r8), pointer, dimension(:,:) :: dp_icwmr_pbuf ! deep convection in cloud mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: sh_icwmr_pbuf ! shallow convection (EDMF) in cloud mixing ratio [kg/kg] real(r8), pointer, dimension(:,:) :: ice_supersat_frac_pbuf ! Cloud fraction of ice clouds (pver)[fraction] real(r8), pointer, dimension(:,:) :: relvar_pbuf ! relative cloud water variance [-] real(r8), pointer, dimension(:,:) :: naai_pbuf @@ -2223,6 +2418,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: npccn_pbuf real(r8), pointer, dimension(:,:) :: prer_evap_pbuf real(r8), pointer, dimension(:,:) :: qrl_pbuf + real(r8), pointer, dimension(:,:) :: radf_clubb_pbuf ! SILHS covariance contributions real(r8), pointer, dimension(:,:) :: rtp2_mc_zt_pbuf @@ -2244,11 +2440,103 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw_mc_pbuf real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc_pbuf + ! CLUBB-MF pointers + real(r8),pointer :: prec_sh(:) ! total precipitation from MF + real(r8),pointer :: snow_sh(:) ! snow from MF + + real(r8), pointer :: ztopmn(:,:,:) + real(r8), pointer :: ztopma(:,:) + real(r8), pointer :: ztopm1_macmic(:,:) + real(r8), pointer :: ddcp(:,:) + real(r8), pointer :: ddcp_macmic(:,:) + real(r8), pointer :: ddcpmn(:,:,:) + + real(r8), pointer :: cbm1(:) + real(r8), pointer :: cbm1_macmic(:) + + real(r8), pointer :: rcm_macmic(:,:) + real(r8), pointer :: cldfrac_macmic(:,:) + real(r8), pointer :: wpthlp_macmic(:,:) + real(r8), pointer :: wprtp_macmic(:,:) + real(r8), pointer :: wpthvp_macmic(:,:) + real(r8), pointer :: mf_thlflx_macmic(:,:) + real(r8), pointer :: mf_qtflx_macmic(:,:) + real(r8), pointer :: mf_thvflx_macmic(:,:) + + ! + ! MF outputs to outfld + real(r8), dimension(pcols) :: mf_ztop_output, mf_L0_output, & + mf_cape_output, mf_cfl_output, & + mf_ddcp_output, mf_freq_output + + real(r8), dimension(pcols,pver) :: mf_thlforcup_output, mf_qtforcup_output, & ! thermodynamic grid + mf_thlforcdn_output, mf_qtforcdn_output, & ! thermodynamic grid + mf_thlforc_output, mf_qtforc_output, & ! thermodynamic grid + mf_ent_output, & ! thermodynamic grid + mf_sqtup_output, mf_sqtdn_output, & ! thermodynamic grid + mf_qc_output, mf_cloudfrac_output ! thermodynamic grid + + ! MF plume level outputs + real(r8), dimension(pcols,pverp,clubb_mf_nup) :: mf_upa_flip, & + mf_upw_flip, & + mf_upmf_flip, & + mf_upqt_flip, & + mf_upthl_flip, & + mf_upthv_flip, & + mf_upth_flip, & + mf_upqc_flip, & + mf_upbuoy_flip, & + mf_upent_flip, & + mf_updet_flip + ! MF plume level outputs to outfld + real(r8), dimension(pcols,pverp*clubb_mf_nup) :: mf_upa_output, & + mf_upw_output, & + mf_upmf_output, & + mf_upqt_output, & + mf_upthl_output, & + mf_upthv_output, & + mf_upth_output, & + mf_upqc_output, & + mf_upent_output, & + mf_updet_output, & + mf_upbuoy_output + ! MF plume level outputs + real(r8), dimension(pcols,pverp,clubb_mf_nup) :: mf_dnw_flip, & + mf_dnthl_flip, & + mf_dnqt_flip + + ! MF plume level outputs to outfld + real(r8), dimension(pcols,pverp*clubb_mf_nup) :: mf_dnw_output, & + mf_dnthl_output, & + mf_dnqt_output + + ! MF Plume + real(r8), pointer :: tpert(:) + + ! MF outputs to outfld + ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines + + real(r8), dimension(state%ncol,nzm_clubb,clubb_mf_nup) :: & + mf_upa, mf_dna, & + mf_upw, mf_dnw, & + mf_upmf, & + mf_upqt, mf_dnqt, & + mf_upthl, mf_dnthl, & + mf_upthv, mf_dnthv, & + mf_upth, mf_dnth, & + mf_upqc, mf_dnqc, & + mf_upbuoy, & + mf_updet, & + mf_upent + + real(r8), dimension(state%ncol,pverp,clubb_mf_nup) :: flip + real(r8), dimension(state%ncol,pverp) :: rho, wpthvp_diag + ! ---------------------------------------------------- ! ! Local Variables ! ! ---------------------------------------------------- ! - integer :: i !Must be delcared outside "CLUBB_SGS" ifdef for det_s and det_ice zero-ing loops + integer :: i,l !Must be delcared outside "CLUBB_SGS" ifdef for det_s and det_ice zero-ing loops #ifdef CLUBB_SGS @@ -2337,10 +2625,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & Lscale, & dz_g, & ! thickness of layer [m] invrs_dz_g, & ! Inverse of layer thickness [1/m] - - ! MF local thermodynamic vars - invrs_exner_zt,& ! thermodynamic grid - kappa_zt ! thermodynamic grid + invrs_exner_zt, & ! thermodynamic grid + kappa_zt, & ! thermodynamic grid + qc_zt, & ! thermodynamic grid + th_zt, & ! thermodynamic grid + qv_zt, & ! thermodynamic grid + mf_thlforcup, mf_qtforcup, & !variables that represents a forcing or a tendency ($d/dt$) + mf_thlforcdn, mf_qtforcdn, & !applied to a mean state variable (like $\theta_l$ or $q_t$) + mf_thlforcup_nadv,mf_qtforcup_nadv, & !fundamentally represents the volumetric change inside a cell. + mf_thlforcdn_nadv,mf_qtforcdn_nadv, & !All forcing variables belong strictly on the + mf_thlforc_nadv, mf_qtforc_nadv !thermodynamic grid (nzt_clubb). real(r8), dimension(state%ncol,nzm_clubb) :: & thlp2_rad, & @@ -2375,22 +2669,44 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_dry_u, mf_moist_u, & mf_dry_v, mf_moist_v, & mf_moist_qc, & - s_ae, s_aw, & + s_ae, s_ac, & + s_aup, s_adn, & + s_aw, & + s_awup, s_awdn, & + s_aww, & + s_awwup, s_awwdn, & + s_awthlup, s_awqtup, s_awuup, s_awvup, & + s_awthldn, s_awqtdn, s_awudn, s_awvdn, & s_awthl, s_awqt, & - s_awql, s_awqi, & s_awu, s_awv, & - mf_thlflx, mf_qtflx, & + mf_sqtup, mf_sthlup, & + mf_sqtdn, mf_sthldn, & + mf_sqt, mf_sthl, & + mf_precc, & + ! MF work arrays (of size NCOL) + + mf_thlflxup, mf_qtflxup, mf_uflxup, mf_vflxup, & + mf_thlflxdn, mf_qtflxdn, mf_uflxdn, mf_vflxdn, & + mf_thlflx, mf_qtflx, mf_uflx, mf_vflx, & + mf_thvflx, & + mf_qc, mf_cloudfrac, & + mf_qc_nadv, mf_cloudfrac_nadv, & + mf_qc_zt, mf_cloudfrac_zt, & + mf_rcm, mf_rcm_nadv, & + mf_ent_nadv, & ! MF local momentum vars rtm_zm, thlm_zm, & ! momentum grid + th_zm, qv_zm, & ! momentum grid + qc_zm, & ! momentum grid kappa_zm, p_in_Pa_zm, & ! momentum grid - invrs_exner_zm ! momentum grid - + invrs_exner_zm ! momentum grid + real(r8), dimension(state%ncol,nzt_clubb,sclr_dim) :: & sclrm_forcing, & ! Passive scalar forcing [{units vary}/s] sclrm, & ! Passive scalar mean (thermo. levels) [units vary] sclrp3 ! sclr'^3 (thermo. levels) [{units vary}^3] - + real(r8), dimension(state%ncol,nzm_clubb,sclr_dim) :: & sclrp2, & ! sclr'^2 (momentum levels) [{units vary}^2] sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] @@ -2439,10 +2755,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_dry_v_output, mf_moist_v_output, & mf_moist_qc_output, & s_ae_output, s_aw_output, & + s_awthlup_output, s_awqtup_output, s_awuup_output, s_awvup_output, & + s_awthldn_output, s_awqtdn_output, s_awudn_output, s_awvdn_output, & s_awthl_output, s_awqt_output, & - s_awql_output, s_awqi_output, & s_awu_output, s_awv_output, & - mf_thlflx_output, mf_qtflx_output + s_aww_output, & + mf_thlflxup_output,mf_qtflxup_output, mf_uflxup_output, mf_vflxup_output, & + mf_thlflxdn_output,mf_qtflxdn_output, mf_uflxdn_output, mf_vflxdn_output, & + mf_thlflx_output, mf_qtflx_output, mf_uflx_output, mf_vflx_output, & + mf_thvflx_output, & + mf_rcm_output, mf_precc_output ! Variables used for output (zt) real(r8), dimension(pcols,pver) :: & @@ -2460,7 +2782,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtp2_zt_output, & ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] wp3_output, & ! wp3 output [m^3/s^3] thl2_zt_output, & ! CLUBB Theta-l variance on thermo levs - wp2_zt_output, & + wp2_zt_output, & rcm_in_layer_output, & ! CLUBB in-cloud liquid water mixing ratio [kg/kg] pdfp_rtp2_output, & ! Calculated R-tot variance from pdf_params [kg^2/kg^2] wm_zt_output, & ! CLUBB mean W on thermo levs output [m/s] @@ -2520,7 +2842,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & latsub, & apply_const, & dl_rad, di_rad, dt_low, & - rrho_tmp, & + eps, & ! Variables below are needed to compute energy integrals for conservation te_a, se_a, ke_a, wv_a, wl_a, & te_b, se_b, ke_b, wv_b, wl_b @@ -2551,6 +2873,32 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #endif + ! CFL limiter vars + real(r8), parameter :: cflval = 1._r8 + integer :: trop_mf + real(r8) :: lambda + real(r8), dimension(state%ncol) :: cflfac, max_cfl, & + th_sfc, max_cfl_nadv + logical :: cfllim + + + real(r8), dimension(state%ncol) :: mf_precc_nadv, mf_snow_nadv,& + mf_cbm1, mf_cbm1_nadv, & + mf_freq_nadv + + real(r8), dimension(state%ncol,clubb_mf_nup) :: mf_ztop, mf_ztop_nadv, & + mf_ztopm1, mf_ztopm1_nadv, & + mf_L0, mf_L0_nadv, & + mf_ddcp, mf_ddcp_nadv, & + mf_cape, mf_cape_nadv + + real(r8), dimension(state%ncol,pver) :: esat, rh + real(r8), dimension(state%ncol,pver) :: mq, mqsat + real(r8), dimension(state%ncol) :: rhlev, rhinv + + real(r8) :: inv_rh2o ! To reduce the number of divisions in clubb_tend + + call t_startf('clubb_tend_cam') do i = 1, pcols @@ -2651,8 +2999,37 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, kvh_idx, khzm_pbuf) call pbuf_get_field(pbuf, pblh_idx, pblh_pbuf) call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr_pbuf) + call pbuf_get_field(pbuf, icwmrsh_idx, sh_icwmr_pbuf) call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh_pbuf) + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) + call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) + + call pbuf_get_field(pbuf, rcm_macmic_idx, rcm_macmic) + call pbuf_get_field(pbuf, cldfrac_macmic_idx, cldfrac_macmic) + call pbuf_get_field(pbuf, wpthlp_macmic_idx, wpthlp_macmic) + call pbuf_get_field(pbuf, wprtp_macmic_idx, wprtp_macmic) + call pbuf_get_field(pbuf, wpthvp_macmic_idx, wpthvp_macmic) + + if (do_clubb_mf) then + call pbuf_get_field(pbuf, mf_wpthlp_macmic_idx, mf_thlflx_macmic) + call pbuf_get_field(pbuf, mf_wprtp_macmic_idx, mf_qtflx_macmic) + call pbuf_get_field(pbuf, mf_wpthvp_macmic_idx, mf_thvflx_macmic) + call pbuf_get_field(pbuf, tpert_idx, tpert) + + call pbuf_get_field(pbuf, ztopmn_idx, ztopmn) + call pbuf_get_field(pbuf, ztopma_idx, ztopma) + call pbuf_get_field(pbuf, ztopm1_macmic_idx, ztopm1_macmic) + + call pbuf_get_field(pbuf, ddcp_idx, ddcp) + call pbuf_get_field(pbuf, ddcp_macmic_idx, ddcp_macmic) + call pbuf_get_field(pbuf, ddcpmn_idx, ddcpmn) + + call pbuf_get_field(pbuf, cbm1_idx, cbm1) + call pbuf_get_field(pbuf, cbm1_macmic_idx, cbm1_macmic) + + end if + ! SILHS covariance contributions call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt_pbuf) call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt_pbuf) @@ -2726,6 +3103,33 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Initialize err_info with parallelization and geographical info call init_err_info_api(ncol, lchnk, iam, state_loc%lat*rad2deg, state_loc%lon*rad2deg, err_info) + + if (do_clubb_mf) then + ! SVP + do k = 1, pver + call qsat(state_loc%t(1:ncol,k), state_loc%pmid(1:ncol,k), esat(1:ncol,k), rh(1:ncol,k), ncol) + end do + + rhlev(:ncol) = 0._r8 + if (clubb_mf_Lopt==7 .or. clubb_mf_Lopt==6) then + ! Interpolate RH to 500 hPa + rh(:ncol,:) = state%q(:ncol,:,1)/rh(:ncol,:) + call vertinterp(ncol, ncol, pver, state%pmid(:ncol,:), 50000._r8, rh, rhlev, & + extrapolate='Z', ln_interp=.true., ps=state%ps(:ncol), phis=state%phis(:ncol), tbot=state%t(:ncol,pver)) + else if (clubb_mf_Lopt==8) then + ! Mass of q, by layer and vertically integrated + mq(:ncol,:) = state%q(:ncol,:,1) * state%pdel(:ncol,:) * rga + mqsat(:ncol,:) = rh(:ncol,:) * state%pdel(:ncol,:) * rga + do k=2,pver + mq(:ncol,1) = mq(:ncol,1) + mq(:ncol,k) + mqsat(:ncol,1) = mqsat(:ncol,1) + mqsat(:ncol,k) + end do + rhlev(:ncol) = mq(:ncol,1)/mqsat(:ncol,1) + end if + ! + end if + + !--------------------- Scalar Setting -------------------- ! Set the ztodt timestep in pbuf for SILHS, this is needed because hdtime is not input to silhs @@ -2794,7 +3198,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif !----------------------------------------- BEGIN GPU SECTION ----------------------------------------- - ! everything within should be functional with the OpenACC code, or be prevented from running + ! everything within should be functional with the OpenACC code, or be prevented from running ! with using OpenACC, see the "ifdef _OPENACC" section above for restriction examples call t_stopf('clubb_tend_cam:non_acc_region') @@ -2843,7 +3247,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc pdf_params_chnk(lchnk)%covar_chi_eta_1, pdf_params_chnk(lchnk)%covar_chi_eta_2, & !$acc pdf_params_chnk(lchnk)%corr_w_chi_1, pdf_params_chnk(lchnk)%corr_w_chi_2, & !$acc pdf_params_chnk(lchnk)%corr_w_eta_1, pdf_params_chnk(lchnk)%corr_w_eta_2, & - !$acc pdf_params_chnk(lchnk)%corr_chi_eta_1, pdf_params_chnk(lchnk)%corr_chi_eta_2, & + !$acc pdf_params_chnk(lchnk)%corr_chi_eta_1, pdf_params_chnk(lchnk)%corr_chi_eta_2, & !$acc pdf_params_chnk(lchnk)%rsatl_1, pdf_params_chnk(lchnk)%rsatl_2, & !$acc pdf_params_chnk(lchnk)%rc_1, pdf_params_chnk(lchnk)%rc_2, & !$acc pdf_params_chnk(lchnk)%cloud_frac_1, pdf_params_chnk(lchnk)%cloud_frac_2, & @@ -2915,7 +3319,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vm_pert(i,k) = 0.0_r8 end do end do - + !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol @@ -3022,6 +3426,53 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if + if (do_clubb_mf) then + mf_L0 = 0._r8 + mf_L0_nadv = 0._r8 + mf_ztop = 0._r8 + mf_ztop_nadv = 0._r8 + mf_ztopm1 = 0._r8 + mf_ztopm1_nadv = 0._r8 + mf_cape_nadv = 0._r8 + mf_ddcp_nadv = 0._r8 + mf_cbm1 = 0._r8 + mf_cbm1_nadv = 0._r8 + mf_freq_nadv = 0._r8 + + if (macmic_it==1) then + ztopm1_macmic(:ncol,:) = 0._r8 + ddcp_macmic(:ncol,:) = 0._r8 + cbm1_macmic(:ncol) = 0._r8 + + end if + + !+++ARH - Temporary hack - pbuf_set_field is apparently not taking? + if (is_first_step() .and. macmic_it==1) then + ddcp(:ncol,:) = 0._r8 + end if + + mf_precc_nadv(:ncol) = 0._r8 + mf_snow_nadv(:ncol) = 0._r8 + + mf_qc(:ncol,:nzm_clubb) = 0._r8 + mf_rcm(:ncol,:nzm_clubb) = 0._r8 + mf_cloudfrac(:ncol,:nzm_clubb) = 0._r8 + mf_qc_nadv(:ncol,:nzm_clubb) = 0._r8 + mf_rcm_nadv(:ncol,:nzm_clubb) = 0._r8 + mf_cloudfrac_nadv(:ncol,:nzm_clubb) = 0._r8 + + mf_thlforcup_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_qtforcup_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_thlforcdn_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_qtforcdn_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_thlforc_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_qtforc_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_ent_nadv(:ncol,:nzm_clubb) = 0._r8 + + max_cfl_nadv(:ncol) = 0._r8 + end if + + !----------------------------------- Ice supersaturation adjustment ----------------------------------- if (clubb_do_icesuper) then @@ -3091,13 +3542,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if ( clubb_do_adv ) then if (macmic_it == 1) then - + ! Note that some of the moments below can be positive or negative. ! Remove a constant that was added to prevent dynamics from clipping ! them to prevent dynamics from making them positive. do k = 1, nzm_clubb do i = 1, ncol - k_cam = top_lev - 1 + k + k_cam = top_lev - 1 + k rtpthlp_pbuf(i,k) = state_loc%q(i,k_cam,ixrtpthlp) - ( rtpthlp_const * apply_const ) wpthlp_pbuf(i,k) = state_loc%q(i,k_cam, ixwpthlp) - ( wpthlp_const * apply_const ) wprtp_pbuf(i,k) = state_loc%q(i,k_cam, ixwprtp) - ( wprtp_const * apply_const ) @@ -3141,7 +3592,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol - k_cam = top_lev - 1 + k + k_cam = top_lev - 1 + k ! Define the CLUBB thermodynamic grid (in units of m) zt_g(i,k) = state_loc%zm(i,k_cam) - state_loc%zi(i,pverp) @@ -3161,10 +3612,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol - k_cam = top_lev - 1 + k + k_cam = top_lev - 1 + k p_in_Pa(i,k) = state_loc%pmid(i,k_cam) - + ! 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 ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables @@ -3182,6 +3633,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlm(i,k) = ( state_loc%t(i,k_cam) - ( latvap * invrs_cpairv(i,k_cam) ) & * state_loc%q(i,k_cam,ixcldliq) ) * invrs_exner_zt(i,k) + qc_zt(i,k) = state_loc%q(i,k_cam,ixcldliq) + qv_zt(i,k) = state_loc%q(i,k_cam,ixq) + th_zt(i,k) = state_loc%t(i,k_cam)*invrs_exner_zt(i,k) end do end do @@ -3189,7 +3643,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol - k_cam = top_lev - 1 + k + k_cam = top_lev - 1 + k ! Compute mean w wind on thermo grid, convert from omega to w wm_zt(i,k) = -1._r8 * ( state_loc%omega(i,k_cam) - state_loc%omega(i,pver) ) / ( rho_zt(i,k) * gravit ) @@ -3209,7 +3663,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & deltaz(i) = state_loc%zi(i,pverp-1) - state_loc%zi(i,pverp) - ! Set the surface pressure + ! Set the surface pressure p_sfc(i) = state_loc%pint(i,pverp) ! Set the elevation of the surface @@ -3221,7 +3675,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol - k_cam = top_lev - 1 + k + k_cam = top_lev - 1 + k zi_g(i,k) = state_loc%zi(i,k_cam) - state_loc%zi(i,pverp) end do end do @@ -3298,7 +3752,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:acc_region') !----------------------------------------- END CLUBB grid initialization ----------------------------------------- - + #ifdef SILHS ! Add forcings for SILHS covariance contributions rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt_pbuf(1:ncol,:) ) @@ -3342,7 +3796,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector default(present) do i = 1, ncol wpthlp_sfc(i) = cam_in%shf(i) / ( cpairv(i,pver,lchnk) * rho_ds_zm(i,nzm_clubb) ) & ! Sensible heat flux - * invrs_exner_zt(i,nzt_clubb) + * invrs_exner_zt(i,nzt_clubb) wprtp_sfc(i) = cam_in%cflx(i,1) / rho_ds_zm(i,nzm_clubb) ! Moisture flux end do @@ -3396,7 +3850,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vpwp_sfc(1) = -vm(1,nzt_clubb)*ustar**2/ubar end if - + ! Implementation after Thomas Toniazzo (NorESM) and Colin Zarzycki (PSU) ! Other Surface fluxes provided by host model if( (cld_macmic_num_steps > 1) .and. clubb_l_intr_sfc_flux_smooth ) then @@ -3410,8 +3864,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ubar = sqrt(state_loc%u(i,pver)**2+state_loc%v(i,pver)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 - rrho_tmp = calc_ideal_gas_rrho(rair, state_loc%t(i,pver), state_loc%pmid(i,pver)) - ustar = calc_friction_velocity(cam_in%wsx(i), cam_in%wsy(i), rrho_tmp) + rrho(i) = calc_ideal_gas_rrho(rair, state_loc%t(i,pver), state_loc%pmid(i,pver)) + ustar = calc_friction_velocity(cam_in%wsx(i), cam_in%wsy(i), rrho(i)) upwp_sfc(i) = -state_loc%u(i,pver)*ustar**2/ubar vpwp_sfc(i) = -state_loc%v(i,pver)*ustar**2/ubar @@ -3431,7 +3885,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif - ! We only need to copy pdf_params from pbuf if this is a restart, we're calling pdf_closure + ! We only need to copy pdf_params from pbuf if this is a restart, we're calling pdf_closure ! at the end of advance_clubb_core, and calling it twice for pdf_params_zm as well if ( is_first_restart_step() & .and. clubb_config_flags%l_call_pdf_closure_twice & @@ -3447,12 +3901,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac_pbuf(i,k) end do end do - end if if ( edsclr_dim > 0 ) then - ! Copy the cam version of the tracers to the clubb version + ! Copy the cam version of the tracers to the clubb version ! NOTE: if clubb_l_do_expldiff_rtm_thlm=.true., then the last two ! tracers are thlm and rtm, which are added inside clubb icnt=0 @@ -3488,30 +3941,91 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !####################################################################### if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + !REMOVECAM_END + call tropopause_findChemTrop( state_loc, troplev ) + + rtm_zm(:,:) = 0._r8 + thlm_zm(:,:) = 0._r8 + th_zm(:,:) = 0._r8 + qv_zm(:,:) = 0._r8 + qc_zm(:,:) = 0._r8 rtm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm(:ncol,:) ) thlm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm(:ncol,:) ) + th_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, th_zt(:ncol,:) ) + qv_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qv_zt(:ncol,:) ) + qc_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qc_zt(:ncol,:) ) ! exner on momentum grid needed for mass flux calc. kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt ) do k = 1, nzm_clubb do i = 1, ncol - k_cam = top_lev - 1 + k invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k) * inv_p0_clubb)**kappa_zm(i,k) ) end do end do + ! pressure,exner on momentum grid needed for mass flux calc. + + th_sfc(:) = 0._r8 + th_sfc(1:ncol) = cam_in%ts(1:ncol)*invrs_exner_zm(1:ncol,nzm_clubb) + + !call calc_ustar( ncol, state_loc%t(:ncol,pver), state_loc%pmid(:ncol,pver), cam_in%wsx(:ncol), cam_in%wsy(:ncol), & + ! rrho(:ncol), ustar2(:ncol) ) + ustar2(1:ncol) = calc_friction_velocity(cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), rrho(1:ncol)) + + if (t>1) then + ! update thv if clubb is subcycled + do i = 1, ncol + thv_ds_zt(i,:) = thlm(i,:) & + + latvap*rcm(i,:)*invrs_exner_zt(i,:)/cpair + thv_ds_zt(i,:) = thv_ds_zt(i,:) & + * (1._r8+zvir*(rtm(i,:)-rcm(i,:)) - rcm(i,:)) + end do + thv_ds_zm(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thv_ds_zt(1:ncol,:) ) + end if + + mf_ztopm1(1:ncol,:) = ztopma(1:ncol,:) + mf_ddcp(1:ncol,:) = ddcp(1:ncol,:) + mf_cbm1(1:ncol) = cbm1(1:ncol) + + rhinv(1:ncol) = 0._r8 + do i = 1, ncol + if (rhlev(i) >= 1._r8) rhlev(i) = 0.990_r8 + if (rhlev(i) > 0._r8) rhinv(i) = 1._r8 / ( (1._r8/rhlev(i)) - 1._r8 ) + end do + !--------------------------------------- integrate_mf call --------------------------------------- ! integrate_mf expects arguments of individual columns. ! If the column loop gets pushed into it, we can also avoid the array slicing. do i = 1, ncol - call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + + trop_mf = troplev(i) + + call integrate_mf( nzm_clubb, nzt_clubb, & ! input + rho_zm(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + rho_zt(i,:), dz_g(i,:), zt_g(i,:), p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input - thlm_zm(i,:), rtm_zm(i,:), & ! input - wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input + trop_mf, wm_zm(i,:), th_zt(i,:), qv_zt(i,:), qc_zt(i,:), & ! input + thlm_zm(i,:), rtm_zm(i,:), thv_ds_zm(i,:), & ! input + th_zm(i,:), qv_zm(i,:), qc_zm(i,:), & ! input + ustar2(i), th_sfc(i), wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input + wpthlp_pbuf(i,:), tke_pbuf(i,:), tpert(i), mf_ztopm1(i,:), rhinv(i), & ! input + wpthvp_pbuf(i,:), wprtp_pbuf(i,:), mf_cape(i,:), mf_ddcp(i,:), mf_cbm1(i), & ! output - plume diagnostics + mf_upa(i,:,:), mf_dna(i,:,:), & ! output - plume diagnostics + mf_upw(i,:,:), mf_dnw(i,:,:), & ! output - plume diagnostics + mf_upmf(i,:,:), & ! output - plume diagnostics + mf_upqt(i,:,:), mf_dnqt(i,:,:), & ! output - plume diagnostics + mf_upthl(i,:,:), mf_dnthl(i,:,:), & ! output - plume diagnostics + mf_upthv(i,:,:), mf_dnthv(i,:,:), & ! output - plume diagnostics + mf_upth(i,:,:), mf_dnth(i,:,:), & ! output - plume diagnostics + mf_upqc(i,:,:), mf_dnqc(i,:,:), & ! output - plume diagnostics + mf_upbuoy(i,:,:), & ! output - plume diagnostics + mf_upent(i,:,:), & ! output - plume diagnostics + mf_updet(i,:,:), & ! output - plume diagnostics 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 @@ -3519,41 +4033,169 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & 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_ae(i,:), & ! output - plume diagnostics + s_ac(i,:), s_aup(i,:), s_adn(i,:), & ! output - plume diagnostics + s_aw(i,:), s_awup(i,:), s_awdn(i,:), & ! output - plume diagnostics + s_aww(i,:), s_awwup(i,:), s_awwdn(i,:), & ! output - plume diagnostics + s_awthlup(i,:), s_awqtup(i,:), s_awuup(i,:), s_awvup(i,:), & ! output - plume diagnostics + s_awthldn(i,:), s_awqtdn(i,:), s_awudn(i,:), s_awvdn(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 + mf_thlflxup(i,:), mf_qtflxup(i,:), mf_uflxup(i,:), mf_vflxup(i,:), & ! output - plume diagnostics + mf_thlflxdn(i,:), mf_qtflxdn(i,:), mf_uflxdn(i,:), mf_vflxdn(i,:), & ! output - plume diagnostics + mf_thlflx(i,:), mf_qtflx(i,:), mf_uflx(i,:), mf_vflx(i,:), & ! output - variables needed for solver + mf_thvflx(i,:), & ! output - plume diagnostics + mf_sqtup(i,:), mf_sthlup(i,:), & ! output - plume diagnostics + mf_sqtdn(i,:), mf_sthldn(i,:), & ! output - plume diagnostics + mf_sqt(i,:), mf_sthl(i,:), & ! output - variables needed for solver + mf_precc(i,:), & ! output - plume diagnostics + mf_ztop(i,:), mf_L0(i,:) ) + + end do + + ! CFL limiter + cfllim = .true. + cflfac(:ncol) = 1._r8 + s_aw(:ncol,nzm_clubb) = 0._r8 + max_cfl(:ncol)= 0._r8 + do i=1,ncol + do k=1,nzt_clubb + max_cfl(i) = max(max_cfl(i),dtime*invrs_dz_g(i,k)*max(abs(s_aw(i,k)),abs(s_aw(i,k+1)))) + end do + if (max_cfl(i).gt.cflval.and.cfllim) cflfac(i) = cflval/max_cfl(i) + end do + + ! Scale microphys so it can't drive qt negative + do k=1,nzt_clubb + do i=1,ncol + if ((-1._r8*mf_sqt(i,k)*dtime) > rtm(i,k)) then + lambda = -1._r8*rtm(i,k)/(mf_sqt(i,k)*dtime) + mf_sqt(i,k) = lambda*mf_sqt(i,k) + mf_sthl(i,k) = lambda*mf_sthl(i,k) + mf_sqtup(i,k) = lambda*mf_sqtup(i,k) + mf_sthlup(i,k) = lambda*mf_sthlup(i,k) + mf_sqtdn(i,k) = lambda*mf_sqtdn(i,k) + mf_sthldn(i,k) = lambda*mf_sthldn(i,k) + end if + end do + end do + + ! Recalculate precip using new microphys forcing + mf_precc(:ncol,:) = 0._r8 + do k = 1, nzt_clubb + do i = 1, ncol + ! Precip accumulates downward across the interfaces + mf_precc(i,k+1) = mf_precc(i,k) - rho_zt(i,k)*dz_g(i,k)*mf_sqt(i,k) + end do end do !--------------------------------------- END integrate_mf call --------------------------------------- + ! pass MF turbulent advection term as CLUBB explicit forcing term + rtm_forcing(:ncol,:) = 0._r8 + thlm_forcing(:ncol,:) = 0._r8 + mf_qtforcup(:ncol,:) = 0._r8 + mf_thlforcup(:ncol,:) = 0._r8 + mf_qtforcdn(:ncol,:) = 0._r8 + mf_thlforcdn(:ncol,:) = 0._r8 + ! pass MF turbulent advection term as CLUBB explicit forcing term do k = 1, nzt_clubb do i = 1, ncol - rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * & - ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflx(i,k+1))) + rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflx(i,k+1))) & + + mf_sqt(i,k) + + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflx(i,k+1))) & + + mf_sthl(i,k) + + mf_qtforcup(i,k) = mf_qtforcup(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_qtflxup(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflxup(i,k+1))) & + + mf_sqtup(i,k) + + mf_thlforcup(i,k) = mf_thlforcup(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_thlflxup(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflxup(i,k+1))) & + + mf_sthlup(i,k) + + mf_qtforcdn(i,k) = mf_qtforcdn(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_qtflxdn(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflxdn(i,k+1))) & + + mf_sqtdn(i,k) - thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * & - ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflx(i,k+1))) + mf_thlforcdn(i,k) = mf_thlforcdn(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_thlflxdn(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflxdn(i,k+1))) & + + mf_sthldn(i,k) end do end do - call t_stopf('clubb_tend_cam:do_clubb_mf') + if (do_clubb_mf_cmt) then + ! convective momentum transport + um_forcing(:ncol,:) = 0._r8 + vm_forcing(:ncol,:) = 0._r8 + do k = 1, nzt_clubb + do i = 1, ncol + um_forcing(i,k) = um_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_uflx(i,k)) - (rho_ds_zm(i,k+1) * mf_uflx(i,k+1))) + + vm_forcing(i,k) = vm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_vflx(i,k)) - (rho_ds_zm(i,k+1) * mf_vflx(i,k+1))) + end do + end do + end if + + do i=1,ncol + ! compute ensemble cloud properties + mf_qc_nadv(i,:nzm_clubb) = mf_qc_nadv(i,:nzm_clubb) + mf_moist_qc(i,:nzm_clubb) + mf_rcm_nadv(i,:nzm_clubb) = mf_rcm_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb)*mf_moist_qc(i,:nzm_clubb) + mf_cloudfrac_nadv(i,:nzm_clubb) = mf_cloudfrac_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb) + + ! [kg/m2/s]->[m/s] + mf_precc_nadv(i) = mf_precc_nadv(i) + mf_precc(i,nzm_clubb)/1000._r8 + mf_snow_nadv(i) = 0._r8 + + ! accumulate over nadv subcycles + mf_L0_nadv(i,:) = mf_L0_nadv(i,:) + mf_L0(i,:) + mf_ztop_nadv(i,:) = mf_ztop_nadv(i,:) + mf_ztop(i,:) + mf_ztopm1_nadv(i,:) = mf_ztopm1_nadv(i,:) + mf_ztopm1(i,:) + mf_cape_nadv(i,:) = mf_cape_nadv(i,:) + mf_cape(i,:) + mf_ddcp_nadv(i,:) = mf_ddcp_nadv(i,:) + mf_ddcp(i,:) + mf_cbm1_nadv(i) = mf_cbm1_nadv(i) + mf_cbm1(i) + + if (ANY(mf_ztop(i,:) > 0._r8)) mf_freq_nadv(i) = mf_freq_nadv(i) + 1._r8 + + mf_thlforcup_nadv(i,:nzt_clubb) = mf_thlforcup_nadv(i,:nzt_clubb) + mf_thlforcup(i,:nzt_clubb) + mf_qtforcup_nadv(i,:nzt_clubb) = mf_qtforcup_nadv(i,:nzt_clubb) + mf_qtforcup(i,:nzt_clubb) + mf_thlforcdn_nadv(i,:nzt_clubb) = mf_thlforcdn_nadv(i,:nzt_clubb) + mf_thlforcdn(i,:nzt_clubb) + mf_qtforcdn_nadv(i,:nzt_clubb) = mf_qtforcdn_nadv(i,:nzt_clubb) + mf_qtforcdn(i,:nzt_clubb) + mf_thlforc_nadv(i,:nzt_clubb) = mf_thlforc_nadv(i,:nzt_clubb) + thlm_forcing(i,:nzt_clubb) + mf_qtforc_nadv(i,:nzt_clubb) = mf_qtforc_nadv(i,:nzt_clubb) + rtm_forcing(i,:nzt_clubb) + + mf_ent_nadv(i,:nzm_clubb) = mf_ent_nadv(i,:nzm_clubb) + s_awu(i,:nzm_clubb) + + max_cfl_nadv(i) = MAX(max_cfl(i),max_cfl_nadv(i)) + end do + call t_stopf('clubb_tend_cam:do_clubb_mf') + ! --- DIAGNOSTIC TRAP: Surface Boundary Array Bounds --- + if (get_nstep() == 1 .and. i == 1 .and. t == 1) then + write(iulog,*) 'DIAG_TRAP: mf_precc TOA = ', mf_precc(1,1) + write(iulog,*) 'DIAG_TRAP: mf_precc SFC = ', mf_precc(1,nzm_clubb) + write(iulog,*) 'DIAG_TRAP: th_sfc = ', th_sfc(1) + end if + ! --- END TRAP --- end if - + if ( clubb_l_ascending_grid ) then - ! CLUBB is to be run in ascending mode, which has the surface at k=1, which is + ! CLUBB is to be run in ascending mode, which has the surface at k=1, which is ! the opposite of the cam grid that the rest of clubb_intr uses, so ! we need to flip the fields (in the vertical dimensions) before calling advance_clubb_core ! ! NOTE: We do not neccesarily flip all arrays, only ones that are used within this - ! subroutine (advance_clubb_core). For example, only the pdf_params fields that + ! subroutine (advance_clubb_core). For example, only the pdf_params fields that ! are used within this subroutine (or used in a subroutine we call) need to - ! be flipped. - + ! be flipped. + call t_startf('clubb_tend_cam:ascending_grid_flip') thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) @@ -3565,6 +4207,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) + khzt = khzt(:,nzt_clubb:1:-1) rtm_ref = rtm_ref(:,nzt_clubb:1:-1) thlm_ref = thlm_ref(:,nzt_clubb:1:-1) um_ref = um_ref(:,nzt_clubb:1:-1) @@ -3633,18 +4276,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if if ( sclr_dim > 0 ) then - + sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) sclrm = sclrm(:,nzt_clubb:1:-1,:) sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) - + sclrp2 = sclrp2(:,nzm_clubb:1:-1,:) sclrprtp = sclrprtp(:,nzm_clubb:1:-1,:) sclrpthlp = sclrpthlp(:,nzm_clubb:1:-1,:) wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) sclrpthvp = sclrpthvp(:,nzm_clubb:1:-1,:) end if - + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. ! only because these are need to be stored for restarts if ( clubb_config_flags%l_call_pdf_closure_twice ) then @@ -3654,9 +4297,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) end if - + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. - ! only for pdfp_rtp2_output calc + ! only for pdfp_rtp2_output calc pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2 (:,nzt_clubb:1:-1) @@ -3673,7 +4316,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) - + ! These are flipped for silhs, which uses a cam grid pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2 (:,nzt_clubb:1:-1) @@ -3693,7 +4336,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2 (:,nzt_clubb:1:-1) - + call cleanup_grid_api( gr ) @@ -3703,7 +4346,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) zi_g(:,nzm_clubb:1:-1), zt_g(:,nzt_clubb:1:-1), & ! intent(in) gr, err_info ) ! intent(inout) - + call t_stopf('clubb_tend_cam:ascending_grid_flip') end if @@ -3780,14 +4423,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) call t_stopf('clubb_tend_cam:advance_clubb_core_api') - + if ( clubb_l_ascending_grid ) then call t_startf('clubb_tend_cam:ascending_grid_flip') ! If running in ascending mode, we flip the arrays before calling advance_clubb_core - ! so we need to flip them back. This section should flip every array that was flipped + ! so we need to flip them back. This section should flip every array that was flipped ! before the advance_clubb_core call. thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) @@ -3880,7 +4523,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if if ( sclr_dim > 0 ) then - + sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) sclrm = sclrm(:,nzt_clubb:1:-1,:) sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) @@ -3891,7 +4534,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) sclrpthvp = sclrpthvp(:,nzm_clubb:1:-1,:) end if - + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid ! only because these are need to be stored for restarts if ( clubb_config_flags%l_call_pdf_closure_twice ) then @@ -3901,16 +4544,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) end if - - ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid - ! only for pdfp_rtp2_output calc + + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid + ! only for pdfp_rtp2_output calc pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) - ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid ! only for update_xp2_mc_api call pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2 (:,nzt_clubb:1:-1) @@ -3920,7 +4563,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) - + ! These are flipped for silhs, which uses a cam grid pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2 (:,nzt_clubb:1:-1) @@ -3965,6 +4608,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol + k_cam = top_lev - 1 + k rvm(i,k) = rtm(i,k) - rcm(i,k) pre(i,k) = prer_evap_pbuf(i,k_cam) end do @@ -3998,7 +4642,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:do_cldcool') thlp2_rad(:,:) = 0._r8 - + do k = 1, nzt_clubb do i = 1, ncol k_cam = top_lev - 1 + k @@ -4043,6 +4687,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + if (do_clubb_mf_addtke) then + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + khzm_pbuf(i,k_cam) = khzm(i,k) + & + clubb_params(i,ic_K) * Lscale(i,k) * sqrt(0.5_r8 * s_aww(i,k)) + end do + end do + else !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol @@ -4050,8 +4704,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & khzm_pbuf(i,k_cam) = khzm(i,k) end do end do + end if - ! pdf_params_zm_chnk is already persistent across calls, but we + ! pdf_params_zm_chnk is already persistent across calls, but we ! save a pbuf version for restarts if ( clubb_config_flags%l_call_pdf_closure_twice ) then !$acc parallel loop gang vector collapse(2) default(present) @@ -4133,6 +4788,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Use correct qflux from cam_in, not lhf/latvap as was done previously te_b = te_b + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime +!jt check with Adam These are not bfb with nonclubbmf run +!jt ! subtract enthalpy of falling precip from tb + te_b = te_b - prec_sh(i)*1000._r8*latice*hdtime + ! Compute the disbalance of total energy, over depth where CLUBB is active se_dis(i) = ( te_a - te_b ) / ( state_loc%pint(i,pverp) - state_loc%pint(i,clubbtop_pbuf(i)) ) @@ -4207,7 +4866,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = top_lev, pverp do i = 1, ncol k_clubb = k + 1 - top_lev - tke_pbuf(i,k) = 0.5_r8 * ( up2_pbuf(i,k_clubb) + vp2_pbuf(i,k_clubb) + wp2_pbuf(i,k_clubb) ) + tke_pbuf(i,k) = 0.5_r8 * ( up2_pbuf(i,k_clubb) + vp2_pbuf(i,k_clubb) + wp2_pbuf(i,k_clubb) ) enddo enddo @@ -4337,7 +4996,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ptend_loc%q(i,k,ixind) = 0._r8 end do end do - + ! Copy CLUBB's edsclr values do k = top_lev, pver do i = 1, ncol @@ -4439,6 +5098,155 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_cam_tend:do_liqsupersat') end if + if (do_clubb_mf) then + ! average over nadv + mf_L0_nadv = mf_L0_nadv/REAL(nadv) + mf_ztop_nadv = mf_ztop_nadv/REAL(nadv) + mf_ztopm1_nadv = mf_ztopm1_nadv/REAL(nadv) + mf_cape_nadv = mf_cape_nadv/REAL(nadv) + mf_ddcp_nadv = mf_ddcp_nadv/REAL(nadv) + mf_cbm1_nadv = mf_cbm1_nadv/REAL(nadv) + mf_freq_nadv = mf_freq_nadv/REAL(nadv) + + ! accumulate in buffer + ztopm1_macmic(:ncol,:) = ztopm1_macmic(:ncol,:) + mf_ztopm1_nadv(:ncol,:) + ddcp_macmic(:ncol,:) = ddcp_macmic(:ncol,:) + mf_ddcp_nadv(:ncol,:) + cbm1_macmic(:ncol) = cbm1_macmic(:ncol) + mf_cbm1_nadv(:ncol) + + if (macmic_it == cld_macmic_num_steps) then + + cbm1(:ncol) = cbm1_macmic(:ncol)/REAL(cld_macmic_num_steps) + + if (clubb_mf_up_ndt == 1) then + ztopma(:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + else + ztopmn(2:clubb_mf_up_ndt,:ncol,:) = ztopmn(1:clubb_mf_up_ndt-1,:ncol,:) + ztopmn(1,:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ztopma(:ncol,:) = 0._r8 + do t=1,clubb_mf_up_ndt + ztopma(:ncol,:) = ztopma(:ncol,:) + ztopmn(t,:ncol,:) + end do + ztopma(:ncol,:) = ztopma(:ncol,:)/REAL(clubb_mf_up_ndt) + end if + + if (clubb_mf_cp_ndt == 1) then + ddcp(:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + else + ddcpmn(2:clubb_mf_cp_ndt,:ncol,:) = ddcpmn(1:clubb_mf_cp_ndt-1,:ncol,:) + ddcpmn(1,:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ddcp(:ncol,:) = 0._r8 + do t=1,clubb_mf_cp_ndt + ddcp(:ncol,:) = ddcp(:ncol,:) + ddcpmn(t,:ncol,:) + end do + ddcp(:ncol,:) = ddcp(:ncol,:)/REAL(clubb_mf_cp_ndt) + end if + + ddcp(:ncol,:) = clubb_mf_ddalph*ddcp(:ncol,:) + + end if + + mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv) + prec_sh(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) + snow_sh(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) + + mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_thlforcdn_nadv(:ncol,:nzt_clubb) = mf_thlforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforcdn_nadv(:ncol,:nzt_clubb) = mf_qtforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_thlforc_nadv(:ncol,:nzt_clubb) = mf_thlforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) + + mf_ent_nadv(:ncol,:nzm_clubb) = mf_ent_nadv(:ncol,:nzm_clubb)/REAL(nadv) + + end if !clubbmf + + ! Need moist_qc and cloudfrac on thermo grid for output + mf_qc_zt(:,:) = 0._r8 + mf_cloudfrac_zt(:,:) = 0._r8 + + + if (do_clubb_mf) then + mf_qc_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_qc) + mf_cloudfrac_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_cloudfrac) + !mf_qc_zt(1:ncol,:) = zm2zt_api( pverp+1-top_lev, ncol, gr, mf_qc(1:ncol,:)) + !mf_cloudfrac_zt(1:ncol,:) = zm2zt_api( pverp+1-top_lev, ncol, gr, mf_cloudfrac(1:ncol,:)) + + do i=1,ncol + mf_ztop_output(i) = MAXVAL(ztopma(i,:)) + mf_cape_output(i) = MAXVAL(mf_cape_nadv(i,:)) + mf_ddcp_output(i) = MAXVAL(ddcp(i,:)) + mf_L0_output(i) = MAXVAL(mf_L0_nadv(i,:)) + end do + + mf_cfl_output(:ncol) = max_cfl_nadv(:ncol) + mf_freq_output(:ncol) = mf_freq_nadv(:ncol) + + end if !clubbmf + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, nzt_clubb + 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) + + k_cam = top_lev - 1 + k + + pdfp_rtp2_output(i,k_cam) = 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 +!jt check with Adam These are not bfb with nonclubbmf run +!jt check with Adam ! Values to use above top_lev, for variables that have not already been +!jt check with Adam ! set up there. These are mostly fill values that should not actually be +!jt check with Adam ! used in the run, but may end up in diagnostic output. +!jt check with Adam !$acc parallel loop gang vector collapse(2) default(present) +!jt check with Adam do k=1, top_lev-1 +!jt check with Adam do i=1, ncol +!jt check with Adam upwp_pbuf(i,k) = 0._r8 +!jt check with Adam vpwp_pbuf(i,k) = 0._r8 +!jt check with Adam rcm(i,k) = 0._r8 +!jt check with Adam wprcp(i,k) = 0._r8 +!jt check with Adam cloud_frac(i,k) = 0._r8 +!jt check with Adam rcm_in_layer(i,k) = 0._r8 +!jt check with Adam zt_output(i,k) = 0._r8 +!jt check with Adam zi_output(i,k) = 0._r8 +!jt check with Adam khzm_pbuf(i,k) = 0._r8 +!jt check with Adam qclvar(i,k) = 2._r8 +!jt check with Adam end do +!jt check with Adam end do + + ! Fill up arrays needed for McICA. Note we do not want the ghost point, + ! thus why the second loop is needed. + !$acc parallel loop gang vector default(present) + do i=1, pcols + zi_output(i,1) = 0._r8 + end do + + ! enforce zero tracer tendencies above the top_lev level -- no change + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, top_lev-1 + do i=1, ncol + edsclr(i,k,icnt) = state_loc%q(i,k,ixind) + end do + end do + + end if + end do + ! ------------------------------------------------------------ ! ! The rest of the code deals with diagnosing variables ! ! for microphysics/radiation computation and macrophysics ! @@ -4553,6 +5361,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! ! --------------------------------------------------------------------------------- ! + sh_icwmr_pbuf(:,:) = 0.0_r8 frac_limit = 0.01_r8 ic_limit = 1.e-12_r8 deepcu_pbuf(:,:) = 0.0_r8 @@ -4574,7 +5383,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud ! from CLUBB plus the deep convective cloud fraction - ! NOTE: concld_pbuf used to be calculated in the commented-out version below, but since we + ! NOTE: concld_pbuf used to be calculated in the commented-out version below, but since we ! set alst_pbuf=cloud_frac_pbuf, this simplifies to only using deepcu_pbuf. ! This is potentially a bug, but there's not really a "right" way to combine the different ! cloud factions, so it has been left to only use deepcu_pbuf for now @@ -4583,6 +5392,29 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo + if (do_clubb_mf) then + do k = 1, pver-1 + do i = 1, ncol + ! While shallow convection is never called, CLUBB+MF uses the shallow cloud fraction and + ! shallow in-cloud mixing ratio pbuf variables to couple with radiation. + if (do_clubb_mf_rad) then + shalcu_pbuf(i,k) = clubb_mf_cldfrac_fac*mf_cloudfrac_output(i,k) + sh_icwmr_pbuf(i,k) = mf_qc_output(i,k) + end if + + if (shalcu_pbuf(i,k) <= frac_limit .or. sh_icwmr_pbuf(i,k) < ic_limit) then + shalcu_pbuf(i,k) = 0._r8 + endif + + ! using the deep convective cloud fraction, CLUBB cloud fraction (variable + ! "cloud_frac") and CLUBB+MF cloud fraction ("shalcu") compute the convective cloud + ! fraction. This follows the formulation found in macrophysics code. Assumes that convective + ! cloud is all nonstratiform cloud from CLUBB or CLUBB+MF plus the deep convective cloud fraction + concld_pbuf(i,k) = min(cloud_frac(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k)+shalcu_pbuf(i,k),0.80_r8) + enddo + enddo + end if + if (single_column .and. .not. scm_cambfb_mode) then if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. & trim(scm_clubb_iop_name) == 'BOMEX_5day' .or. & @@ -4605,7 +5437,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists troplev(:) = 0 !REMOVECAM_END - call tropopause_findChemTrop( state, troplev ) + call tropopause_findChemTrop( state_loc, troplev ) aist_pbuf(:,:top_lev-1) = 0._r8 qsatfac_pbuf(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below @@ -4773,6 +5605,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + rcm_macmic(:ncol,nzt_clubb*(macmic_it-1)+1:nzt_clubb*macmic_it) = rcm(:ncol,:nzt_clubb) + cldfrac_macmic(:ncol,pver*(macmic_it-1)+1:pver*macmic_it) = cld_pbuf(:ncol,:pver) + wpthlp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wpthlp_output(:ncol,:pverp) + wprtp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wprtp_output(:ncol,:pverp) + wpthvp_macmic(:ncol,nzm_clubb*(macmic_it-1)+1:nzm_clubb*macmic_it) = wpthvp_pbuf(:ncol,:nzm_clubb) + if (do_clubb_mf) then + mf_thlflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_thlflx_output(:ncol,:pverp) + mf_qtflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_qtflx_output(:ncol,:pverp) + mf_thvflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_thvflx_output(:ncol,:pverp) + end if + ! Convert RTP2 and THLP2 to thermo grid for output rtp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_pbuf(:ncol,:) ) thl2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_pbuf(:ncol,:) ) @@ -4889,7 +5732,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) call outfld( 'QSATFAC', qsatfac_pbuf, pcols, lchnk ) - + call outfld( 'TKE_CLUBB', tke_pbuf, pcols, lchnk ) ! --------------------------------------------------------------- ! ! Writing state variables after EDMF scheme for detailed analysis ! @@ -4916,17 +5759,68 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_aw_output(i,k) = s_aw(i,k_clubb) s_awthl_output(i,k) = s_awthl(i,k_clubb) s_awqt_output(i,k) = s_awqt(i,k_clubb) - s_awql_output(i,k) = s_awql(i,k_clubb) - s_awqi_output(i,k) = s_awqi(i,k_clubb) s_awu_output(i,k) = s_awu(i,k_clubb) s_awv_output(i,k) = s_awv(i,k_clubb) mf_thlflx_output(i,k) = mf_thlflx(i,k_clubb) * rho_zm(i,k_clubb) * cpair mf_qtflx_output(i,k) = mf_qtflx(i,k_clubb) * rho_zm(i,k_clubb) * latvap + s_awthlup_output(i,k) = s_awthlup(i,k_clubb) + s_awqtup_output(i,k) = s_awqtup(i,k_clubb) + s_awuup_output(i,k) = s_awuup(i,k_clubb) + s_awvup_output(i,k) = s_awvup(i,k_clubb) + s_awthldn_output(i,k) = s_awthldn(i,k_clubb) + s_awqtdn_output(i,k) = s_awqtdn(i,k_clubb) + s_awudn_output(i,k) = s_awudn(i,k_clubb) + s_awvdn_output(i,k) = s_awvdn(i,k_clubb) + s_aww_output(i,k) = s_aww(i,k_clubb) + mf_thlflxup_output(i,k) = mf_thlflxup(i,k_clubb) * rho_zm(i,k_clubb) * cpair + mf_qtflxup_output(i,k) = mf_qtflxup(i,k_clubb) * rho_zm(i,k_clubb) * latvap + mf_uflxup_output(i,k) = mf_uflxup(i,k_clubb) + mf_vflxup_output(i,k) = mf_vflxup(i,k_clubb) + mf_thlflxdn_output(i,k) = mf_thlflxdn(i,k_clubb) * rho_zm(i,k_clubb) * cpair + mf_qtflxdn_output(i,k) = mf_qtflxdn(i,k_clubb) * rho_zm(i,k_clubb) * latvap + mf_uflxdn_output(i,k) = mf_uflxdn(i,k_clubb) + mf_vflxdn_output(i,k) = mf_vflxdn(i,k_clubb) + mf_uflx_output(i,k) = mf_uflx(i,k_clubb) + mf_vflx_output(i,k) = mf_vflx(i,k_clubb) + mf_thvflx_output(i,k) = mf_thvflx(i,k_clubb) + mf_rcm_output(i,k) = mf_rcm(i,k_clubb) + mf_precc_output(i,k) = mf_precc(i,k_clubb) + mf_upa_flip(i,k,:clubb_mf_nup) = mf_upa(i,k_clubb,:clubb_mf_nup) + mf_upw_flip(i,k,:clubb_mf_nup) = mf_upw(i,k_clubb,:clubb_mf_nup) + mf_upmf_flip(i,k,:clubb_mf_nup) = mf_upmf(i,k_clubb,:clubb_mf_nup) + mf_upqt_flip(i,k,:clubb_mf_nup) = mf_upqt(i,k_clubb,:clubb_mf_nup) + mf_upthl_flip(i,k,:clubb_mf_nup) = mf_upthl(i,k_clubb,:clubb_mf_nup) + mf_upthv_flip(i,k,:clubb_mf_nup) = mf_upthv(i,k_clubb,:clubb_mf_nup) + mf_upth_flip(i,k,:clubb_mf_nup) = mf_upth(i,k_clubb,:clubb_mf_nup) + mf_upqc_flip(i,k,:clubb_mf_nup) = mf_upqc(i,k_clubb,:clubb_mf_nup) + mf_upent_flip(i,k,:clubb_mf_nup) = mf_upent(i,k_clubb,:clubb_mf_nup) + mf_updet_flip(i,k,:clubb_mf_nup) = mf_updet(i,k_clubb,:clubb_mf_nup) + mf_upbuoy_flip(i,k,:clubb_mf_nup) = mf_upbuoy(i,k_clubb,:clubb_mf_nup) + mf_dnw_flip(i,k,:clubb_mf_nup) = mf_dnw(i,k_clubb,:clubb_mf_nup) + mf_dnthl_flip(i,k,:clubb_mf_nup) = mf_dnthl(i,k_clubb,:clubb_mf_nup) + mf_dnqt_flip(i,k,:clubb_mf_nup) = mf_dnqt(i,k_clubb,:clubb_mf_nup) end do end do + do k=1,clubb_mf_nup + mf_upa_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upa_flip(:ncol,:pverp,k) + mf_upw_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upw_flip(:ncol,:pverp,k) + mf_upmf_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upmf_flip(:ncol,:pverp,k) + mf_upqt_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upqt_flip(:ncol,:pverp,k) + mf_upthl_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upthl_flip(:ncol,:pverp,k) + mf_upthv_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upthv_flip(:ncol,:pverp,k) + mf_upth_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upth_flip(:ncol,:pverp,k) + mf_upqc_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upqc_flip(:ncol,:pverp,k) + mf_upent_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upent_flip(:ncol,:pverp,k) + mf_updet_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_updet_flip(:ncol,:pverp,k) + mf_upbuoy_output(:ncol,pverp*(k-1)+1:pverp*k)= mf_upbuoy_flip(:ncol,:pverp,k) + mf_dnw_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_dnw_flip(:ncol,:pverp,k) + mf_dnthl_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_dnthl_flip(:ncol,:pverp,k) + mf_dnqt_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_dnqt_flip(:ncol,:pverp,k) + end do + do k = 1, top_lev-1 - do i = 1, ncol + do i = 1, ncol mf_dry_a_output(i,k) = 0._r8 mf_moist_a_output(i,k) = 0._r8 mf_dry_w_output(i,k) = 0._r8 @@ -4944,15 +5838,53 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_aw_output(i,k) = 0._r8 s_awthl_output(i,k) = 0._r8 s_awqt_output(i,k) = 0._r8 - s_awql_output(i,k) = 0._r8 - s_awqi_output(i,k) = 0._r8 s_awu_output(i,k) = 0._r8 s_awv_output(i,k) = 0._r8 mf_thlflx_output(i,k) = 0._r8 mf_qtflx_output(i,k) = 0._r8 + s_awthlup_output(i,k) = 0._r8 + s_awqtup_output(i,k) = 0._r8 + s_awuup_output(i,k) = 0._r8 + s_awvup_output(i,k) = 0._r8 + s_awthldn_output(i,k) = 0._r8 + s_awqtdn_output(i,k) = 0._r8 + s_awudn_output(i,k) = 0._r8 + s_awvdn_output(i,k) = 0._r8 + s_aww_output(i,k) = 0._r8 + mf_thlflxup_output(i,k) = 0._r8 + mf_qtflxup_output(i,k) = 0._r8 + mf_uflxup_output(i,k) = 0._r8 + mf_vflxup_output(i,k) = 0._r8 + mf_thlflxdn_output(i,k) = 0._r8 + mf_qtflxdn_output(i,k) = 0._r8 + mf_uflxdn_output(i,k) = 0._r8 + mf_vflxdn_output(i,k) = 0._r8 + mf_uflx_output(i,k) = 0._r8 + mf_vflx_output(i,k) = 0._r8 + mf_thvflx_output(i,k) = 0._r8 + mf_rcm_output(i,k) = 0._r8 + mf_precc_output(i,k) = 0._r8 + do l=1,clubb_mf_nup + mf_upa_output(i,pverp*(l-1)+k) = 0._r8 + mf_upw_output(i,pverp*(l-1)+k) = 0._r8 + mf_upmf_output(i,pverp*(l-1)+k) = 0._r8 + mf_upqt_output(i,pverp*(l-1)+k) = 0._r8 + mf_upthl_output(i,pverp*(l-1)+k) = 0._r8 + mf_upthv_output(i,pverp*(l-1)+k) = 0._r8 + mf_upth_output(i,pverp*(l-1)+k) = 0._r8 + mf_upqc_output(i,pverp*(l-1)+k) = 0._r8 + mf_upent_output(i,pverp*(l-1)+k) = 0._r8 + mf_updet_output(i,pverp*(l-1)+k) = 0._r8 + mf_upbuoy_output(i,pverp*(l-1)+k) = 0._r8 + mf_dnw_output(i,pverp*(l-1)+k) = 0._r8 + mf_dnthl_output(i,pverp*(l-1)+k) = 0._r8 + mf_dnqt_output(i,pverp*(l-1)+k) = 0._r8 + end do end do end do + call outfld( 'PRECSH' , prec_sh(:ncol), pcols, lchnk ) + call outfld( 'SNOWSH' , snow_sh(:ncol), pcols, lchnk ) call outfld( 'edmf_DRY_A' , mf_dry_a_output, pcols, lchnk ) call outfld( 'edmf_MOIST_A' , mf_moist_a_output, pcols, lchnk ) call outfld( 'edmf_DRY_W' , mf_dry_w_output, pcols, lchnk ) @@ -4966,15 +5898,77 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'edmf_DRY_V' , mf_dry_v_output, pcols, lchnk ) call outfld( 'edmf_MOIST_V' , mf_moist_v_output, pcols, lchnk ) call outfld( 'edmf_MOIST_QC' , mf_moist_qc_output, pcols, lchnk ) + call outfld( 'edmf_precc' , mf_precc_output, pcols, lchnk ) call outfld( 'edmf_S_AE' , s_ae_output, pcols, lchnk ) call outfld( 'edmf_S_AW' , s_aw_output, pcols, lchnk ) + call outfld( 'edmf_S_AWW' , s_aww_output, pcols, lchnk ) call outfld( 'edmf_S_AWTHL' , s_awthl_output, pcols, lchnk ) call outfld( 'edmf_S_AWQT' , s_awqt_output, pcols, lchnk ) call outfld( 'edmf_S_AWU' , s_awu_output, pcols, lchnk ) call outfld( 'edmf_S_AWV' , s_awv_output, pcols, lchnk ) + call outfld( 'edmf_thlforcup', mf_thlforcup_output, pcols, lchnk ) + call outfld( 'edmf_qtforcup' , mf_qtforcup_output, pcols, lchnk ) + call outfld( 'edmf_thlforcdn', mf_thlforcdn_output, pcols, lchnk ) + call outfld( 'edmf_qtforcdn' , mf_qtforcdn_output, pcols, lchnk ) + call outfld( 'edmf_thlforc' , mf_thlforc_output, pcols, lchnk ) + call outfld( 'edmf_qtforc' , mf_qtforc_output, pcols, lchnk ) + call outfld( 'edmf_thlflxup' , mf_thlflxup_output, pcols, lchnk ) + call outfld( 'edmf_qtflxup' , mf_qtflxup_output, pcols, lchnk ) + call outfld( 'edmf_thlflxdn' , mf_thlflxdn_output, pcols, lchnk ) + call outfld( 'edmf_qtflxdn' , mf_qtflxdn_output, pcols, lchnk ) call outfld( 'edmf_thlflx' , mf_thlflx_output, pcols, lchnk ) call outfld( 'edmf_qtflx' , mf_qtflx_output, pcols, lchnk ) + call outfld( 'edmf_thvflx' , mf_thvflx_output, pcols, lchnk ) + call outfld( 'edmf_rcm' , mf_rcm_output, pcols, lchnk ) + call outfld( 'edmf_uflxup' , mf_uflxup_output, pcols, lchnk ) + call outfld( 'edmf_vflxup' , mf_vflxup_output, pcols, lchnk ) + call outfld( 'edmf_uflxdn' , mf_uflxdn_output, pcols, lchnk ) + call outfld( 'edmf_vflxdn' , mf_vflxdn_output, pcols, lchnk ) + call outfld( 'edmf_uflx' , mf_uflx_output, pcols, lchnk ) + call outfld( 'edmf_vflx' , mf_vflx_output, pcols, lchnk ) + call outfld( 'edmf_cloudfrac', mf_cloudfrac_output, pcols, lchnk ) + call outfld( 'edmf_ent' , mf_ent_output, pcols, lchnk ) + call outfld( 'edmf_upa' , mf_upa_output, pcols, lchnk ) + call outfld( 'edmf_upw' , mf_upw_output, pcols, lchnk ) + call outfld( 'edmf_upmf' , mf_upmf_output, pcols, lchnk ) + call outfld( 'edmf_upqt' , mf_upqt_output, pcols, lchnk ) + call outfld( 'edmf_upthl' , mf_upthl_output, pcols, lchnk ) + call outfld( 'edmf_upthv' , mf_upthv_output, pcols, lchnk ) + call outfld( 'edmf_upth' , mf_upth_output, pcols, lchnk ) + call outfld( 'edmf_upqc' , mf_upqc_output, pcols, lchnk ) + call outfld( 'edmf_upbuoy' , mf_upbuoy_output, pcols, lchnk ) + call outfld( 'edmf_upent' , mf_upent_output, pcols, lchnk ) + call outfld( 'edmf_updet' , mf_updet_output, pcols, lchnk ) + call outfld( 'edmf_dnw' , mf_dnw_output, pcols, lchnk ) + call outfld( 'edmf_dnthl' , mf_dnthl_output, pcols, lchnk ) + call outfld( 'edmf_dnqt' , mf_dnqt_output, pcols, lchnk ) + call outfld( 'edmf_sqtup' , mf_sqtup_output, pcols, lchnk ) + call outfld( 'edmf_sqtdn' , mf_sqtdn_output, pcols, lchnk ) + + ! macmic_it==1 ensures that this is ddcp aeraged over the prior time-steps + if (macmic_it==1) call outfld( 'edmf_ztop' , mf_ztop_output, pcols, lchnk ) + if (macmic_it==1) call outfld( 'edmf_ddcp' , mf_ddcp_output, pcols, lchnk ) + + call outfld( 'edmf_L0' , mf_L0_output, pcols, lchnk ) + call outfld( 'edmf_freq' , mf_freq_output, pcols, lchnk ) + call outfld( 'edmf_cape' , mf_cape_output, pcols, lchnk ) + call outfld( 'edmf_cfl' , mf_cfl_output, pcols, lchnk ) + call outfld( 'ICWMRSH' , sh_icwmr_pbuf, pcols, lchnk ) + end if + + if (macmic_it==cld_macmic_num_steps) then + call outfld( 'RCM_CLUBB_macmic' , rcm_macmic, pcols, lchnk ) + call outfld( 'CLDFRAC_CLUBB_macmic' , cldfrac_macmic, pcols, lchnk ) + + call outfld( 'WPTHLP_CLUBB_macmic' , wpthlp_macmic, pcols, lchnk ) + call outfld( 'WPRTP_CLUBB_macmic' , wprtp_macmic, pcols, lchnk ) + call outfld( 'WPTHVP_CLUBB_macmic' , wpthvp_macmic, pcols, lchnk ) + if (do_clubb_mf) then + call outfld( 'edmf_thlflx_macmic' , mf_thlflx_macmic, pcols, lchnk ) + call outfld( 'edmf_qtflx_macmic' , mf_qtflx_macmic, pcols, lchnk ) + call outfld( 'edmf_thvflx_macmic' , mf_thvflx_macmic, pcols, lchnk ) + end if end if ! Output CLUBB history here diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index de85d1ef70..47a886b636 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1,684 +1,3287 @@ module clubb_mf +! =============================================================================== ! +! Mass-flux module for use with CLUBB ! +! Together (CLUBB+MF) they comprise a eddy-diffusivity mass-flux approach (EDMF) ! +! =============================================================================== ! + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_abortutils,only: endrun + use time_manager, only: is_first_step, get_nstep + use spmd_utils, only: iam + use physconst, only: cpair, epsilo, gravit, latice, latvap, tmelt, rair, & + cpwv, cpliq, rh2o, zvir, pi + + implicit none + private + save + + public :: integrate_mf, & + clubb_mf_readnl, & + do_clubb_mf, & + do_clubb_mf_diag, & + clubb_mf_nup, & + do_clubb_mf_rad, & + clubb_mf_Lopt, & + clubb_mf_ddalph, & + clubb_mf_up_ndt, & + clubb_mf_cp_ndt, & + do_clubb_mf_cmt, & + do_clubb_mf_addtke, & + clubb_mf_cldfrac_fac + + ! + ! Lopt 0 = fixed L0 + ! 1 = tke_clubb L0 + ! 2 = wpthlp_clubb L0 + ! 3 = test plume L0 + ! 4 = lel + ! 5 = cape + ! 6 = ztopm1 + ! 7 = rel.hum. at 500 hPa + ! 8 = column int. rel.hum. + integer :: clubb_mf_Lopt = 0 + real(r8) :: clubb_mf_a0 = 0._r8 + real(r8) :: clubb_mf_b0 = 0._r8 + real(r8) :: clubb_mf_L0 = 0._r8 + real(r8) :: clubb_mf_ent0 = 0._r8 + real(r8) :: clubb_mf_alphturb= 0._r8 + real(r8) :: clubb_mf_max_L0 = 0._r8 + real(r8) :: clubb_mf_fdd = 0._r8 + real(r8) :: clubb_mf_ddalph = 0._r8 + real(r8) :: clubb_mf_ddbeta = 0._r8 + real(r8) :: clubb_mf_pwfac = 0._r8 + real(r8) :: clubb_mf_ddexp = 0._r8 + real(r8) :: clubb_mf_cldfrac_fac = 1._r8 + integer :: clubb_mf_up_ndt = 1 + integer :: clubb_mf_cp_ndt = 1 + integer :: clubb_mf_kseed = 1 + integer, protected :: clubb_mf_nup = 0 + logical, protected :: do_clubb_mf = .false. + logical, protected :: do_clubb_mf_diag = .false. + logical, protected :: do_clubb_mf_rad = .false. + logical, protected :: do_clubb_mf_addtke = .false. + logical, protected :: do_clubb_mf_coldpool = .false. + logical, protected :: do_clubb_mf_ustar = .false. + logical, protected :: do_clubb_mf_mixd = .false. + logical, protected :: do_clubb_mf_precip = .false. + logical, protected :: do_clubb_mf_rhtke = .false. + logical, protected :: do_clubb_mf_cmt = .false. + logical, protected :: do_clubb_mf_aloft = .false. + logical, protected :: do_clubb_mf_coldpool_init = .false. + logical, protected :: do_clubb_mf_coldpool_perplume = .false. + logical, protected :: do_clubb_mf_lscale_perplume = .false. + logical :: tht_tweaks = .true. + integer :: mf_num_cin = 5 + + contains + + subroutine clubb_mf_readnl(nlfile) + ! =============================================================================== ! - ! Mass-flux module for use with CLUBB ! - ! Together (CLUBB+MF) they comprise a eddy-diffusivity mass-flux approach (EDMF) ! + ! MF namelists ! ! =============================================================================== ! - - use shr_kind_mod, only: r8=>shr_kind_r8 - use spmd_utils, only: masterproc - use cam_logfile, only: iulog - - implicit none - private - save - - public :: integrate_mf, & - clubb_mf_readnl, & - do_clubb_mf, & - do_clubb_mf_diag - - real(r8) :: clubb_mf_L0 = 0._r8 - real(r8) :: clubb_mf_ent0 = 0._r8 - integer :: clubb_mf_nup = 0 - logical, protected :: do_clubb_mf = .false. - logical, protected :: do_clubb_mf_diag = .false. - - contains - - subroutine clubb_mf_readnl(nlfile) - - ! =============================================================================== ! - ! MF namelists ! - ! =============================================================================== ! - - use namelist_utils, only: find_group_name - use cam_abortutils, only: endrun - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_integer, mpi_logical - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - character(len=*), parameter :: sub = 'clubb_mf_readnl' - - integer :: iunit, read_status, ierr - - - namelist /clubb_mf_nl/ clubb_mf_L0, clubb_mf_ent0, clubb_mf_nup, do_clubb_mf, do_clubb_mf_diag - - if (masterproc) then - open( newunit=iunit, file=trim(nlfile), status='old' ) - call find_group_name(iunit, 'clubb_mf_nl', status=read_status) - if (read_status == 0) then - read(iunit, clubb_mf_nl, iostat=ierr) - if (ierr /= 0) then - call endrun('clubb_mf_readnl: ERROR reading namelist') - end if - end if - close(iunit) - end if - - call mpi_bcast(clubb_mf_L0, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_L0") - call mpi_bcast(clubb_mf_ent0, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ent0") - call mpi_bcast(clubb_mf_nup, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_nup") - call mpi_bcast(do_clubb_mf, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf") - call mpi_bcast(do_clubb_mf_diag, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_diag") - - if ((.not. do_clubb_mf) .and. do_clubb_mf_diag ) then - call endrun('clubb_mf_readnl: Error - cannot turn on do_clubb_mf_diag without also turning on do_clubb_mf') - end if - - - end subroutine clubb_mf_readnl - - subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, & ! input - p_zt, iexner_zt, & ! input - u, v, thl, qt, thv, & ! input - thl_zm, qt_zm, & ! input - wthl, wqt, pblh, & ! input - dry_a, moist_a, & ! output - plume diagnostics - dry_w, moist_w, & ! output - plume diagnostics - dry_qt, moist_qt, & ! output - plume diagnostics - dry_thl, moist_thl, & ! output - plume diagnostics - dry_u, moist_u, & ! output - plume diagnostics - dry_v, moist_v, & ! output - plume diagnostics - moist_qc, & ! output - plume diagnostics - ae, aw, & ! output - diagnosed fluxes BEFORE mean field update - awthl, awqt, & ! output - diagnosed fluxes BEFORE mean field update - awql, awqi, & ! output - diagnosed fluxes BEFORE mean field update - awu, awv, & ! output - diagnosed fluxes BEFORE mean field update - thlflx, qtflx ) ! output - variables needed for solver - - ! ================================================================================= ! - ! Mass-flux algorithm ! - ! ! - ! Provides rtm and thl fluxes due to mass flux ensemble, ! - ! which are fed into the mixed explicit/implicit clubb solver as explicit terms ! - ! ! - ! Variables needed for solver ! - ! ae = sum_i (1-a_i) ! - ! aw3 = sum (a_i w_i) ! - ! aws3 = sum (a_i w_i*s_i); s=thl*cp ! - ! aws3,awqv3,awql3,awqi3,awu3,awv3 similar as above except for different variables ! - ! ! - ! Mass flux variables are computed on edges (i.e. momentum grid): ! - ! upa,upw,upqt,... ! - ! dry_a,moist_a,dry_w,moist_w, ... ! - ! ! - ! In CLUBB (unlike CAM) nlevs of momentum grid = nlevs of thermodynamic grid, ! - ! due to a subsurface thermodynamic layer. To avoid confusion, below the variables ! - ! are grouped by the grid they are on. ! - ! ! - ! *note that state on the lowest thermo level is equal to state on the lowest ! - ! momentum level due to state_zt(1) = state_zt(2), and lowest momentum level ! - ! is a weighted combination of the lowest two thermodynamic levels. ! - ! ! - ! ---------------------------------Authors---------------------------------------- ! - ! Marcin Kurowski, JPL ! - ! Modified heavily by Mikael Witte, UCLA/JPL for implementation in CESM2/E3SM ! - ! Additional modifications by Adam Herrington, NCAR ! - ! ================================================================================= ! - - use physconst, only: rair, cpair, gravit, latvap, latice, zvir - - integer, intent(in) :: nzm, nzt - real(r8), dimension(nzt), intent(in) :: u, v, & ! thermodynamic grid - thl, thv, & ! thermodynamic grid - qt, & ! thermodynamic grid - dzt, & ! thermodynamic grid - p_zt, iexner_zt ! thermodynamic grid - - real(r8), dimension(nzm), intent(in) :: thl_zm, & ! momentum grid - qt_zm, & ! momentum grid - zm, & ! momentum grid - p_zm, iexner_zm ! momentum grid - - real(r8), intent(in) :: wthl,wqt - real(r8), intent(inout) :: pblh - - real(r8),dimension(nzm), intent(out) :: dry_a, moist_a, & ! momentum grid - dry_w, moist_w, & ! momentum grid - dry_qt, moist_qt, & ! momentum grid - dry_thl, moist_thl, & ! momentum grid - dry_u, moist_u, & ! momentum grid - dry_v, moist_v, & ! momentum grid - moist_qc, & ! momentum grid - ae, aw, & ! momentum grid - awthl, awqt, & ! momentum grid - awql, awqi, & ! momentum grid - awu, awv, & ! momentum grid - thlflx, qtflx ! momentum grid - - ! =============================================================================== ! - ! INTERNAL VARIABLES - ! - ! sums over all plumes - real(r8), dimension(nzm) :: moist_th, dry_th, & ! momentum grid - awqv, awth ! momentum grid - ! - ! updraft properties - real(r8), dimension(nzm,clubb_mf_nup) :: upw, upa, & ! momentum grid - upqt, upqc, & ! momentum grid - upqv, upqs, & ! momentum grid - upql, upqi, & ! momentum grid - upth, upthv, & ! momentum grid - upthl, & ! momentum grid - upu, upv ! momentum grid - ! - ! entrainment profiles - real(r8), dimension(nzt,clubb_mf_nup) :: ent, entf ! thermodynamic grid - integer, dimension(nzt,clubb_mf_nup) :: enti ! thermodynamic grid - ! - ! other variables - integer :: k,i,ih - real(r8), dimension(clubb_mf_nup) :: zcb - real(r8) :: zcb_unset, & - wthv, & - wstar, qstar, thvstar, & - sigmaw, sigmaqt, sigmathv,& - wmin, wmax, & - wlv, wtv, wp, & - B, & ! thermodynamic grid - entexp, entexpu, entw, & ! thermodynamic grid - thln, thvn, thn, & ! momentum grid - qtn, qsn, & ! momentum grid - qcn, qln, qin, & ! momentum grid - un, vn, wn2, & ! momentum grid - lmixn, & ! momentum grid - supqt, supthl ! thermodynamic grid - ! - ! parameters defining initial conditions for updrafts - real(r8),parameter :: pwmin = 1.5_r8, & - pwmax = 3._r8 - - ! - ! alpha, z-scores after Suselj etal 2019 - real(r8),parameter :: alphw = 0.572_r8, & - alphqt = 2.890_r8, & - alphthv = 2.890_r8 - ! - ! w' covariance after Suselj etal 2019 - real(r8),parameter :: cwqt = 0.32_r8, & - cwthv = 0.58_r8 - ! - ! virtual mass coefficients for w-eqn after Suselj etal 2019 - real(r8),parameter :: wa = 1.0_r8, & - wb = 1.5_r8 - ! - ! min values to avoid singularities - real(r8),parameter :: wstarmin = 1.e-3_r8, & - pblhmin = 100._r8 - ! - ! to condensate or not to condensate - logical :: do_condensation = .true. - ! - ! to precip or not to precip - logical :: do_precip = .false. - ! - ! to debug flag (overides stochastic entrainment) - logical :: debug = .false. - real(r8),parameter :: fixent = 0.004_r8 - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! INITIALIZE OUTPUT VARIABLES - ! set updraft properties to zero - dry_a = 0._r8 - moist_a = 0._r8 - dry_w = 0._r8 - moist_w = 0._r8 - dry_qt = 0._r8 - moist_qt = 0._r8 - dry_thl = 0._r8 - moist_thl = 0._r8 - dry_u = 0._r8 - moist_u = 0._r8 - dry_v = 0._r8 - moist_v = 0._r8 - moist_qc = 0._r8 - ! outputs - variables needed for solver - aw = 0._r8 - awthl = 0._r8 - awqt = 0._r8 - awqv = 0._r8 - awql = 0._r8 - awqi = 0._r8 - awu = 0._r8 - awv = 0._r8 - thlflx = 0._r8 - qtflx = 0._r8 - - ent = 0._r8 - entf = 0._r8 - enti = 0 - - ! this is the environmental area - by default 1. - ae = 1._r8 - - ! START MAIN COMPUTATION - upw = 0._r8 - upthl = 0._r8 - upthv = 0._r8 - upqt = 0._r8 - upa = 0._r8 - upu = 0._r8 - upv = 0._r8 - upqc = 0._r8 - upth = 0._r8 - upql = 0._r8 - upqi = 0._r8 - upqv = 0._r8 - upqs = 0._r8 - - ! unique identifier - zcb_unset = 9999999._r8 - zcb = zcb_unset - - pblh = max(pblh,pblhmin) - wthv = wthl+zvir*thv(nzt)*wqt - - ! if surface buoyancy is positive then do mass-flux - if ( wthv > 0._r8 ) then - - if (debug) then - ! overide stochastic entrainment with fixent - ent(:,:) = fixent - else - - ! get entrainment coefficient, dz/L0 - do i=1,clubb_mf_nup - do k=nzt,1,-1 - entf(k,i) = dzt(k) / clubb_mf_L0 - enddo - enddo - - ! get poisson, P(dz/L0) - call poisson( nzt, clubb_mf_nup, entf, enti, u(nzt:nzt-3:-1)) - - ! get entrainment, ent=ent0/dz*P(dz/L0) - do i=1,clubb_mf_nup - do k=nzt,1,-1 - ent(k,i) = real( enti(k,i))*clubb_mf_ent0/dzt(k) - enddo - enddo - + + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_integer, mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + character(len=*), parameter :: sub = 'clubb_mf_readnl' + + integer :: iunit, read_status, ierr + + + namelist /clubb_mf_nl/ clubb_mf_Lopt, clubb_mf_a0, clubb_mf_b0, clubb_mf_L0, clubb_mf_ent0, clubb_mf_alphturb, & + clubb_mf_nup, clubb_mf_max_L0, do_clubb_mf, do_clubb_mf_diag, do_clubb_mf_precip, do_clubb_mf_rad, & + clubb_mf_fdd, do_clubb_mf_coldpool, clubb_mf_ddalph, clubb_mf_ddbeta, clubb_mf_pwfac, do_clubb_mf_ustar, & + clubb_mf_ddexp, do_clubb_mf_mixd, clubb_mf_up_ndt, clubb_mf_cp_ndt, do_clubb_mf_rhtke, do_clubb_mf_cmt, & + do_clubb_mf_coldpool_init, do_clubb_mf_coldpool_perplume, do_clubb_mf_lscale_perplume, clubb_mf_kseed, & + do_clubb_mf_addtke, do_clubb_mf_aloft, clubb_mf_cldfrac_fac + + if (masterproc) then + open( newunit=iunit, file=trim(nlfile), status='old' ) + call find_group_name(iunit, 'clubb_mf_nl', status=read_status) + if (read_status == 0) then + read(iunit, clubb_mf_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('clubb_mf_readnl: ERROR reading namelist') end if - - ! get surface conditions - wstar = max( wstarmin, (gravit/thv(nzt)*wthv*pblh)**(1._r8/3._r8) ) + end if + close(iunit) + end if + + call mpi_bcast(clubb_mf_Lopt, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_Lopt") + call mpi_bcast(clubb_mf_a0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_a0") + call mpi_bcast(clubb_mf_b0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_b0") + call mpi_bcast(clubb_mf_L0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_L0") + call mpi_bcast(clubb_mf_ent0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ent0") + call mpi_bcast(clubb_mf_alphturb,1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_alphturb") + call mpi_bcast(clubb_mf_nup, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_nup") + call mpi_bcast(clubb_mf_max_L0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_max_L0") + call mpi_bcast(do_clubb_mf, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf") + call mpi_bcast(do_clubb_mf_diag, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_diag") + call mpi_bcast(do_clubb_mf_precip, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_precip") + call mpi_bcast(do_clubb_mf_rad, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_rad") + call mpi_bcast(clubb_mf_fdd, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_fdd") + call mpi_bcast(do_clubb_mf_coldpool, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_coldpool") + call mpi_bcast(clubb_mf_ddalph, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ddalph") + call mpi_bcast(clubb_mf_ddbeta, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ddbeta") + call mpi_bcast(clubb_mf_pwfac, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_pwfac") + call mpi_bcast(clubb_mf_up_ndt, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_up_ndt") + call mpi_bcast(clubb_mf_cp_ndt, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_cp_ndt") + call mpi_bcast(do_clubb_mf_ustar, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_ustar") + call mpi_bcast(clubb_mf_ddexp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ddexp") + call mpi_bcast(do_clubb_mf_mixd, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_mixd") + call mpi_bcast(do_clubb_mf_rhtke, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_rhtke") + call mpi_bcast(do_clubb_mf_cmt, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_cmt") + call mpi_bcast(clubb_mf_kseed, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_kseed") + call mpi_bcast(do_clubb_mf_coldpool_init, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_coldpool_init") + call mpi_bcast(do_clubb_mf_coldpool_perplume, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_coldpool_perplume") + call mpi_bcast(do_clubb_mf_lscale_perplume, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_lscale_perplume") + call mpi_bcast(do_clubb_mf_addtke, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_addtke") + call mpi_bcast(do_clubb_mf_aloft, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_aloft") + call mpi_bcast(clubb_mf_cldfrac_fac, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_cldfrac_fac") + + if ((.not. do_clubb_mf) .and. do_clubb_mf_diag ) then + call endrun('clubb_mf_readnl: Error - cannot turn on do_clubb_mf_diag without also turning on do_clubb_mf') + end if + + end subroutine clubb_mf_readnl + + + subroutine integrate_mf( nzm, nzt, & ! input + rho_zm, zm, p_zm, iexner_zm, & ! input + rho_zt, dzt, zt, p_zt, iexner_zt, & ! input + u, v, thl, qt, thv, & ! input + ktropo, w, th, qv, qc, & ! input + thl_zm, qt_zm, thv_zm, & ! input + th_zm, qv_zm, qc_zm, & ! input + ustar, ths, wthl_sfc, wqt_sfc, pblh, & ! input + wpthlp_env, tke, tpert, ztopm1, rhinv, & ! input + wpthvp_env, wpqtp_env, mcape, ddcp, cbm1, & ! output + upa, dna, & ! output + upw, dnw, & ! output + upmf, & ! output + upqt, dnqt, & ! output + upthl, dnthl, & ! output + upthv, dnthv, & ! output + upth, dnth, & ! output + upqc, dnqc, & ! output + upbuoy, & ! output + upent, & ! output + updet, & ! output + dry_a, moist_a, & ! output + dry_w, moist_w, & ! output + dry_qt, moist_qt, & ! output + dry_thl, moist_thl, & ! output + dry_u, moist_u, & ! output + dry_v, moist_v, & ! output + moist_qc, & ! output + ae, & + ac, aup, adn, & + aw, awup, awdn, & + aww, awwup, awwdn, & + awthlup, awqtup, awuup, awvup, & ! output + awthldn, awqtdn, awudn, awvdn, & ! output + awthl, awqt, & ! output + awu, awv, & ! output + thlflxup,qtflxup, uflxup, vflxup, & ! output + thlflxdn,qtflxdn, uflxdn, vflxdn, & ! output + thlflx, qtflx, uflx, vflx, & ! output - variables needed for solver + thvflx, & ! output + sqtup, sthlup, & ! output + sqtdn, sthldn, & ! output + sqt, sthl, & ! output - variables needed for solver + precc, & ! output + ztop, dynamic_L0 ) + + ! ================================================================================= ! + ! Mass-flux algorithm ! + ! ! + ! Provides rtm and thl fluxes due to mass flux ensemble, ! + ! which are fed into the mixed explicit/implicit clubb solver as explicit terms ! + ! ! + ! Mass flux variables are computed on edges (i.e. momentum grid): ! + ! upa,upw,upqt,... ! + ! dry_a,moist_a,dry_w,moist_w, ... ! + ! ! + ! In CLUBB (unlike CAM) nlevs of momentum grid = nlevs of thermodynamic grid, ! + ! due to a subsurface thermodynamic layer. To avoid confusion, below the variables ! + ! are grouped by the grid they are on. ! + ! ! + ! *note that state on the lowest thermo level is equal to state on the lowest ! + ! momentum level due to state_zt(1) = state_zt(2), and lowest momentum level ! + ! is a weighted combination of the lowest two thermodynamic levels. ! + ! ! + ! ---------------------------------Authors---------------------------------------- ! + ! Marcin Kurowski, JPL ! + ! Modified heavily by Mikael Witte, UCLA/JPL for implementation in CESM2/E3SM ! + ! Additional modifications by Adam Herrington, NCAR ! + ! ================================================================================= ! + + use wv_saturation, only : qsat + + integer, intent(in) :: nzm, nzt, ktropo + real(r8), dimension(nzt), intent(in) :: u, v, & ! thermodynamic grid + thl, thv, & ! thermodynamic grid + th, qv, & ! thermodynamic grid + qt, qc, & ! thermodynamic grid + p_zt, iexner_zt, & ! thermodynamic grid + dzt, rho_zt, & ! thermodynamic grid + zt + + real(r8), dimension(nzm), intent(in) :: thl_zm, thv_zm, & ! momentum grid + w, & + th_zm, qv_zm, & + qt_zm, qc_zm, & ! momentum grid + p_zm, iexner_zm, & ! momentum grid + rho_zm, & ! momentum grid + zm, & ! momentum grid + tke, wpthlp_env, & ! momentum grid + wpthvp_env, wpqtp_env + + real(r8), intent(in) :: wthl_sfc,wqt_sfc + real(r8), intent(in) :: pblh,tpert + real(r8), intent(in) :: rhinv + real(r8), intent(in) :: ths,ustar + real(r8), intent(inout) :: cbm1 + + real(r8),dimension(clubb_mf_nup), intent(inout) :: ztopm1,ddcp + + real(r8),dimension(nzm,clubb_mf_nup), intent(out) :: upa, & ! momentum grid + upw, & ! momentum grid + upmf, & ! momentum grid + upqt, & ! momentum grid + upthl, & ! momentum grid + upthv, & ! momentum grid + upth, & ! momentum grid + upqc, & ! momentum grid + upbuoy, & ! momentum grid + upent, & ! momentum grid + updet + + real(r8),dimension(nzm,clubb_mf_nup), intent(out) :: dna, & ! momentum grid + dnw, & ! momentum grid + dnqt, & ! momentum grid + dnthl, & ! momentum grid + dnthv, & ! momentum grid + dnth, & ! momentum grid + dnqc + + real(r8),dimension(nzm), intent(out) :: dry_a, moist_a, & ! momentum grid + dry_w, moist_w, & ! momentum grid + dry_qt, moist_qt, & ! momentum grid + dry_thl, moist_thl, & ! momentum grid + dry_u, moist_u, & ! momentum grid + dry_v, moist_v, & ! momentum grid + moist_qc ! momentum grid + + real(r8),dimension(nzm), intent(out) :: ae, & + ac, aup, adn, & + aw, awup, awdn, & + aww, awwup, awwdn, & + awthlup, awqtup, awuup, awvup, & ! momentum grid + awthldn, awqtdn, awudn, awvdn, & ! momentum grid + awthl, awqt, & ! momentum grid + awu, awv, & ! momentum grid + thlflxup,qtflxup, uflxup, vflxup, & ! momentum grid + thlflxdn,qtflxdn, uflxdn, vflxdn, & ! momentum grid + thlflx, qtflx, uflx, vflx, & ! momentum grid + thvflx, precc + + real(r8),dimension(nzt), intent(out) :: sqtup, sthlup, & ! thermodynamic grid + sqtdn, sthldn, & ! thermodynamic grid + sqt, sthl ! thermodynamic grid + + real(r8),dimension(clubb_mf_nup), intent(out) :: ztop, dynamic_L0, mcape + + ! =============================================================================== ! + ! INTERNAL VARIABLES + ! + + ! =============================================================================== ! + ! GRID ORIENTATION GENERALIZATION VARIABLES + ! ------------------------------------------------------------------------------- ! + ! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without + ! duplicating code, these variables abstract the vertical loop bounds and slices. + ! + ! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. + ! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. + ! kdir : Directional step (+1 for moving up, -1 for moving down). + ! + ! STAGGERED GRID INDEXING + ! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative + ! index of the cell center (zt) to the interface (zm) flips depending on whether + ! memory is loaded top-down or bottom-up. These variables dynamically map them: + ! + ! kt : The active thermodynamic cell center associated with the current step. + ! Upward Sweep: kt = k - (1-kdir)/2 + ! Downward Sweep: kt = k - (1+kdir)/2 + ! + ! kn : The NEXT momentum interface in the direction of the current sweep. + ! Upward Sweep: kn = k + kdir + ! Downward Sweep: kn = k - kdir + ! + ! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. + ! kt_up = k - (1-kdir)/2 + ! + ! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. + ! kt_dn = k - (1+kdir)/2 + ! =============================================================================== ! + integer :: ksfcm, ktopm, ksfct, ktopt, kdir, kt, kn, kt_up, kt_dn + + ! sums over all plumes + real(r8), dimension(nzm) :: moist_th, dry_th, & + thl_env, qt_env, & + thv_env, & + thvflxup, thvflxdn, & + awthvup, awthvdn + ! updraft properties + real(r8), dimension(nzm,clubb_mf_nup) :: upqv, upqs, & ! momentum grid + upql, upqi, & ! momentum grid + upu, upv, & ! momentum grid + uplmix, upauto ! momentum grid + ! downdraft properties + real(r8), dimension(nzm,clubb_mf_nup) :: dnqs, & ! momentum grid + dnql, dnqi, & ! momentum grid + dnu, dnv, & ! momentum grid + dnlmix ! momentum grid + ! microphyiscs terms + real(r8), dimension(nzt,clubb_mf_nup) :: supqt, supthl, & ! thermodynamic grid + sdnqt, sdnthl, & ! thermodynamic grid + uprr, dnrr + ! entrainment profiles + real(r8), dimension(nzt,clubb_mf_nup) :: entf, mix ! thermodynamic grid + integer, dimension(nzt,clubb_mf_nup) :: enti ! thermodynamic grid + + ! other variables + integer :: k,i,kstart,ddtop,kcb,kpbl,kmid,nbot + integer, dimension(clubb_mf_nup) :: ddbot,kcbarr + real(r8), dimension(clubb_mf_nup) :: zcb,cpfac + real(r8) :: zcb_unset, & + wthv_sfc, wthv, wqt, & + ddint, iddcp, & + wstar, qstar, thvstar, & + sigmaw, sigmaqt, sigmathv,& + convh, wmin, wmax, & + wlv, wtv, wp, & + B, & ! thermodynamic grid + entexp, entexpu, entw, & ! thermodynamic grid + Mn, & ! momentum grid + eturb, det, lmixt, & ! thermodynamic grid + qtovqs, sevap, taum1, & ! thermodynamic grid + sqtint, sthlint, alphint, & + qtmp, betathl, betaqt, & ! thermodynamic grid + thln, thvn, thn, & ! momentum grid + qtn, qsn, & ! momentum grid + qcn, qln, qin, & ! momentum grid + un, vn, wn2, & ! momentum grid + wn, & ! momentum grid + lmixn, srfarea, & ! momentum grid + srfwqtu, srfwthvu, & + facqtu, facthvu, & + zsub, wcb, rh_L0, & + dzext + + real(r8), dimension(nzt-1,1) :: dmpdz + real(r8), dimension(1) :: tl, & + cape, cin + integer, dimension(1) :: lcl, lel + real(r8) :: landfrac + integer :: msg, & + lon, mx + ! limit convective area + logical :: limarea = .false. + real(r8),parameter :: amax = 0.6_r8 + + ! buoyancy sorting variables + logical :: bsort = .false. + real(r8),parameter :: rle = 0.1_r8 + integer :: niter_xc = 1 + integer :: kk, status, iter_xc + real(r8) :: tlm, excessm, qsm, & + tln, excessn, es, & + xc, xsat, x_en, & + x_cu, xs1, xs2, & + aquad, bquad, cquad, & + thlxsat, thvxsat, qtxsat, & + thv_x0, thv_x1, cridis, & + thln0, qtn0, wn0, & + entn, detn, mfn, & + ee2, ud2 + + real(r8), dimension(4) :: u_seed + + ! parameters defining initial conditions for updrafts + real(r8),parameter :: pwmin = 1.5_r8, & + pwmax = 3._r8 + + ! alpha relates star qunataties to stddev after Suselj etal 2019 + real(r8),parameter :: alphw = 0.572_r8, & + alphqt = 2.890_r8, & + alphthv = 2.890_r8 + ! w' covariance after Suselj etal 2019 + real(r8),parameter :: cwqt = 0.32_r8, & + cwthv = 0.58_r8 + ! virtual mass coefficients for w-eqn after Suselj etal 2019 + real(r8),parameter :: wa = 1.0_r8, & + wb = 1.5_r8 + ! min values to avoid singularities + real(r8),parameter :: wstarmin = 1.e-3_r8, & + pblhmin = 100._r8 + ! evaporation efficiency after Suselj etal 2019 + real(r8),parameter :: ke = 2.5e-4_r8 + ! height here downdrafts feel the surface + real(r8),parameter :: z00dn = 1.e3_r8, & + tinynum = 1.e-7_r8 + ! to fix entrainmnet rate + logical :: fixent = .false. + ! fixed entrainment rate + real(r8),parameter :: fixent_ent = 2.e-4_r8 + ! Arakawa and Schubert detrainment limiter + logical :: do_aspd = .false. + ! Lower limit on entrainment length scale + real(r8),parameter :: min_L0 = 0.5_r8 + ! limiter for tke enahnced fractional entrainment + ! (only used when do_aspd = .true.) + real(r8),parameter :: max_eturb = 10._r8 + ! to condensate or not to condensate + logical :: do_condensation = .true. + ! use implicit method for plume updraft velocity + logical :: do_implicit = .false. + ! to scale surface fluxes + logical :: scalesrf = .false. + ! minimum downdraft speed + real(r8),parameter :: mindnw = 1.E-2_r8 + ! limiter on cold pool effects + real(r8),parameter :: max_cpfac = 5._r8 + ! max limiter on cold pool init effects + real(r8),parameter :: max_cpinit = 0.5_r8 + ! to scale surface fluxes + logical :: aloft = .false. + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! DETERMINE GRID ORIENTATION + if (zm(1) < zm(nzm)) then + ! Bottom-up + ksfcm = 1 + ktopm = nzm + kdir = 1 + else + ! Top-down + ksfcm = nzm + ktopm = 1 + kdir = -1 + end if + + if (zt(1) < zt(nzt)) then + ksfct = 1 + ktopt = nzt + else + ksfct = nzt + ktopt = 1 + end if + + ! INITIALIZE OUTPUT VARIABLES + dry_a = 0._r8 + moist_a = 0._r8 + dry_w = 0._r8 + moist_w = 0._r8 + dry_qt = 0._r8 + moist_qt = 0._r8 + dry_thl = 0._r8 + moist_thl = 0._r8 + dry_u = 0._r8 + moist_u = 0._r8 + dry_v = 0._r8 + moist_v = 0._r8 + moist_qc = 0._r8 + + ! this is the environmental area - by default 1. + ae = 1._r8 + ac = 0._r8 + aup = 0._r8 + adn = 0._r8 + aw = 0._r8 + awup = 0._r8 + awdn = 0._r8 + aww = 0._r8 + awwup = 0._r8 + awwdn = 0._r8 + awuup = 0._r8 + awvup = 0._r8 + awudn = 0._r8 + awvdn = 0._r8 + awthvup = 0._r8 + awthvdn = 0._r8 + awthlup = 0._r8 + awqtup = 0._r8 + awthldn = 0._r8 + awqtdn = 0._r8 + awthl = 0._r8 + awqt = 0._r8 + awu = 0._r8 + awv = 0._r8 + thvflxup = 0._r8 + thlflxup = 0._r8 + qtflxup = 0._r8 + thvflxdn = 0._r8 + thlflxdn = 0._r8 + qtflxdn = 0._r8 + thvflx = 0._r8 + thlflx = 0._r8 + uflxup = 0._r8 + vflxup = 0._r8 + uflxdn = 0._r8 + vflxdn = 0._r8 + uflx = 0._r8 + vflx = 0._r8 + qtflx = 0._r8 + sqtup = 0._r8 + sthlup = 0._r8 + sqtdn = 0._r8 + sthldn = 0._r8 + sqt = 0._r8 + sthl = 0._r8 + precc = 0._r8 + + mix = 0._r8 + entf = 0._r8 + enti = 0 + det = 0._r8 + + ! START MAIN COMPUTATION + upw = 0._r8 + upth = 0._r8 + upthl = 0._r8 + upthv = 0._r8 + upqt = 0._r8 + upa = 0._r8 + upmf = 0._r8 + upu = 0._r8 + upv = 0._r8 + upqc = 0._r8 + upth = 0._r8 + upql = 0._r8 + upqi = 0._r8 + upqv = 0._r8 + upqs = 0._r8 + upbuoy= 0._r8 + uplmix= 0._r8 + uprr = 0._r8 + supqt = 0._r8 + supthl= 0._r8 + upent = 0._r8 + updet = 0._r8 + upauto= 0._r8 + + dnw = 0._r8 + dna = 0._r8 + dnu = 0._r8 + dnv = 0._r8 + dnqt = 0._r8 + dnthl = 0._r8 + dnthv = 0._r8 + dnrr = 0._r8 + dnth = 0._r8 + dnqc = 0._r8 + dnql = 0._r8 + dnqi = 0._r8 + dnqs = 0._r8 + dnlmix= 0._r8 + sdnqt = 0._r8 + sdnthl= 0._r8 + + dynamic_L0 = 0._r8 + ztop = 0._r8 + ddbot= 0 + + if (bsort) then + niter_xc = 3 + limarea = .true. + end if + + ! unique identifier + zcb_unset = 9999999._r8 + zcb = zcb_unset + + ! surface buoyancy flux + !wthv = wthl+zvir*ths*wqt + wthv_sfc = wthl_sfc+zvir*ths*wqt_sfc + + if (do_clubb_mf_aloft .and. wthv_sfc < 0.01_r8) then + aloft = .true. + kpbl = ksfcm + do while (zm(kpbl) < pblh) + kpbl = kpbl + kdir + end do + + kmid = ksfcm + ! Use a pressure-based criterion to locate the mid-level within the + ! troposphere. A threshold of ~500 hPa is preferred over the previous + ! fixed height (9 km) because it better represents the tropopause + ! location across different atmospheric conditions. + do while (p_zm(kmid) > 500.E2_r8) + kmid = kmid + kdir + end do + + ! Search absolute bounds by converting relative slice index + kstart = maxloc(wpthvp_env(kpbl : kmid : kdir), DIM=1) + kstart = kpbl + (kstart - 1) * kdir + + wthv = wpthvp_env(kstart) + wqt = wpqtp_env(kstart) + + if (kstart == ktopm) then + wthv = 0._r8 + wqt = 0._r8 + end if + + else + aloft = .false. + kstart = ksfcm + wthv = wthv_sfc + wqt = wqt_sfc + end if + + ! if surface buoyancy is positive then do mass-flux + !if ( wthv > 0._r8 ) then + if ( wthv > 0._r8 .and. wqt > 0._r8) then + + if (do_clubb_mf_mixd) then + convh = max(cbm1,pblhmin) + else + convh = max(pblh,pblhmin) + end if + + ! --------------------------------------------------------- ! + ! Initialize using Deardorff convective velocity scale ! + ! --------------------------------------------------------- ! + wstar = max( wstarmin, (gravit/thv(kstart - (1-kdir)/2)*wthv*convh)**(1._r8/3._r8) ) + + ! --------------------------------------------------------- ! + ! Compute cold pool feedback parameter ! + ! --------------------------------------------------------- ! + + cpfac(:) = 1._r8 + if (do_clubb_mf_coldpool) then + do i=1,clubb_mf_nup + cpfac(i) = min( (max(ddcp(i)/wstar,1._r8))**clubb_mf_ddbeta, max_cpfac ) + end do + end if + + ! --------------------------------------------------------- ! + ! Construct tri-variate PDF at the surface from wstar ! + ! and initialize plume thv, qt, w ! + ! --------------------------------------------------------- ! + + if (do_clubb_mf_ustar) then + qstar = wqt / max(wstarmin,ustar) + thvstar = wthv / max(wstarmin,ustar) + else qstar = wqt / wstar thvstar = wthv / wstar - - sigmaw = alphw * wstar - sigmaqt = alphqt * abs(qstar) - sigmathv = alphthv * abs(thvstar) - + end if + + do i=1,clubb_mf_nup + + if (do_clubb_mf_coldpool_init) then + sigmaw = alphw * wstar * (1._r8 + max_cpinit*cpfac(i)/max_cpfac) + sigmaqt = alphqt * abs(qstar) * (1._r8 + max_cpinit*cpfac(i)/max_cpfac) + sigmathv = alphthv * abs(thvstar) * (1._r8 + max_cpinit*cpfac(i)/max_cpfac) + else + sigmaw = alphw * wstar + sigmaqt = alphqt * abs(qstar) + sigmathv = alphthv * abs(thvstar) + end if + wmin = sigmaw * pwmin wmax = sigmaw * pwmax - + + wlv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * (real(i-1, r8)) + wtv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * real(i,r8) + + upw(kstart,i) = 0.5_r8 * (wlv+wtv) + upa(kstart,i) = 0.5_r8 * erf( wtv/(sqrt(2._r8)*sigmaw) ) & + - 0.5_r8 * erf( wlv/(sqrt(2._r8)*sigmaw) ) + + upu(kstart,i) = u(kstart - (1-kdir)/2) + upv(kstart,i) = v(kstart - (1-kdir)/2) + + upqt(kstart,i) = cwqt * upw(kstart,i) * sigmaqt/sigmaw + upthv(kstart,i) = cwthv * upw(kstart,i) * sigmathv/sigmaw + enddo + + facqtu=1._r8 + facthvu=1._r8 + if (scalesrf) then + ! scale surface fluxes + ! (req'd for conservation if not running with zero-flux b.c.'s) + srfwqtu = 0._r8 + srfwthvu = 0._r8 + srfarea = 0._r8 + do i=1,clubb_mf_nup + srfwqtu=srfwqtu+upqt(kstart,i)*upw(kstart,i)*upa(kstart,i) + srfwthvu=srfwthvu+upthv(kstart,i)*upw(kstart,i)*upa(kstart,i) + srfarea = srfarea+upa(kstart,i) + end do + facqtu=srfarea*wqt/srfwqtu + facthvu=srfarea*wthv/srfwthvu + end if + + do i=1,clubb_mf_nup + + kt = kstart - (1-kdir)/2 + kn = kstart + kdir + + betaqt = (qt(kt+2*kdir)-qt(kt))/(0.5_r8*(dzt(kt+2*kdir)+2._r8*dzt(kt+kdir)+dzt(kt))) + betathl = (thv(kt+2*kdir)-thv(kt))/(0.5_r8*(dzt(kt+2*kdir)+2._r8*dzt(kt+kdir)+dzt(kt))) + + if (.not.aloft) then +!jt The following 2 lines I think are correct since the surface is .5 grid down from the surface dzt +!jt upqt(kstart,i)= qt(kt)-betaqt*0.5_r8*dzt(kt)+facqtu*upqt(kstart,i) +!jt upthv(kstart,i)= thv(kt)-betathl*0.5_r8*dzt(kt)+facthvu*upthv(kstart,i) +!jt The following 2 lines are to restore bfb accuracy + upqt(kstart,i)= qt(kt)-betaqt*dzt(kt)+facqtu*upqt(kstart,i) + upthv(kstart,i)= thv(kt)-betathl*dzt(kt)+facthvu*upthv(kstart,i) + else + upqt(kstart,i)= qt(kt)+upqt(kstart,i) + upthv(kstart,i)= thv(kt)+upthv(kstart,i) + if (w(kstart) > 0._r8) upw(kstart,i)= w(kstart)+upw(kstart,i) + end if + + upthl(kstart,i) = upthv(kstart,i) / (1._r8+zvir*upqt(kstart,i)) + upth(kstart,i) = upthl(kstart,i) + upmf(kstart,i) = rho_zm(kstart)*upa(kstart,i)*upw(kstart,i) + + ! get cloud, lowest momentum level + if (do_condensation) then + call condensation_mf(upqt(kstart,i), upthl(kstart,i), p_zm(kstart), iexner_zm(kstart), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + upthv(kstart,i) = thvn + upqc(kstart,i) = qcn + upql(kstart,i) = qln + upqi(kstart,i) = qin + upqs(kstart,i) = qsn + upth(kstart,i) = thn + if (qcn > 0._r8) zcb(i) = zm(kstart) + else + ! assume no cldliq + upqc(kstart,i) = 0._r8 + end if + end do + + ! if aloft extend the mass flux plume below kstart nbot levels + if (aloft) then + zsub = zm(kstart) + dzext = 1000._r8 + !if greater than dzext above the surface + if (zsub > dzext) then + ! find nbot levs below kstart + nbot = 0 + do k = kstart-kdir, ksfcm, -kdir + if ((zm(kstart)-zm(k)) < dzext) then + nbot = nbot + 1 + end if + end do + else + !else set dxext to height above the suface + dzext = zm(kstart) - zm(ksfcm) + nbot = abs(kstart-ksfcm) + end if + + zsub = zm(kstart) do i=1,clubb_mf_nup - - wlv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * (real(i-1, r8)) - wtv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * real(i,r8) - - upw(nzm,i) = 0.5_r8 * (wlv+wtv) - upa(nzm,i) = 0.5_r8 * erf( wtv/(sqrt(2._r8)*sigmaw) ) & - - 0.5_r8 * erf( wlv/(sqrt(2._r8)*sigmaw) ) - - upu(nzm,i) = u(nzt) - upv(nzm,i) = v(nzt) - - upqt(nzm,i) = qt(nzt) + cwqt * upw(nzm,i) * sigmaqt/sigmaw - upthv(nzm,i) = thv(nzt) + cwthv * upw(nzm,i) * sigmathv/sigmaw - upthl(nzm,i) = upthv(nzm,i) / (1._r8+zvir*upqt(nzm,i)) - - ! get cloud, lowest momentum level - if (do_condensation) then - call condensation_mf(upqt(nzm,i), upthl(nzm,i), p_zm(nzm), iexner_zm(nzm), & - thvn, qcn, thn, qln, qin, qsn, lmixn) - upthv(nzm,i) = thvn - upqc(nzm,i) = qcn - upql(nzm,i) = qln - upqi(nzm,i) = qin - upqs(nzm,i) = qsn - if (qcn > 0._r8) zcb(i) = zm(nzm) + wcb = upw(kstart,i) + do k = kstart-kdir, kstart-nbot*kdir, -kdir + upw(k,i) = wcb - (wcb/(dzext**clubb_mf_ddexp))*(zsub - zm(k))**clubb_mf_ddexp + upa(k,i) = upa(kstart,i) + upmf(k,i) = rho_zm(k)*upa(k,i)*upw(k,i) + + upu(k,i) = upu(kstart,i) + upv(k,i) = upv(kstart,i) + upqt(k,i) = upqt(kstart,i) + upthv(k,i) = upthv(kstart,i) + upthl(k,i) = upthl(kstart,i) + upth(k,i) = upth(kstart,i) + upqc(k,i) = upqc(kstart,i) + upql(k,i) = upql(kstart,i) + upqi(k,i) = upqi(kstart,i) + upqs(k,i) = upqs(kstart,i) + end do + end do + end if + + do i=1,clubb_mf_nup + ! --------------------------------------------------------- ! + ! Calculate ztop and dynamic_L based on value of namelist ! + ! --------------------------------------------------------- ! + call get_Lscale (nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, th, & + wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, wa, wb, & + do_condensation, qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1(i), dynamic_L0(i), ztop(i), mcape(i)) + + ! cold pool feedback on the entrainmnet length scale + dynamic_L0(i) = dynamic_L0(i) * cpfac(i) + + ! limit max/min + dynamic_L0(i) = max(min_L0,dynamic_L0(i)) + dynamic_L0(i) = min(clubb_mf_max_L0,dynamic_L0(i)) + + ! --------------------------------------------------------- ! + ! Stochastic entrainmnet calculation ! + ! From Suselj et al 2019, after Romps and Kuang 2010 ! + ! (ideally we wouldn't fill the entire arrray w/ the RNG, ! + ! but the RNG doesn't work properly when it operates on ! + ! the entire array. I'm not sure why this is happening.) ! + ! --------------------------------------------------------- ! + do k = ksfct, ktopt-kdir, kdir + ! get entrainment coefficient, dz/L0 + entf(k,i) = dzt(k) / dynamic_L0(i) + end do + end do + + ! get poisson, P(dz/L0) + ! Grab the u-wind from the exact physical near-surface layers to preserve the PRNG seed + u_seed(1) = u(ksfct) + u_seed(2) = u(ksfct + (clubb_mf_kseed + 0)* kdir) + u_seed(3) = u(ksfct + (clubb_mf_kseed + 1) * kdir) + u_seed(4) = u(ksfct + (clubb_mf_kseed + 2) * kdir) + + ! get poisson, P(dz/L0) + call poisson( nzt, clubb_mf_nup, ksfct, ktopt, kdir, entf, enti, u_seed ) + ! call poisson( nzt, clubb_mf_nup, entf, enti, u(clubb_mf_kseed+1:clubb_mf_kseed+4)) + + ! --------------------------------------------------------- ! + ! Main upward sweep to compute updraft properties ! + ! ! + ! --------------------------------------------------------- ! + do i=1,clubb_mf_nup + do k = kstart, ktopm-kdir, kdir + + kt = k - (1-kdir)/2 + kn = k + kdir + + ! get microphysics, autoconversion + if (do_clubb_mf_precip .and. upqc(k,i) > 0._r8) then + call precip_mf(upqs(k,i),upqt(k,i),upw(k,i),dzt(kt),abs(zm(kn)-zcb(i)),supqt(kt,i)) + supthl(kt,i) = -1._r8*lmixn*supqt(kt,i)*iexner_zt(kt)/cpair else - ! assume no cldliq - upqc(nzm,i) = 0._r8 + supqt(kt,i) = 0._r8 + supthl(kt,i) = 0._r8 end if - - enddo - - ! get updraft properties - do i=1,clubb_mf_nup - do k=nzm,2,-1 - ! get microphysics, autoconversion - if (do_precip .and. upqc(k,i) > 0._r8) then - call precip_mf(upqs(k,i),upqt(k,i),upw(k,i),dzt(k-1),zm(k-1)-zcb(i),supqt) - - supthl = -1._r8*lmixn*supqt*iexner_zt(k-1)/cpair + ! compute mixing rate + if (fixent) then + mix(kt,i) = fixent_ent + else + ! get entrainment, ent=ent0/dz*P(dz/L0) + mix(kt,i) = real( enti(kt,i))*clubb_mf_ent0/dzt(kt) + end if + + do iter_xc = 1, niter_xc + + if (bsort) then + if (iter_xc==1) then + qtn = upqt(k,i) + thln = upthl(k,i) + wn = upw(k,i) + else + qtn = 0.5_r8*(qtn + qtn0) + thln = 0.5_r8*(thln + thln0) + wn = 0.5_r8*(wn + wn0) + end if + + ! save this iteration + qtn0 = qtn + thln0 = thln + wn0 = wn + + ! --------------------------------------------------------- ! + ! Compute excess water to derive neutral mixing fraction ! + ! after Bretherton et al 2014 ! + ! --------------------------------------------------------- ! + + ! qexcess of the envrionment + tlm = thl_zm(kn)/iexner_zm(kn) + call qsat(tlm,p_zm(kn),es,qsm) + excessm = qt_zm(kn) - qsm + + ! qexcess in plume + tln = thln/iexner_zm(kn) + call qsat(tln,p_zm(kn),es,qsn) + excessn = qtn - qsn + + call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + + ! critical stopping distance + cridis = rle*ztopm1(i) + + ! ----------------------------------------------------------------- ! + ! Case 1 : When both cumulus and env. are unsaturated or saturated. ! + ! ----------------------------------------------------------------- ! + if (excessm*excessn > 0._r8) then + xc = min(1._r8,max(0._r8,1._r8-2._r8*wa*gravit*cridis/wn**2._r8*(1._r8-thvn/thv_zm(kn)))) + aquad = 0._r8 + bquad = 0._r8 + cquad = 0._r8 + else + ! -------------------------------------------------- ! + ! Case 2 : When either cumulus or env. is saturated. ! + ! -------------------------------------------------- ! + xsat = excessn / ( excessn - excessm ); + thlxsat = thln + xsat * ( thl_zm(kn) - thln ); + qtxsat = qtn + xsat * ( qt_zm(kn) - qtn ); + call condensation_mf(qtxsat, thlxsat, p_zm(kn), iexner_zm(kn), & + thvxsat, qcn, thn, qln, qin, qsn, lmixn) + ! -------------------------------------------------- ! + ! kk=1 : Cumulus Segment, kk=2 : Environment Segment ! + ! -------------------------------------------------- ! + do kk = 1, 2 + if( kk .eq. 1 ) then + thv_x0 = thvn + thv_x1 = ( 1._r8 - 1._r8/xsat ) * thvn + ( 1._r8/xsat ) * thvxsat + else + thv_x1 = thv_zm(kn) + thv_x0 = ( xsat / ( xsat - 1._r8 ) ) * thv_zm(kn) + ( 1._r8/( 1._r8 - xsat ) ) * thvxsat + endif + aquad = wn**2 + bquad = 2._r8*wa*gravit*cridis*(thv_x1 - thv_x0)/thv_zm(kn) - 2._r8*wn**2 + cquad = 2._r8*wa*gravit*cridis*(thv_x0 - thv_zm(kn))/thv_zm(kn) + wn**2 + if( kk .eq. 1 ) then + if( ( bquad**2-4._r8*aquad*cquad ) .ge. 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_cu = min(1._r8,max(0._r8,min(xsat,min(xs1,xs2)))) + else + x_cu = xsat + endif + else + if( ( bquad**2-4._r8*aquad*cquad) .ge. 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_en = min(1._r8,max(0._r8,max(xsat,min(xs1,xs2)))) + else + x_en = 1._r8 + endif + endif + enddo + if( x_cu .eq. xsat ) then + xc = max(x_cu, x_en) + else + xc = x_cu + endif + endif + + ee2 = xc**2 + ud2 = 1._r8 - 2._r8*xc + xc**2 + + ! detrainment rate + detn = mix(kt,i) * ud2 + + else !no bsort + ee2 = 1._r8 + ud2 = 1._r8 + end if + + ! entrainment rate + entn = mix(kt,i) * ee2 + + ! --------------------------------------------------------- ! + ! TKE enhanced entrainment ! + ! switches off when dynamic_L0 > max_L0 ! + ! --------------------------------------------------------- ! + eturb = (1._r8 + clubb_mf_alphturb*sqrt(tke(k))/upw(k,i)) + if (do_clubb_mf_rhtke) then + rh_L0 = 50._r8*(rhinv**3._r8) + if (rh_L0 >= 733.34_r8) eturb = 1._r8 else - supqt = 0._r8 - supthl = 0._r8 + if (dynamic_L0(i) >= clubb_mf_max_L0) eturb = 1._r8 end if - + entn = entn * eturb + ! integrate updraft - entexp = exp(-ent(k-1,i)*dzt(k-1)) - entexpu = exp(-ent(k-1,i)*dzt(k-1)/3._r8) - - qtn = qt(k-1) *(1._r8-entexp ) + upqt (k,i)*entexp + supqt - thln = thl(k-1)*(1._r8-entexp ) + upthl(k,i)*entexp + supthl - un = u(k-1) *(1._r8-entexpu) + upu (k,i)*entexpu - vn = v(k-1) *(1._r8-entexpu) + upv (k,i)*entexpu - + entexp = exp(-entn*eturb*dzt(kt)) + entexpu = exp(-entn*dzt(kt)/3._r8) + + qtn = qt(kt) *(1._r8-entexp ) + upqt (k,i)*entexp + supqt(kt,i) + thln = thl(kt)*(1._r8-entexp ) + upthl(k,i)*entexp + supthl(kt,i) + un = u(kt) *(1._r8-entexpu) + upu (k,i)*entexpu + vn = v(kt) *(1._r8-entexpu) + upv (k,i)*entexpu + + ! convert source terms to a tendency (convert from S*dz/w to S) + supqt(kt,i) = supqt(kt,i)*upw(k,i)/dzt(kt) + upauto(kn,i) = supqt(kt,i) + supthl(kt,i) = supthl(kt,i)*upw(k,i)/dzt(kt) + ! get cloud, momentum levels if (do_condensation) then - call condensation_mf(qtn, thln, p_zm(k-1), iexner_zm(k-1), & + call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & thvn, qcn, thn, qln, qin, qsn, lmixn) - if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(k-1) + if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(kn) else thvn = thln*(1._r8+zvir*qtn) end if - + ! get buoyancy - B=gravit*(0.5_r8*(thvn + upthv(k,i))/thv(k-1)-1._r8) - if (debug) then - if ( masterproc ) then - write(iulog,*) "B(k,i), k, i ", B, k, i + B=gravit*(0.5_r8*(thvn + upthv(k,i))/thv(kt)-1._r8) + + if (do_implicit) then + wp = clubb_mf_alphturb*wb*entn*sqrt(0.5_r8*(tke(kn)+tke(k)))*dzt(kt) + wn = (-wp + sqrt(wp**2._r8 + (1._r8 + 2._r8*wb*entn*dzt(kt))* & + (upw(k,i)**2._r8 + 2._r8*wa*B*dzt(kt))) )/(1._r8 + 2._r8*wb*entn*dzt(kt)) + else + ! get wn2 + wp = wb*entn*eturb + if (wp==0._r8) then + wn2 = upw(k,i)**2._r8+2._r8*wa*B*dzt(kt) + else + entw = exp(-2._r8*wp*dzt(kt)) + wn2 = entw*upw(k,i)**2._r8+(1._r8-entw)*wa*B/wp end if + wn = sqrt(max(wn2, 0._r8)) end if - - ! get wn^2 - wp = wb*ent(k-1,i) - if (wp==0._r8) then - wn2 = upw(k,i)**2._r8+2._r8*wa*B*dzt(k-1) + + end do !iter_xc + + if (wn>0._r8) then + + upthv(kn,i) = thvn + upthl(kn,i) = thln + upqt(kn,i) = qtn + upqc(kn,i) = qcn + upqs(kn,i) = qsn + upu(kn,i) = un + upv(kn,i) = vn + upql(kn,i) = qln + upqi(kn,i) = qin + upqv(kn,i) = qtn - qcn + uplmix(kn,i)= lmixn + upth(kn,i) = thn + + if (bsort) then + mfn = upmf(k,i)*exp( dzt(kt)*( entn - detn )) + upa(kn,i) = mfn/(wn*rho_zm(kn)) else - entw = exp(-2._r8*wp*dzt(k-1)) - wn2 = entw*upw(k,i)**2._r8+wa*B/(wb*ent(k-1,i))*(1._r8-entw) + upa(kn,i) = upa(k,i) + mfn = rho_zm(kn)*upa(kn,i)*wn + detn = entn - (mfn - rho_zm(k)*upa(k,i)*upw(k,i)) & + /(rho_zm(k)*upa(k,i)*upw(k,i)*dzt(kt)) + end if + + upbuoy(kn,i)= B + upw(kn,i) = wn + upmf(kn,i) = mfn + upent(kn,i) = entn + updet(kn,i) = detn + + else + ! zero out plumes that terminate at k<3 + if (abs(k-kstart+kdir)<4) then + supqt(:,i) = 0._r8 + upauto(:,i)= 0._r8 + supthl(:,i)= 0._r8 + upa(:,i) = 0._r8 + upbuoy(:,i)= 0._r8 + upw(:,i) = 0._r8 + upmf(:,i) = 0._r8 + upent(:,i) = 0._r8 + updet(:,i) = 0._r8 + upthv(:,i) = 0._r8 + upthl(:,i) = 0._r8 + upqt(:,i) = 0._r8 + upqc(:,i) = 0._r8 + upqs(:,i) = 0._r8 + upu(:,i) = 0._r8 + upv(:,i) = 0._r8 + upql(:,i) = 0._r8 + upqi(:,i) = 0._r8 + upqv(:,i) = 0._r8 + uplmix(:,i)= 0._r8 + upth(:,i) = 0._r8 end if - - if (wn2>0._r8) then - upw(k-1,i) = sqrt(wn2) - upthv(k-1,i) = thvn - upthl(k-1,i) = thln - upqt(k-1,i) = qtn - upqc(k-1,i) = qcn - upqs(k-1,i) = qsn - upu(k-1,i) = un - upv(k-1,i) = vn - upa(k-1,i) = upa(k,i) - upql(k-1,i) = qln - upqi(k-1,i) = qin - upqv(k-1,i) = qtn - qcn + ! exit updraft integration + exit + end if + enddo + enddo + + ! --------------------------------------------------------- ! + ! downward sweep for rain evaporation, snow melting ! + ! --------------------------------------------------------- ! + if (do_clubb_mf_precip) then + do i=1,clubb_mf_nup + do k = ktopm, ksfcm+kdir, -kdir + kt = k - (1+kdir)/2 + kn = k - kdir + + ! get rain evaporation + if ((upqs(k,i) + upqs(kn,i)).le.0._r8) then + qtovqs = 0._r8 else + qtovqs = (upqt(k,i) + upqt(kn,i))/(upqs(k,i) + upqs(kn,i)) + end if + qtovqs = min(1._r8,qtovqs) + sevap = ke*(1._r8 - qtovqs)*sqrt(max(uprr(k,i),0._r8)) + + ! limit evaporation to available precip + sevap = min(sevap,( uprr(k,i)/(rho_zt(kt)*dzt(kt)) - supqt(k,i)*(1._r8-clubb_mf_fdd) )) + + ! get rain rate + uprr(kn,i) = uprr(k,i) & + - rho_zt(kt)*dzt(kt)*( supqt(k,i)*(1._r8-clubb_mf_fdd) + sevap ) + + ! update source terms + lmixt = 0.5_r8*(uplmix(k,i)+uplmix(kn,i)) + supqt(k,i) = supqt(k,i) + sevap + supthl(k,i) = supthl(k,i) - lmixt*sevap*iexner_zt(kt)/cpair + end do + end do + end if + + ! --------------------------------------------------------- ! + ! begin computing downdrafts ! + ! --------------------------------------------------------- ! + if (do_clubb_mf_precip .and. clubb_mf_fdd > 0._r8) then + + do i=1,clubb_mf_nup + + ! find cloud base + do k = ksfcm, ktopm, kdir + if (upqc(k,i) > 0._r8) then + ddbot(i) = k exit end if - enddo - enddo - - ! writing updraft properties for output - do k=nzm,1,-1 + end do - ! first sum over all i-updrafts - do i=1,clubb_mf_nup - if (upqc(k,i)>0._r8) then - moist_a(k) = moist_a(k) + upa(k,i) - moist_w(k) = moist_w(k) + upa(k,i)*upw(k,i) - moist_qt(k) = moist_qt(k) + upa(k,i)*upqt(k,i) - moist_thl(k) = moist_thl(k) + upa(k,i)*upthl(k,i) - moist_u(k) = moist_u(k) + upa(k,i)*upu(k,i) - moist_v(k) = moist_v(k) + upa(k,i)*upv(k,i) - moist_qc(k) = moist_qc(k) + upa(k,i)*upqc(k,i) + ! find cloud top + ddtop = 0 + do k = ksfcm, ktopm, kdir + if (uprr(k,i) > 0._r8) ddtop = k + end do + + if (ddtop /= 0) then + ! initilaize downdrafts + + ! Kay initializes using negative of the updraft velocity + ! this causes anomalouly large downdrafts at the initializaiton level + ! I am intializing with zero velocity as that is more physically defensible + dnw(ddtop,i) = -1._r8*mindnw + dna(ddtop,i) = upa(ddtop,i) + dnu(ddtop,i) = 0.5_r8*(u(ddtop - (1-kdir)/2)+u(ddtop - (1+kdir)/2)) + dnv(ddtop,i) = 0.5_r8*(v(ddtop - (1-kdir)/2)+v(ddtop - (1+kdir)/2)) + dnqt(ddtop,i) = qt_zm(ddtop) + + ! no cloud in downdrafts, set to cloud free thl + dnthl(ddtop,i) = thl_zm(ddtop) + dnthv(ddtop,i) = thv_zm(ddtop) ! includes condensate loading (!) + + ! get rain generated in the updraft, appropriate it to the downdraft + dnrr(ddtop,i) = -1._r8*dzt(ddtop - (1+kdir)/2)*rho_zt(ddtop - (1+kdir)/2)*upauto(ddtop,i)*clubb_mf_fdd + + if (fixent) then + entn = fixent_ent else - dry_a(k) = dry_a(k) + upa(k,i) - dry_w(k) = dry_w(k) + upa(k,i)*upw(k,i) - dry_qt(k) = dry_qt(k) + upa(k,i)*upqt(k,i) - dry_thl(k) = dry_thl(k) + upa(k,i)*upthl(k,i) - dry_u(k) = dry_u(k) + upa(k,i)*upu(k,i) - dry_v(k) = dry_v(k) + upa(k,i)*upv(k,i) - endif - enddo - - if ( dry_a(k) > 0._r8 ) then - dry_w(k) = dry_w(k) / dry_a(k) - dry_qt(k) = dry_qt(k) / dry_a(k) - dry_thl(k) = dry_thl(k) / dry_a(k) - dry_u(k) = dry_u(k) / dry_a(k) - dry_v(k) = dry_v(k) / dry_a(k) - else - dry_w(k) = 0._r8 - dry_qt(k) = 0._r8 - dry_thl(k) = 0._r8 - dry_u(k) = 0._r8 - dry_v(k) = 0._r8 - endif - - if ( moist_a(k) > 0._r8 ) then - moist_w(k) = moist_w(k) / moist_a(k) - moist_qt(k) = moist_qt(k) / moist_a(k) - moist_thl(k) = moist_thl(k) / moist_a(k) - moist_u(k) = moist_u(k) / moist_a(k) - moist_v(k) = moist_v(k) / moist_a(k) - moist_qc(k) = moist_qc(k) / moist_a(k) + ! use deterministic mean entrainment + entn = clubb_mf_ent0/dynamic_L0(i) + end if + + ! downdraft qsat + call qsat(dnthl(ddtop,i)/iexner_zm(ddtop),p_zm(ddtop),es,dnqs(ddtop,i)) + + do k = ddtop, ksfcm+kdir, -kdir + + kt = k - (1+kdir)/2 + kn = k - kdir + + ! assume fixed area with height + dna(kn,i) = dna(k,i) + + ! get rain evaporation in integrated form + taum1 = ke*sqrt(dnrr(k,i))/dnqs(k,i) + alphint = exp(dzt(kt)*taum1/dnw(k,i)) + sqtint = max( (dnqs(k,i) - dnqt(k,i))*(1._r8 - alphint) ,0._r8) + + ! limit to available rain + sqtint = min( sqtint, -1._r8*dnrr(k,i) / (rho_zt(kt)*dzt(kt)*dnw(k,i)) ) + sthlint = -1._r8*latvap*sqtint*iexner_zt(kt)/cpair + + ! get rain evaporation in tendency form + sdnqt(kn,i) = max( (dnqs(k,i) - dnqt(k,i))*taum1, 0._r8 ) + sdnthl(kn,i) = -1._r8*latvap*sdnqt(kn,i)*iexner_zt(kt)/cpair + + ! compute rain rate (rain above - evaporation + appropriate updraft rain) + dnrr(kn,i) = max( dnrr(k,i) & + - rho_zt(kt)*dzt(kt)*(sdnqt(kn,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) + + ! include eturb? + entexp = exp(-1._r8*entn*eturb*dzt(kt)) + entexpu = exp(-1._r8*entn*dzt(kt)/3._r8) + + ! integrate downward + dnu(kn,i) = u(kt) *(1._r8-entexpu) + dnu (k,i)*entexpu + dnv(kn,i) = v(kt) *(1._r8-entexpu) + dnv (k,i)*entexpu + dnqt(kn,i) = qt(kt) *(1._r8-entexp ) + dnqt (k,i)*entexp + sqtint + dnthl(kn,i) = thl(kt)*(1._r8-entexp ) + dnthl(k,i)*entexp + sthlint + + ! get qsat + call qsat(dnthl(kn,i)/iexner_zm(kn),p_zm(kn),es,dnqs(kn,i)) + + ! no supersaturation in downdrafts + if (dnqt(kn,i) > dnqs(kn,i)) then + ! set qt to saturation vapor pressure + dnqt(kn,i) = dnqs(kn,i) + + ! find evaporation that gives saturation vapor pressure + sqtint = dnqt(kn,i) - (qt(kt) *(1._r8-entexp ) + dnqt (k,i)*entexp) + + ! limit to available rain + sqtint = min( sqtint, -1._r8*dnrr(k,i) / (rho_zt(kt)*dzt(kt)*dnw(k,i)) ) + sthlint = -1._r8*latvap*sqtint*iexner_zt(kt)/cpair + + ! find new evap tendency + if ((alphint - 1._r8) /= 0._r8) then + qtmp = dnqs(k,i) + sqtint/(alphint - 1._r8) + sdnqt(kn,i) = max( (dnqs(k,i) - qtmp)*taum1, 0._r8 ) + else + sdnqt(kn,i) = 0._r8 + end if + sdnthl(kn,i) = -1._r8*latvap*sdnqt(kn,i)*iexner_zt(kt)/cpair + + ! re-compute thl with new evaporation rate + dnthl(kn,i) = thl(kt)*(1._r8-entexp ) + dnthl(k,i)*entexp + sthlint + + ! adjust rain + dnrr(kn,i) = max( dnrr(k,i) & + - rho_zt(kt)*dzt(kt)*(sdnqt(kn,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) + end if + + ! get virtual temperature + dnthv(kn,i) = dnthl(kn,i)*(1._r8+zvir*dnqt(kn,i)) + + if ((kn - ddbot(i))*kdir > 0) then + ! get virtual temperature + dnthv(kn,i) = dnthl(kn,i)*(1._r8+zvir*dnqt(kn,i)) + + ! get buoyancy + ! (midpoint k is surrounded by interface k and k-1, + ! and therefore we can't compute B at the midpoint properly) + B = gravit*(dnthv(kn,i)/thv(kn + kdir)-1._r8) + + ! get wn2 + wp = wb*entn*eturb & + + clubb_mf_pwfac/( 2._r8*zm(kn + kdir)+tinynum ) * max( 1._r8 - exp( zm(kn + kdir)/z00dn-1._r8), 0._r8 ) + if (wp==0._r8) then + wn2 = dnw(k,i)**2._r8-2._r8*wa*B*dzt(kt) + else + entw = exp(-2._r8*wp*dzt(kt)) + wn2 = entw*dnw(k,i)**2._r8-(1._r8-entw)*wa*B/wp + end if + wn2 = max(wn2,mindnw**2._r8) + dnw(kn,i) = -1._r8*sqrt(wn2) + + else + zsub = zm(ddbot(i)+kdir) + wcb = dnw(ddbot(i)+kdir,i) + dnw(kn,i) = wcb - (wcb/(zsub**clubb_mf_ddexp))*(zsub - zm(kn))**clubb_mf_ddexp + dnw(kn,i) = min(dnw(kn,i),-1._r8*mindnw) + end if + + end do!k + + end if + + end do!i + +!+++ARH this should be changed to only zero out above the downdraft (dnw<-mindw) +!+++ARH also this should zero out dna as well + ! zero out downdraft fluxes for dnw == -mindnw + do i=1,clubb_mf_nup + do k=ksfcm, ktopm, kdir + if ( dnw(k,i) == -1._r8*mindnw ) then + dnw(k,i) = 0._r8 + dna(k,i) = 0._r8 + end if + end do + end do + + end if + ! end computing downdrafts + + ! --------------------------------------------------------- ! + ! AS.pd limiter ! + ! --------------------------------------------------------- ! + if (do_aspd) then + do k = ksfcm, ktopm-kdir, kdir + kt = k - (1-kdir)/2 + kn = k + kdir + do i=1,clubb_mf_nup + if (upw(kn,i)>0._r8) then + ! diagnose detrainment + Mn = rho_zm(k)*upa(k,i)*upw(k,i) + det = upent(kn,i)*eturb - (rho_zm(kn)*upa(kn,i)*upw(kn,i) - Mn) & + /(Mn*dzt(kt)) + if (det < 0._r8) then + ! diagnose area to eliminate detrainment and conserve mass + Mn = rho_zm(k)*upa(k,i)*upw(k,i)*exp(upent(kn,i)*eturb*dzt(kt)) + upa(kn,i) = Mn/(rho_zm(kn)*upw(kn,i)) + end if + end if + end do + end do + end if + + ! --------------------------------------------------------- ! + ! integrate for total convective area ! + ! --------------------------------------------------------- ! + do k=ksfcm, ktopm-kdir, kdir + do i=1,clubb_mf_nup + aup(k) = aup(k) + upa(k,i) + adn(k) = adn(k) + dna(k,i) + end do + ac(k) = aup(k) + adn(k) + if (limarea .and. ac(k) > amax) then + upa(k,:) = upa(k,:)*amax/ac(k) + ac(k) = amax + end if + ae(k) = ae(k) - ac(k) + end do + + ! --------------------------------------------------------- ! + ! updraft properties for output ! + ! --------------------------------------------------------- ! + do k=ksfcm, ktopm, kdir + + ! first sum over all i-updrafts + do i=1,clubb_mf_nup + if (upqc(k,i)>0._r8) then + moist_a(k) = moist_a(k) + upa(k,i) + moist_w(k) = moist_w(k) + upa(k,i)*upw(k,i) + moist_qt(k) = moist_qt(k) + upa(k,i)*upqt(k,i) + moist_thl(k) = moist_thl(k) + upa(k,i)*upthl(k,i) + moist_u(k) = moist_u(k) + upa(k,i)*upu(k,i) + moist_v(k) = moist_v(k) + upa(k,i)*upv(k,i) + moist_qc(k) = moist_qc(k) + upa(k,i)*upqc(k,i) else - moist_w(k) = 0._r8 - moist_qt(k) = 0._r8 - moist_thl(k) = 0._r8 - moist_u(k) = 0._r8 - moist_v(k) = 0._r8 - moist_qc(k) = 0._r8 + dry_a(k) = dry_a(k) + upa(k,i) + dry_w(k) = dry_w(k) + upa(k,i)*upw(k,i) + dry_qt(k) = dry_qt(k) + upa(k,i)*upqt(k,i) + dry_thl(k) = dry_thl(k) + upa(k,i)*upthl(k,i) + dry_u(k) = dry_u(k) + upa(k,i)*upu(k,i) + dry_v(k) = dry_v(k) + upa(k,i)*upv(k,i) endif - enddo - - do k=nzm,1,-1 - do i=1,clubb_mf_nup - ae (k) = ae (k) - upa(k,i) - aw (k) = aw (k) + upa(k,i)*upw(k,i) - awu (k) = awu (k) + upa(k,i)*upw(k,i)*upu(k,i) - awv (k) = awv (k) + upa(k,i)*upw(k,i)*upv(k,i) - awthl(k)= awthl(k)+ upa(k,i)*upw(k,i)*upthl(k,i) - awqt(k) = awqt(k) + upa(k,i)*upw(k,i)*upqt(k,i) - awqv(k) = awqv(k) + upa(k,i)*upw(k,i)*upqv(k,i) - awql(k) = awql(k) + upa(k,i)*upw(k,i)*upql(k,i) - awqi(k) = awqi(k) + upa(k,i)*upw(k,i)*upqi(k,i) - enddo - enddo - - do k=nzm,1,-1 - thlflx(k)= awthl(k) - aw(k)*thl_zm(k) - qtflx(k)= awqt(k) - aw(k)*qt_zm(k) - enddo - - end if ! ( wthv > 0.0 ) - - end subroutine integrate_mf - - subroutine condensation_mf( qt, thl, p, iex, thv, qc, th, ql, qi, qs, lmix ) - ! =============================================================================== ! - ! zero or one condensation for edmf: calculates thv and qc ! - ! =============================================================================== ! - use physconst, only: cpair, zvir, h2otrip - use wv_saturation, only : qsat - - real(r8),intent(in) :: qt,thl,p,iex - real(r8),intent(out):: thv,qc,th,ql,qi,qs,lmix - - !local variables - integer :: niter,i - real(r8) :: diff,t,qstmp,qcold,es,wf - - ! max number of iterations - niter=50 - ! minimum difference - diff=2.e-5_r8 - - qc=0._r8 - t=thl/iex - - !by definition: - ! T = Th*Exner, Exner=(p/p0)^(R/cp) (1) - ! Thl = Th - L/cp*ql/Exner (2) - !so: - ! Th = Thl + L/cp*ql/Exner (3) - ! T = Th*Exner=(Thl+L/cp*ql/Exner)*Exner (4) - ! = Thl*Exner + L/cp*ql - do i=1,niter - wf = get_watf(t) - t = thl/iex+get_alhl(wf)/cpair*qc !as in (4) - - ! qsat, p is in pascal (check!) - call qsat(t,p,es,qstmp) - qcold = qc - qc = max(0.5_r8*qc+0.5_r8*(qt-qstmp),0._r8) - if (abs(qc-qcold)tmax) then - get_watf=1._r8 - else if (tc 0._r8 ) then + dry_w(k) = dry_w(k) / dry_a(k) + dry_qt(k) = dry_qt(k) / dry_a(k) + dry_thl(k) = dry_thl(k) / dry_a(k) + dry_u(k) = dry_u(k) / dry_a(k) + dry_v(k) = dry_v(k) / dry_a(k) else - get_watf=(tc-tmin)/(tmax-tmin); - end if - - end function get_watf - - - function get_alhl(wf) - !latent heat of the mixture based on water fraction - use physconst, only : latvap , latice - real(r8) :: get_alhl,wf - - get_alhl = wf*latvap+(1._r8-wf)*(latvap+latice) - - end function get_alhl - - end subroutine condensation_mf - - subroutine precip_mf(qs,qt,w,dz,dzcld,Supqt) - !********************************************************************** - ! Precipitation microphysics - ! By Adam Herrington, after Kay Suselj - !********************************************************************** - - real(r8),intent(in) :: qs,qt,w,dz,dzcld - real(r8),intent(out) :: Supqt - ! - ! local vars - real(r8) :: tauwgt, tau, & ! time-scale vars - qstar ! excess cloud liquid - - real(r8),parameter :: tau0 = 15._r8, & ! base time-scale - zmin = 300._r8, & ! small cloud thick - zmax = 3000._r8, & ! large cloud thick - qcmin = 0.00125_r8 ! supersat threshold - - qstar = qs+qcmin - - if (qt > qstar) then - ! get precip efficiency - tauwgt = (dzcld-zmin)/(zmax-zmin) - tauwgt = min(max(tauwgt,0._r8),1._r8) - tau = tauwgt/tau0 - - ! get source for updraft - Supqt = (qstar-qt)*(1._r8 - exp(-1._r8*tau*dz/w)) + dry_w(k) = 0._r8 + dry_qt(k) = 0._r8 + dry_thl(k) = 0._r8 + dry_u(k) = 0._r8 + dry_v(k) = 0._r8 + endif + + if ( moist_a(k) > 0._r8 ) then + moist_w(k) = moist_w(k) / moist_a(k) + moist_qt(k) = moist_qt(k) / moist_a(k) + moist_thl(k) = moist_thl(k) / moist_a(k) + moist_u(k) = moist_u(k) / moist_a(k) + moist_v(k) = moist_v(k) / moist_a(k) + moist_qc(k) = moist_qc(k) / moist_a(k) else - Supqt = 0._r8 - end if - - end subroutine precip_mf - - subroutine poisson(nz,nup,lambda,poi,state) - !********************************************************************** - ! Set a unique (but reproduceble) seed for the kiss RNG - ! Call Poisson deviate - ! By Adam Herrington - !********************************************************************** - use shr_RandNum_mod, only: ShrKissRandGen - - integer, intent(in) :: nz,nup - real(r8), dimension(4), intent(in) :: state - real(r8), dimension(nz,nup), intent(in) :: lambda - integer, dimension(nz,nup), intent(out) :: poi - integer, dimension(1,4) :: tmpseed - integer :: i,j - type(ShrKissRandGen) :: kiss_gen - - ! Compute seed - tmpseed(1,1) = int((state(1) - int(state(1))) * 1000000000._r8) - tmpseed(1,2) = int((state(2) - int(state(2))) * 1000000000._r8) - tmpseed(1,3) = int((state(3) - int(state(3))) * 1000000000._r8) - tmpseed(1,4) = int((state(4) - int(state(4))) * 1000000000._r8) - - ! Set seed - kiss_gen = ShrKissRandGen(tmpseed) - - do i=nz,1,-1 - do j=1,nup - call knuth(kiss_gen,lambda(i,j),poi(i,j)) - enddo + moist_w(k) = 0._r8 + moist_qt(k) = 0._r8 + moist_thl(k) = 0._r8 + moist_u(k) = 0._r8 + moist_v(k) = 0._r8 + moist_qc(k) = 0._r8 + endif + + enddo + ! --------------------------------------------------------- ! + ! get ensemble mean ! + ! --------------------------------------------------------- ! + + ! 1. Momentum Grid Accumulations (Interfaces) + ! Iterates over all interfaces (1 to 59) + do k=ksfcm, ktopm, kdir + do i=1,clubb_mf_nup + awup(k) = awup(k) + upa(k,i)*upw(k,i) + awdn(k) = awdn(k) + dna(k,i)*dnw(k,i) + + awwup(k) = awwup(k) + upa(k,i)*upw(k,i)*upw(k,i) + awwdn(k) = awwdn(k) + dna(k,i)*dnw(k,i)*dnw(k,i) + + awuup(k) = awuup(k) + upa(k,i)*upw(k,i)*upu(k,i) + awudn(k) = awudn(k) + dna(k,i)*dnw(k,i)*dnu(k,i) + awvup(k) = awvup(k) + upa(k,i)*upw(k,i)*upv(k,i) + awvdn(k) = awvdn(k) + dna(k,i)*dnw(k,i)*dnv(k,i) + + awthvdn(k)= awthvdn(k)+ dna(k,i)*dnw(k,i)*dnthv(k,i) + awthldn(k)= awthldn(k)+ dna(k,i)*dnw(k,i)*dnthl(k,i) + awqtdn(k) = awqtdn(k) + dna(k,i)*dnw(k,i)*dnqt(k,i) + + awthvup(k)= awthvup(k)+ upa(k,i)*upw(k,i)*upthv(k,i) + awthlup(k)= awthlup(k)+ upa(k,i)*upw(k,i)*upthl(k,i) + awqtup(k) = awqtup(k) + upa(k,i)*upw(k,i)*upqt(k,i) enddo - - end subroutine poisson - - subroutine knuth(kiss_gen,lambda,kout) - !********************************************************************** - ! Discrete random poisson from Knuth - ! The Art of Computer Programming, v2, 137-138 - ! By Adam Herrington - !********************************************************************** - use shr_RandNum_mod, only: ShrKissRandGen - - type(ShrKissRandGen), intent(inout) :: kiss_gen - real(r8), intent(in) :: lambda - integer, intent(out) :: kout - - ! Local variables - real(r8), dimension(1,1) :: tmpuni - real(r8) :: puni, explam - integer :: k - - k = 0 - explam = exp(-1._r8*lambda) - puni = 1._r8 - do while (puni > explam) - k = k + 1 - call kiss_gen%random(tmpuni) - puni = puni*tmpuni(1,1) + + aw (k) = awup(k)+ awdn(k) + aww(k) = awwup(k)+ awwdn(k) + if (aloft) awu(k) = 1._r8 + + awv(k) = awvup(k)+ awvdn(k) + enddo + + ! 2. Thermodynamic Grid Accumulations (Cells) + ! Iterates over active atmospheric cells only + ! Top-Down: 58 down to 1. Bottom-Up: 2 up to nzm. + do k = ksfcm+kdir, ktopm, kdir + ! The interface directly BELOW the current cell + ! In top-down (-1): cell 58 -> interface 59 + ! In bottom-up (1): cell 2 -> interface 1 + kn = k - kdir + + do i=1,clubb_mf_nup + sqtup(k) = sqtup(k) + upa(kn,i)*supqt(k,i) + sthlup(k) = sthlup(k) + upa(kn,i)*supthl(k,i) + + sqtdn(k) = sqtdn(k) + dna(kn,i)*sdnqt(k,i) + sthldn(k) = sthldn(k) + dna(kn,i)*sdnthl(k,i) end do - kout = k - 1 - - end subroutine knuth - - end module clubb_mf - + + sqt(k) = sqtup(k) + sqtdn(k) + sthl(k) = sthlup(k) + sthldn(k) + enddo + ! --------------------------------------------------------- ! + ! ztopm1 calculation ! + ! --------------------------------------------------------- ! + do i=1,clubb_mf_nup + do k=kstart, ktopm, kdir + ! return if no convection at first level above surface + if (k == (ksfcm+kdir) .and. ac(k) == 0._r8 .and. .not.aloft) then + sqt(k) = 0._r8 + sthl(k) = 0._r8 + ztopm1(:) = zm(ksfcm) + ddcp(:) = 0._r8 + return + end if + ! height of the plume ensemble + if (do_clubb_mf_lscale_perplume) then + if ((upa(k,i)+dna(k,i)) > 0._r8) ztopm1(i) = zm(k) + else + if (ac(k) > 0._r8) ztopm1(:) = zm(k) + end if + end do + end do + + !subtract init level from ztop for aloft plumes + if (aloft) then + ztopm1 = ztopm1 - zm(kstart-nbot*kdir) + do i=1,clubb_mf_nup + if (ztopm1(i) < zm(ksfcm)) ztopm1(i) = zm(ksfcm) + end do + end if + + ! --------------------------------------------------------- ! + ! cloud base / mixing depth calculation ! + ! --------------------------------------------------------- ! + cbm1 = 0._r8 + do i=1,clubb_mf_nup + kcbarr(i) = 0 + do k=kstart, ktopm, kdir + if (upqc(k,i) > 0._r8) then + kcbarr(i) = k + exit + end if + end do + + ! find height of dry plumes + if (kcbarr(i) == 0) then + do k=kstart, ktopm, kdir + if (upw(k,i) <= 0._r8) then + kcbarr(i) = k + exit + end if + end do + end if + + cbm1 = cbm1 + zm(kcbarr(i)) + + end do + cbm1 = cbm1/REAL(clubb_mf_nup) + + ! --------------------------------------------------------- ! + ! bulk downdraft velocity for coldpool parameterization ! + ! --------------------------------------------------------- ! +!+++ARH +! ! reset ddcp +! ddcp = 0._r8 +! do i=1,clubb_mf_nup +! ! find cloud base +! kcb = 0 +! do k=1,nz +! if (upqc(k,i) > 0._r8) then +! kcb = k +! exit +! end if +! end do +! +! ! reset iddcp +! iddcp = 0._r8 +! if (kcb == 0) then +! continue +! else if (kcb == 1) then +! iddcp = iddcp + dna(k,i)*dnw(k,i) +! continue +! else +! ddint = 0._r8 +! do k=1,kcb-1 +! ddint = ddint + dna(k,i)*dnw(k,i)*dzt(k+1) +! end do +! iddcp = iddcp + -1._r8*ddint/zm(kcb) +! end if +! ddcp = ddcp + iddcp +! ! +! end do +! + + ddcp(:) = 0._r8 + if (do_clubb_mf_coldpool .and. clubb_mf_fdd > 0._r8) then + ! use single level for cold pool param. + ! reset ddcp + do i=1,clubb_mf_nup + if (ddbot(i) == 0) then + continue + else + if (do_clubb_mf_coldpool_perplume) then + ddcp(i) = -1._r8*dnw(ddbot(i)+kdir,i) + else + ddcp(:) = ddcp(:) + -1._r8*dna(ddbot(i)+kdir,i)*dnw(ddbot(i)+kdir,i) + end if + end if + end do + end if + + ! --------------------------------------------------------- ! + ! downward sweep to get ensemble mean precip ! + ! --------------------------------------------------------- ! + do k = ktopm, ksfcm+kdir, -kdir + kt_dn = k - (1+kdir)/2 + precc(k-kdir) = precc(k) - rho_zt(kt_dn)*dzt(kt_dn)*sqt(k) + end do + + ! --------------------------------------------------------- ! + ! get turbulent fluxes ! + ! --------------------------------------------------------- ! + kstart = ksfcm + kdir + if (scalesrf) then + kstart = ksfcm + end if + + do k=kstart, ktopm-kdir, kdir + + ! Secure boundary cells to prevent array out-of-bounds on zero-flux boundaries + kt_up = max(1, min(nzt, k - (1-kdir)/2)) + kt_dn = max(1, min(nzt, k - (1+kdir)/2)) + + thvflxup(k)= awthvup(k) - awup(k)*thv(kt_up) + thlflxup(k)= awthlup(k) - awup(k)*thl(kt_up) + qtflxup (k)= awqtup (k) - awup(k)*qt(kt_up) + + uflxup (k)= awuup(k) - awup(k)*u(kt_up) + vflxup (k)= awvup(k) - awup(k)*v(kt_up) + + thvflxdn(k)= awthvdn(k) - awdn(k)*thv(kt_dn) + thlflxdn(k)= awthldn(k) - awdn(k)*thl(kt_dn) + qtflxdn (k)= awqtdn (k) - awdn(k)*qt(kt_dn) + + uflxdn (k)= awudn(k) - awdn(k)*u(kt_dn) + vflxdn (k)= awvdn(k) - awdn(k)*v(kt_dn) + + thvflx(k) = thvflxup(k) + thvflxdn(k) + thlflx(k) = thlflxup(k) + thlflxdn(k) + qtflx (k) = qtflxup (k) + qtflxdn (k) + + uflx(k) = uflxup(k) + uflxdn(k) + vflx(k) = vflxup(k) + vflxdn(k) + enddo + !jt thl_env, qt_env, and thv_env were created as separate arrays was so the solver could extrapolate a subsurface "dummy" value (thl_env(1)) + !jt using the gradients without overwriting the actual atmospheric thl state. + !jt However, the solver only uses that dummy value at the surface interface, where the downdraft velocity (awdn) is exactly 0.0. + !jt This means the extrapolated dummy value is always mathematically multiplied by zero! + !jt we can safely delete thl_env, thv_env, qt_env, betathl, and betaqt and cap the kt_up and kt_dn indices inside the flux loop so they never exceed 1 to nzt. + !jt When the solver hits the zero-flux boundary, it will read a valid atmospheric cell, multiply it by 0.0, and cleanly yield 0.0. +!!$ ! --------------------------------------------------------- ! +!!$ ! get turbulent fluxes ! +!!$ ! --------------------------------------------------------- ! +!!$ thv_env = thv +!!$ thl_env = thl +!!$ qt_env = qt +!!$ +!!$ betathl = (thl_env(ksfcm+3*kdir)-thl_env(ksfcm+kdir))/(0.5_r8*(dzt(ksfcm+3*kdir)+2._r8*dzt(ksfcm+2*kdir)+dzt(ksfcm+kdir))) +!!$ betaqt = (qt_env(ksfcm+3*kdir)-qt_env(ksfcm+kdir))/(0.5_r8*(dzt(ksfcm+3*kdir)+2._r8*dzt(ksfcm+2*kdir)+dzt(ksfcm+kdir))) +!!$ +!!$ thl_env(ksfcm) = thl_env(ksfcm+kdir)-betathl*0.5_r8*(dzt(ksfcm+kdir)+dzt(ksfcm)) +!!$ qt_env(ksfcm) = qt_env(ksfcm+kdir)-betaqt*0.5_r8*(dzt(ksfcm+kdir)+dzt(ksfcm)) +!!$ if (qt_env(ksfcm) < 0._r8) qt_env(ksfcm) = 0._r8 +!!$ +!!$ kstart = ksfcm + kdir +!!$ if (scalesrf) then +!!$ kstart = ksfcm +!!$ end if +!!$ +!!$ do k=kstart, ktopm-kdir, kdir +!!$ +!!$ kt_up = k - (1-kdir)/2 +!!$ kt_dn = k - (1+kdir)/2 +!!$ +!!$ thvflxup(k)= awthvup(k) - awup(k)*thv_env(kt_up) +!!$ thlflxup(k)= awthlup(k) - awup(k)*thl_env(kt_up) +!!$ qtflxup (k)= awqtup (k) - awup(k)*qt_env (kt_up) +!!$ +!!$ uflxup (k)= awuup(k) - awup(k)*u(kt_up) +!!$ vflxup (k)= awvup(k) - awup(k)*v(kt_up) +!!$ +!!$ ! if no downdrafts, should be zero since awdn should be zero +!!$ thvflxdn(k)= awthvdn(k) - awdn(k)*thv_env(kt_dn) +!!$ thlflxdn(k)= awthldn(k) - awdn(k)*thl_env(kt_dn) +!!$ qtflxdn (k)= awqtdn (k) - awdn(k)*qt_env (kt_dn) +!!$ +!!$ uflxdn (k)= awudn(k) - awdn(k)*u(kt_dn) +!!$ vflxdn (k)= awvdn(k) - awdn(k)*v(kt_dn) +!!$ +!!$ thvflx(k) = thvflxup(k) + thvflxdn(k) +!!$ thlflx(k) = thlflxup(k) + thlflxdn(k) +!!$ qtflx (k) = qtflxup (k) + qtflxdn (k) +!!$ +!!$ uflx(k) = uflxup(k) + uflxdn(k) +!!$ vflx(k) = vflxup(k) + vflxdn(k) +!!$ enddo +!!$ + else + ddcp(:) = 0._r8 + ztopm1(:) = zm(ksfcm) + end if + + end subroutine integrate_mf + + + subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, th, & + wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, wa, wb, & + do_condensation, qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1, dynamic_L0, ztop, mcape) + ! --------------------------------------------------------- ! + ! Calculate ztop and dynamic_L based on value of namelist ! + ! --------------------------------------------------------- ! + integer, intent(in) :: nzt, nzm + real(r8), dimension(nzt), intent(in) :: thl, thv, & + th, & + qt, qv, & + p_zt, iexner_zt, & + dzt, zt + + real(r8), dimension(nzm), intent(in) :: p_zm, iexner_zm, & + zm, tke, wpthlp_env + + real(r8), intent(in) :: wmax, wmin, tpert, & + sigmaw, sigmaqt, sigmathv, & + cwqt, cwthv, zcb_unset, & + wa, wb, ztopm1, & + pblh, convh, rhinv + + logical, intent(in) :: do_condensation + + real(r8), intent(out) :: dynamic_L0, ztop, mcape + + ! local variables + ! =============================================================================== ! + ! GRID ORIENTATION GENERALIZATION VARIABLES + ! ------------------------------------------------------------------------------- ! + ! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without + ! duplicating code, these variables abstract the vertical loop bounds and slices. + ! + ! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. + ! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. + ! kdir : Directional step (+1 for moving up, -1 for moving down). + ! + ! STAGGERED GRID INDEXING + ! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative + ! index of the cell center (zt) to the interface (zm) flips depending on whether + ! memory is loaded top-down or bottom-up. These variables dynamically map them: + ! + ! kt : The active thermodynamic cell center associated with the current step. + ! Upward Sweep: kt = k - (1-kdir)/2 + ! Downward Sweep: kt = k - (1+kdir)/2 + ! + ! kn : The NEXT momentum interface in the direction of the current sweep. + ! Upward Sweep: kn = k + kdir + ! Downward Sweep: kn = k - kdir + ! + ! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. + ! kt_up = k - (1-kdir)/2 + ! + ! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. + ! kt_dn = k - (1+kdir)/2 + ! =============================================================================== ! + integer :: ksfc, ktop, kdir + + + real(r8), dimension(nzt) :: t_zt + real(r8), dimension(nzt) :: tp, qstp + real(r8), dimension(nzt,1) :: dmpdz + real(r8), dimension(1) :: tl, & + cape, cin + integer, dimension(1) :: lcl, lel + real(r8) :: landfrac + integer :: kpbl, msg, & + lon, mx, & + k + + ! intialize local variables + cape = 0._r8 + mcape = 0._r8 + dmpdz = 0._r8 + + if (zt(1) < zt(nzt)) then + ksfc = 1 + ktop = nzt + kdir = 1 + else + ksfc = nzt + ktop = 1 + kdir = -1 + end if + + if (clubb_mf_Lopt==0) then + !Constant L0 + dynamic_L0 = clubb_mf_L0 + ztop = clubb_mf_L0 + else if (clubb_mf_Lopt==1) then + !TKE + do k = ktop-2*kdir, ksfc+kdir, -kdir + if (zm(k) < 20000 .and. tke(k) - tke(k+kdir) > 1e-5) then + ztop = zm(k) + exit + endif + enddo + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + + else if (clubb_mf_Lopt==2) then + !Heat flux + do k = ktop-2*kdir, ksfc+kdir, -kdir + if (zm(k) < 20000 .and. abs(abs(wpthlp_env(k))-abs(wpthlp_env(k-kdir))) > 1e-4) then + ztop = zm(k) + exit + endif + enddo + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + + else if (clubb_mf_Lopt==3) then + !Test plume + call oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, & + wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, & + wa, wb, tke, do_condensation, do_clubb_mf_precip, ztop ) + + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + !ztop = ztop - 1600._r8 + !if (ztop < 1._r8) then + ! dynamic_L0 = clubb_mf_a0 + !else + ! dynamic_L0 = min(35._r8,clubb_mf_a0*(ztop**clubb_mf_b0)) + !end if + else if (clubb_mf_Lopt==4 .or. clubb_mf_Lopt==5) then + !dilute cape calculation + !dmpdz = -1._r8*ent_zt(2:nz,:) + dmpdz(:,:) = -1.E-3_r8 + t_zt = th/iexner_zt + landfrac = 1._r8 + + do k = ksfc+kdir, ktop, kdir + if (zt(k-kdir) <= pblh) then + kpbl = k + end if + end do + + do k = ksfc, ktop, kdir + if (p_zt(k) > 40.e2_r8) then + msg = k + end if + end do + + call buoyan_dilute(nzt, nzm, 1 ,dmpdz , & + qv ,t_zt ,p_zt*0.01_r8 ,zt ,p_zm*0.01_r8 , & + tp ,qstp ,tl ,cape ,cin , & + kpbl-kdir ,lcl ,lel ,lon ,mx , & + msg-kdir ,tpert ,landfrac ) + + !do i=1,clubb_mf_nup + ! mcape = mcape + cape(i) + !end do + !mcape = mcape/REAL(clubb_mf_nup) + mcape = max(cape(1),25._r8) + + if (clubb_mf_Lopt==4) then + ztop = max(zt(lel(1)+kdir),convh) + else if (clubb_mf_Lopt==5) then + ztop = mcape + end if + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + + else if (clubb_mf_Lopt==6) then + ! grab ztop from max height of ensemble in prior time-step(s) + ztop = ztopm1 + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + else if (clubb_mf_Lopt==7 .or. clubb_mf_Lopt==8) then + ztop = rhinv + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + end if + + end subroutine get_Lscale + + subroutine condensation_mf( qt, thl, p, iex, thv, qc, th, ql, qi, qs, lmix ) + ! =============================================================================== ! + ! zero or one condensation for edmf: calculates thv and qc ! + ! =============================================================================== ! + use physconst, only: cpair, zvir, h2otrip + use wv_saturation, only : qsat + + real(r8),intent(in) :: qt,thl,p,iex + real(r8),intent(out):: thv,qc,th,ql,qi,qs,lmix + + !local variables + integer :: niter,i + real(r8) :: diff,t,qstmp,qcold,es,wf + logical :: noice = .true. + ! max number of iterations + niter=50 + ! minimum difference + diff=2.e-5_r8 + + qc=0._r8 + t=thl/iex + + !by definition: + ! T = Th*Exner, Exner=(p/p0)^(R/cp) (1) + ! Thl = Th - L/cp*ql/Exner (2) + !so: + ! Th = Thl + L/cp*ql/Exner (3) + ! T = Th*Exner=(Thl+L/cp*ql/Exner)*Exner (4) + ! = Thl*Exner + L/cp*ql + do i=1,niter + + if (noice) then + wf = 1._r8 + else + wf = get_watf(t) + end if + t = thl/iex+get_alhl(wf)/cpair*qc !as in (4) + + ! qsat, p is in pascal (check!) + call qsat(t,p,es,qstmp) + qcold = qc + qc = max(0.5_r8*qc+0.5_r8*(qt-qstmp),0._r8) + if (abs(qc-qcold)tmax) then + get_watf=1._r8 + else if (tc qstar) then + ! get precip efficiency + tauwgt = (dzcld-zmin)/(zmax-zmin) + tauwgt = min(max(tauwgt,0._r8),1._r8) + tau = tauwgt/tau0 + + ! get source for updraft + Supqt = (qstar-qt)*(1._r8 - exp(-1._r8*tau*dz/w)) + else + Supqt = 0._r8 + end if + + end subroutine precip_mf + + subroutine poisson(nz, nup, ksfc, ktop, kdir, lambda, poi, state) + !********************************************************************** + ! Set a unique (but reproduceble) seed for the kiss RNG + ! Call Poisson deviate + ! By Adam Herrington + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + integer, intent(in) :: nz, nup, ksfc, ktop, kdir + real(r8), dimension(4), intent(in) :: state + real(r8), dimension(nz,nup), intent(in) :: lambda + integer, dimension(nz,nup), intent(out) :: poi + integer, dimension(1,4) :: tmpseed + integer :: i,j + type(ShrKissRandGen) :: kiss_gen + + ! Compute seed + tmpseed(1,1) = int((state(1) - int(state(1))) * 1000000000._r8) + tmpseed(1,2) = int((state(2) - int(state(2))) * 1000000000._r8) + tmpseed(1,3) = int((state(3) - int(state(3))) * 1000000000._r8) + tmpseed(1,4) = int((state(4) - int(state(4))) * 1000000000._r8) + + ! Set seed + kiss_gen = ShrKissRandGen(tmpseed) + + ! Loop from the SURFACE to the TOP to preserve the exact PRNG sequence + do i = ksfc, ktop, kdir + do j = 1, nup + call hybridRNG(kiss_gen, lambda(i,j), poi(i,j)) + enddo + enddo + + end subroutine poisson + + subroutine poisson_notgeneralcoords(nz,nup,lambda,poi,state) + !********************************************************************** + ! Set a unique (but reproduceble) seed for the kiss RNG + ! Call Poisson deviate + ! By Adam Herrington + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + integer, intent(in) :: nz,nup + real(r8), dimension(4), intent(in) :: state + real(r8), dimension(nz,nup), intent(in) :: lambda + integer, dimension(nz,nup), intent(out) :: poi + integer, dimension(1,4) :: tmpseed + integer :: i,j + type(ShrKissRandGen) :: kiss_gen + + ! Compute seed + tmpseed(1,1) = int((state(1) - int(state(1))) * 1000000000._r8) + tmpseed(1,2) = int((state(2) - int(state(2))) * 1000000000._r8) + tmpseed(1,3) = int((state(3) - int(state(3))) * 1000000000._r8) + tmpseed(1,4) = int((state(4) - int(state(4))) * 1000000000._r8) + + ! Set seed + kiss_gen = ShrKissRandGen(tmpseed) + + do i=1,nz + do j=1,nup + call hybridRNG(kiss_gen,lambda(i,j),poi(i,j)) + enddo + enddo + + end subroutine poisson_notgeneralcoords + + + subroutine hybridRNG(kiss_gen,lambda,kout) + !********************************************************************** + ! Interface for the two poisson rng subroutines + ! chooses the appropriate subroutine based on the value of lambda + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + type(ShrKissRandGen), intent(inout) :: kiss_gen + real(r8), intent(in) :: lambda + integer, intent(out) :: kout + + if (lambda < 10._r8) then + call knuth(kiss_gen,lambda,kout) + else + call hormann(kiss_gen,lambda,kout) + end if + + end subroutine hybridRNG + + + subroutine knuth(kiss_gen,lambda,kout) + !********************************************************************** + ! Discrete random poisson from Knuth + ! The Art of Computer Programming, v2, 137-138 + ! By Adam Herrington + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + type(ShrKissRandGen), intent(inout) :: kiss_gen + real(r8), intent(in) :: lambda + integer, intent(out) :: kout + + ! Local variables + real(r8), dimension(1,1) :: tmpuni + real(r8) :: puni, explam + integer :: k + + k = 0 + explam = exp(-1._r8*lambda) + puni = 1._r8 + do while (puni > explam) + k = k + 1 + call kiss_gen%random(tmpuni) + puni = puni*tmpuni(1,1) + end do + kout = k - 1 + + end subroutine knuth + + + subroutine hormann(kiss_gen,lambda,kout) + !********************************************************************** + ! Discrete random poisson + ! Implements Poisson Transformed Rejection with Squeeze (PTRS) + ! from W. Hormann Insurance: Mathematics and Economics 12, 39-45 (1993) + ! By Jake Reschke + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + type(ShrKissRandGen), intent(inout) :: kiss_gen + real(r8), intent(in) :: lambda + integer, intent(out) :: kout + + ! Local variables + real(r8), dimension(1,1) :: U,V + real(r8) :: a,b,vr,alphinv,us,loggam + integer :: k,i + + b = 0.931_r8 + 2.53_r8*sqrt(lambda) + a = -0.059_r8 + 0.02483_r8*b + vr = 0.9277_r8 - 3.6224_r8/(b - 2._r8) + alphinv = 1.1239_r8 + 1.1328_r8/(b - 3.4_r8) + + do + call kiss_gen%random(U) + call kiss_gen%random(V) + U(1,1) = U(1,1) - 0.5_r8 + us = 0.5_r8 - abs(U(1,1)) + k = floor( (2._r8*a/us + b)*U(1,1) + lambda + 0.43_r8 ) + if (us >= 0.07_r8 .and. V(1,1) <= vr) then + kout = k + exit + end if + if (k <= 0 .or. (us < 0.013_r8 .and. V(1,1) > us)) then + cycle + end if + ! compute log(k!). If k >=10 use stirling's approximation + if (k < 10) then + loggam = 0._r8 + do i = 1, k + loggam = loggam + log(1._r8*i) + end do + else + loggam = log(sqrt(2._r8*pi)) + (k + 0.5_r8)*log(1._r8*k) - k + (1._r8/12._r8 - 1._r8/(360._r8*k*k))/k + end if + if (log( V(1,1)*alphinv/(a/(us*us) + b) ) <= -1._r8*lambda + k*log(lambda) - loggam) then + kout = k + exit + end if + end do + + end subroutine hormann + + subroutine roots(a,b,c,r1,r2,status) + ! --------------------------------------------------------- ! + ! Subroutine to solve the second order polynomial equation. ! + ! after uwshcu.F90 ! + ! --------------------------------------------------------- ! + real(r8), intent(in) :: a + real(r8), intent(in) :: b + real(r8), intent(in) :: c + real(r8), intent(out) :: r1 + real(r8), intent(out) :: r2 + integer , intent(out) :: status + real(r8) :: q + + status = 0 + + if( a .eq. 0._r8 ) then ! Form b*x + c = 0 + if( b .eq. 0._r8 ) then ! Failure: c = 0 + status = 1 + else ! b*x + c = 0 + r1 = -c/b + endif + r2 = r1 + else + if( b .eq. 0._r8 ) then ! Form a*x**2 + c = 0 + if( a*c .gt. 0._r8 ) then ! Failure: x**2 = -c/a < 0 + status = 2 + else ! x**2 = -c/a + r1 = sqrt(-c/a) + endif + r2 = -r1 + else ! Form a*x**2 + b*x + c = 0 + if( (b**2 - 4._r8*a*c) .lt. 0._r8 ) then ! Failure, no real roots + status = 3 + else + q = -0.5_r8*(b + sign(1.0_r8,b)*sqrt(b**2 - 4._r8*a*c)) + r1 = q/a + r2 = c/q + endif + endif + endif + + return + + end subroutine roots + + + subroutine oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, & + wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, & + wa, wb, tke, do_condensation, do_precip, plumeheight ) + !********************************************************************** + ! Calculate a single plume with fixed entrainment + ! to be used for a dynamic mixing length calculation + ! By Rachel Storer + !********************************************************************** + use physconst, only: cpair, gravit, zvir + + integer, intent(in) :: nzm, nzt + real(r8), dimension(nzt), intent(in) :: dzt, iexner_zt, & + qt, thv, thl + real(r8), dimension(nzm), intent(in) :: zm, p_zm, iexner_zm, tke + + real(r8), intent(in) :: wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, & + cwthv, zcb_unset, wa, wb + logical, intent(in) :: do_condensation, do_precip + + real(r8), intent(inout) :: plumeheight + + !local variables + + ! =============================================================================== ! + ! GRID ORIENTATION GENERALIZATION VARIABLES + ! ------------------------------------------------------------------------------- ! + ! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without + ! duplicating code, these variables abstract the vertical loop bounds and slices. + ! + ! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. + ! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. + ! kdir : Directional step (+1 for moving up, -1 for moving down). + ! + ! STAGGERED GRID INDEXING + ! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative + ! index of the cell center (zt) to the interface (zm) flips depending on whether + ! memory is loaded top-down or bottom-up. These variables dynamically map them: + ! + ! kt : The active thermodynamic cell center associated with the current step. + ! Upward Sweep: kt = k - (1-kdir)/2 + ! Downward Sweep: kt = k - (1+kdir)/2 + ! + ! kn : The NEXT momentum interface in the direction of the current sweep. + ! Upward Sweep: kn = k + kdir + ! Downward Sweep: kn = k - kdir + ! + ! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. + ! kt_up = k - (1-kdir)/2 + ! + ! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. + ! kt_dn = k - (1+kdir)/2 + ! =============================================================================== ! + integer :: ksfcm, ktopm, kdir, kt, kn + integer :: k + real(r8) :: thvn, qtn, thln, qcn, thn, qln, qin, qsn, lmixn, zcb, B, wn2, pentexp, pturb, pentw, wp + real(r8), dimension(nzm) :: upw, upa, upqt, upthv, upthl, upth, upqs, & + upqc, upql, upqi + real(r8), dimension(nzt) :: supqt, supthl + ! ! fractional entrainment rate + real(r8), parameter :: pent = 1.E-3_r8 + ! ! use tke enhanced entrainment + logical :: do_tptke = .false. + + if (zm(1) < zm(nzm)) then + ksfcm = 1 + ktopm = nzm + kdir = 1 + else + ksfcm = nzm + ktopm = 1 + kdir = -1 + end if + + zcb = zcb_unset + + upw(ksfcm) = 0.5_r8 * wmax + upa(ksfcm) = 0.5_r8 * erf( wmax/(sqrt(2._r8)*sigmaw) ) + + upqt(ksfcm) = cwqt * upw(ksfcm) * sigmaqt/sigmaw + upthv(ksfcm) = cwthv * upw(ksfcm) * sigmathv/sigmaw + + upqt(ksfcm) = qt(ksfcm)+upqt(ksfcm) + upthv(ksfcm) = thv(ksfcm)+upthv(ksfcm) + upthl(ksfcm) = upthv(ksfcm) / (1._r8+zvir*upqt(ksfcm)) + upth(ksfcm) = upthl(ksfcm) + + ! get cloud, lowest momentum level + if (do_condensation) then + call condensation_mf(upqt(ksfcm), upthl(ksfcm), p_zm(ksfcm), iexner_zm(ksfcm), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + upthv(ksfcm) = thvn + upqc(ksfcm) = qcn + upql(ksfcm) = qln + upqi(ksfcm) = qin + upqs(ksfcm) = qsn + upth(ksfcm) = thn + if (qcn > 0._r8) zcb = zm(ksfcm) + else + ! assume no cldliq + upqc(ksfcm) = 0._r8 + end if + + do k = ksfcm, ktopm-kdir, kdir + kt = k - (1-kdir)/2 + kn = k + kdir + + ! get microphysics, autoconversion + if (do_precip .and. upqc(k) > 0._r8) then + call precip_mf(upqs(k),upqt(k),upw(k),dzt(kt),abs(zm(kn)-zcb),supqt(kt)) + supthl(kt) = -1._r8*lmixn*supqt(kt)*iexner_zt(kt)/cpair + else + supqt(kt) = 0._r8 + supthl(kt) = 0._r8 + end if + ! integrate updraft + if (do_tptke) then + pturb = (1._r8 + clubb_mf_alphturb*sqrt(tke(k))/upw(k)) + else + pturb = 1._r8 + end if + pentexp = exp(-pent*pturb*dzt(kt)) + qtn = qt(kt) *(1._r8-pentexp ) + upqt (k)*pentexp + supqt(kt) + thln = thl(kt)*(1._r8-pentexp ) + upthl(k)*pentexp + supthl(kt) + + ! convert source terms to a tendency + supqt(kt) = supqt(kt)*upw(k)/dzt(kt) + supthl(kt) = supthl(kt)*upw(k)/dzt(kt) + + ! get cloud, momentum levels + if (do_condensation) then + call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + if (zcb.eq.zcb_unset .and. qcn > 0._r8) zcb = zm(kn) + else + thvn = thln*(1._r8+zvir*qtn) + end if + ! get buoyancy + B=gravit*(0.5_r8*(thvn + upthv(k))/thv(kt)-1._r8) + + ! get wn^2 + wp = wb*pent*pturb + if (wp==0._r8) then + wn2 = upw(k)**2._r8+2._r8*wa*B*dzt(kt) + else + pentw = exp(-2._r8*wp*dzt(kt)) + wn2 = pentw*upw(k)**2._r8+(1._r8-pentw)*wa*B/wp + end if + + if (wn2>0._r8) then + upw(kn) = sqrt(wn2) + upthv(kn) = thvn + upthl(kn) = thln + upqt(kn) = qtn + upqc(kn) = qcn + upqs(kn) = qsn + upa(kn) = upa(k) + upql(kn) = qln + upqi(kn) = qin + upth(kn) = thn + else + plumeheight = zm(k) + exit + end if + enddo + + end subroutine oneplume + + +subroutine buoyan_dilute( nzt, nzm, nup, dmpdz, q, t, p, z, pf, & + tp, qstp, tl, cape, cin, pblt, lcl, lel, lon, mx, & + msg, tpert, landfrac ) +!----------------------------------------------------------------------- +! Calculates CAPE the lifting condensation level and the convective top +! where buoyancy is first -ve. +! Method: Calculates the parcel temperature based on a simple constant +! entraining plume model. CAPE is integrated from buoyancy. +! 09/09/04 - Simplest approach using an assumed entrainment rate for +! testing (dmpdp). +! 08/04/05 - Swap to convert dmpdz to dmpdp +! +! SCAM Logical Switches - DILUTE:RBN - Now Disabled +! --------------------- +! switch(1) = .T. - Uses the dilute parcel calculation to obtain tendencies. +! switch(2) = .T. - Includes entropy/q changes due to condensate loss and freezing. +! switch(3) = .T. - Adds the PBL Tpert for the parcel temperature at all levels. +! +! References: +! Raymond and Blythe (1992) JAS +! +! Author: +! Richard Neale - September 2004 +! +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! input arguments +! + integer, intent(in) :: nzt, nzm ! vertical grid sizes + integer, intent(in) :: nup ! number of plumes + + real(r8), intent(in) :: dmpdz(nzt,nup)! Parcel fractional mass entrainment rate (/m) 3D + + real(r8), intent(in) :: q(nzt) ! spec. humidity + real(r8), intent(in) :: t(nzt) ! temperature + real(r8), intent(in) :: p(nzt) ! pressure + real(r8), intent(in) :: z(nzt) ! height + real(r8), intent(in) :: pf(nzm) ! pressure at interfaces + integer, intent(in) :: pblt ! index of pbl depth + integer, intent(in) :: msg + real(r8), intent(in) :: tpert ! perturbation temperature by pbl processes + real(r8), intent(in) :: landfrac + +! output arguments + real(r8), intent(out) :: tp(nzt,nup) ! parcel temperature + real(r8), intent(out) :: qstp(nzt,nup) ! saturation mixing ratio of parcel (only above lcl, just q below). + real(r8), intent(out) :: tl(nup) ! parcel temperature at lcl + real(r8), intent(out) :: cape(nup) ! convective aval. pot. energy. + real(r8), intent(out) :: cin (nup) ! CIN + integer, intent(out) :: lcl(nup) ! + integer, intent(out) :: lel(nup) ! + integer, intent(out) :: lon ! level of onset of deep convection + integer, intent(out) :: mx ! level of max moist static energy + + !--------------------------Local Variables------------------------------ + + ! =============================================================================== ! + ! GRID ORIENTATION GENERALIZATION VARIABLES + ! ------------------------------------------------------------------------------- ! + ! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without + ! duplicating code, these variables abstract the vertical loop bounds and slices. + ! + ! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. + ! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. + ! kdir : Directional step (+1 for moving up, -1 for moving down). + ! + ! STAGGERED GRID INDEXING + ! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative + ! index of the cell center (zt) to the interface (zm) flips depending on whether + ! memory is loaded top-down or bottom-up. These variables dynamically map them: + ! + ! kt : The active thermodynamic cell center associated with the current step. + ! Upward Sweep: kt = k - (1-kdir)/2 + ! Downward Sweep: kt = k - (1+kdir)/2 + ! + ! kn : The NEXT momentum interface in the direction of the current sweep. + ! Upward Sweep: kn = k + kdir + ! Downward Sweep: kn = k - kdir + ! + ! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. + ! kt_up = k - (1-kdir)/2 + ! + ! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. + ! kt_dn = k - (1+kdir)/2 + ! =============================================================================== ! + integer :: ksfct, ktopt, kdir, kn + integer lelten(nup,mf_num_cin) + real(r8) capeten(nup,mf_num_cin) ! provisional value of cape + real(r8) cinten(nup,mf_num_cin) ! provisional value of CIN + real(r8) tv(nzt) + real(r8) tpv(nzt,nup) + real(r8) buoy(nzt,nup) + real(r8) pl(nup) + + real(r8) a1, a2, estp, plexp, hmax, hmn, y + logical plge600(nup) + integer knt(nup) + real(r8) e + integer i, k, n + + real(r8), parameter :: tiedke_add = 0.5_r8 +!----------------------------------------------------------------------- + if (z(1) < z(nzt)) then + ksfct = 1 + ktopt = nzt + kdir = 1 + else + ksfct = nzt + ktopt = 1 + kdir = -1 + end if + + do n = 1,mf_num_cin + do i = 1,nup + lelten(i,n) = ksfct + capeten(i,n) = 0._r8 + cinten (i,n) = 0._r8 + end do + end do + + lon = ksfct + mx = lon + hmax = 0._r8 + + do i = 1,nup + knt(i) = 0 + lel(i) = ksfct + cape(i) = 0._r8 + tp(:,i) = t(:) + qstp(:,i) = q(:) + end do + +!!! RBN - Initialize tv and buoy for output. +!!! tv=tv : tpv=tpv : qstp=q : buoy=0. + if (tht_tweaks) then + tv (:) = t(:) *(1._r8+q(:)/epsilo)/ (1._r8+q(:)) + else + tv (:) = t(:) *(1._r8+1.608_r8*q(:))/ (1._r8+q(:)) + endif +!-tht + do i = 1,nup + tpv (:,i) = tv(:) + end do + buoy(:,:) = 0._r8 + +! set "launching" level(mx) to be at maximum moist static energy. +! search for this level stops at planetary boundary layer top. + do k = ksfct, msg-kdir, kdir + hmn =(cpair+q(k)*cpliq)*t(k)/(1._r8+q(k)) + (1._r8+q(k)/epsilo)/(1._r8+q(k))*gravit*z(k) & + +(latvap-(cpliq-cpwv)*(t(k)-tmelt))*q(k) + if ((k - pblt)*kdir <= 0 .and. (k - lon)*kdir >= 0 .and. hmn > hmax) then + hmax = hmn + mx = k + end if + end do + +! LCL dilute calculation - initialize to mx(i) +! Determine lcl in parcel_dilute and get pl,tl after parcel_dilute +! Original code actually sets LCL as level above wher condensate forms. +! Therefore in parcel_dilute lcl(i) will be at first level where qsmix < qtmix. + + do i = 1,nup ! Initialise LCL variables. + lcl(i) = mx + tl(i) = t(mx) + pl(i) = p(mx) + end do + +! +! main buoyancy calculation. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! DILUTE PLUME CALCULATION USING ENTRAINING PLUME !!! + call parcel_dilute(nzt, nzm, nup, msg, mx, p, z, t, q, & + tpert, tp, tpv, qstp, pl, tl, lcl, & + landfrac, dmpdz) + +! If lcl is above the nominal level of non-divergence (600 mbs), +! no deep convection is permitted (ensuing calculations +! skipped and cape retains initialized value of zero). +! + do i = 1,nup + plge600(i) = pl(i).ge.600._r8 ! Just change to always allow buoy calculation. + end do + +! Main buoyancy calculation. + do k = ksfct, msg-kdir, kdir + do i=1,nup + if ((k - mx)*kdir >= 0 .and. plge600(i)) then + if (tht_tweaks) then + tv(k) = t(k)* (1._r8+q(k)/epsilo)/ (1._r8+q(k)) !+tht + else + tv(k) = t(k)* (1._r8+1.608_r8*q(k))/ (1._r8+q(k)) !orig + endif +! +0.5K or not? (arbitrary at this point - introduce in parcel_dilute instead? tht) + buoy(k,i) = tpv(k,i) - tv(k) + tiedke_add ! +0.5K or not? + else + qstp(k,i) = q(k) + tp(k,i) = t(k) + tpv(k,i) = tv(k) + endif + end do + end do + +!------------------------------------------------------------------------------- +! beginning from one below top (first level p>40hPa, msg) check for at most +! num_cin levels of neutral buoyancy (LELten) and compute CAPEten between LCL + do k = msg-2*kdir, ksfct, -kdir + do i = 1,nup + if ((k - lcl(i))*kdir > 0 .and. plge600(i)) then + if (buoy(k-kdir,i) > 0._r8 .and. buoy(k,i) <= 0._r8) then + knt(i) = min(mf_num_cin,knt(i) + 1) + lelten(i,knt(i)) = k + end if + end if + end do + end do + +! calculate convective available potential energy (cape). + do n = 1,mf_num_cin + do k = msg-kdir, ksfct, -kdir + do i = 1,nup + if (plge600(i) .and. (k - mx)*kdir >= 0 .and. (k - lelten(i,n))*kdir < 0) then + ! Using pf(k) and pf(k+kdir). Since pf is on momentum grid (nzm=nzt+1), + ! if k ranges from 1 to nzt, k+1 ranges from 2 to nzm (valid). + ! For top-down (kdir=-1), k-1 ranges from nzt-1 to 0. + ! The interface pressure above thermo layer k is k - (1-kdir)/2 + kn = k - (1-kdir)/2 + capeten(i,n) = capeten(i,n) + rair*buoy(k,i)*abs(log(pf(kn)/pf(kn+kdir))) + cinten (i,n) = cinten (i,n) - rair*min(buoy(k,i),0._r8)*abs(log(pf(kn)/pf(kn+kdir))) + end if + end do + end do + end do + +! find maximum cape from all possible tentative capes from one sounding + do n = 1,mf_num_cin + do i = 1,nup + if (capeten(i,n) > cape(i)) then + cape(i) = capeten(i,n) + cin (i) = cinten (i,n) !+tht CIN + lel(i) = lelten(i,n) + end if + end do + end do + +! put lower bound on cape for diagnostic purposes. + do i = 1,nup + cape(i) = max(cape(i), 0._r8) + end do + +return +end subroutine buoyan_dilute + + + subroutine parcel_dilute (nzt, nzm, nup, msg, klaunch, p, z, t, q, & + tpert, tp, tpv, qstp, pl, tl, lcl, & + landfrac, dmpdz) +!-tht + +! Routine to determine +! 1. Tp - Parcel temperature +! 2. qstp - Saturated mixing ratio at the parcel temperature. + +!-------------------- +implicit none +!-------------------- + +integer, intent(in) :: nzt, nzm +integer, intent(in) :: nup +integer, intent(in) :: msg +integer, intent(in) :: klaunch + +real(r8), intent(in) :: tpert ! PBL temperature perturbation. +real(r8), intent(in) :: landfrac +real(r8), intent(in), dimension(nzt) :: p +real(r8), intent(in), dimension(nzt) :: z +real(r8), intent(in), dimension(nzt) :: t +real(r8), intent(in), dimension(nzt) :: q + +real(r8), intent(inout), dimension(nzt,nup) :: tp ! Parcel temp. +real(r8), intent(inout), dimension(nzt,nup) :: qstp ! Parcel water vapour (sat value above lcl). +real(r8), intent(inout), dimension(nup) :: tl ! Actual temp of LCL. +real(r8), intent(inout), dimension(nup) :: pl ! Actual pressure of LCL. +integer, intent(inout), dimension(nup) :: lcl ! Lifting condesation level (first model level with saturation). + +real(r8), intent(out), dimension(nzt,nup) :: tpv ! Define tpv within this routine. + +real(r8), dimension(nzt,nup) :: dmpdz ! Parcel fractional mass entrainment rate (/m) 3D + +! =============================================================================== ! +! GRID ORIENTATION GENERALIZATION VARIABLES +! ------------------------------------------------------------------------------- ! +! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without +! duplicating code, these variables abstract the vertical loop bounds and slices. +! +! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. +! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. +! kdir : Directional step (+1 for moving up, -1 for moving down). +! +! STAGGERED GRID INDEXING +! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative +! index of the cell center (zt) to the interface (zm) flips depending on whether +! memory is loaded top-down or bottom-up. These variables dynamically map them: +! +! kt : The active thermodynamic cell center associated with the current step. +! Upward Sweep: kt = k - (1-kdir)/2 +! Downward Sweep: kt = k - (1+kdir)/2 +! +! kn : The NEXT momentum interface in the direction of the current sweep. +! Upward Sweep: kn = k + kdir +! Downward Sweep: kn = k - kdir +! +! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. +! kt_up = k - (1-kdir)/2 +! +! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. +! kt_dn = k - (1+kdir)/2 +! =============================================================================== ! +integer :: ksfct, ktopt, kdir + +real(r8) tmix(nzt,nup) ! Tempertaure of the entraining parcel. +real(r8) qtmix(nzt,nup) ! Total water of the entraining parcel. +real(r8) qsmix(nzt,nup) ! Saturated mixing ratio at the tmix. +real(r8) smix(nzt,nup) ! Entropy of the entraining parcel. +real(r8) xsh2o(nzt,nup) ! Precipitate lost from parcel. +real(r8) ds_xsh2o(nzt,nup) ! Entropy change due to loss of condensate. +real(r8) ds_freeze(nzt,nup) ! Entropy change sue to freezing of precip. +real(r8) dmpdz2d(nzt,nup) ! variable detrainment rate + +real(r8) zl(nup) ! lcl + +real(r8) mp(nup) ! Parcel mass flux. +real(r8) qtp(nup) ! Parcel total water. +real(r8) sp(nup) ! Parcel entropy. +real(r8) sp0(nup) ! Parcel launch entropy. +real(r8) qtp0(nup) ! Parcel launch total water. +real(r8) mp0(nup) ! Parcel launch relative mass flux. + +real(r8) lwmax ! Maximum condesate that can be held in cloud before rainout. +real(r8) dmpdp ! Parcel fractional mass entrainment rate (/mb). +real(r8) dpdz,dzdp ! Hydrstatic relation and inverse of. +real(r8) senv ! Environmental entropy at each grid point. +real(r8) qtenv ! Environmental total water " " ". +real(r8) penv ! Environmental total pressure " " ". +real(r8) zenv +real(r8) tenv ! Environmental total temperature " " ". +real(r8) new_s ! Hold value for entropy after condensation/freezing adjustments. +real(r8) new_q ! Hold value for total water after condensation/freezing adjustments. +real(r8) dp ! Layer thickness (center to center) +real(r8) tfguess ! First guess for entropy inversion - crucial for efficiency! +real(r8) tscool ! Super cooled temperature offset (in degC) (eg -35). + +real(r8) qxsk, qxskp1 ! LCL excess water (k, k+1) +real(r8) dsdp, dqtdp, dqxsdp ! LCL s, qt, p gradients (k, k+1) +real(r8) slcl,qtlcl,qslcl ! LCL s, qt, qs values. +real(r8) dmpdz_lnd, dmpdz_mask + +integer rcall ! Number of ientropy call for errors recording +integer nit_lheat ! Number of iterations for condensation/freezing loop. +integer i,k,ii ! Loop counters. + +real(r8) est + +if (z(1) < z(nzt)) then + ksfct = 1 + ktopt = nzt + kdir = 1 +else + ksfct = nzt + ktopt = 1 + kdir = -1 +end if + +nit_lheat = 2 ! iterations for ds,dq changes from condensation freezing. + +lwmax = 1.e10_r8 ! tht: don't precipitate +tscool =-10._r8 ! tht: allow even just mild supercooling?! + +qtmix=0._r8 +smix=0._r8 + +qtenv = 0._r8 +senv = 0._r8 +tenv = 0._r8 +penv = 0._r8 +zenv = 0._r8 + +qtp0 = 0._r8 +sp0 = 0._r8 +mp0 = 0._r8 + +qtp = 0._r8 +sp = 0._r8 +mp = 0._r8 + +new_q = 0._r8 +new_s = 0._r8 + +zl(:)=0._r8 + +! **** Begin loops **** + +do k = ksfct, msg-kdir, kdir + do i=1,nup + +! Initialize parcel values at launch level. + + if (k == klaunch) then + qtp0(i) = q(k) ! Parcel launch total water (assuming subsaturated) - OK????. + +!+tht: formulate dilution on enthalpy not on entropy + if (tht_tweaks) then + sp0(i) = enthalpy(t(k),p(k),qtp0(i),z(k)) ! Parcel launch enthalpy. + else + sp0(i) = entropy (t(k),p(k),qtp0(i)) ! Parcel launch entropy. + endif +!-tht + mp0(i) = 1._r8 ! Parcel launch relative mass (=1 for dmpdp=0 i.e. undilute). + smix(k,i) = sp0(i) + qtmix(k,i) = qtp0(i) +!+tht: since the function to invert for T is *identical* with sp0(i)=entropy(t), unless there is +! a coding error (likely, given the mess) the result must be t(i,k) (verified 21/2/2014) + if (tht_tweaks) then + tmix(k,i) = t(k) + call qsat_hPa(tmix(k,i),p(k), est, qsmix(k,i)) + else + tfguess = t(k) + rcall = 1 + call ientropy (rcall,smix(k,i),p(k),qtmix(k,i),tmix(k,i),qsmix(k,i),tfguess) + endif +!-tht + end if + + if ((k - klaunch)*kdir > 0) then + + dp = -abs(p(k)-p(k-kdir)) + qtenv = 0.5_r8*(q(k)+q(k-kdir)) + tenv = 0.5_r8*(t(k)+t(k-kdir)) + penv = 0.5_r8*(p(k)+p(k-kdir)) + zenv = 0.5_r8*(z(k)+z(k-kdir)) + + if (tht_tweaks) then + senv = enthalpy(tenv,penv,qtenv,zenv) ! Enthalpy of environment. + else + senv = entropy (tenv,penv,qtenv) ! Entropy of environment. + endif + +! Determine fractional entrainment rate /pa given value /m. + + dpdz = -(penv*gravit)/(rair*tenv) ! in mb/m since p in mb. + dzdp = 1._r8/dpdz ! in m/mb +!+tht +! NB: land fudge makes no sense to me - make dmpdz_lnd=dmpdz (as per default code, hard-wired to 1e-3) + !dmpdp = dmpdz*dzdp + !dmpdp = dmpdz(i)*dzdp ! /mb Fractional entrainment 2D + dmpdp = dmpdz(k,i)*dzdp ! /mb Fractional entrainment 3D +!-tht + +! Sum entrainment to current level +! entrains q,s out of intervening dp layers, in which linear variation is assumed +! so really it entrains the mean of the 2 stored values. + + sp(i) = sp(i) - dmpdp*dp*senv + qtp(i) = qtp(i) - dmpdp*dp*qtenv + mp(i) = mp(i) - dmpdp*dp + +! Entrain s and qt to next level. + + smix(k,i) = (sp0(i) + sp(i)) / (mp0(i) + mp(i)) + qtmix(k,i) = (qtp0(i) + qtp(i)) / (mp0(i) + mp(i)) + + tfguess = tmix(k-kdir,i) + rcall = 2 + + if (tht_tweaks) then + call ienthalpy(rcall,smix(k,i),p(k),z(k),qtmix(k,i),tmix(k,i),qsmix(k,i),tfguess) + else + call ientropy (rcall,smix(k,i),p(k),qtmix(k,i),tmix(k,i),qsmix(k,i),tfguess) + endif + + if (qsmix(k,i) <= qtmix(k,i) .and. qsmix(k-kdir,i) > qtmix(k-kdir,i)) then + lcl(i) = k + qxsk = qtmix(k,i) - qsmix(k,i) + qxskp1 = qtmix(k-kdir,i) - qsmix(k-kdir,i) + dqxsdp = (qxsk - qxskp1)/dp + pl(i) = p(k-kdir) - qxskp1/dqxsdp + zl(i) = z(k-kdir) - qxskp1/dqxsdp *dzdp + dsdp = (smix(k,i) - smix(k-kdir,i))/dp + dqtdp = (qtmix(k,i) - qtmix(k-kdir,i))/dp + slcl = smix(k-kdir,i) + dsdp* (pl(i)-p(k-kdir)) + qtlcl = qtmix(k-kdir,i) + dqtdp*(pl(i)-p(k-kdir)) + + tfguess = tmix(k,i) + rcall = 3 + + if (tht_tweaks) then + call ienthalpy(rcall,slcl,pl(i),zl(i),qtlcl,tl(i),qslcl,tfguess) + else + call ientropy (rcall,slcl,pl(i),qtlcl,tl(i),qslcl,tfguess) + endif + endif +! + end if ! k < klaunch + + + end do ! Levels loop +end do ! Columns loop + + +! if ( masterproc ) then +! do k = 1,msg-1 +! do i = 1,nup +! write(iulog,*) "after, k, nup, dmpdz ", k, i, dmpdz(k,i) +! end do +! end do +! end if + + +!!!!!!!!!!!!!!!!!!!!!!!!!!END ENTRAINMENT LOOP!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!! Could stop now and test with this as it will provide some estimate of buoyancy +!! without the effects of freezing/condensation taken into account for tmix. + +!! So we now have a profile of entropy and total water of the entraining parcel +!! Varying with height from the launch level klaunch parcel=environment. To the +!! top allowed level for the existence of convection. + +!! Now we have to adjust these values such that the water held in vaopor is < or +!! = to qsmix. Therefore, we assume that the cloud holds a certain amount of +!! condensate (lwmax) and the rest is rained out (xsh2o). This, obviously +!! provides latent heating to the mixed parcel and so this has to be added back +!! to it. But does this also increase qsmix as well? Also freezing processes + + +xsh2o = 0._r8 +ds_xsh2o = 0._r8 +ds_freeze = 0._r8 + +!!!!!!!!!!!!!!!!!!!!!!!!!PRECIPITATION/FREEZING LOOP!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Iterate solution twice for accuracy + + +do k = ksfct, msg-kdir, kdir + do i=1,nup + +! Initialize variables at k=klaunch + + if (k == klaunch) then + +! Set parcel values at launch level assume no liquid water. + + tp(k,i) = tmix(k,i) + qstp(k,i) = q(k) + if (tht_tweaks) then + tpv(k,i) = (tp(k,i) + tpert) * (1._r8+qstp(k,i)/epsilo) / (1._r8+qstp(k,i)) !+tht OK with mx ratio + else + tpv(k,i) = (tp(k,i) + tpert) * (1._r8+1.608_r8*qstp(k,i)) / (1._r8+qstp(k,i)) + endif + end if + + if ((k - klaunch)*kdir > 0) then + + if (tht_tweaks) then + smix(k,i)=entropy(tmix(k,i),p(k),qtmix(k,i)) !+tht make sure to use entropy here + endif + +!---- +! Initiate loop if switch(2) = .T. - RBN:DILUTE - TAKEN OUT BUT COULD BE RETURNED LATER. +! Iterate nit_lheat times for s,qt changes. + do ii=0,nit_lheat-1 + +! Rain (xsh2o) is excess condensate, bar LWMAX (Accumulated loss from qtmix). + xsh2o(k,i) = max (0._r8, qtmix(k,i) - qsmix(k,i) - lwmax) + ds_xsh2o(k,i) = ds_xsh2o(k-kdir,i) - cpliq * log (tmix(k,i)/tmelt) * max(0._r8,(xsh2o(k,i)-xsh2o(k-kdir,i))) + + if (tmix(k,i) <= tmelt+tscool .and. ds_freeze(k-kdir,i) == 0._r8) then + ds_freeze(k,i) = (latice/tmix(k,i)) * max(0._r8,qtmix(k,i)-qsmix(k,i)-xsh2o(k,i)) + end if + + if (tmix(k,i) <= tmelt+tscool .and. ds_freeze(k-kdir,i) /= 0._r8) then + ds_freeze(k,i) = ds_freeze(k-kdir,i)+(latice/tmix(k,i)) * max(0._r8,(qsmix(k-kdir,i)-qsmix(k,i))) + end if + +! Adjust entropy and accordingly to sum of ds (be careful of signs). + new_s = smix(k,i) + ds_xsh2o(k,i) + ds_freeze(k,i) + +! Adjust liquid water and accordingly to xsh2o. + new_q = qtmix(k,i) - xsh2o(k,i) + +! Invert entropy to get updated Tmix and qsmix of parcel. + + tfguess = tmix(k,i) + rcall =4 + call ientropy (rcall,new_s, p(k), new_q, tmix(k,i), qsmix(k,i), tfguess) + + end do ! Iteration loop for freezing processes. + +! tp - Parcel temp is temp of mixture. +! tpv - Parcel v. temp should be density temp with new_q total water. + + tp(k,i) = tmix(k,i) + +! tpv = tprho in the presence of condensate (i.e. when new_q > qsmix) + if (new_q > qsmix(k,i)) then ! Super-saturated so condensate present - reduces buoyancy. + qstp(k,i) = qsmix(k,i) + else ! Just saturated/sub-saturated - no condensate virtual effects. + qstp(k,i) = new_q + end if + + if (tht_tweaks) then + tpv(k,i) = (tp(k,i)+tpert)* (1._r8+qstp(k,i)/epsilo) / (1._r8+ new_q) !+tht + else + tpv(k,i) = (tp(k,i)+tpert)* (1._r8+1.608_r8*qstp(k,i)) / (1._r8+ new_q) + endif + + end if ! k > klaunch + + end do ! Loop for columns + +end do ! Loop for vertical levels. + + +return +end subroutine parcel_dilute + +!----------------------------------------------------------------------------------------- +real(r8) function entropy(TK,p,qtot) +!----------------------------------------------------------------------------------------- +! +! TK(K),p(mb),qtot(kg/kg) +! from Raymond and Blyth 1992 +! + real(r8), intent(in) :: p,qtot,TK + real(r8) :: qv,qst,e,est,L + real(r8), parameter :: pref = 1000._r8 + +L = latvap - (cpliq - cpwv)*(TK-tmelt) ! T IN CENTIGRADE + +call qsat_hPa(TK, p, est, qst) + +qv = min(qtot,qst) ! Partition qtot into vapor part only. +e = qv*p / (epsilo +qv) + +entropy = (cpair + qtot*cpliq)*log( TK/tmelt) - rair*log( (p-e)/pref ) + & + L*qv/TK - qv*rh2o*log(qv/qst) + +end FUNCTION entropy + +!----------------------------------------------------------------------------------------- +SUBROUTINE ientropy (rcall,s,p,qt,T,qst,Tfg) +!----------------------------------------------------------------------------------------- +! +! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). +! Inverts entropy, pressure and total water qt +! for T and saturated vapor mixing ratio +! + + integer, intent(in) :: rcall + real(r8), intent(in) :: s, p, Tfg, qt + real(r8), intent(out) :: qst, T + real(r8) :: est + real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol + integer :: i + + logical :: converged + + ! Max number of iteration loops. + integer, parameter :: LOOPMAX = 100 + real(r8), parameter :: EPS = 3.e-8_r8 + + converged = .false. + + ! Invert the entropy equation -- use Brent's method + ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. + + T = Tfg ! Better first guess based on Tprofile from conv. + + a = Tfg-10 !low bracket + b = Tfg+10 !high bracket + + fa = entropy(a, p, qt) - s + fb = entropy(b, p, qt) - s + + c=b + fc=fb + tol=0.001_r8 + + converge: do i=0, LOOPMAX + if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & + (fb < 0.0_r8 .and. fc < 0.0_r8)) then + c=a + fc=fa + d=b-a + ebr=d + end if + if (abs(fc) < abs(fb)) then + a=b + b=c + c=a + fa=fb + fb=fc + fc=fa + end if + + tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol + xm=0.5_r8*(c-b) + converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) + if (converged) exit converge + + if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then + sbr=fb/fa + if (a == c) then + pbr=2.0_r8*xm*sbr + qbr=1.0_r8-sbr + else + qbr=fa/fc + rbr=fb/fc + pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) + qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) + end if + if (pbr > 0.0_r8) qbr=-qbr + pbr=abs(pbr) + if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then + ebr=d + d=pbr/qbr + else + d=xm + ebr=d + end if + else + d=xm + ebr=d + end if + a=b + fa=fb + b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) + + fb = entropy(b, p, qt) - s + + end do converge + + T = b + call qsat_hPa(T, p, est, qst) + + if (.not. converged) then + call endrun('**** ZM_CONV IENTROPY: Tmix did not converge ****') + end if + +100 format (A,I1,I4,I4,7(A,F6.2)) + +end SUBROUTINE ientropy + +! Wrapper for qsat_water that does translation between Pa and hPa +! qsat_water uses Pa internally, so get it right, need to pass in Pa. +! Afterward, set es back to hPa. +subroutine qsat_hPa(t, p, es, qm) + use wv_saturation, only: qsat_water + + ! Inputs + real(r8), intent(in) :: t ! Temperature (K) + real(r8), intent(in) :: p ! Pressure (hPa) + ! Outputs + real(r8), intent(out) :: es ! Saturation vapor pressure (hPa) + real(r8), intent(out) :: qm ! Saturation mass mixing ratio + ! (vapor mass over dry mass, kg/kg) + + call qsat_water(t, p*100._r8, es, qm) + + es = es*0.01_r8 + +end subroutine qsat_hPa + +!----------------------------------------------------------------------------------------- +real(r8) function enthalpy(TK,p,qtot,z) +!----------------------------------------------------------------------------------------- +! +! TK(K),p(mb),qtot(kg/kg) +! + real(r8), intent(in) :: p,qtot,TK,z + real(r8) :: qv,qst,e,est,L + +L = latvap - (cpliq - cpwv)*(TK-tmelt) + +call qsat_hPa(TK, p, est, qst) +qv = min(qtot,qst) ! Partition qtot into vapor part only. + + enthalpy = (cpair + qtot*cpliq)* TK + L*qv + (1._r8+qtot)*gravit*z + +return +end FUNCTION enthalpy + +!----------------------------------------------------------------------------------------- + SUBROUTINE ienthalpy (rcall,s,p,z,qt,T,qst,Tfg) !identical with iENTROPY, only function calls swapped +!----------------------------------------------------------------------------------------- +! +! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). +! Inverts entropy, pressure and total water qt +! for T and saturated vapor mixing ratio +! + + integer, intent(in) :: rcall + real(r8), intent(in) :: s, p, z, Tfg, qt + real(r8), intent(out) :: qst, T + real(r8) :: est + real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol + integer :: i + + logical :: converged + + ! Max number of iteration loops. + integer, parameter :: LOOPMAX = 100 + real(r8), parameter :: EPS = 3.e-8_r8 + + converged = .false. + + ! Invert the entropy equation -- use Brent's method + ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. + + T = Tfg ! Better first guess based on Tprofile from conv. + + a = Tfg-10 !low bracket + b = Tfg+10 !high bracket + + fa = enthalpy(a, p, qt,z) - s + fb = enthalpy(b, p, qt,z) - s + + c=b + fc=fb + tol=0.001_r8 + + converge: do i=0, LOOPMAX + if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & + (fb < 0.0_r8 .and. fc < 0.0_r8)) then + c=a + fc=fa + d=b-a + ebr=d + end if + if (abs(fc) < abs(fb)) then + a=b + b=c + c=a + fa=fb + fb=fc + fc=fa + end if + + tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol + xm=0.5_r8*(c-b) + converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) + if (converged) exit converge + + if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then + sbr=fb/fa + if (a == c) then + pbr=2.0_r8*xm*sbr + qbr=1.0_r8-sbr + else + qbr=fa/fc + rbr=fb/fc + pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) + qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) + end if + if (pbr > 0.0_r8) qbr=-qbr + pbr=abs(pbr) + if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then + ebr=d + d=pbr/qbr + else + d=xm + ebr=d + end if + else + d=xm + ebr=d + end if + a=b + fa=fb + b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) + + fb = enthalpy(b, p, qt,z) - s + + end do converge + + T = b + call qsat_hPa(T, p, est, qst) + + if (.not. converged) then + call endrun('**** ZM_CONV IENTHALPY: Tmix did not converge ****') + end if + +100 format (A,I1,I4,I4,7(A,F6.2)) + + end SUBROUTINE ienthalpy + +end module clubb_mf From a4c18bbc6da5efc077656be825ea10ccc0060f02 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 10 Jun 2026 11:03:34 -0600 Subject: [PATCH 02/63] merge new clubbmf into cam6_4_180 --- bld/build-namelist | 30 +- bld/namelist_files/namelist_defaults_cam.xml | 31 +- bld/namelist_files/namelist_definition.xml | 161 +- src/physics/cam/clubb_intr.F90 | 1076 ++++- src/physics/cam/clubb_mf.F90 | 3807 +++++++++++++++--- 5 files changed, 4406 insertions(+), 699 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index dbc6adfc43..e655e70405 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3685,15 +3685,39 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_wpxp_Ri_exp'); add_default($nl, 'clubb_z_displace'); + #Turn on HB scheme where CLUBB not active + add_default($nl, 'do_hb_above_clubb'); + #CLUBB+MF options add_default($nl, 'do_clubb_mf'); add_default($nl, 'do_clubb_mf_diag'); + add_default($nl, 'do_clubb_mf_rad'); + add_default($nl, 'do_clubb_mf_precip'); + add_default($nl, 'do_clubb_mf_addtke'); add_default($nl, 'clubb_mf_L0'); add_default($nl, 'clubb_mf_ent0'); + add_default($nl, 'clubb_mf_alphturb'); + add_default($nl, 'clubb_mf_Lopt'); + add_default($nl, 'clubb_mf_a0'); + add_default($nl, 'clubb_mf_b0'); add_default($nl, 'clubb_mf_nup'); - - #Turn on HB scheme where CLUBB not active - add_default($nl, 'do_hb_above_clubb'); + add_default($nl, 'clubb_mf_max_L0'); + add_default($nl, 'clubb_mf_fdd'); + add_default($nl, 'do_clubb_mf_coldpool'); + add_default($nl, 'clubb_mf_ddalph'); + add_default($nl, 'clubb_mf_ddbeta'); + add_default($nl, 'clubb_mf_pwfac'); + add_default($nl, 'clubb_mf_ddexp'); + add_default($nl, 'do_clubb_mf_ustar'); + add_default($nl, 'do_clubb_mf_mixd'); + add_default($nl, 'clubb_mf_up_ndt'); + add_default($nl, 'clubb_mf_cp_ndt'); + add_default($nl, 'do_clubb_mf_rhtke'); + add_default($nl, 'do_clubb_mf_cmt'); + add_default($nl, 'clubb_mf_kseed'); + add_default($nl, 'do_clubb_mf_lscale_perplume'); + add_default($nl, 'do_clubb_mf_coldpool_perplume'); + add_default($nl, 'do_clubb_mf_coldpool_init'); } # Tuning for wet scavenging of modal aerosols diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 007e115d8e..5a776a753b 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2354,9 +2354,35 @@ .false. .false. + .false. + .false. + .false. 50.0 - 0.22 + 0.22 + 0.0 + 0 + 2.0 + 0.5 10 + 10.e3 + 0.0 + .false + 2.e2 + 1.0 + 1.0 + 3.0 + 1.0 + .false. + .false. + 1 + 1 + .false. + .false. + .false. + .false. + .false. + 1 + .false. 10 @@ -2469,6 +2495,9 @@ 1 2 1 + + 6 + 6 1.0D0 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 6a2be626e7..71665711f7 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -2530,7 +2530,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP ISCCP data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell’s longitude (t_local = t_UTC − longitude * 24/360). +gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). Default: none @@ -2538,7 +2538,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP MISR data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell’s longitude (t_local = t_UTC − longitude * 24/360). +gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). Default: none @@ -2546,7 +2546,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP MODIS data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell’s longitude (t_local = t_UTC − longitude * 24/360). +gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). Default: none @@ -2554,7 +2554,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP CloudSat-CALIPSO data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell’s longitude (t_local = t_UTC − longitude * 24/360). +gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). Default: none @@ -2562,7 +2562,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP PARASOL data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell’s longitude (t_local = t_UTC − longitude * 24/360). +gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). Default: none @@ -2570,7 +2570,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP ATLID data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell’s longitude (t_local = t_UTC − longitude * 24/360). +gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). Default: none @@ -4617,6 +4617,24 @@ If .true. add detailed budget terms to output by default. Note that do_clubb_mf Default: .false. + +If .true. turn on Suselj et al 2019 microphysics. +Default: .false. + + + +If .true. couple MF plumes to radiation +Default: .false. + + + +If .true. add MF contribution to TKE pbuf variable +Default: .false. + + Entrainment length scale in meters for individual plumes. Not used if @@ -4624,6 +4642,24 @@ do_clubb_mf=FALSE. Default: 50.0 + +Integer: dynamic entrainment length scale option +Default: 0 + + + +Real: linear coefficient relating ztop/cape to entrainment length scale +Default: 2.0 + + + +Real: expoential coefficient relating ztop/cape to entrainment length scale +Default: 0.5 + + Entrainment efficiency for individual plumes. Not used if @@ -4631,12 +4667,125 @@ do_clubb_mf=FALSE. Default: 0.22 + +Weighting factor for CLUBB TKE on plume entrainment +Default: 0.0 + Real: number of plumes in mass flux ensemble Default: 10 + +Real: limiter on entrainmnet length scale + threshold to diable TKE enhanced entrainmnet +Default: 10.e3 + + + +Fraction of autoconversion partitioned to downdrafts (zero means no downdrafts) +Default: 0.0 + + +If .true. turn on cold pool feedback parameterizations +Default: .false. + + + +Linear enhancement factor to the downdrafts used for the cold pool calculations +Default: 200.0 + + +Exponent enhancement factor to the downdrafts used for the cold pool calculations +Default: 1.0 + + +Enhancement factor for the near surface pressure drag term in downdraft equation +Default: 1.0 + + +Elevation power law exponent for downdrafts velocities in the subcloud layer +Default: 3.0 + + +Factor to increase the ensemble MF plume cloud fractions +Default: 1.0 + + +If .true. use ustar for initializing the plume ensemble +Default: .false. + + + +If .true. use clubbmf mixing depth in place of the PBLH pbuf var +Default: .false. + + + +Real: number of time-steps for running average of the convective height scale +Default: 1 + + + +Real: number of time-steps for running average of cold pool effects +Default: 1 + + + +If .true. use relative humidity thresholds to turn off TKE enhanced entrainment +Default: .false. + + + +If .true. turn on convective momentum transport +Default: .false. + + + +If .true. set unique entrainment length scale for each plume member +Default: .false. + + + +If .true. let cold pool feedback impact plume intialization +Default: .false. + + + +If .true. set cold pool feedback to unique to each plume member +Default: .false. + + + +Real: level position of state used to seed the random number generator +Default: 1 + + + +If .true. turn on elevated convective initiliazation +Default: .false. + + shr_kind_r8 use ppgrid, only: pver, pverp, pcols, begchunk, endchunk use phys_control, only: phys_getopts - use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi, rair, omega + use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi, rair, omega, rhoh2o use air_composition, only: rairv, cpairv - use cam_history_support, only: max_fieldname_len + use cam_history_support, only: max_fieldname_len, fillvalue - use spmd_utils, only: masterproc + use spmd_utils, only: masterproc, iam use constituents, only: pcnst, cnst_add, cnst_ndropmixed use atmos_phys_pbl_utils,only: calc_friction_velocity, calc_kinematic_heat_flux, calc_ideal_gas_rrho, & calc_kinematic_water_vapor_flux, calc_kinematic_buoyancy_flux, calc_obukhov_length @@ -38,7 +38,10 @@ module clubb_intr hm_metadata_type, sclr_idx_type, & nparams - use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag + use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag, clubb_mf_nup, do_clubb_mf_rad, clubb_mf_Lopt, & + clubb_mf_ddalph, clubb_mf_up_ndt, clubb_mf_cp_ndt, do_clubb_mf_cmt, do_clubb_mf_addtke, & + clubb_mf_cldfrac_fac + use cam_history_support, only: add_hist_coord use cloud_fraction, only: dp1, dp2 #endif @@ -427,9 +430,13 @@ module clubb_intr vpwp_idx, & ! north-south momentum flux wpthvp_idx, & ! buoyancy flux wp2thvp_idx, & ! second order buoyancy term + thlm_idx, & ! mean thetal + um_idx, & ! mean of east-west wind + vm_idx, & ! mean of north-south wind wp2up_idx, & ! w'^2 u' wp2up_idx, & ! w'^2 u' 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' > @@ -440,6 +447,7 @@ module clubb_intr 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 ast_idx, & ! Stratiform cloud fraction @@ -453,6 +461,7 @@ module clubb_intr pblh_idx, & ! PBL pbuf icwmrdp_idx, & ! In cloud mixing ratio for deep convection tke_idx, & ! turbulent kinetic energy + icwmrsh_idx, & ! In cloud mixing ratio for shallow convection (MF) tpert_idx, & ! temperature perturbation from PBL fice_idx, & ! fice_idx index in physics buffer cmeliq_idx, & ! cmeliq_idx index in physics buffer @@ -461,8 +470,10 @@ module clubb_intr naai_idx, & ! ice number concentration prer_evap_idx, & ! rain evaporation rate qrl_idx, & ! longwave cooling rate + radf_idx, & qsatfac_idx, & ! subgrid cloud water saturation scaling factor ice_supersat_idx, & ! ice cloud fraction for SILHS + ztodt_idx,& ! physics timestep for SILHS clubbtop_idx ! level index for CLUBB top ! For Gravity Wave code @@ -497,6 +508,29 @@ module clubb_intr integer :: & cmfmc_sh_idx = 0 + integer :: & + rcm_macmic_idx, & + cldfrac_macmic_idx, & + wpthlp_macmic_idx, & + wprtp_macmic_idx, & + wpthvp_macmic_idx, & + mf_wpthlp_macmic_idx, & + mf_wprtp_macmic_idx, & + mf_wpthvp_macmic_idx + + integer :: & + prec_sh_idx, & + snow_sh_idx + + integer :: ztopmn_idx + integer :: ztopma_idx + integer :: ztopm1_macmic_idx + integer :: ddcp_idx + integer :: ddcp_macmic_idx + integer :: ddcpmn_idx + integer :: cbm1_idx + integer :: cbm1_macmic_idx + contains ! =============================================================================== ! @@ -521,12 +555,15 @@ subroutine clubb_register_cam( ) use physics_buffer, only: pbuf_add_field, dtype_r8, dtype_i4, dyn_time_lvls use subcol_utils, only: subcol_get_scheme + integer :: cld_macmic_num_steps + !----- Begin Code ----- call phys_getopts( eddy_scheme_out = eddy_scheme, & deep_scheme_out = deep_scheme, & history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num, & - do_hb_above_clubb_out = do_hb_above_clubb) + do_hb_above_clubb_out = do_hb_above_clubb, & + cld_macmic_num_steps_out = cld_macmic_num_steps) subcol_scheme = subcol_get_scheme() @@ -568,9 +605,10 @@ subroutine clubb_register_cam( ) call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx) call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx) - call pbuf_add_field('FICE', 'physpkg',dtype_r8, (/pcols,pver/), fice_idx) - call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx) - call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx) + call pbuf_add_field('FICE', 'global', dtype_r8, (/pcols,pver/), fice_idx) + call pbuf_add_field('RAD_CLUBB', 'global', dtype_r8, (/pcols,pver/), radf_idx) + call pbuf_add_field('CMELIQ', 'global', dtype_r8, (/pcols,pver/), cmeliq_idx) + call pbuf_add_field('QSATFAC', 'global', dtype_r8, (/pcols,pver/), qsatfac_idx) ! pbuf fields for Gravity Wave scheme call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver /), ttend_clubb_idx ) @@ -602,6 +640,8 @@ subroutine clubb_register_cam( ) call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,nzm_clubb/), vprcp_idx) call pbuf_add_field('RC_COEF_ZM', 'global', dtype_r8, (/pcols,nzm_clubb/), rc_coef_zm_idx) call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,nzm_clubb/), wp4_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wpvp2_idx) call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2up2_idx) call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2vp2_idx) @@ -639,6 +679,33 @@ subroutine clubb_register_cam( ) ! Only in clubb_intr.F90 or SILHS call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), ice_supersat_idx) + call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) + call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), cloud_frac_idx) + + ! these extrra coord vars don't seem to work for interpolate_output=.true. + call add_hist_coord('ncyc', cld_macmic_num_steps, 'macro/micro cycle index') + call add_hist_coord('nens', clubb_mf_nup, 'clubb+mf ensemble size') + + call pbuf_add_field('RCM_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), rcm_macmic_idx) + call pbuf_add_field('CLDFRAC_CLUBB_macmic','physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), cldfrac_macmic_idx) + call pbuf_add_field('WPTHLP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthlp_macmic_idx) + call pbuf_add_field('WPRTP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) + call pbuf_add_field('WPTHVP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) + + if (do_clubb_mf) then + call pbuf_add_field('edmf_thlflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthlp_macmic_idx) + call pbuf_add_field('edmf_qtflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wprtp_macmic_idx) + call pbuf_add_field('edmf_thvflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthvp_macmic_idx) + call pbuf_add_field('ZTOPMN' ,'global' , dtype_r8, (/clubb_mf_up_ndt,pcols,clubb_mf_nup/), ztopmn_idx) + call pbuf_add_field('ZTOPMA' ,'global' , dtype_r8, (/pcols,clubb_mf_nup/), ztopma_idx) + call pbuf_add_field('ZTOP_MACMIC' ,'physpkg', dtype_r8, (/pcols,clubb_mf_nup/), ztopm1_macmic_idx) + call pbuf_add_field('DDCP' ,'global' , dtype_r8, (/pcols,clubb_mf_nup/), ddcp_idx) + call pbuf_add_field('DDCP_MACMIC' ,'physpkg', dtype_r8, (/pcols,clubb_mf_nup/), ddcp_macmic_idx) + call pbuf_add_field('DDCPMN' ,'global' , dtype_r8, (/clubb_mf_cp_ndt,pcols,clubb_mf_nup/), ddcpmn_idx) + call pbuf_add_field('CBM1' ,'global' , dtype_r8, (/pcols/), cbm1_idx) + call pbuf_add_field('CBM1_MACMIC' ,'physpkg', dtype_r8, (/pcols/), cbm1_macmic_idx) + end if + #endif end subroutine clubb_register_cam @@ -1511,6 +1578,8 @@ subroutine clubb_ini_cam(pbuf_ini) ! The similar name to clubb_history is unfortunate... logical :: history_amwg, history_clubb + integer :: cld_macmic_num_steps + type(err_info_type) :: & err_info ! err_info struct used in CLUBB containing err_code and err_header @@ -1570,7 +1639,8 @@ subroutine clubb_ini_cam(pbuf_ini) call phys_getopts(history_amwg_out=history_amwg, & history_clubb_out=history_clubb, & - do_hb_above_clubb_out=do_hb_above_clubb) + do_hb_above_clubb_out=do_hb_above_clubb, & + cld_macmic_num_steps_out=cld_macmic_num_steps) ! Select variables to apply tendencies back to CAM @@ -1623,6 +1693,7 @@ subroutine clubb_ini_cam(pbuf_ini) qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio + icwmrsh_idx = pbuf_get_index('ICWMRSH') ! In-cloud shallow convective mixing ratio (EDMF) sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance prer_evap_idx = pbuf_get_index('PRER_EVAP') @@ -1631,6 +1702,10 @@ subroutine clubb_ini_cam(pbuf_ini) naai_idx = pbuf_get_index('NAAI') npccn_idx = pbuf_get_index('NPCCN') + ! CLUBB+MF + prec_sh_idx = pbuf_get_index('PREC_SH') + snow_sh_idx = pbuf_get_index('SNOW_SH') + ! Scalars aren't in use, set all indices to -1 sclr_idx%iisclr_rt = -1 sclr_idx%iisclr_thl = -1 @@ -1819,6 +1894,8 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ('ELEAK_CLUBB', horiz_only, 'A', 'W/m2', 'CLUBB energy leak', sampled_on_subcycle=.true.) call addfld ('TFIX_CLUBB', horiz_only, 'A', 'K', 'Temperature increment to conserve energy', sampled_on_subcycle=.true.) + call addfld ('TKE_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'CLUBB tke on interface levels', sampled_on_subcycle=.true.) + ! ---------------------------------------------------------------------------- ! ! Below are for detailed analysis of EDMF Scheme ! ! ---------------------------------------------------------------------------- ! @@ -1836,14 +1913,74 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_DRY_V' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft meridional velocity (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_MOIST_V' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft meridional velocity (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_MOIST_QC' , (/ 'ilev' /), 'A', 'kg/kg' , 'Moist updraft condensate mixing ratio (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_precc' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft precipitation rate (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_S_AE' , (/ 'ilev' /), 'A', 'fraction', '1 minus sum of a_i*w_i (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_S_AW' , (/ 'ilev' /), 'A', 'm/s' , 'Sum of a_i*w_i (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AWW' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*w_i (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_S_AWTHL' , (/ 'ilev' /), 'A', 'K m/s' , 'Sum of a_i*w_i*thl_i (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_S_AWQT' , (/ 'ilev' /), 'A', 'kgm/kgs' , 'Sum of a_i*w_i*q_ti (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AWTH' , (/ 'ilev' /), 'A', 'K m/s' , 'Sum of a_i*w_i*th_i (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_S_AWQV' , (/ 'ilev' /), 'A', 'kgm/kgs' , 'Sum of a_i*w_i*q_vi (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_S_AWU' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*u_i (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_S_AWV' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*v_i (EDMF)', sampled_on_subcycle=.true.) - call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'W/m2' , 'thl flux (EDMF)', sampled_on_subcycle=.true.) - call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'W/m2' , 'qt flux (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_thlforcup', (/ 'lev' /), 'A', 'K/s' , 'thl updraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtforcup' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt updraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlforcdn', (/ 'lev' /), 'A', 'K/s' , 'thl downdraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtforcdn' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt downdraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlforc' , (/ 'lev' /), 'A', 'K/s' , 'thl forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtforc' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflxup' , (/ 'ilev' /), 'A', 'K m/s' , 'thl updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflxup' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflxdn' , (/ 'ilev' /), 'A', 'K m/s' , 'thl downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflxdn' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'K m/s' , 'thl flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thvflx' , (/ 'ilev' /), 'A', 'K m/s' , 'thv flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_uflxup' , (/ 'ilev' /), 'A', 'm2/s2' , 'u updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_vflxup' , (/ 'ilev' /), 'A', 'm2/s2' , 'v updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_uflxdn' , (/ 'ilev' /), 'A', 'm2/s2' , 'u downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_vflxdn' , (/ 'ilev' /), 'A', 'm2/s2' , 'v downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_uflx' , (/ 'ilev' /), 'A', 'm2/s2' , 'u flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_vflx' , (/ 'ilev' /), 'A', 'm2/s2' , 'v flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_sqtup' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Plume updraft microphysics tendency (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_sqtdn' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Plume downdraft microphysics tendency (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_rcm' , (/ 'ilev' /), 'A', 'kg/kg' , 'grid mean cloud (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_cloudfrac', (/ 'lev' /), 'A', 'fraction', 'grid mean cloud fraction (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_ent' , (/ 'lev' /), 'A', '1/m' , 'ensemble mean entrainment (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_ztop' , horiz_only, 'A', 'm' , 'edmf ztop', flag_xyfill=.True., sampled_on_subcycle=.true.) + call addfld ( 'edmf_ddcp' , horiz_only, 'A', 'm/s' , 'edmf ddcp', flag_xyfill=.True., sampled_on_subcycle=.true.) + call addfld ( 'edmf_L0' , horiz_only, 'A', 'm' , 'edmf dynamic L0', flag_xyfill=.True., sampled_on_subcycle=.true.) + call addfld ( 'edmf_freq' , horiz_only, 'A', 'unitless', 'edmf frequency mf is active', flag_xyfill=.True., sampled_on_subcycle=.true.) + call addfld ( 'edmf_cfl' , horiz_only, 'A', 'unitless', 'max flux cfl number (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_cape' , horiz_only, 'A', 'J/kg' , 'ensemble mean CAPE (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upa' , (/ 'ilev', 'nens' /), 'A', 'fraction', 'Plume updraft area fraction (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upw' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume updraft vertical velocity (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upmf' , (/ 'ilev', 'nens' /), 'A', 'kg/m2/s' , 'Plume updraft mass flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upqt' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume updraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upthl' , (/ 'ilev', 'nens' /), 'A', 'K' , 'Plume updraft liquid potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upthv' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume updraft virtual potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upth' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume updraft potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upqc' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume updraft condensate mixing ratio (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upent' , (/ 'ilev', 'nens' /), 'A', '1/m' , 'Plume updraft entrainment rate (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_updet' , (/ 'ilev', 'nens' /), 'A', '1/m' , 'Plume updraft dettrainment rate (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upbuoy' , (/ 'ilev', 'nens' /), 'A', 'm/s2' , 'Plume updraft buoyancy (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_dnw' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume downdraft vertical velocity (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_dnthl' , (/ 'ilev', 'nens' /), 'A', 'K' , 'Plume downdraft liquid potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_dnqt' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume downdraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true. ) + end if + + call addfld ('RCM_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'kg/kg' , 'RCM CLUBB at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('CLDFRAC_CLUBB_macmic', (/ 'ilev', 'ncyc' /), 'A', 'fraction', 'CLDFRAC CLUBB at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('WPTHLP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Heat Flux at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('WPRTP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Moisture Flux at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('WPTHVP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Buoyancy Flux at macro/micro substep', sampled_on_subcycle=.true.) + + if (do_clubb_mf) then + call addfld( 'PRECSH', horiz_only, 'A', 'm/s', 'Shallow Convection precipitation rate' ) + call addfld( 'SNOWSH', horiz_only, 'A', 'm/s', 'CLUBB-MF Snow precipitation rate' ) + call addfld ( 'edmf_thlflx_macmic', (/ 'ilev', 'ncyc' /), 'A', 'K m/s' , 'thl flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thvflx_macmic', (/ 'ilev', 'ncyc' /), 'A', 'K m/s' , 'thv flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflx_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'kg/kg m/s' , 'qt flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) end if if ( trim(subcol_scheme) /= 'SILHS' ) then @@ -1934,6 +2071,8 @@ subroutine clubb_ini_cam(pbuf_ini) end if if (do_clubb_mf_diag) then + call add_default('PRECSH', 1, ' ') + call add_default('SNOWSH', 1, ' ') call add_default( 'edmf_DRY_A' , 1, ' ') call add_default( 'edmf_MOIST_A' , 1, ' ') call add_default( 'edmf_DRY_W' , 1, ' ') @@ -1947,14 +2086,51 @@ subroutine clubb_ini_cam(pbuf_ini) call add_default( 'edmf_DRY_V' , 1, ' ') call add_default( 'edmf_MOIST_V' , 1, ' ') call add_default( 'edmf_MOIST_QC' , 1, ' ') + call add_default( 'edmf_precc' , 1, ' ') call add_default( 'edmf_S_AE' , 1, ' ') call add_default( 'edmf_S_AW' , 1, ' ') + call add_default( 'edmf_S_AWW' , 1, ' ') + call add_default( 'edmf_S_AWTH' , 1, ' ') call add_default( 'edmf_S_AWTHL' , 1, ' ') call add_default( 'edmf_S_AWQT' , 1, ' ') call add_default( 'edmf_S_AWU' , 1, ' ') call add_default( 'edmf_S_AWV' , 1, ' ') + call add_default( 'edmf_thlflxup' , 1, ' ') + call add_default( 'edmf_qtflxup' , 1, ' ') + call add_default( 'edmf_thlflxdn' , 1, ' ') + call add_default( 'edmf_qtflxdn' , 1, ' ') call add_default( 'edmf_thlflx' , 1, ' ') + call add_default( 'edmf_thvflx' , 1, ' ') + call add_default( 'edmf_uflxup' , 1, ' ') + call add_default( 'edmf_vflxup' , 1, ' ') + call add_default( 'edmf_uflxdn' , 1, ' ') + call add_default( 'edmf_vflxdn' , 1, ' ') + call add_default( 'edmf_uflx' , 1, ' ') + call add_default( 'edmf_vflx' , 1, ' ') call add_default( 'edmf_qtflx' , 1, ' ') + + call add_default( 'edmf_thlforcup', 1, ' ') + call add_default( 'edmf_qtforcup' , 1, ' ') + call add_default( 'edmf_thlforcdn', 1, ' ') + call add_default( 'edmf_qtforcdn' , 1, ' ') + + call add_default( 'edmf_thlforc' , 1, ' ') + call add_default( 'edmf_qtforc' , 1, ' ') + call add_default( 'edmf_sqtup' , 1, ' ') + call add_default( 'edmf_sqtdn' , 1, ' ') + call add_default( 'edmf_rcm' , 1, ' ') + call add_default( 'edmf_cloudfrac', 1, ' ') + call add_default( 'edmf_ent' , 1, ' ') + call add_default( 'edmf_ztop' , 1, ' ') + call add_default( 'edmf_ddcp' , 1, ' ') + call add_default( 'edmf_L0' , 1, ' ') + call add_default( 'edmf_freq' , 1, ' ') + call add_default( 'edmf_cape' , 1, ' ') + call add_default( 'edmf_cfl' , 1, ' ') + + call add_default( 'edmf_thlflx_macmic' , 1, ' ') + call add_default( 'edmf_qtflx_macmic' , 1, ' ') + call add_default( 'edmf_thvflx_macmic' , 1, ' ') end if if (history_budget) then @@ -2001,6 +2177,7 @@ subroutine clubb_ini_cam(pbuf_ini) call pbuf_set_field(pbuf_ini, thlpthvp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, tke_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, kvh_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, radf_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, wp2rtp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, wp2thlp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, uprcp_idx, 0.0_r8) @@ -2013,6 +2190,17 @@ subroutine clubb_ini_cam(pbuf_ini) call pbuf_set_field(pbuf_ini, wp2vp2_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, ice_supersat_idx, 0.0_r8) + if (do_clubb_mf) then + call pbuf_set_field(pbuf_ini, ztopmn_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ztopma_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ztopm1_macmic_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ddcp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ddcp_macmic_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ddcpmn_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, cbm1_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, cbm1_macmic_idx, 0.0_r8) + end if + ! Initialize SILHS covariance contributions call pbuf_set_field(pbuf_ini, rtp2_mc_zt_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, thlp2_mc_zt_idx, 0.0_r8) @@ -2086,6 +2274,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & use time_manager, only: get_nstep, is_first_restart_step use perf_mod, only: t_startf, t_stopf + use wv_saturation, only: qsat + use interpolate_data,only: vertinterp + #ifdef CLUBB_SGS use holtslag_boville_diff, only: hb_pbl_dependent_coefficients_run use spmd_utils, only: iam @@ -2112,6 +2303,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & init_pdf_params_api, & init_pdf_implicit_coefs_terms_api, & setup_grid_api, & + ic_K, & cleanup_grid_api, & iiPDF_new, & iiPDF_new_hybrid @@ -2194,12 +2386,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wp2thlp_pbuf ! w'^2 thl' (thermodynamic levels) real(r8), pointer, dimension(:,:) :: uprcp_pbuf ! < u' r_c' > (momentum levels) real(r8), pointer, dimension(:,:) :: vprcp_pbuf ! < v' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: rc_coef_pbuf ! Coef. of X'r_c' in Eq. (34) (t-levs.) real(r8), pointer, dimension(:,:) :: rc_coef_zm_pbuf ! Coef. of X'r_c' in Eq. (34) (t-levs.) real(r8), pointer, dimension(:,:) :: wp4_pbuf ! w'^4 (momentum levels real(r8), pointer, dimension(:,:) :: wpup2_pbuf ! w'u'^2 (thermodynamic levels) real(r8), pointer, dimension(:,:) :: wpvp2_pbuf ! w'v'^2 (thermodynamic levels) real(r8), pointer, dimension(:,:) :: wp2up2_pbuf ! w'^2 u'^2 (momentum levels) real(r8), pointer, dimension(:,:) :: wp2vp2_pbuf ! w'^2 v'^2 (momentum levels) + real(r8), pointer, dimension(:) :: ztodtptr_pbuf ! timestep to send to SILHS real(r8), pointer, dimension(:,:) :: cld_pbuf ! cloud fraction [fraction] real(r8), pointer, dimension(:,:) :: concld_pbuf ! convective cloud fraction [fraction] real(r8), pointer, dimension(:,:) :: ast_pbuf ! stratiform cloud fraction [fraction] @@ -2213,6 +2407,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:) :: pblh_pbuf ! planetary boundary layer height [m] real(r8), pointer, dimension(:,:) :: tke_pbuf ! turbulent kinetic energy [m^2/s^2] real(r8), pointer, dimension(:,:) :: dp_icwmr_pbuf ! deep convection in cloud mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: sh_icwmr_pbuf ! shallow convection (EDMF) in cloud mixing ratio [kg/kg] real(r8), pointer, dimension(:,:) :: ice_supersat_frac_pbuf ! Cloud fraction of ice clouds (pver)[fraction] real(r8), pointer, dimension(:,:) :: relvar_pbuf ! relative cloud water variance [-] real(r8), pointer, dimension(:,:) :: naai_pbuf @@ -2223,6 +2418,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: npccn_pbuf real(r8), pointer, dimension(:,:) :: prer_evap_pbuf real(r8), pointer, dimension(:,:) :: qrl_pbuf + real(r8), pointer, dimension(:,:) :: radf_clubb_pbuf ! SILHS covariance contributions real(r8), pointer, dimension(:,:) :: rtp2_mc_zt_pbuf @@ -2244,11 +2440,103 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw_mc_pbuf real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc_pbuf + ! CLUBB-MF pointers + real(r8),pointer :: prec_sh(:) ! total precipitation from MF + real(r8),pointer :: snow_sh(:) ! snow from MF + + real(r8), pointer :: ztopmn(:,:,:) + real(r8), pointer :: ztopma(:,:) + real(r8), pointer :: ztopm1_macmic(:,:) + real(r8), pointer :: ddcp(:,:) + real(r8), pointer :: ddcp_macmic(:,:) + real(r8), pointer :: ddcpmn(:,:,:) + + real(r8), pointer :: cbm1(:) + real(r8), pointer :: cbm1_macmic(:) + + real(r8), pointer :: rcm_macmic(:,:) + real(r8), pointer :: cldfrac_macmic(:,:) + real(r8), pointer :: wpthlp_macmic(:,:) + real(r8), pointer :: wprtp_macmic(:,:) + real(r8), pointer :: wpthvp_macmic(:,:) + real(r8), pointer :: mf_thlflx_macmic(:,:) + real(r8), pointer :: mf_qtflx_macmic(:,:) + real(r8), pointer :: mf_thvflx_macmic(:,:) + + ! + ! MF outputs to outfld + real(r8), dimension(pcols) :: mf_ztop_output, mf_L0_output, & + mf_cape_output, mf_cfl_output, & + mf_ddcp_output, mf_freq_output + + real(r8), dimension(pcols,pver) :: mf_thlforcup_output, mf_qtforcup_output, & ! thermodynamic grid + mf_thlforcdn_output, mf_qtforcdn_output, & ! thermodynamic grid + mf_thlforc_output, mf_qtforc_output, & ! thermodynamic grid + mf_ent_output, & ! thermodynamic grid + mf_sqtup_output, mf_sqtdn_output, & ! thermodynamic grid + mf_qc_output, mf_cloudfrac_output ! thermodynamic grid + + ! MF plume level outputs + real(r8), dimension(pcols,pverp,clubb_mf_nup) :: mf_upa_flip, & + mf_upw_flip, & + mf_upmf_flip, & + mf_upqt_flip, & + mf_upthl_flip, & + mf_upthv_flip, & + mf_upth_flip, & + mf_upqc_flip, & + mf_upbuoy_flip, & + mf_upent_flip, & + mf_updet_flip + ! MF plume level outputs to outfld + real(r8), dimension(pcols,pverp*clubb_mf_nup) :: mf_upa_output, & + mf_upw_output, & + mf_upmf_output, & + mf_upqt_output, & + mf_upthl_output, & + mf_upthv_output, & + mf_upth_output, & + mf_upqc_output, & + mf_upent_output, & + mf_updet_output, & + mf_upbuoy_output + ! MF plume level outputs + real(r8), dimension(pcols,pverp,clubb_mf_nup) :: mf_dnw_flip, & + mf_dnthl_flip, & + mf_dnqt_flip + + ! MF plume level outputs to outfld + real(r8), dimension(pcols,pverp*clubb_mf_nup) :: mf_dnw_output, & + mf_dnthl_output, & + mf_dnqt_output + + ! MF Plume + real(r8), pointer :: tpert(:) + + ! MF outputs to outfld + ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines + + real(r8), dimension(state%ncol,nzm_clubb,clubb_mf_nup) :: & + mf_upa, mf_dna, & + mf_upw, mf_dnw, & + mf_upmf, & + mf_upqt, mf_dnqt, & + mf_upthl, mf_dnthl, & + mf_upthv, mf_dnthv, & + mf_upth, mf_dnth, & + mf_upqc, mf_dnqc, & + mf_upbuoy, & + mf_updet, & + mf_upent + + real(r8), dimension(state%ncol,pverp,clubb_mf_nup) :: flip + real(r8), dimension(state%ncol,pverp) :: rho, wpthvp_diag + ! ---------------------------------------------------- ! ! Local Variables ! ! ---------------------------------------------------- ! - integer :: i !Must be delcared outside "CLUBB_SGS" ifdef for det_s and det_ice zero-ing loops + integer :: i,l !Must be delcared outside "CLUBB_SGS" ifdef for det_s and det_ice zero-ing loops #ifdef CLUBB_SGS @@ -2337,10 +2625,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & Lscale, & dz_g, & ! thickness of layer [m] invrs_dz_g, & ! Inverse of layer thickness [1/m] - - ! MF local thermodynamic vars - invrs_exner_zt,& ! thermodynamic grid - kappa_zt ! thermodynamic grid + invrs_exner_zt, & ! thermodynamic grid + kappa_zt, & ! thermodynamic grid + qc_zt, & ! thermodynamic grid + th_zt, & ! thermodynamic grid + qv_zt, & ! thermodynamic grid + mf_thlforcup, mf_qtforcup, & !variables that represents a forcing or a tendency ($d/dt$) + mf_thlforcdn, mf_qtforcdn, & !applied to a mean state variable (like $\theta_l$ or $q_t$) + mf_thlforcup_nadv,mf_qtforcup_nadv, & !fundamentally represents the volumetric change inside a cell. + mf_thlforcdn_nadv,mf_qtforcdn_nadv, & !All forcing variables belong strictly on the + mf_thlforc_nadv, mf_qtforc_nadv !thermodynamic grid (nzt_clubb). real(r8), dimension(state%ncol,nzm_clubb) :: & thlp2_rad, & @@ -2375,14 +2669,36 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_dry_u, mf_moist_u, & mf_dry_v, mf_moist_v, & mf_moist_qc, & - s_ae, s_aw, & + s_ae, s_ac, & + s_aup, s_adn, & + s_aw, & + s_awup, s_awdn, & + s_aww, & + s_awwup, s_awwdn, & + s_awthlup, s_awqtup, s_awuup, s_awvup, & + s_awthldn, s_awqtdn, s_awudn, s_awvdn, & s_awthl, s_awqt, & - s_awql, s_awqi, & s_awu, s_awv, & - mf_thlflx, mf_qtflx, & + mf_sqtup, mf_sthlup, & + mf_sqtdn, mf_sthldn, & + mf_sqt, mf_sthl, & + mf_precc, & + ! MF work arrays (of size NCOL) + + mf_thlflxup, mf_qtflxup, mf_uflxup, mf_vflxup, & + mf_thlflxdn, mf_qtflxdn, mf_uflxdn, mf_vflxdn, & + mf_thlflx, mf_qtflx, mf_uflx, mf_vflx, & + mf_thvflx, & + mf_qc, mf_cloudfrac, & + mf_qc_nadv, mf_cloudfrac_nadv, & + mf_qc_zt, mf_cloudfrac_zt, & + mf_rcm, mf_rcm_nadv, & + mf_ent_nadv, & ! MF local momentum vars rtm_zm, thlm_zm, & ! momentum grid + th_zm, qv_zm, & ! momentum grid + qc_zm, & ! momentum grid kappa_zm, p_in_Pa_zm, & ! momentum grid invrs_exner_zm ! momentum grid @@ -2439,10 +2755,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_dry_v_output, mf_moist_v_output, & mf_moist_qc_output, & s_ae_output, s_aw_output, & + s_awthlup_output, s_awqtup_output, s_awuup_output, s_awvup_output, & + s_awthldn_output, s_awqtdn_output, s_awudn_output, s_awvdn_output, & s_awthl_output, s_awqt_output, & - s_awql_output, s_awqi_output, & s_awu_output, s_awv_output, & - mf_thlflx_output, mf_qtflx_output + s_aww_output, & + mf_thlflxup_output,mf_qtflxup_output, mf_uflxup_output, mf_vflxup_output, & + mf_thlflxdn_output,mf_qtflxdn_output, mf_uflxdn_output, mf_vflxdn_output, & + mf_thlflx_output, mf_qtflx_output, mf_uflx_output, mf_vflx_output, & + mf_thvflx_output, & + mf_rcm_output, mf_precc_output ! Variables used for output (zt) real(r8), dimension(pcols,pver) :: & @@ -2520,7 +2842,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & latsub, & apply_const, & dl_rad, di_rad, dt_low, & - rrho_tmp, & + eps, & ! Variables below are needed to compute energy integrals for conservation te_a, se_a, ke_a, wv_a, wl_a, & te_b, se_b, ke_b, wv_b, wl_b @@ -2551,6 +2873,32 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #endif + ! CFL limiter vars + real(r8), parameter :: cflval = 1._r8 + integer :: trop_mf + real(r8) :: lambda + real(r8), dimension(state%ncol) :: cflfac, max_cfl, & + th_sfc, max_cfl_nadv + logical :: cfllim + + + real(r8), dimension(state%ncol) :: mf_precc_nadv, mf_snow_nadv,& + mf_cbm1, mf_cbm1_nadv, & + mf_freq_nadv + + real(r8), dimension(state%ncol,clubb_mf_nup) :: mf_ztop, mf_ztop_nadv, & + mf_ztopm1, mf_ztopm1_nadv, & + mf_L0, mf_L0_nadv, & + mf_ddcp, mf_ddcp_nadv, & + mf_cape, mf_cape_nadv + + real(r8), dimension(state%ncol,pver) :: esat, rh + real(r8), dimension(state%ncol,pver) :: mq, mqsat + real(r8), dimension(state%ncol) :: rhlev, rhinv + + real(r8) :: inv_rh2o ! To reduce the number of divisions in clubb_tend + + call t_startf('clubb_tend_cam') do i = 1, pcols @@ -2651,8 +2999,37 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, kvh_idx, khzm_pbuf) call pbuf_get_field(pbuf, pblh_idx, pblh_pbuf) call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr_pbuf) + call pbuf_get_field(pbuf, icwmrsh_idx, sh_icwmr_pbuf) call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh_pbuf) + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) + call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) + + call pbuf_get_field(pbuf, rcm_macmic_idx, rcm_macmic) + call pbuf_get_field(pbuf, cldfrac_macmic_idx, cldfrac_macmic) + call pbuf_get_field(pbuf, wpthlp_macmic_idx, wpthlp_macmic) + call pbuf_get_field(pbuf, wprtp_macmic_idx, wprtp_macmic) + call pbuf_get_field(pbuf, wpthvp_macmic_idx, wpthvp_macmic) + + if (do_clubb_mf) then + call pbuf_get_field(pbuf, mf_wpthlp_macmic_idx, mf_thlflx_macmic) + call pbuf_get_field(pbuf, mf_wprtp_macmic_idx, mf_qtflx_macmic) + call pbuf_get_field(pbuf, mf_wpthvp_macmic_idx, mf_thvflx_macmic) + call pbuf_get_field(pbuf, tpert_idx, tpert) + + call pbuf_get_field(pbuf, ztopmn_idx, ztopmn) + call pbuf_get_field(pbuf, ztopma_idx, ztopma) + call pbuf_get_field(pbuf, ztopm1_macmic_idx, ztopm1_macmic) + + call pbuf_get_field(pbuf, ddcp_idx, ddcp) + call pbuf_get_field(pbuf, ddcp_macmic_idx, ddcp_macmic) + call pbuf_get_field(pbuf, ddcpmn_idx, ddcpmn) + + call pbuf_get_field(pbuf, cbm1_idx, cbm1) + call pbuf_get_field(pbuf, cbm1_macmic_idx, cbm1_macmic) + + end if + ! SILHS covariance contributions call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt_pbuf) call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt_pbuf) @@ -2726,6 +3103,33 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Initialize err_info with parallelization and geographical info call init_err_info_api(ncol, lchnk, iam, state_loc%lat*rad2deg, state_loc%lon*rad2deg, err_info) + + if (do_clubb_mf) then + ! SVP + do k = 1, pver + call qsat(state_loc%t(1:ncol,k), state_loc%pmid(1:ncol,k), esat(1:ncol,k), rh(1:ncol,k), ncol) + end do + + rhlev(:ncol) = 0._r8 + if (clubb_mf_Lopt==7 .or. clubb_mf_Lopt==6) then + ! Interpolate RH to 500 hPa + rh(:ncol,:) = state%q(:ncol,:,1)/rh(:ncol,:) + call vertinterp(ncol, ncol, pver, state%pmid(:ncol,:), 50000._r8, rh, rhlev, & + extrapolate='Z', ln_interp=.true., ps=state%ps(:ncol), phis=state%phis(:ncol), tbot=state%t(:ncol,pver)) + else if (clubb_mf_Lopt==8) then + ! Mass of q, by layer and vertically integrated + mq(:ncol,:) = state%q(:ncol,:,1) * state%pdel(:ncol,:) * rga + mqsat(:ncol,:) = rh(:ncol,:) * state%pdel(:ncol,:) * rga + do k=2,pver + mq(:ncol,1) = mq(:ncol,1) + mq(:ncol,k) + mqsat(:ncol,1) = mqsat(:ncol,1) + mqsat(:ncol,k) + end do + rhlev(:ncol) = mq(:ncol,1)/mqsat(:ncol,1) + end if + ! + end if + + !--------------------- Scalar Setting -------------------- ! Set the ztodt timestep in pbuf for SILHS, this is needed because hdtime is not input to silhs @@ -3022,6 +3426,53 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if + if (do_clubb_mf) then + mf_L0 = 0._r8 + mf_L0_nadv = 0._r8 + mf_ztop = 0._r8 + mf_ztop_nadv = 0._r8 + mf_ztopm1 = 0._r8 + mf_ztopm1_nadv = 0._r8 + mf_cape_nadv = 0._r8 + mf_ddcp_nadv = 0._r8 + mf_cbm1 = 0._r8 + mf_cbm1_nadv = 0._r8 + mf_freq_nadv = 0._r8 + + if (macmic_it==1) then + ztopm1_macmic(:ncol,:) = 0._r8 + ddcp_macmic(:ncol,:) = 0._r8 + cbm1_macmic(:ncol) = 0._r8 + + end if + + !+++ARH - Temporary hack - pbuf_set_field is apparently not taking? + if (is_first_step() .and. macmic_it==1) then + ddcp(:ncol,:) = 0._r8 + end if + + mf_precc_nadv(:ncol) = 0._r8 + mf_snow_nadv(:ncol) = 0._r8 + + mf_qc(:ncol,:nzm_clubb) = 0._r8 + mf_rcm(:ncol,:nzm_clubb) = 0._r8 + mf_cloudfrac(:ncol,:nzm_clubb) = 0._r8 + mf_qc_nadv(:ncol,:nzm_clubb) = 0._r8 + mf_rcm_nadv(:ncol,:nzm_clubb) = 0._r8 + mf_cloudfrac_nadv(:ncol,:nzm_clubb) = 0._r8 + + mf_thlforcup_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_qtforcup_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_thlforcdn_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_qtforcdn_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_thlforc_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_qtforc_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_ent_nadv(:ncol,:nzm_clubb) = 0._r8 + + max_cfl_nadv(:ncol) = 0._r8 + end if + + !----------------------------------- Ice supersaturation adjustment ----------------------------------- if (clubb_do_icesuper) then @@ -3182,6 +3633,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlm(i,k) = ( state_loc%t(i,k_cam) - ( latvap * invrs_cpairv(i,k_cam) ) & * state_loc%q(i,k_cam,ixcldliq) ) * invrs_exner_zt(i,k) + qc_zt(i,k) = state_loc%q(i,k_cam,ixcldliq) + qv_zt(i,k) = state_loc%q(i,k_cam,ixq) + th_zt(i,k) = state_loc%t(i,k_cam)*invrs_exner_zt(i,k) end do end do @@ -3410,8 +3864,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ubar = sqrt(state_loc%u(i,pver)**2+state_loc%v(i,pver)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 - rrho_tmp = calc_ideal_gas_rrho(rair, state_loc%t(i,pver), state_loc%pmid(i,pver)) - ustar = calc_friction_velocity(cam_in%wsx(i), cam_in%wsy(i), rrho_tmp) + rrho(i) = calc_ideal_gas_rrho(rair, state_loc%t(i,pver), state_loc%pmid(i,pver)) + ustar = calc_friction_velocity(cam_in%wsx(i), cam_in%wsy(i), rrho(i)) upwp_sfc(i) = -state_loc%u(i,pver)*ustar**2/ubar vpwp_sfc(i) = -state_loc%v(i,pver)*ustar**2/ubar @@ -3488,30 +3942,91 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !####################################################################### if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + !REMOVECAM_END + call tropopause_findChemTrop( state_loc, troplev ) + + rtm_zm(:,:) = 0._r8 + thlm_zm(:,:) = 0._r8 + th_zm(:,:) = 0._r8 + qv_zm(:,:) = 0._r8 + qc_zm(:,:) = 0._r8 rtm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm(:ncol,:) ) thlm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm(:ncol,:) ) + th_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, th_zt(:ncol,:) ) + qv_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qv_zt(:ncol,:) ) + qc_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qc_zt(:ncol,:) ) ! exner on momentum grid needed for mass flux calc. kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt ) do k = 1, nzm_clubb do i = 1, ncol - k_cam = top_lev - 1 + k invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k) * inv_p0_clubb)**kappa_zm(i,k) ) end do end do + ! pressure,exner on momentum grid needed for mass flux calc. + + th_sfc(:) = 0._r8 + th_sfc(1:ncol) = cam_in%ts(1:ncol)*invrs_exner_zm(1:ncol,nzm_clubb) + + !call calc_ustar( ncol, state_loc%t(:ncol,pver), state_loc%pmid(:ncol,pver), cam_in%wsx(:ncol), cam_in%wsy(:ncol), & + ! rrho(:ncol), ustar2(:ncol) ) + ustar2(1:ncol) = calc_friction_velocity(cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), rrho(1:ncol)) + + if (t>1) then + ! update thv if clubb is subcycled + do i = 1, ncol + thv_ds_zt(i,:) = thlm(i,:) & + + latvap*rcm(i,:)*invrs_exner_zt(i,:)/cpair + thv_ds_zt(i,:) = thv_ds_zt(i,:) & + * (1._r8+zvir*(rtm(i,:)-rcm(i,:)) - rcm(i,:)) + end do + thv_ds_zm(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thv_ds_zt(1:ncol,:) ) + end if + + mf_ztopm1(1:ncol,:) = ztopma(1:ncol,:) + mf_ddcp(1:ncol,:) = ddcp(1:ncol,:) + mf_cbm1(1:ncol) = cbm1(1:ncol) + + rhinv(1:ncol) = 0._r8 + do i = 1, ncol + if (rhlev(i) >= 1._r8) rhlev(i) = 0.990_r8 + if (rhlev(i) > 0._r8) rhinv(i) = 1._r8 / ( (1._r8/rhlev(i)) - 1._r8 ) + end do + !--------------------------------------- integrate_mf call --------------------------------------- ! integrate_mf expects arguments of individual columns. ! If the column loop gets pushed into it, we can also avoid the array slicing. do i = 1, ncol - call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + + trop_mf = troplev(i) + + call integrate_mf( nzm_clubb, nzt_clubb, & ! input + rho_zm(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + rho_zt(i,:), dz_g(i,:), zt_g(i,:), p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input - thlm_zm(i,:), rtm_zm(i,:), & ! input - wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input + trop_mf, wm_zm(i,:), th_zt(i,:), qv_zt(i,:), qc_zt(i,:), & ! input + thlm_zm(i,:), rtm_zm(i,:), thv_ds_zm(i,:), & ! input + th_zm(i,:), qv_zm(i,:), qc_zm(i,:), & ! input + ustar2(i), th_sfc(i), wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input + wpthlp_pbuf(i,:), tke_pbuf(i,:), tpert(i), mf_ztopm1(i,:), rhinv(i), & ! input + wpthvp_pbuf(i,:), wprtp_pbuf(i,:), mf_cape(i,:), mf_ddcp(i,:), mf_cbm1(i), & ! output - plume diagnostics + mf_upa(i,:,:), mf_dna(i,:,:), & ! output - plume diagnostics + mf_upw(i,:,:), mf_dnw(i,:,:), & ! output - plume diagnostics + mf_upmf(i,:,:), & ! output - plume diagnostics + mf_upqt(i,:,:), mf_dnqt(i,:,:), & ! output - plume diagnostics + mf_upthl(i,:,:), mf_dnthl(i,:,:), & ! output - plume diagnostics + mf_upthv(i,:,:), mf_dnthv(i,:,:), & ! output - plume diagnostics + mf_upth(i,:,:), mf_dnth(i,:,:), & ! output - plume diagnostics + mf_upqc(i,:,:), mf_dnqc(i,:,:), & ! output - plume diagnostics + mf_upbuoy(i,:,:), & ! output - plume diagnostics + mf_upent(i,:,:), & ! output - plume diagnostics + mf_updet(i,:,:), & ! output - plume diagnostics 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 @@ -3519,30 +4034,151 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & 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_ae(i,:), & ! output - plume diagnostics + s_ac(i,:), s_aup(i,:), s_adn(i,:), & ! output - plume diagnostics + s_aw(i,:), s_awup(i,:), s_awdn(i,:), & ! output - plume diagnostics + s_aww(i,:), s_awwup(i,:), s_awwdn(i,:), & ! output - plume diagnostics + s_awthlup(i,:), s_awqtup(i,:), s_awuup(i,:), s_awvup(i,:), & ! output - plume diagnostics + s_awthldn(i,:), s_awqtdn(i,:), s_awudn(i,:), s_awvdn(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 + mf_thlflxup(i,:), mf_qtflxup(i,:), mf_uflxup(i,:), mf_vflxup(i,:), & ! output - plume diagnostics + mf_thlflxdn(i,:), mf_qtflxdn(i,:), mf_uflxdn(i,:), mf_vflxdn(i,:), & ! output - plume diagnostics + mf_thlflx(i,:), mf_qtflx(i,:), mf_uflx(i,:), mf_vflx(i,:), & ! output - variables needed for solver + mf_thvflx(i,:), & ! output - plume diagnostics + mf_sqtup(i,:), mf_sthlup(i,:), & ! output - plume diagnostics + mf_sqtdn(i,:), mf_sthldn(i,:), & ! output - plume diagnostics + mf_sqt(i,:), mf_sthl(i,:), & ! output - variables needed for solver + mf_precc(i,:), & ! output - plume diagnostics + mf_ztop(i,:), mf_L0(i,:) ) + + end do + + ! CFL limiter + cfllim = .true. + cflfac(:ncol) = 1._r8 + s_aw(:ncol,nzm_clubb) = 0._r8 + max_cfl(:ncol)= 0._r8 + do i=1,ncol + do k=1,nzt_clubb + max_cfl(i) = max(max_cfl(i),dtime*invrs_dz_g(i,k)*max(abs(s_aw(i,k)),abs(s_aw(i,k+1)))) + end do + if (max_cfl(i).gt.cflval.and.cfllim) cflfac(i) = cflval/max_cfl(i) + end do + + ! Scale microphys so it can't drive qt negative + do k=1,nzt_clubb + do i=1,ncol + if ((-1._r8*mf_sqt(i,k)*dtime) > rtm(i,k)) then + lambda = -1._r8*rtm(i,k)/(mf_sqt(i,k)*dtime) + mf_sqt(i,k) = lambda*mf_sqt(i,k) + mf_sthl(i,k) = lambda*mf_sthl(i,k) + mf_sqtup(i,k) = lambda*mf_sqtup(i,k) + mf_sthlup(i,k) = lambda*mf_sthlup(i,k) + mf_sqtdn(i,k) = lambda*mf_sqtdn(i,k) + mf_sthldn(i,k) = lambda*mf_sthldn(i,k) + end if + end do + end do + + ! Recalculate precip using new microphys forcing + mf_precc(:ncol,:) = 0._r8 + do k = 1, nzt_clubb + do i = 1, ncol + ! Precip accumulates downward across the interfaces + mf_precc(i,k+1) = mf_precc(i,k) - rho_zt(i,k)*dz_g(i,k)*mf_sqt(i,k) + end do end do !--------------------------------------- END integrate_mf call --------------------------------------- + ! pass MF turbulent advection term as CLUBB explicit forcing term + rtm_forcing(:ncol,:) = 0._r8 + thlm_forcing(:ncol,:) = 0._r8 + mf_qtforcup(:ncol,:) = 0._r8 + mf_thlforcup(:ncol,:) = 0._r8 + mf_qtforcdn(:ncol,:) = 0._r8 + mf_thlforcdn(:ncol,:) = 0._r8 + ! pass MF turbulent advection term as CLUBB explicit forcing term do k = 1, nzt_clubb do i = 1, ncol - rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * & - ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflx(i,k+1))) + rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflx(i,k+1))) & + + mf_sqt(i,k) - thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * & - ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflx(i,k+1))) + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflx(i,k+1))) & + + mf_sthl(i,k) + + mf_qtforcup(i,k) = mf_qtforcup(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_qtflxup(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflxup(i,k+1))) & + + mf_sqtup(i,k) + + mf_thlforcup(i,k) = mf_thlforcup(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_thlflxup(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflxup(i,k+1))) & + + mf_sthlup(i,k) + + mf_qtforcdn(i,k) = mf_qtforcdn(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_qtflxdn(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflxdn(i,k+1))) & + + mf_sqtdn(i,k) + + mf_thlforcdn(i,k) = mf_thlforcdn(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_thlflxdn(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflxdn(i,k+1))) & + + mf_sthldn(i,k) end do end do - call t_stopf('clubb_tend_cam:do_clubb_mf') + if (do_clubb_mf_cmt) then + ! convective momentum transport + um_forcing(:ncol,:) = 0._r8 + vm_forcing(:ncol,:) = 0._r8 + do k = 1, nzt_clubb + do i = 1, ncol + um_forcing(i,k) = um_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_uflx(i,k)) - (rho_ds_zm(i,k+1) * mf_uflx(i,k+1))) + + vm_forcing(i,k) = vm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k) * mf_vflx(i,k)) - (rho_ds_zm(i,k+1) * mf_vflx(i,k+1))) + end do + end do + end if + + do i=1,ncol + ! compute ensemble cloud properties + mf_qc_nadv(i,:nzm_clubb) = mf_qc_nadv(i,:nzm_clubb) + mf_moist_qc(i,:nzm_clubb) + mf_rcm_nadv(i,:nzm_clubb) = mf_rcm_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb)*mf_moist_qc(i,:nzm_clubb) + mf_cloudfrac_nadv(i,:nzm_clubb) = mf_cloudfrac_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb) + + ! [kg/m2/s]->[m/s] + mf_precc_nadv(i) = mf_precc_nadv(i) + mf_precc(i,nzm_clubb)/1000._r8 + mf_snow_nadv(i) = 0._r8 + + ! accumulate over nadv subcycles + mf_L0_nadv(i,:) = mf_L0_nadv(i,:) + mf_L0(i,:) + mf_ztop_nadv(i,:) = mf_ztop_nadv(i,:) + mf_ztop(i,:) + mf_ztopm1_nadv(i,:) = mf_ztopm1_nadv(i,:) + mf_ztopm1(i,:) + mf_cape_nadv(i,:) = mf_cape_nadv(i,:) + mf_cape(i,:) + mf_ddcp_nadv(i,:) = mf_ddcp_nadv(i,:) + mf_ddcp(i,:) + mf_cbm1_nadv(i) = mf_cbm1_nadv(i) + mf_cbm1(i) + + if (ANY(mf_ztop(i,:) > 0._r8)) mf_freq_nadv(i) = mf_freq_nadv(i) + 1._r8 + + mf_thlforcup_nadv(i,:nzt_clubb) = mf_thlforcup_nadv(i,:nzt_clubb) + mf_thlforcup(i,:nzt_clubb) + mf_qtforcup_nadv(i,:nzt_clubb) = mf_qtforcup_nadv(i,:nzt_clubb) + mf_qtforcup(i,:nzt_clubb) + mf_thlforcdn_nadv(i,:nzt_clubb) = mf_thlforcdn_nadv(i,:nzt_clubb) + mf_thlforcdn(i,:nzt_clubb) + mf_qtforcdn_nadv(i,:nzt_clubb) = mf_qtforcdn_nadv(i,:nzt_clubb) + mf_qtforcdn(i,:nzt_clubb) + mf_thlforc_nadv(i,:nzt_clubb) = mf_thlforc_nadv(i,:nzt_clubb) + thlm_forcing(i,:nzt_clubb) + mf_qtforc_nadv(i,:nzt_clubb) = mf_qtforc_nadv(i,:nzt_clubb) + rtm_forcing(i,:nzt_clubb) + + mf_ent_nadv(i,:nzm_clubb) = mf_ent_nadv(i,:nzm_clubb) + s_awu(i,:nzm_clubb) + + max_cfl_nadv(i) = MAX(max_cfl(i),max_cfl_nadv(i)) + end do + call t_stopf('clubb_tend_cam:do_clubb_mf') end if - + if ( clubb_l_ascending_grid ) then ! CLUBB is to be run in ascending mode, which has the surface at k=1, which is @@ -3565,6 +4201,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) + khzt = khzt(:,nzt_clubb:1:-1) rtm_ref = rtm_ref(:,nzt_clubb:1:-1) thlm_ref = thlm_ref(:,nzt_clubb:1:-1) um_ref = um_ref(:,nzt_clubb:1:-1) @@ -3965,6 +4602,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol + k_cam = top_lev - 1 + k rvm(i,k) = rtm(i,k) - rcm(i,k) pre(i,k) = prer_evap_pbuf(i,k_cam) end do @@ -4043,6 +4681,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + if (do_clubb_mf_addtke) then + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + khzm_pbuf(i,k_cam) = khzm(i,k) + & + clubb_params(i,ic_K) * Lscale(i,k) * sqrt(0.5_r8 * s_aww(i,k)) + end do + end do + else !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol @@ -4050,6 +4698,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & khzm_pbuf(i,k_cam) = khzm(i,k) end do end do + end if ! pdf_params_zm_chnk is already persistent across calls, but we ! save a pbuf version for restarts @@ -4133,6 +4782,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Use correct qflux from cam_in, not lhf/latvap as was done previously te_b = te_b + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime +!jt check with Adam These are not bfb with nonclubbmf run +!jt ! subtract enthalpy of falling precip from tb + te_b = te_b - prec_sh(i)*1000._r8*latice*hdtime + ! Compute the disbalance of total energy, over depth where CLUBB is active se_dis(i) = ( te_a - te_b ) / ( state_loc%pint(i,pverp) - state_loc%pint(i,clubbtop_pbuf(i)) ) @@ -4439,6 +5092,155 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_cam_tend:do_liqsupersat') end if + if (do_clubb_mf) then + ! average over nadv + mf_L0_nadv = mf_L0_nadv/REAL(nadv) + mf_ztop_nadv = mf_ztop_nadv/REAL(nadv) + mf_ztopm1_nadv = mf_ztopm1_nadv/REAL(nadv) + mf_cape_nadv = mf_cape_nadv/REAL(nadv) + mf_ddcp_nadv = mf_ddcp_nadv/REAL(nadv) + mf_cbm1_nadv = mf_cbm1_nadv/REAL(nadv) + mf_freq_nadv = mf_freq_nadv/REAL(nadv) + + ! accumulate in buffer + ztopm1_macmic(:ncol,:) = ztopm1_macmic(:ncol,:) + mf_ztopm1_nadv(:ncol,:) + ddcp_macmic(:ncol,:) = ddcp_macmic(:ncol,:) + mf_ddcp_nadv(:ncol,:) + cbm1_macmic(:ncol) = cbm1_macmic(:ncol) + mf_cbm1_nadv(:ncol) + + if (macmic_it == cld_macmic_num_steps) then + + cbm1(:ncol) = cbm1_macmic(:ncol)/REAL(cld_macmic_num_steps) + + if (clubb_mf_up_ndt == 1) then + ztopma(:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + else + ztopmn(2:clubb_mf_up_ndt,:ncol,:) = ztopmn(1:clubb_mf_up_ndt-1,:ncol,:) + ztopmn(1,:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ztopma(:ncol,:) = 0._r8 + do t=1,clubb_mf_up_ndt + ztopma(:ncol,:) = ztopma(:ncol,:) + ztopmn(t,:ncol,:) + end do + ztopma(:ncol,:) = ztopma(:ncol,:)/REAL(clubb_mf_up_ndt) + end if + + if (clubb_mf_cp_ndt == 1) then + ddcp(:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + else + ddcpmn(2:clubb_mf_cp_ndt,:ncol,:) = ddcpmn(1:clubb_mf_cp_ndt-1,:ncol,:) + ddcpmn(1,:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ddcp(:ncol,:) = 0._r8 + do t=1,clubb_mf_cp_ndt + ddcp(:ncol,:) = ddcp(:ncol,:) + ddcpmn(t,:ncol,:) + end do + ddcp(:ncol,:) = ddcp(:ncol,:)/REAL(clubb_mf_cp_ndt) + end if + + ddcp(:ncol,:) = clubb_mf_ddalph*ddcp(:ncol,:) + + end if + + mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv) + prec_sh(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) + snow_sh(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) + + mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_thlforcdn_nadv(:ncol,:nzt_clubb) = mf_thlforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforcdn_nadv(:ncol,:nzt_clubb) = mf_qtforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_thlforc_nadv(:ncol,:nzt_clubb) = mf_thlforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) + + mf_ent_nadv(:ncol,:nzm_clubb) = mf_ent_nadv(:ncol,:nzm_clubb)/REAL(nadv) + + end if !clubbmf + + ! Need moist_qc and cloudfrac on thermo grid for output + mf_qc_zt(:,:) = 0._r8 + mf_cloudfrac_zt(:,:) = 0._r8 + + + if (do_clubb_mf) then + mf_qc_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_qc) + mf_cloudfrac_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_cloudfrac) + !mf_qc_zt(1:ncol,:) = zm2zt_api( pverp+1-top_lev, ncol, gr, mf_qc(1:ncol,:)) + !mf_cloudfrac_zt(1:ncol,:) = zm2zt_api( pverp+1-top_lev, ncol, gr, mf_cloudfrac(1:ncol,:)) + + do i=1,ncol + mf_ztop_output(i) = MAXVAL(ztopma(i,:)) + mf_cape_output(i) = MAXVAL(mf_cape_nadv(i,:)) + mf_ddcp_output(i) = MAXVAL(ddcp(i,:)) + mf_L0_output(i) = MAXVAL(mf_L0_nadv(i,:)) + end do + + mf_cfl_output(:ncol) = max_cfl_nadv(:ncol) + mf_freq_output(:ncol) = mf_freq_nadv(:ncol) + + end if !clubbmf + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, nzt_clubb + 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) + + k_cam = top_lev - 1 + k + + pdfp_rtp2_output(i,k_cam) = 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 +!jt check with Adam These are not bfb with nonclubbmf run +!jt check with Adam ! Values to use above top_lev, for variables that have not already been +!jt check with Adam ! set up there. These are mostly fill values that should not actually be +!jt check with Adam ! used in the run, but may end up in diagnostic output. +!jt check with Adam !$acc parallel loop gang vector collapse(2) default(present) +!jt check with Adam do k=1, top_lev-1 +!jt check with Adam do i=1, ncol +!jt check with Adam upwp_pbuf(i,k) = 0._r8 +!jt check with Adam vpwp_pbuf(i,k) = 0._r8 +!jt check with Adam rcm(i,k) = 0._r8 +!jt check with Adam wprcp(i,k) = 0._r8 +!jt check with Adam cloud_frac(i,k) = 0._r8 +!jt check with Adam rcm_in_layer(i,k) = 0._r8 +!jt check with Adam zt_output(i,k) = 0._r8 +!jt check with Adam zi_output(i,k) = 0._r8 +!jt check with Adam khzm_pbuf(i,k) = 0._r8 +!jt check with Adam qclvar(i,k) = 2._r8 +!jt check with Adam end do +!jt check with Adam end do + + ! Fill up arrays needed for McICA. Note we do not want the ghost point, + ! thus why the second loop is needed. + !$acc parallel loop gang vector default(present) + do i=1, pcols + zi_output(i,1) = 0._r8 + end do + + ! enforce zero tracer tendencies above the top_lev level -- no change + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, top_lev-1 + do i=1, ncol + edsclr(i,k,icnt) = state_loc%q(i,k,ixind) + end do + end do + + end if + end do + ! ------------------------------------------------------------ ! ! The rest of the code deals with diagnosing variables ! ! for microphysics/radiation computation and macrophysics ! @@ -4553,6 +5355,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! ! --------------------------------------------------------------------------------- ! + sh_icwmr_pbuf(:,:) = 0.0_r8 frac_limit = 0.01_r8 ic_limit = 1.e-12_r8 deepcu_pbuf(:,:) = 0.0_r8 @@ -4583,6 +5386,29 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo + if (do_clubb_mf) then + do k = 1, pver-1 + do i = 1, ncol + ! While shallow convection is never called, CLUBB+MF uses the shallow cloud fraction and + ! shallow in-cloud mixing ratio pbuf variables to couple with radiation. + if (do_clubb_mf_rad) then + shalcu_pbuf(i,k) = clubb_mf_cldfrac_fac*mf_cloudfrac_output(i,k) + sh_icwmr_pbuf(i,k) = mf_qc_output(i,k) + end if + + if (shalcu_pbuf(i,k) <= frac_limit .or. sh_icwmr_pbuf(i,k) < ic_limit) then + shalcu_pbuf(i,k) = 0._r8 + endif + + ! using the deep convective cloud fraction, CLUBB cloud fraction (variable + ! "cloud_frac") and CLUBB+MF cloud fraction ("shalcu") compute the convective cloud + ! fraction. This follows the formulation found in macrophysics code. Assumes that convective + ! cloud is all nonstratiform cloud from CLUBB or CLUBB+MF plus the deep convective cloud fraction + concld_pbuf(i,k) = min(cloud_frac(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k)+shalcu_pbuf(i,k),0.80_r8) + enddo + enddo + end if + if (single_column .and. .not. scm_cambfb_mode) then if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. & trim(scm_clubb_iop_name) == 'BOMEX_5day' .or. & @@ -4605,7 +5431,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists troplev(:) = 0 !REMOVECAM_END - call tropopause_findChemTrop( state, troplev ) + call tropopause_findChemTrop( state_loc, troplev ) aist_pbuf(:,:top_lev-1) = 0._r8 qsatfac_pbuf(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below @@ -4773,6 +5599,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + rcm_macmic(:ncol,nzt_clubb*(macmic_it-1)+1:nzt_clubb*macmic_it) = rcm(:ncol,:nzt_clubb) + cldfrac_macmic(:ncol,pver*(macmic_it-1)+1:pver*macmic_it) = cld_pbuf(:ncol,:pver) + wpthlp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wpthlp_output(:ncol,:pverp) + wprtp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wprtp_output(:ncol,:pverp) + wpthvp_macmic(:ncol,nzm_clubb*(macmic_it-1)+1:nzm_clubb*macmic_it) = wpthvp_pbuf(:ncol,:nzm_clubb) + if (do_clubb_mf) then + mf_thlflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_thlflx_output(:ncol,:pverp) + mf_qtflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_qtflx_output(:ncol,:pverp) + mf_thvflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_thvflx_output(:ncol,:pverp) + end if + ! Convert RTP2 and THLP2 to thermo grid for output rtp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_pbuf(:ncol,:) ) thl2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_pbuf(:ncol,:) ) @@ -4889,7 +5726,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) call outfld( 'QSATFAC', qsatfac_pbuf, pcols, lchnk ) - + call outfld( 'TKE_CLUBB', tke_pbuf, pcols, lchnk ) ! --------------------------------------------------------------- ! ! Writing state variables after EDMF scheme for detailed analysis ! @@ -4916,15 +5753,66 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_aw_output(i,k) = s_aw(i,k_clubb) s_awthl_output(i,k) = s_awthl(i,k_clubb) s_awqt_output(i,k) = s_awqt(i,k_clubb) - s_awql_output(i,k) = s_awql(i,k_clubb) - s_awqi_output(i,k) = s_awqi(i,k_clubb) s_awu_output(i,k) = s_awu(i,k_clubb) s_awv_output(i,k) = s_awv(i,k_clubb) mf_thlflx_output(i,k) = mf_thlflx(i,k_clubb) * rho_zm(i,k_clubb) * cpair mf_qtflx_output(i,k) = mf_qtflx(i,k_clubb) * rho_zm(i,k_clubb) * latvap + s_awthlup_output(i,k) = s_awthlup(i,k_clubb) + s_awqtup_output(i,k) = s_awqtup(i,k_clubb) + s_awuup_output(i,k) = s_awuup(i,k_clubb) + s_awvup_output(i,k) = s_awvup(i,k_clubb) + s_awthldn_output(i,k) = s_awthldn(i,k_clubb) + s_awqtdn_output(i,k) = s_awqtdn(i,k_clubb) + s_awudn_output(i,k) = s_awudn(i,k_clubb) + s_awvdn_output(i,k) = s_awvdn(i,k_clubb) + s_aww_output(i,k) = s_aww(i,k_clubb) + mf_thlflxup_output(i,k) = mf_thlflxup(i,k_clubb) * rho_zm(i,k_clubb) * cpair + mf_qtflxup_output(i,k) = mf_qtflxup(i,k_clubb) * rho_zm(i,k_clubb) * latvap + mf_uflxup_output(i,k) = mf_uflxup(i,k_clubb) + mf_vflxup_output(i,k) = mf_vflxup(i,k_clubb) + mf_thlflxdn_output(i,k) = mf_thlflxdn(i,k_clubb) * rho_zm(i,k_clubb) * cpair + mf_qtflxdn_output(i,k) = mf_qtflxdn(i,k_clubb) * rho_zm(i,k_clubb) * latvap + mf_uflxdn_output(i,k) = mf_uflxdn(i,k_clubb) + mf_vflxdn_output(i,k) = mf_vflxdn(i,k_clubb) + mf_uflx_output(i,k) = mf_uflx(i,k_clubb) + mf_vflx_output(i,k) = mf_vflx(i,k_clubb) + mf_thvflx_output(i,k) = mf_thvflx(i,k_clubb) + mf_rcm_output(i,k) = mf_rcm(i,k_clubb) + mf_precc_output(i,k) = mf_precc(i,k_clubb) + mf_upa_flip(i,k,:clubb_mf_nup) = mf_upa(i,k_clubb,:clubb_mf_nup) + mf_upw_flip(i,k,:clubb_mf_nup) = mf_upw(i,k_clubb,:clubb_mf_nup) + mf_upmf_flip(i,k,:clubb_mf_nup) = mf_upmf(i,k_clubb,:clubb_mf_nup) + mf_upqt_flip(i,k,:clubb_mf_nup) = mf_upqt(i,k_clubb,:clubb_mf_nup) + mf_upthl_flip(i,k,:clubb_mf_nup) = mf_upthl(i,k_clubb,:clubb_mf_nup) + mf_upthv_flip(i,k,:clubb_mf_nup) = mf_upthv(i,k_clubb,:clubb_mf_nup) + mf_upth_flip(i,k,:clubb_mf_nup) = mf_upth(i,k_clubb,:clubb_mf_nup) + mf_upqc_flip(i,k,:clubb_mf_nup) = mf_upqc(i,k_clubb,:clubb_mf_nup) + mf_upent_flip(i,k,:clubb_mf_nup) = mf_upent(i,k_clubb,:clubb_mf_nup) + mf_updet_flip(i,k,:clubb_mf_nup) = mf_updet(i,k_clubb,:clubb_mf_nup) + mf_upbuoy_flip(i,k,:clubb_mf_nup) = mf_upbuoy(i,k_clubb,:clubb_mf_nup) + mf_dnw_flip(i,k,:clubb_mf_nup) = mf_dnw(i,k_clubb,:clubb_mf_nup) + mf_dnthl_flip(i,k,:clubb_mf_nup) = mf_dnthl(i,k_clubb,:clubb_mf_nup) + mf_dnqt_flip(i,k,:clubb_mf_nup) = mf_dnqt(i,k_clubb,:clubb_mf_nup) end do end do + do k=1,clubb_mf_nup + mf_upa_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upa_flip(:ncol,:pverp,k) + mf_upw_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upw_flip(:ncol,:pverp,k) + mf_upmf_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upmf_flip(:ncol,:pverp,k) + mf_upqt_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upqt_flip(:ncol,:pverp,k) + mf_upthl_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upthl_flip(:ncol,:pverp,k) + mf_upthv_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upthv_flip(:ncol,:pverp,k) + mf_upth_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upth_flip(:ncol,:pverp,k) + mf_upqc_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upqc_flip(:ncol,:pverp,k) + mf_upent_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upent_flip(:ncol,:pverp,k) + mf_updet_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_updet_flip(:ncol,:pverp,k) + mf_upbuoy_output(:ncol,pverp*(k-1)+1:pverp*k)= mf_upbuoy_flip(:ncol,:pverp,k) + mf_dnw_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_dnw_flip(:ncol,:pverp,k) + mf_dnthl_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_dnthl_flip(:ncol,:pverp,k) + mf_dnqt_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_dnqt_flip(:ncol,:pverp,k) + end do + do k = 1, top_lev-1 do i = 1, ncol mf_dry_a_output(i,k) = 0._r8 @@ -4944,15 +5832,53 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_aw_output(i,k) = 0._r8 s_awthl_output(i,k) = 0._r8 s_awqt_output(i,k) = 0._r8 - s_awql_output(i,k) = 0._r8 - s_awqi_output(i,k) = 0._r8 s_awu_output(i,k) = 0._r8 s_awv_output(i,k) = 0._r8 mf_thlflx_output(i,k) = 0._r8 mf_qtflx_output(i,k) = 0._r8 + s_awthlup_output(i,k) = 0._r8 + s_awqtup_output(i,k) = 0._r8 + s_awuup_output(i,k) = 0._r8 + s_awvup_output(i,k) = 0._r8 + s_awthldn_output(i,k) = 0._r8 + s_awqtdn_output(i,k) = 0._r8 + s_awudn_output(i,k) = 0._r8 + s_awvdn_output(i,k) = 0._r8 + s_aww_output(i,k) = 0._r8 + mf_thlflxup_output(i,k) = 0._r8 + mf_qtflxup_output(i,k) = 0._r8 + mf_uflxup_output(i,k) = 0._r8 + mf_vflxup_output(i,k) = 0._r8 + mf_thlflxdn_output(i,k) = 0._r8 + mf_qtflxdn_output(i,k) = 0._r8 + mf_uflxdn_output(i,k) = 0._r8 + mf_vflxdn_output(i,k) = 0._r8 + mf_uflx_output(i,k) = 0._r8 + mf_vflx_output(i,k) = 0._r8 + mf_thvflx_output(i,k) = 0._r8 + mf_rcm_output(i,k) = 0._r8 + mf_precc_output(i,k) = 0._r8 + do l=1,clubb_mf_nup + mf_upa_output(i,pverp*(l-1)+k) = 0._r8 + mf_upw_output(i,pverp*(l-1)+k) = 0._r8 + mf_upmf_output(i,pverp*(l-1)+k) = 0._r8 + mf_upqt_output(i,pverp*(l-1)+k) = 0._r8 + mf_upthl_output(i,pverp*(l-1)+k) = 0._r8 + mf_upthv_output(i,pverp*(l-1)+k) = 0._r8 + mf_upth_output(i,pverp*(l-1)+k) = 0._r8 + mf_upqc_output(i,pverp*(l-1)+k) = 0._r8 + mf_upent_output(i,pverp*(l-1)+k) = 0._r8 + mf_updet_output(i,pverp*(l-1)+k) = 0._r8 + mf_upbuoy_output(i,pverp*(l-1)+k) = 0._r8 + mf_dnw_output(i,pverp*(l-1)+k) = 0._r8 + mf_dnthl_output(i,pverp*(l-1)+k) = 0._r8 + mf_dnqt_output(i,pverp*(l-1)+k) = 0._r8 + end do end do end do + call outfld( 'PRECSH' , prec_sh(:ncol), pcols, lchnk ) + call outfld( 'SNOWSH' , snow_sh(:ncol), pcols, lchnk ) call outfld( 'edmf_DRY_A' , mf_dry_a_output, pcols, lchnk ) call outfld( 'edmf_MOIST_A' , mf_moist_a_output, pcols, lchnk ) call outfld( 'edmf_DRY_W' , mf_dry_w_output, pcols, lchnk ) @@ -4966,15 +5892,77 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'edmf_DRY_V' , mf_dry_v_output, pcols, lchnk ) call outfld( 'edmf_MOIST_V' , mf_moist_v_output, pcols, lchnk ) call outfld( 'edmf_MOIST_QC' , mf_moist_qc_output, pcols, lchnk ) + call outfld( 'edmf_precc' , mf_precc_output, pcols, lchnk ) call outfld( 'edmf_S_AE' , s_ae_output, pcols, lchnk ) call outfld( 'edmf_S_AW' , s_aw_output, pcols, lchnk ) + call outfld( 'edmf_S_AWW' , s_aww_output, pcols, lchnk ) call outfld( 'edmf_S_AWTHL' , s_awthl_output, pcols, lchnk ) call outfld( 'edmf_S_AWQT' , s_awqt_output, pcols, lchnk ) call outfld( 'edmf_S_AWU' , s_awu_output, pcols, lchnk ) call outfld( 'edmf_S_AWV' , s_awv_output, pcols, lchnk ) + call outfld( 'edmf_thlforcup', mf_thlforcup_output, pcols, lchnk ) + call outfld( 'edmf_qtforcup' , mf_qtforcup_output, pcols, lchnk ) + call outfld( 'edmf_thlforcdn', mf_thlforcdn_output, pcols, lchnk ) + call outfld( 'edmf_qtforcdn' , mf_qtforcdn_output, pcols, lchnk ) + call outfld( 'edmf_thlforc' , mf_thlforc_output, pcols, lchnk ) + call outfld( 'edmf_qtforc' , mf_qtforc_output, pcols, lchnk ) + call outfld( 'edmf_thlflxup' , mf_thlflxup_output, pcols, lchnk ) + call outfld( 'edmf_qtflxup' , mf_qtflxup_output, pcols, lchnk ) + call outfld( 'edmf_thlflxdn' , mf_thlflxdn_output, pcols, lchnk ) + call outfld( 'edmf_qtflxdn' , mf_qtflxdn_output, pcols, lchnk ) call outfld( 'edmf_thlflx' , mf_thlflx_output, pcols, lchnk ) call outfld( 'edmf_qtflx' , mf_qtflx_output, pcols, lchnk ) + call outfld( 'edmf_thvflx' , mf_thvflx_output, pcols, lchnk ) + call outfld( 'edmf_rcm' , mf_rcm_output, pcols, lchnk ) + call outfld( 'edmf_uflxup' , mf_uflxup_output, pcols, lchnk ) + call outfld( 'edmf_vflxup' , mf_vflxup_output, pcols, lchnk ) + call outfld( 'edmf_uflxdn' , mf_uflxdn_output, pcols, lchnk ) + call outfld( 'edmf_vflxdn' , mf_vflxdn_output, pcols, lchnk ) + call outfld( 'edmf_uflx' , mf_uflx_output, pcols, lchnk ) + call outfld( 'edmf_vflx' , mf_vflx_output, pcols, lchnk ) + call outfld( 'edmf_cloudfrac', mf_cloudfrac_output, pcols, lchnk ) + call outfld( 'edmf_ent' , mf_ent_output, pcols, lchnk ) + call outfld( 'edmf_upa' , mf_upa_output, pcols, lchnk ) + call outfld( 'edmf_upw' , mf_upw_output, pcols, lchnk ) + call outfld( 'edmf_upmf' , mf_upmf_output, pcols, lchnk ) + call outfld( 'edmf_upqt' , mf_upqt_output, pcols, lchnk ) + call outfld( 'edmf_upthl' , mf_upthl_output, pcols, lchnk ) + call outfld( 'edmf_upthv' , mf_upthv_output, pcols, lchnk ) + call outfld( 'edmf_upth' , mf_upth_output, pcols, lchnk ) + call outfld( 'edmf_upqc' , mf_upqc_output, pcols, lchnk ) + call outfld( 'edmf_upbuoy' , mf_upbuoy_output, pcols, lchnk ) + call outfld( 'edmf_upent' , mf_upent_output, pcols, lchnk ) + call outfld( 'edmf_updet' , mf_updet_output, pcols, lchnk ) + call outfld( 'edmf_dnw' , mf_dnw_output, pcols, lchnk ) + call outfld( 'edmf_dnthl' , mf_dnthl_output, pcols, lchnk ) + call outfld( 'edmf_dnqt' , mf_dnqt_output, pcols, lchnk ) + call outfld( 'edmf_sqtup' , mf_sqtup_output, pcols, lchnk ) + call outfld( 'edmf_sqtdn' , mf_sqtdn_output, pcols, lchnk ) + + ! macmic_it==1 ensures that this is ddcp aeraged over the prior time-steps + if (macmic_it==1) call outfld( 'edmf_ztop' , mf_ztop_output, pcols, lchnk ) + if (macmic_it==1) call outfld( 'edmf_ddcp' , mf_ddcp_output, pcols, lchnk ) + + call outfld( 'edmf_L0' , mf_L0_output, pcols, lchnk ) + call outfld( 'edmf_freq' , mf_freq_output, pcols, lchnk ) + call outfld( 'edmf_cape' , mf_cape_output, pcols, lchnk ) + call outfld( 'edmf_cfl' , mf_cfl_output, pcols, lchnk ) + call outfld( 'ICWMRSH' , sh_icwmr_pbuf, pcols, lchnk ) + end if + + if (macmic_it==cld_macmic_num_steps) then + + call outfld( 'RCM_CLUBB_macmic' , rcm_macmic, pcols, lchnk ) + call outfld( 'CLDFRAC_CLUBB_macmic' , cldfrac_macmic, pcols, lchnk ) + call outfld( 'WPTHLP_CLUBB_macmic' , wpthlp_macmic, pcols, lchnk ) + call outfld( 'WPRTP_CLUBB_macmic' , wprtp_macmic, pcols, lchnk ) + call outfld( 'WPTHVP_CLUBB_macmic' , wpthvp_macmic, pcols, lchnk ) + if (do_clubb_mf) then + call outfld( 'edmf_thlflx_macmic' , mf_thlflx_macmic, pcols, lchnk ) + call outfld( 'edmf_qtflx_macmic' , mf_qtflx_macmic, pcols, lchnk ) + call outfld( 'edmf_thvflx_macmic' , mf_thvflx_macmic, pcols, lchnk ) + end if end if ! Output CLUBB history here diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index de85d1ef70..8c1dc8cac3 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1,684 +1,3201 @@ module clubb_mf +! =============================================================================== ! +! Mass-flux module for use with CLUBB ! +! Together (CLUBB+MF) they comprise a eddy-diffusivity mass-flux approach (EDMF) ! +! =============================================================================== ! + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_abortutils,only: endrun + use time_manager, only: is_first_step, get_nstep + use spmd_utils, only: iam + use physconst, only: cpair, epsilo, gravit, latice, latvap, tmelt, rair, & + cpwv, cpliq, rh2o, zvir, pi + + implicit none + private + save + + public :: integrate_mf, & + clubb_mf_readnl, & + do_clubb_mf, & + do_clubb_mf_diag, & + clubb_mf_nup, & + do_clubb_mf_rad, & + clubb_mf_Lopt, & + clubb_mf_ddalph, & + clubb_mf_up_ndt, & + clubb_mf_cp_ndt, & + do_clubb_mf_cmt, & + do_clubb_mf_addtke, & + clubb_mf_cldfrac_fac + + ! + ! Lopt 0 = fixed L0 + ! 1 = tke_clubb L0 + ! 2 = wpthlp_clubb L0 + ! 3 = test plume L0 + ! 4 = lel + ! 5 = cape + ! 6 = ztopm1 + ! 7 = rel.hum. at 500 hPa + ! 8 = column int. rel.hum. + integer :: clubb_mf_Lopt = 0 + real(r8) :: clubb_mf_a0 = 0._r8 + real(r8) :: clubb_mf_b0 = 0._r8 + real(r8) :: clubb_mf_L0 = 0._r8 + real(r8) :: clubb_mf_ent0 = 0._r8 + real(r8) :: clubb_mf_alphturb= 0._r8 + real(r8) :: clubb_mf_max_L0 = 0._r8 + real(r8) :: clubb_mf_fdd = 0._r8 + real(r8) :: clubb_mf_ddalph = 0._r8 + real(r8) :: clubb_mf_ddbeta = 0._r8 + real(r8) :: clubb_mf_pwfac = 0._r8 + real(r8) :: clubb_mf_ddexp = 0._r8 + real(r8) :: clubb_mf_cldfrac_fac = 1._r8 + integer :: clubb_mf_up_ndt = 1 + integer :: clubb_mf_cp_ndt = 1 + integer :: clubb_mf_kseed = 1 + integer, protected :: clubb_mf_nup = 0 + logical, protected :: do_clubb_mf = .false. + logical, protected :: do_clubb_mf_diag = .false. + logical, protected :: do_clubb_mf_rad = .false. + logical, protected :: do_clubb_mf_addtke = .false. + logical, protected :: do_clubb_mf_coldpool = .false. + logical, protected :: do_clubb_mf_ustar = .false. + logical, protected :: do_clubb_mf_mixd = .false. + logical, protected :: do_clubb_mf_precip = .false. + logical, protected :: do_clubb_mf_rhtke = .false. + logical, protected :: do_clubb_mf_cmt = .false. + logical, protected :: do_clubb_mf_aloft = .false. + logical, protected :: do_clubb_mf_coldpool_init = .false. + logical, protected :: do_clubb_mf_coldpool_perplume = .false. + logical, protected :: do_clubb_mf_lscale_perplume = .false. + logical :: tht_tweaks = .true. + integer :: mf_num_cin = 5 + + contains + + subroutine clubb_mf_readnl(nlfile) + ! =============================================================================== ! - ! Mass-flux module for use with CLUBB ! - ! Together (CLUBB+MF) they comprise a eddy-diffusivity mass-flux approach (EDMF) ! + ! MF namelists ! ! =============================================================================== ! - - use shr_kind_mod, only: r8=>shr_kind_r8 - use spmd_utils, only: masterproc - use cam_logfile, only: iulog - - implicit none - private - save - - public :: integrate_mf, & - clubb_mf_readnl, & - do_clubb_mf, & - do_clubb_mf_diag - - real(r8) :: clubb_mf_L0 = 0._r8 - real(r8) :: clubb_mf_ent0 = 0._r8 - integer :: clubb_mf_nup = 0 - logical, protected :: do_clubb_mf = .false. - logical, protected :: do_clubb_mf_diag = .false. - - contains - - subroutine clubb_mf_readnl(nlfile) - - ! =============================================================================== ! - ! MF namelists ! - ! =============================================================================== ! - - use namelist_utils, only: find_group_name - use cam_abortutils, only: endrun - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_integer, mpi_logical - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - character(len=*), parameter :: sub = 'clubb_mf_readnl' - - integer :: iunit, read_status, ierr - - - namelist /clubb_mf_nl/ clubb_mf_L0, clubb_mf_ent0, clubb_mf_nup, do_clubb_mf, do_clubb_mf_diag - - if (masterproc) then - open( newunit=iunit, file=trim(nlfile), status='old' ) - call find_group_name(iunit, 'clubb_mf_nl', status=read_status) - if (read_status == 0) then - read(iunit, clubb_mf_nl, iostat=ierr) - if (ierr /= 0) then - call endrun('clubb_mf_readnl: ERROR reading namelist') - end if - end if - close(iunit) - end if - - call mpi_bcast(clubb_mf_L0, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_L0") - call mpi_bcast(clubb_mf_ent0, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ent0") - call mpi_bcast(clubb_mf_nup, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_nup") - call mpi_bcast(do_clubb_mf, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf") - call mpi_bcast(do_clubb_mf_diag, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_diag") - - if ((.not. do_clubb_mf) .and. do_clubb_mf_diag ) then - call endrun('clubb_mf_readnl: Error - cannot turn on do_clubb_mf_diag without also turning on do_clubb_mf') - end if - - - end subroutine clubb_mf_readnl - - subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, & ! input - p_zt, iexner_zt, & ! input - u, v, thl, qt, thv, & ! input - thl_zm, qt_zm, & ! input - wthl, wqt, pblh, & ! input - dry_a, moist_a, & ! output - plume diagnostics - dry_w, moist_w, & ! output - plume diagnostics - dry_qt, moist_qt, & ! output - plume diagnostics - dry_thl, moist_thl, & ! output - plume diagnostics - dry_u, moist_u, & ! output - plume diagnostics - dry_v, moist_v, & ! output - plume diagnostics - moist_qc, & ! output - plume diagnostics - ae, aw, & ! output - diagnosed fluxes BEFORE mean field update - awthl, awqt, & ! output - diagnosed fluxes BEFORE mean field update - awql, awqi, & ! output - diagnosed fluxes BEFORE mean field update - awu, awv, & ! output - diagnosed fluxes BEFORE mean field update - thlflx, qtflx ) ! output - variables needed for solver - - ! ================================================================================= ! - ! Mass-flux algorithm ! - ! ! - ! Provides rtm and thl fluxes due to mass flux ensemble, ! - ! which are fed into the mixed explicit/implicit clubb solver as explicit terms ! - ! ! - ! Variables needed for solver ! - ! ae = sum_i (1-a_i) ! - ! aw3 = sum (a_i w_i) ! - ! aws3 = sum (a_i w_i*s_i); s=thl*cp ! - ! aws3,awqv3,awql3,awqi3,awu3,awv3 similar as above except for different variables ! - ! ! - ! Mass flux variables are computed on edges (i.e. momentum grid): ! - ! upa,upw,upqt,... ! - ! dry_a,moist_a,dry_w,moist_w, ... ! - ! ! - ! In CLUBB (unlike CAM) nlevs of momentum grid = nlevs of thermodynamic grid, ! - ! due to a subsurface thermodynamic layer. To avoid confusion, below the variables ! - ! are grouped by the grid they are on. ! - ! ! - ! *note that state on the lowest thermo level is equal to state on the lowest ! - ! momentum level due to state_zt(1) = state_zt(2), and lowest momentum level ! - ! is a weighted combination of the lowest two thermodynamic levels. ! - ! ! - ! ---------------------------------Authors---------------------------------------- ! - ! Marcin Kurowski, JPL ! - ! Modified heavily by Mikael Witte, UCLA/JPL for implementation in CESM2/E3SM ! - ! Additional modifications by Adam Herrington, NCAR ! - ! ================================================================================= ! - - use physconst, only: rair, cpair, gravit, latvap, latice, zvir - - integer, intent(in) :: nzm, nzt - real(r8), dimension(nzt), intent(in) :: u, v, & ! thermodynamic grid - thl, thv, & ! thermodynamic grid - qt, & ! thermodynamic grid - dzt, & ! thermodynamic grid - p_zt, iexner_zt ! thermodynamic grid - - real(r8), dimension(nzm), intent(in) :: thl_zm, & ! momentum grid - qt_zm, & ! momentum grid - zm, & ! momentum grid - p_zm, iexner_zm ! momentum grid - - real(r8), intent(in) :: wthl,wqt - real(r8), intent(inout) :: pblh - - real(r8),dimension(nzm), intent(out) :: dry_a, moist_a, & ! momentum grid - dry_w, moist_w, & ! momentum grid - dry_qt, moist_qt, & ! momentum grid - dry_thl, moist_thl, & ! momentum grid - dry_u, moist_u, & ! momentum grid - dry_v, moist_v, & ! momentum grid - moist_qc, & ! momentum grid - ae, aw, & ! momentum grid - awthl, awqt, & ! momentum grid - awql, awqi, & ! momentum grid - awu, awv, & ! momentum grid - thlflx, qtflx ! momentum grid - - ! =============================================================================== ! - ! INTERNAL VARIABLES - ! - ! sums over all plumes - real(r8), dimension(nzm) :: moist_th, dry_th, & ! momentum grid - awqv, awth ! momentum grid - ! - ! updraft properties - real(r8), dimension(nzm,clubb_mf_nup) :: upw, upa, & ! momentum grid - upqt, upqc, & ! momentum grid - upqv, upqs, & ! momentum grid - upql, upqi, & ! momentum grid - upth, upthv, & ! momentum grid - upthl, & ! momentum grid - upu, upv ! momentum grid - ! - ! entrainment profiles - real(r8), dimension(nzt,clubb_mf_nup) :: ent, entf ! thermodynamic grid - integer, dimension(nzt,clubb_mf_nup) :: enti ! thermodynamic grid - ! - ! other variables - integer :: k,i,ih - real(r8), dimension(clubb_mf_nup) :: zcb - real(r8) :: zcb_unset, & - wthv, & - wstar, qstar, thvstar, & - sigmaw, sigmaqt, sigmathv,& - wmin, wmax, & - wlv, wtv, wp, & - B, & ! thermodynamic grid - entexp, entexpu, entw, & ! thermodynamic grid - thln, thvn, thn, & ! momentum grid - qtn, qsn, & ! momentum grid - qcn, qln, qin, & ! momentum grid - un, vn, wn2, & ! momentum grid - lmixn, & ! momentum grid - supqt, supthl ! thermodynamic grid - ! - ! parameters defining initial conditions for updrafts - real(r8),parameter :: pwmin = 1.5_r8, & - pwmax = 3._r8 - - ! - ! alpha, z-scores after Suselj etal 2019 - real(r8),parameter :: alphw = 0.572_r8, & - alphqt = 2.890_r8, & - alphthv = 2.890_r8 - ! - ! w' covariance after Suselj etal 2019 - real(r8),parameter :: cwqt = 0.32_r8, & - cwthv = 0.58_r8 - ! - ! virtual mass coefficients for w-eqn after Suselj etal 2019 - real(r8),parameter :: wa = 1.0_r8, & - wb = 1.5_r8 - ! - ! min values to avoid singularities - real(r8),parameter :: wstarmin = 1.e-3_r8, & - pblhmin = 100._r8 - ! - ! to condensate or not to condensate - logical :: do_condensation = .true. - ! - ! to precip or not to precip - logical :: do_precip = .false. - ! - ! to debug flag (overides stochastic entrainment) - logical :: debug = .false. - real(r8),parameter :: fixent = 0.004_r8 - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! INITIALIZE OUTPUT VARIABLES - ! set updraft properties to zero - dry_a = 0._r8 - moist_a = 0._r8 - dry_w = 0._r8 - moist_w = 0._r8 - dry_qt = 0._r8 - moist_qt = 0._r8 - dry_thl = 0._r8 - moist_thl = 0._r8 - dry_u = 0._r8 - moist_u = 0._r8 - dry_v = 0._r8 - moist_v = 0._r8 - moist_qc = 0._r8 - ! outputs - variables needed for solver - aw = 0._r8 - awthl = 0._r8 - awqt = 0._r8 - awqv = 0._r8 - awql = 0._r8 - awqi = 0._r8 - awu = 0._r8 - awv = 0._r8 - thlflx = 0._r8 - qtflx = 0._r8 - - ent = 0._r8 - entf = 0._r8 - enti = 0 - - ! this is the environmental area - by default 1. - ae = 1._r8 - - ! START MAIN COMPUTATION - upw = 0._r8 - upthl = 0._r8 - upthv = 0._r8 - upqt = 0._r8 - upa = 0._r8 - upu = 0._r8 - upv = 0._r8 - upqc = 0._r8 - upth = 0._r8 - upql = 0._r8 - upqi = 0._r8 - upqv = 0._r8 - upqs = 0._r8 - - ! unique identifier - zcb_unset = 9999999._r8 - zcb = zcb_unset - - pblh = max(pblh,pblhmin) - wthv = wthl+zvir*thv(nzt)*wqt - - ! if surface buoyancy is positive then do mass-flux - if ( wthv > 0._r8 ) then - - if (debug) then - ! overide stochastic entrainment with fixent - ent(:,:) = fixent - else - - ! get entrainment coefficient, dz/L0 - do i=1,clubb_mf_nup - do k=nzt,1,-1 - entf(k,i) = dzt(k) / clubb_mf_L0 - enddo - enddo - - ! get poisson, P(dz/L0) - call poisson( nzt, clubb_mf_nup, entf, enti, u(nzt:nzt-3:-1)) - - ! get entrainment, ent=ent0/dz*P(dz/L0) - do i=1,clubb_mf_nup - do k=nzt,1,-1 - ent(k,i) = real( enti(k,i))*clubb_mf_ent0/dzt(k) - enddo - enddo - + + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_integer, mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + character(len=*), parameter :: sub = 'clubb_mf_readnl' + + integer :: iunit, read_status, ierr + + + namelist /clubb_mf_nl/ clubb_mf_Lopt, clubb_mf_a0, clubb_mf_b0, clubb_mf_L0, clubb_mf_ent0, clubb_mf_alphturb, & + clubb_mf_nup, clubb_mf_max_L0, do_clubb_mf, do_clubb_mf_diag, do_clubb_mf_precip, do_clubb_mf_rad, & + clubb_mf_fdd, do_clubb_mf_coldpool, clubb_mf_ddalph, clubb_mf_ddbeta, clubb_mf_pwfac, do_clubb_mf_ustar, & + clubb_mf_ddexp, do_clubb_mf_mixd, clubb_mf_up_ndt, clubb_mf_cp_ndt, do_clubb_mf_rhtke, do_clubb_mf_cmt, & + do_clubb_mf_coldpool_init, do_clubb_mf_coldpool_perplume, do_clubb_mf_lscale_perplume, clubb_mf_kseed, & + do_clubb_mf_addtke, do_clubb_mf_aloft, clubb_mf_cldfrac_fac + + if (masterproc) then + open( newunit=iunit, file=trim(nlfile), status='old' ) + call find_group_name(iunit, 'clubb_mf_nl', status=read_status) + if (read_status == 0) then + read(iunit, clubb_mf_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('clubb_mf_readnl: ERROR reading namelist') end if - - ! get surface conditions - wstar = max( wstarmin, (gravit/thv(nzt)*wthv*pblh)**(1._r8/3._r8) ) + end if + close(iunit) + end if + + call mpi_bcast(clubb_mf_Lopt, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_Lopt") + call mpi_bcast(clubb_mf_a0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_a0") + call mpi_bcast(clubb_mf_b0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_b0") + call mpi_bcast(clubb_mf_L0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_L0") + call mpi_bcast(clubb_mf_ent0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ent0") + call mpi_bcast(clubb_mf_alphturb,1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_alphturb") + call mpi_bcast(clubb_mf_nup, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_nup") + call mpi_bcast(clubb_mf_max_L0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_max_L0") + call mpi_bcast(do_clubb_mf, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf") + call mpi_bcast(do_clubb_mf_diag, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_diag") + call mpi_bcast(do_clubb_mf_precip, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_precip") + call mpi_bcast(do_clubb_mf_rad, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_rad") + call mpi_bcast(clubb_mf_fdd, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_fdd") + call mpi_bcast(do_clubb_mf_coldpool, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_coldpool") + call mpi_bcast(clubb_mf_ddalph, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ddalph") + call mpi_bcast(clubb_mf_ddbeta, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ddbeta") + call mpi_bcast(clubb_mf_pwfac, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_pwfac") + call mpi_bcast(clubb_mf_up_ndt, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_up_ndt") + call mpi_bcast(clubb_mf_cp_ndt, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_cp_ndt") + call mpi_bcast(do_clubb_mf_ustar, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_ustar") + call mpi_bcast(clubb_mf_ddexp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ddexp") + call mpi_bcast(do_clubb_mf_mixd, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_mixd") + call mpi_bcast(do_clubb_mf_rhtke, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_rhtke") + call mpi_bcast(do_clubb_mf_cmt, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_cmt") + call mpi_bcast(clubb_mf_kseed, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_kseed") + call mpi_bcast(do_clubb_mf_coldpool_init, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_coldpool_init") + call mpi_bcast(do_clubb_mf_coldpool_perplume, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_coldpool_perplume") + call mpi_bcast(do_clubb_mf_lscale_perplume, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_lscale_perplume") + call mpi_bcast(do_clubb_mf_addtke, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_addtke") + call mpi_bcast(do_clubb_mf_aloft, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_aloft") + call mpi_bcast(clubb_mf_cldfrac_fac, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_cldfrac_fac") + + if ((.not. do_clubb_mf) .and. do_clubb_mf_diag ) then + call endrun('clubb_mf_readnl: Error - cannot turn on do_clubb_mf_diag without also turning on do_clubb_mf') + end if + + end subroutine clubb_mf_readnl + + + subroutine integrate_mf( nzm, nzt, & ! input + rho_zm, zm, p_zm, iexner_zm, & ! input + rho_zt, dzt, zt, p_zt, iexner_zt, & ! input + u, v, thl, qt, thv, & ! input + ktropo, w, th, qv, qc, & ! input + thl_zm, qt_zm, thv_zm, & ! input + th_zm, qv_zm, qc_zm, & ! input + ustar, ths, wthl_sfc, wqt_sfc, pblh, & ! input + wpthlp_env, tke, tpert, ztopm1, rhinv, & ! input + wpthvp_env, wpqtp_env, mcape, ddcp, cbm1, & ! output + upa, dna, & ! output + upw, dnw, & ! output + upmf, & ! output + upqt, dnqt, & ! output + upthl, dnthl, & ! output + upthv, dnthv, & ! output + upth, dnth, & ! output + upqc, dnqc, & ! output + upbuoy, & ! output + upent, & ! output + updet, & ! output + dry_a, moist_a, & ! output + dry_w, moist_w, & ! output + dry_qt, moist_qt, & ! output + dry_thl, moist_thl, & ! output + dry_u, moist_u, & ! output + dry_v, moist_v, & ! output + moist_qc, & ! output + ae, & + ac, aup, adn, & + aw, awup, awdn, & + aww, awwup, awwdn, & + awthlup, awqtup, awuup, awvup, & ! output + awthldn, awqtdn, awudn, awvdn, & ! output + awthl, awqt, & ! output + awu, awv, & ! output + thlflxup,qtflxup, uflxup, vflxup, & ! output + thlflxdn,qtflxdn, uflxdn, vflxdn, & ! output + thlflx, qtflx, uflx, vflx, & ! output - variables needed for solver + thvflx, & ! output + sqtup, sthlup, & ! output + sqtdn, sthldn, & ! output + sqt, sthl, & ! output - variables needed for solver + precc, & ! output + ztop, dynamic_L0 ) + + ! ================================================================================= ! + ! Mass-flux algorithm ! + ! ! + ! Provides rtm and thl fluxes due to mass flux ensemble, ! + ! which are fed into the mixed explicit/implicit clubb solver as explicit terms ! + ! ! + ! Mass flux variables are computed on edges (i.e. momentum grid): ! + ! upa,upw,upqt,... ! + ! dry_a,moist_a,dry_w,moist_w, ... ! + ! ! + ! In CLUBB (unlike CAM) nlevs of momentum grid = nlevs of thermodynamic grid, ! + ! due to a subsurface thermodynamic layer. To avoid confusion, below the variables ! + ! are grouped by the grid they are on. ! + ! ! + ! *note that state on the lowest thermo level is equal to state on the lowest ! + ! momentum level due to state_zt(1) = state_zt(2), and lowest momentum level ! + ! is a weighted combination of the lowest two thermodynamic levels. ! + ! ! + ! ---------------------------------Authors---------------------------------------- ! + ! Marcin Kurowski, JPL ! + ! Modified heavily by Mikael Witte, UCLA/JPL for implementation in CESM2/E3SM ! + ! Additional modifications by Adam Herrington, NCAR ! + ! ================================================================================= ! + + use wv_saturation, only : qsat + + integer, intent(in) :: nzm, nzt, ktropo + real(r8), dimension(nzt), intent(in) :: u, v, & ! thermodynamic grid + thl, thv, & ! thermodynamic grid + th, qv, & ! thermodynamic grid + qt, qc, & ! thermodynamic grid + p_zt, iexner_zt, & ! thermodynamic grid + dzt, rho_zt, & ! thermodynamic grid + zt + + real(r8), dimension(nzm), intent(in) :: thl_zm, thv_zm, & ! momentum grid + w, & + th_zm, qv_zm, & + qt_zm, qc_zm, & ! momentum grid + p_zm, iexner_zm, & ! momentum grid + rho_zm, & ! momentum grid + zm, & ! momentum grid + tke, wpthlp_env, & ! momentum grid + wpthvp_env, wpqtp_env + + real(r8), intent(in) :: wthl_sfc,wqt_sfc + real(r8), intent(in) :: pblh,tpert + real(r8), intent(in) :: rhinv + real(r8), intent(in) :: ths,ustar + real(r8), intent(inout) :: cbm1 + + real(r8),dimension(clubb_mf_nup), intent(inout) :: ztopm1,ddcp + + real(r8),dimension(nzm,clubb_mf_nup), intent(out) :: upa, & ! momentum grid + upw, & ! momentum grid + upmf, & ! momentum grid + upqt, & ! momentum grid + upthl, & ! momentum grid + upthv, & ! momentum grid + upth, & ! momentum grid + upqc, & ! momentum grid + upbuoy, & ! momentum grid + upent, & ! momentum grid + updet + + real(r8),dimension(nzm,clubb_mf_nup), intent(out) :: dna, & ! momentum grid + dnw, & ! momentum grid + dnqt, & ! momentum grid + dnthl, & ! momentum grid + dnthv, & ! momentum grid + dnth, & ! momentum grid + dnqc + + real(r8),dimension(nzm), intent(out) :: dry_a, moist_a, & ! momentum grid + dry_w, moist_w, & ! momentum grid + dry_qt, moist_qt, & ! momentum grid + dry_thl, moist_thl, & ! momentum grid + dry_u, moist_u, & ! momentum grid + dry_v, moist_v, & ! momentum grid + moist_qc ! momentum grid + + real(r8),dimension(nzm), intent(out) :: ae, & + ac, aup, adn, & + aw, awup, awdn, & + aww, awwup, awwdn, & + awthlup, awqtup, awuup, awvup, & ! momentum grid + awthldn, awqtdn, awudn, awvdn, & ! momentum grid + awthl, awqt, & ! momentum grid + awu, awv, & ! momentum grid + thlflxup,qtflxup, uflxup, vflxup, & ! momentum grid + thlflxdn,qtflxdn, uflxdn, vflxdn, & ! momentum grid + thlflx, qtflx, uflx, vflx, & ! momentum grid + thvflx, precc + + real(r8),dimension(nzt), intent(out) :: sqtup, sthlup, & ! thermodynamic grid + sqtdn, sthldn, & ! thermodynamic grid + sqt, sthl ! thermodynamic grid + + real(r8),dimension(clubb_mf_nup), intent(out) :: ztop, dynamic_L0, mcape + + ! =============================================================================== ! + ! INTERNAL VARIABLES + ! + + ! =============================================================================== ! + ! GRID ORIENTATION GENERALIZATION VARIABLES + ! ------------------------------------------------------------------------------- ! + ! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without + ! duplicating code, these variables abstract the vertical loop bounds and slices. + ! + ! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. + ! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. + ! kdir : Directional step (+1 for moving up, -1 for moving down). + ! + ! STAGGERED GRID INDEXING + ! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative + ! index of the cell center (zt) to the interface (zm) flips depending on whether + ! memory is loaded top-down or bottom-up. These variables dynamically map them: + ! + ! kt : The active thermodynamic cell center associated with the current step. + ! Upward Sweep: kt = k - (1-kdir)/2 + ! Downward Sweep: kt = k - (1+kdir)/2 + ! + ! kn : The NEXT momentum interface in the direction of the current sweep. + ! Upward Sweep: kn = k + kdir + ! Downward Sweep: kn = k - kdir + ! + ! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. + ! kt_up = k - (1-kdir)/2 + ! + ! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. + ! kt_dn = k - (1+kdir)/2 + ! =============================================================================== ! + integer :: ksfcm, ktopm, ksfct, ktopt, kdir, kt, kn, kt_up, kt_dn + + ! sums over all plumes + real(r8), dimension(nzm) :: moist_th, dry_th, & + thl_env, qt_env, & + thv_env, & + thvflxup, thvflxdn, & + awthvup, awthvdn + ! updraft properties + real(r8), dimension(nzm,clubb_mf_nup) :: upqv, upqs, & ! momentum grid + upql, upqi, & ! momentum grid + upu, upv, & ! momentum grid + uplmix, upauto ! momentum grid + ! downdraft properties + real(r8), dimension(nzm,clubb_mf_nup) :: dnqs, & ! momentum grid + dnql, dnqi, & ! momentum grid + dnu, dnv, & ! momentum grid + dnlmix ! momentum grid + ! microphyiscs terms + real(r8), dimension(nzt,clubb_mf_nup) :: supqt, supthl, & ! thermodynamic grid + sdnqt, sdnthl, & ! thermodynamic grid + uprr, dnrr + ! entrainment profiles + real(r8), dimension(nzt,clubb_mf_nup) :: entf, mix ! thermodynamic grid + integer, dimension(nzt,clubb_mf_nup) :: enti ! thermodynamic grid + + ! other variables + integer :: k,i,kstart,ddtop,kcb,kpbl,kmid,nbot + integer, dimension(clubb_mf_nup) :: ddbot,kcbarr + real(r8), dimension(clubb_mf_nup) :: zcb,cpfac + real(r8) :: zcb_unset, & + wthv_sfc, wthv, wqt, & + ddint, iddcp, & + wstar, qstar, thvstar, & + sigmaw, sigmaqt, sigmathv,& + convh, wmin, wmax, & + wlv, wtv, wp, & + B, & ! thermodynamic grid + entexp, entexpu, entw, & ! thermodynamic grid + Mn, & ! momentum grid + eturb, det, lmixt, & ! thermodynamic grid + qtovqs, sevap, taum1, & ! thermodynamic grid + sqtint, sthlint, alphint, & + qtmp, betathl, betaqt, & ! thermodynamic grid + thln, thvn, thn, & ! momentum grid + qtn, qsn, & ! momentum grid + qcn, qln, qin, & ! momentum grid + un, vn, wn2, & ! momentum grid + wn, & ! momentum grid + lmixn, srfarea, & ! momentum grid + srfwqtu, srfwthvu, & + facqtu, facthvu, & + zsub, wcb, rh_L0, & + dzext + + real(r8), dimension(nzt-1,1) :: dmpdz + real(r8), dimension(1) :: tl, & + cape, cin + integer, dimension(1) :: lcl, lel + real(r8) :: landfrac + integer :: msg, & + lon, mx + ! limit convective area + logical :: limarea = .false. + real(r8),parameter :: amax = 0.6_r8 + + ! buoyancy sorting variables + logical :: bsort = .false. + real(r8),parameter :: rle = 0.1_r8 + integer :: niter_xc = 1 + integer :: kk, status, iter_xc + real(r8) :: tlm, excessm, qsm, & + tln, excessn, es, & + xc, xsat, x_en, & + x_cu, xs1, xs2, & + aquad, bquad, cquad, & + thlxsat, thvxsat, qtxsat, & + thv_x0, thv_x1, cridis, & + thln0, qtn0, wn0, & + entn, detn, mfn, & + ee2, ud2 + + real(r8), dimension(4) :: u_seed + + ! parameters defining initial conditions for updrafts + real(r8),parameter :: pwmin = 1.5_r8, & + pwmax = 3._r8 + + ! alpha relates star qunataties to stddev after Suselj etal 2019 + real(r8),parameter :: alphw = 0.572_r8, & + alphqt = 2.890_r8, & + alphthv = 2.890_r8 + ! w' covariance after Suselj etal 2019 + real(r8),parameter :: cwqt = 0.32_r8, & + cwthv = 0.58_r8 + ! virtual mass coefficients for w-eqn after Suselj etal 2019 + real(r8),parameter :: wa = 1.0_r8, & + wb = 1.5_r8 + ! min values to avoid singularities + real(r8),parameter :: wstarmin = 1.e-3_r8, & + pblhmin = 100._r8 + ! evaporation efficiency after Suselj etal 2019 + real(r8),parameter :: ke = 2.5e-4_r8 + ! height here downdrafts feel the surface + real(r8),parameter :: z00dn = 1.e3_r8, & + tinynum = 1.e-7_r8 + ! to fix entrainmnet rate + logical :: fixent = .false. + ! fixed entrainment rate + real(r8),parameter :: fixent_ent = 2.e-4_r8 + ! Arakawa and Schubert detrainment limiter + logical :: do_aspd = .false. + ! Lower limit on entrainment length scale + real(r8),parameter :: min_L0 = 0.5_r8 + ! limiter for tke enahnced fractional entrainment + ! (only used when do_aspd = .true.) + real(r8),parameter :: max_eturb = 10._r8 + ! to condensate or not to condensate + logical :: do_condensation = .true. + ! use implicit method for plume updraft velocity + logical :: do_implicit = .false. + ! to scale surface fluxes + logical :: scalesrf = .false. + ! minimum downdraft speed + real(r8),parameter :: mindnw = 1.E-2_r8 + ! limiter on cold pool effects + real(r8),parameter :: max_cpfac = 5._r8 + ! max limiter on cold pool init effects + real(r8),parameter :: max_cpinit = 0.5_r8 + ! to scale surface fluxes + logical :: aloft = .false. + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! DETERMINE GRID ORIENTATION + if (zm(1) < zm(nzm)) then + ! Bottom-up + ksfcm = 1 + ktopm = nzm + kdir = 1 + else + ! Top-down + ksfcm = nzm + ktopm = 1 + kdir = -1 + end if + + if (zt(1) < zt(nzt)) then + ksfct = 1 + ktopt = nzt + else + ksfct = nzt + ktopt = 1 + end if + + ! INITIALIZE OUTPUT VARIABLES + dry_a = 0._r8 + moist_a = 0._r8 + dry_w = 0._r8 + moist_w = 0._r8 + dry_qt = 0._r8 + moist_qt = 0._r8 + dry_thl = 0._r8 + moist_thl = 0._r8 + dry_u = 0._r8 + moist_u = 0._r8 + dry_v = 0._r8 + moist_v = 0._r8 + moist_qc = 0._r8 + + ! this is the environmental area - by default 1. + ae = 1._r8 + ac = 0._r8 + aup = 0._r8 + adn = 0._r8 + aw = 0._r8 + awup = 0._r8 + awdn = 0._r8 + aww = 0._r8 + awwup = 0._r8 + awwdn = 0._r8 + awuup = 0._r8 + awvup = 0._r8 + awudn = 0._r8 + awvdn = 0._r8 + awthvup = 0._r8 + awthvdn = 0._r8 + awthlup = 0._r8 + awqtup = 0._r8 + awthldn = 0._r8 + awqtdn = 0._r8 + awthl = 0._r8 + awqt = 0._r8 + awu = 0._r8 + awv = 0._r8 + thvflxup = 0._r8 + thlflxup = 0._r8 + qtflxup = 0._r8 + thvflxdn = 0._r8 + thlflxdn = 0._r8 + qtflxdn = 0._r8 + thvflx = 0._r8 + thlflx = 0._r8 + uflxup = 0._r8 + vflxup = 0._r8 + uflxdn = 0._r8 + vflxdn = 0._r8 + uflx = 0._r8 + vflx = 0._r8 + qtflx = 0._r8 + sqtup = 0._r8 + sthlup = 0._r8 + sqtdn = 0._r8 + sthldn = 0._r8 + sqt = 0._r8 + sthl = 0._r8 + precc = 0._r8 + + mix = 0._r8 + entf = 0._r8 + enti = 0 + det = 0._r8 + + ! START MAIN COMPUTATION + upw = 0._r8 + upth = 0._r8 + upthl = 0._r8 + upthv = 0._r8 + upqt = 0._r8 + upa = 0._r8 + upmf = 0._r8 + upu = 0._r8 + upv = 0._r8 + upqc = 0._r8 + upth = 0._r8 + upql = 0._r8 + upqi = 0._r8 + upqv = 0._r8 + upqs = 0._r8 + upbuoy= 0._r8 + uplmix= 0._r8 + uprr = 0._r8 + supqt = 0._r8 + supthl= 0._r8 + upent = 0._r8 + updet = 0._r8 + upauto= 0._r8 + + dnw = 0._r8 + dna = 0._r8 + dnu = 0._r8 + dnv = 0._r8 + dnqt = 0._r8 + dnthl = 0._r8 + dnthv = 0._r8 + dnrr = 0._r8 + dnth = 0._r8 + dnqc = 0._r8 + dnql = 0._r8 + dnqi = 0._r8 + dnqs = 0._r8 + dnlmix= 0._r8 + sdnqt = 0._r8 + sdnthl= 0._r8 + + dynamic_L0 = 0._r8 + ztop = 0._r8 + ddbot= 0 + + if (bsort) then + niter_xc = 3 + limarea = .true. + end if + + ! unique identifier + zcb_unset = 9999999._r8 + zcb = zcb_unset + + ! surface buoyancy flux + !wthv = wthl+zvir*ths*wqt + wthv_sfc = wthl_sfc+zvir*ths*wqt_sfc + + if (do_clubb_mf_aloft .and. wthv_sfc < 0.01_r8) then + aloft = .true. + kpbl = ksfcm + do while (zm(kpbl) < pblh) + kpbl = kpbl + kdir + end do + + kmid = ksfcm + ! Use a pressure-based criterion to locate the mid-level within the + ! troposphere. A threshold of ~500 hPa is preferred over the previous + ! fixed height (9 km) because it better represents the tropopause + ! location across different atmospheric conditions. + do while (p_zm(kmid) > 500.E2_r8) + kmid = kmid + kdir + end do + + ! Search absolute bounds by converting relative slice index + kstart = maxloc(wpthvp_env(kpbl : kmid : kdir), DIM=1) + kstart = kpbl + (kstart - 1) * kdir + + wthv = wpthvp_env(kstart) + wqt = wpqtp_env(kstart) + + if (kstart == ktopm) then + wthv = 0._r8 + wqt = 0._r8 + end if + + else + aloft = .false. + kstart = ksfcm + wthv = wthv_sfc + wqt = wqt_sfc + end if + + ! if surface buoyancy is positive then do mass-flux + !if ( wthv > 0._r8 ) then + if ( wthv > 0._r8 .and. wqt > 0._r8) then + + if (do_clubb_mf_mixd) then + convh = max(cbm1,pblhmin) + else + convh = max(pblh,pblhmin) + end if + + ! --------------------------------------------------------- ! + ! Initialize using Deardorff convective velocity scale ! + ! --------------------------------------------------------- ! + wstar = max( wstarmin, (gravit/thv(kstart - (1-kdir)/2)*wthv*convh)**(1._r8/3._r8) ) + + ! --------------------------------------------------------- ! + ! Compute cold pool feedback parameter ! + ! --------------------------------------------------------- ! + + cpfac(:) = 1._r8 + if (do_clubb_mf_coldpool) then + do i=1,clubb_mf_nup + cpfac(i) = min( (max(ddcp(i)/wstar,1._r8))**clubb_mf_ddbeta, max_cpfac ) + end do + end if + + ! --------------------------------------------------------- ! + ! Construct tri-variate PDF at the surface from wstar ! + ! and initialize plume thv, qt, w ! + ! --------------------------------------------------------- ! + + if (do_clubb_mf_ustar) then + qstar = wqt / max(wstarmin,ustar) + thvstar = wthv / max(wstarmin,ustar) + else qstar = wqt / wstar thvstar = wthv / wstar - - sigmaw = alphw * wstar - sigmaqt = alphqt * abs(qstar) - sigmathv = alphthv * abs(thvstar) - + end if + + do i=1,clubb_mf_nup + + if (do_clubb_mf_coldpool_init) then + sigmaw = alphw * wstar * (1._r8 + max_cpinit*cpfac(i)/max_cpfac) + sigmaqt = alphqt * abs(qstar) * (1._r8 + max_cpinit*cpfac(i)/max_cpfac) + sigmathv = alphthv * abs(thvstar) * (1._r8 + max_cpinit*cpfac(i)/max_cpfac) + else + sigmaw = alphw * wstar + sigmaqt = alphqt * abs(qstar) + sigmathv = alphthv * abs(thvstar) + end if + wmin = sigmaw * pwmin wmax = sigmaw * pwmax - + + wlv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * (real(i-1, r8)) + wtv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * real(i,r8) + + upw(kstart,i) = 0.5_r8 * (wlv+wtv) + upa(kstart,i) = 0.5_r8 * erf( wtv/(sqrt(2._r8)*sigmaw) ) & + - 0.5_r8 * erf( wlv/(sqrt(2._r8)*sigmaw) ) + + upu(kstart,i) = u(kstart - (1-kdir)/2) + upv(kstart,i) = v(kstart - (1-kdir)/2) + + upqt(kstart,i) = cwqt * upw(kstart,i) * sigmaqt/sigmaw + upthv(kstart,i) = cwthv * upw(kstart,i) * sigmathv/sigmaw + enddo + + facqtu=1._r8 + facthvu=1._r8 + if (scalesrf) then + ! scale surface fluxes + ! (req'd for conservation if not running with zero-flux b.c.'s) + srfwqtu = 0._r8 + srfwthvu = 0._r8 + srfarea = 0._r8 + do i=1,clubb_mf_nup + srfwqtu=srfwqtu+upqt(kstart,i)*upw(kstart,i)*upa(kstart,i) + srfwthvu=srfwthvu+upthv(kstart,i)*upw(kstart,i)*upa(kstart,i) + srfarea = srfarea+upa(kstart,i) + end do + facqtu=srfarea*wqt/srfwqtu + facthvu=srfarea*wthv/srfwthvu + end if + + do i=1,clubb_mf_nup + + kt = kstart - (1-kdir)/2 + kn = kstart + kdir + + betaqt = (qt(kt+2*kdir)-qt(kt))/(0.5_r8*(dzt(kt+2*kdir)+2._r8*dzt(kt+kdir)+dzt(kt))) + betathl = (thv(kt+2*kdir)-thv(kt))/(0.5_r8*(dzt(kt+2*kdir)+2._r8*dzt(kt+kdir)+dzt(kt))) + + if (.not.aloft) then +!jt The following 2 lines I think are correct since the surface is .5 grid down from the surface dzt +!jt upqt(kstart,i)= qt(kt)-betaqt*0.5_r8*dzt(kt)+facqtu*upqt(kstart,i) +!jt upthv(kstart,i)= thv(kt)-betathl*0.5_r8*dzt(kt)+facthvu*upthv(kstart,i) +!jt The following 2 lines are to restore bfb accuracy + upqt(kstart,i)= qt(kt)-betaqt*dzt(kt)+facqtu*upqt(kstart,i) + upthv(kstart,i)= thv(kt)-betathl*dzt(kt)+facthvu*upthv(kstart,i) + else + upqt(kstart,i)= qt(kt)+upqt(kstart,i) + upthv(kstart,i)= thv(kt)+upthv(kstart,i) + if (w(kstart) > 0._r8) upw(kstart,i)= w(kstart)+upw(kstart,i) + end if + + upthl(kstart,i) = upthv(kstart,i) / (1._r8+zvir*upqt(kstart,i)) + upth(kstart,i) = upthl(kstart,i) + upmf(kstart,i) = rho_zm(kstart)*upa(kstart,i)*upw(kstart,i) + + ! get cloud, lowest momentum level + if (do_condensation) then + call condensation_mf(upqt(kstart,i), upthl(kstart,i), p_zm(kstart), iexner_zm(kstart), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + upthv(kstart,i) = thvn + upqc(kstart,i) = qcn + upql(kstart,i) = qln + upqi(kstart,i) = qin + upqs(kstart,i) = qsn + upth(kstart,i) = thn + if (qcn > 0._r8) zcb(i) = zm(kstart) + else + ! assume no cldliq + upqc(kstart,i) = 0._r8 + end if + end do + + ! if aloft extend the mass flux plume below kstart nbot levels + if (aloft) then + zsub = zm(kstart) + dzext = 1000._r8 + !if greater than dzext above the surface + if (zsub > dzext) then + ! find nbot levs below kstart + nbot = 0 + do k = kstart-kdir, ksfcm, -kdir + if ((zm(kstart)-zm(k)) < dzext) then + nbot = nbot + 1 + end if + end do + else + !else set dxext to height above the suface + dzext = zm(kstart) - zm(ksfcm) + nbot = abs(kstart-ksfcm) + end if + + zsub = zm(kstart) do i=1,clubb_mf_nup - - wlv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * (real(i-1, r8)) - wtv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * real(i,r8) - - upw(nzm,i) = 0.5_r8 * (wlv+wtv) - upa(nzm,i) = 0.5_r8 * erf( wtv/(sqrt(2._r8)*sigmaw) ) & - - 0.5_r8 * erf( wlv/(sqrt(2._r8)*sigmaw) ) - - upu(nzm,i) = u(nzt) - upv(nzm,i) = v(nzt) - - upqt(nzm,i) = qt(nzt) + cwqt * upw(nzm,i) * sigmaqt/sigmaw - upthv(nzm,i) = thv(nzt) + cwthv * upw(nzm,i) * sigmathv/sigmaw - upthl(nzm,i) = upthv(nzm,i) / (1._r8+zvir*upqt(nzm,i)) - - ! get cloud, lowest momentum level - if (do_condensation) then - call condensation_mf(upqt(nzm,i), upthl(nzm,i), p_zm(nzm), iexner_zm(nzm), & - thvn, qcn, thn, qln, qin, qsn, lmixn) - upthv(nzm,i) = thvn - upqc(nzm,i) = qcn - upql(nzm,i) = qln - upqi(nzm,i) = qin - upqs(nzm,i) = qsn - if (qcn > 0._r8) zcb(i) = zm(nzm) + wcb = upw(kstart,i) + do k = kstart-kdir, kstart-nbot*kdir, -kdir + upw(k,i) = wcb - (wcb/(dzext**clubb_mf_ddexp))*(zsub - zm(k))**clubb_mf_ddexp + upa(k,i) = upa(kstart,i) + upmf(k,i) = rho_zm(k)*upa(k,i)*upw(k,i) + + upu(k,i) = upu(kstart,i) + upv(k,i) = upv(kstart,i) + upqt(k,i) = upqt(kstart,i) + upthv(k,i) = upthv(kstart,i) + upthl(k,i) = upthl(kstart,i) + upth(k,i) = upth(kstart,i) + upqc(k,i) = upqc(kstart,i) + upql(k,i) = upql(kstart,i) + upqi(k,i) = upqi(kstart,i) + upqs(k,i) = upqs(kstart,i) + end do + end do + end if + + do i=1,clubb_mf_nup + ! --------------------------------------------------------- ! + ! Calculate ztop and dynamic_L based on value of namelist ! + ! --------------------------------------------------------- ! + call get_Lscale (nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, th, & + wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, wa, wb, & + do_condensation, qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1(i), dynamic_L0(i), ztop(i), mcape(i)) + + ! cold pool feedback on the entrainmnet length scale + dynamic_L0(i) = dynamic_L0(i) * cpfac(i) + + ! limit max/min + dynamic_L0(i) = max(min_L0,dynamic_L0(i)) + dynamic_L0(i) = min(clubb_mf_max_L0,dynamic_L0(i)) + + ! --------------------------------------------------------- ! + ! Stochastic entrainmnet calculation ! + ! From Suselj et al 2019, after Romps and Kuang 2010 ! + ! (ideally we wouldn't fill the entire arrray w/ the RNG, ! + ! but the RNG doesn't work properly when it operates on ! + ! the entire array. I'm not sure why this is happening.) ! + ! --------------------------------------------------------- ! + do k = ksfct, ktopt-kdir, kdir + ! get entrainment coefficient, dz/L0 + entf(k,i) = dzt(k) / dynamic_L0(i) + end do + end do + + ! get poisson, P(dz/L0) + ! Grab the u-wind from the exact physical near-surface layers to preserve the PRNG seed + u_seed(1) = u(ksfct) + u_seed(2) = u(ksfct + (clubb_mf_kseed + 0)* kdir) + u_seed(3) = u(ksfct + (clubb_mf_kseed + 1) * kdir) + u_seed(4) = u(ksfct + (clubb_mf_kseed + 2) * kdir) + + ! get poisson, P(dz/L0) + call poisson( nzt, clubb_mf_nup, ksfct, ktopt, kdir, entf, enti, u_seed ) + ! call poisson( nzt, clubb_mf_nup, entf, enti, u(clubb_mf_kseed+1:clubb_mf_kseed+4)) + + ! --------------------------------------------------------- ! + ! Main upward sweep to compute updraft properties ! + ! ! + ! --------------------------------------------------------- ! + do i=1,clubb_mf_nup + do k = kstart, ktopm-kdir, kdir + + kt = k - (1-kdir)/2 + kn = k + kdir + + ! get microphysics, autoconversion + if (do_clubb_mf_precip .and. upqc(k,i) > 0._r8) then + call precip_mf(upqs(k,i),upqt(k,i),upw(k,i),dzt(kt),abs(zm(kn)-zcb(i)),supqt(kt,i)) + supthl(kt,i) = -1._r8*lmixn*supqt(kt,i)*iexner_zt(kt)/cpair else - ! assume no cldliq - upqc(nzm,i) = 0._r8 + supqt(kt,i) = 0._r8 + supthl(kt,i) = 0._r8 end if - - enddo - - ! get updraft properties - do i=1,clubb_mf_nup - do k=nzm,2,-1 - ! get microphysics, autoconversion - if (do_precip .and. upqc(k,i) > 0._r8) then - call precip_mf(upqs(k,i),upqt(k,i),upw(k,i),dzt(k-1),zm(k-1)-zcb(i),supqt) - - supthl = -1._r8*lmixn*supqt*iexner_zt(k-1)/cpair + ! compute mixing rate + if (fixent) then + mix(kt,i) = fixent_ent + else + ! get entrainment, ent=ent0/dz*P(dz/L0) + mix(kt,i) = real( enti(kt,i))*clubb_mf_ent0/dzt(kt) + end if + + do iter_xc = 1, niter_xc + + if (bsort) then + if (iter_xc==1) then + qtn = upqt(k,i) + thln = upthl(k,i) + wn = upw(k,i) + else + qtn = 0.5_r8*(qtn + qtn0) + thln = 0.5_r8*(thln + thln0) + wn = 0.5_r8*(wn + wn0) + end if + + ! save this iteration + qtn0 = qtn + thln0 = thln + wn0 = wn + + ! --------------------------------------------------------- ! + ! Compute excess water to derive neutral mixing fraction ! + ! after Bretherton et al 2014 ! + ! --------------------------------------------------------- ! + + ! qexcess of the envrionment + tlm = thl_zm(kn)/iexner_zm(kn) + call qsat(tlm,p_zm(kn),es,qsm) + excessm = qt_zm(kn) - qsm + + ! qexcess in plume + tln = thln/iexner_zm(kn) + call qsat(tln,p_zm(kn),es,qsn) + excessn = qtn - qsn + + call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + + ! critical stopping distance + cridis = rle*ztopm1(i) + + ! ----------------------------------------------------------------- ! + ! Case 1 : When both cumulus and env. are unsaturated or saturated. ! + ! ----------------------------------------------------------------- ! + if (excessm*excessn > 0._r8) then + xc = min(1._r8,max(0._r8,1._r8-2._r8*wa*gravit*cridis/wn**2._r8*(1._r8-thvn/thv_zm(kn)))) + aquad = 0._r8 + bquad = 0._r8 + cquad = 0._r8 + else + ! -------------------------------------------------- ! + ! Case 2 : When either cumulus or env. is saturated. ! + ! -------------------------------------------------- ! + xsat = excessn / ( excessn - excessm ); + thlxsat = thln + xsat * ( thl_zm(kn) - thln ); + qtxsat = qtn + xsat * ( qt_zm(kn) - qtn ); + call condensation_mf(qtxsat, thlxsat, p_zm(kn), iexner_zm(kn), & + thvxsat, qcn, thn, qln, qin, qsn, lmixn) + ! -------------------------------------------------- ! + ! kk=1 : Cumulus Segment, kk=2 : Environment Segment ! + ! -------------------------------------------------- ! + do kk = 1, 2 + if( kk .eq. 1 ) then + thv_x0 = thvn + thv_x1 = ( 1._r8 - 1._r8/xsat ) * thvn + ( 1._r8/xsat ) * thvxsat + else + thv_x1 = thv_zm(kn) + thv_x0 = ( xsat / ( xsat - 1._r8 ) ) * thv_zm(kn) + ( 1._r8/( 1._r8 - xsat ) ) * thvxsat + endif + aquad = wn**2 + bquad = 2._r8*wa*gravit*cridis*(thv_x1 - thv_x0)/thv_zm(kn) - 2._r8*wn**2 + cquad = 2._r8*wa*gravit*cridis*(thv_x0 - thv_zm(kn))/thv_zm(kn) + wn**2 + if( kk .eq. 1 ) then + if( ( bquad**2-4._r8*aquad*cquad ) .ge. 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_cu = min(1._r8,max(0._r8,min(xsat,min(xs1,xs2)))) + else + x_cu = xsat + endif + else + if( ( bquad**2-4._r8*aquad*cquad) .ge. 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_en = min(1._r8,max(0._r8,max(xsat,min(xs1,xs2)))) + else + x_en = 1._r8 + endif + endif + enddo + if( x_cu .eq. xsat ) then + xc = max(x_cu, x_en) + else + xc = x_cu + endif + endif + + ee2 = xc**2 + ud2 = 1._r8 - 2._r8*xc + xc**2 + + ! detrainment rate + detn = mix(kt,i) * ud2 + + else !no bsort + ee2 = 1._r8 + ud2 = 1._r8 + end if + + ! entrainment rate + entn = mix(kt,i) * ee2 + + ! --------------------------------------------------------- ! + ! TKE enhanced entrainment ! + ! switches off when dynamic_L0 > max_L0 ! + ! --------------------------------------------------------- ! + eturb = (1._r8 + clubb_mf_alphturb*sqrt(tke(k))/upw(k,i)) + if (do_clubb_mf_rhtke) then + rh_L0 = 50._r8*(rhinv**3._r8) + if (rh_L0 >= 733.34_r8) eturb = 1._r8 else - supqt = 0._r8 - supthl = 0._r8 + if (dynamic_L0(i) >= clubb_mf_max_L0) eturb = 1._r8 end if - + entn = entn * eturb + ! integrate updraft - entexp = exp(-ent(k-1,i)*dzt(k-1)) - entexpu = exp(-ent(k-1,i)*dzt(k-1)/3._r8) - - qtn = qt(k-1) *(1._r8-entexp ) + upqt (k,i)*entexp + supqt - thln = thl(k-1)*(1._r8-entexp ) + upthl(k,i)*entexp + supthl - un = u(k-1) *(1._r8-entexpu) + upu (k,i)*entexpu - vn = v(k-1) *(1._r8-entexpu) + upv (k,i)*entexpu - + entexp = exp(-entn*eturb*dzt(kt)) + entexpu = exp(-entn*dzt(kt)/3._r8) + + qtn = qt(kt) *(1._r8-entexp ) + upqt (k,i)*entexp + supqt(kt,i) + thln = thl(kt)*(1._r8-entexp ) + upthl(k,i)*entexp + supthl(kt,i) + un = u(kt) *(1._r8-entexpu) + upu (k,i)*entexpu + vn = v(kt) *(1._r8-entexpu) + upv (k,i)*entexpu + + ! convert source terms to a tendency (convert from S*dz/w to S) + supqt(kt,i) = supqt(kt,i)*upw(k,i)/dzt(kt) + upauto(kn,i) = supqt(kt,i) + supthl(kt,i) = supthl(kt,i)*upw(k,i)/dzt(kt) + ! get cloud, momentum levels if (do_condensation) then - call condensation_mf(qtn, thln, p_zm(k-1), iexner_zm(k-1), & + call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & thvn, qcn, thn, qln, qin, qsn, lmixn) - if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(k-1) + if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(kn) else thvn = thln*(1._r8+zvir*qtn) end if - + ! get buoyancy - B=gravit*(0.5_r8*(thvn + upthv(k,i))/thv(k-1)-1._r8) - if (debug) then - if ( masterproc ) then - write(iulog,*) "B(k,i), k, i ", B, k, i + B=gravit*(0.5_r8*(thvn + upthv(k,i))/thv(kt)-1._r8) + + if (do_implicit) then + wp = clubb_mf_alphturb*wb*entn*sqrt(0.5_r8*(tke(kn)+tke(k)))*dzt(kt) + wn = (-wp + sqrt(wp**2._r8 + (1._r8 + 2._r8*wb*entn*dzt(kt))* & + (upw(k,i)**2._r8 + 2._r8*wa*B*dzt(kt))) )/(1._r8 + 2._r8*wb*entn*dzt(kt)) + else + ! get wn2 + wp = wb*entn*eturb + if (wp==0._r8) then + wn2 = upw(k,i)**2._r8+2._r8*wa*B*dzt(kt) + else + entw = exp(-2._r8*wp*dzt(kt)) + wn2 = entw*upw(k,i)**2._r8+(1._r8-entw)*wa*B/wp end if + wn = sqrt(max(wn2, 0._r8)) end if - - ! get wn^2 - wp = wb*ent(k-1,i) - if (wp==0._r8) then - wn2 = upw(k,i)**2._r8+2._r8*wa*B*dzt(k-1) + + end do !iter_xc + + if (wn>0._r8) then + + upthv(kn,i) = thvn + upthl(kn,i) = thln + upqt(kn,i) = qtn + upqc(kn,i) = qcn + upqs(kn,i) = qsn + upu(kn,i) = un + upv(kn,i) = vn + upql(kn,i) = qln + upqi(kn,i) = qin + upqv(kn,i) = qtn - qcn + uplmix(kn,i)= lmixn + upth(kn,i) = thn + + if (bsort) then + mfn = upmf(k,i)*exp( dzt(kt)*( entn - detn )) + upa(kn,i) = mfn/(wn*rho_zm(kn)) else - entw = exp(-2._r8*wp*dzt(k-1)) - wn2 = entw*upw(k,i)**2._r8+wa*B/(wb*ent(k-1,i))*(1._r8-entw) + upa(kn,i) = upa(k,i) + mfn = rho_zm(kn)*upa(kn,i)*wn + detn = entn - (mfn - rho_zm(k)*upa(k,i)*upw(k,i)) & + /(rho_zm(k)*upa(k,i)*upw(k,i)*dzt(kt)) + end if + + upbuoy(kn,i)= B + upw(kn,i) = wn + upmf(kn,i) = mfn + upent(kn,i) = entn + updet(kn,i) = detn + + else + ! zero out plumes that terminate at k<3 + if (abs(k-kstart+kdir)<4) then + supqt(:,i) = 0._r8 + upauto(:,i)= 0._r8 + supthl(:,i)= 0._r8 + upa(:,i) = 0._r8 + upbuoy(:,i)= 0._r8 + upw(:,i) = 0._r8 + upmf(:,i) = 0._r8 + upent(:,i) = 0._r8 + updet(:,i) = 0._r8 + upthv(:,i) = 0._r8 + upthl(:,i) = 0._r8 + upqt(:,i) = 0._r8 + upqc(:,i) = 0._r8 + upqs(:,i) = 0._r8 + upu(:,i) = 0._r8 + upv(:,i) = 0._r8 + upql(:,i) = 0._r8 + upqi(:,i) = 0._r8 + upqv(:,i) = 0._r8 + uplmix(:,i)= 0._r8 + upth(:,i) = 0._r8 end if - - if (wn2>0._r8) then - upw(k-1,i) = sqrt(wn2) - upthv(k-1,i) = thvn - upthl(k-1,i) = thln - upqt(k-1,i) = qtn - upqc(k-1,i) = qcn - upqs(k-1,i) = qsn - upu(k-1,i) = un - upv(k-1,i) = vn - upa(k-1,i) = upa(k,i) - upql(k-1,i) = qln - upqi(k-1,i) = qin - upqv(k-1,i) = qtn - qcn + ! exit updraft integration + exit + end if + enddo + enddo + + ! --------------------------------------------------------- ! + ! downward sweep for rain evaporation, snow melting ! + ! --------------------------------------------------------- ! + if (do_clubb_mf_precip) then + do i=1,clubb_mf_nup + do k = ktopm, ksfcm+kdir, -kdir + kt = k - (1+kdir)/2 + kn = k - kdir + + ! get rain evaporation + if ((upqs(k,i) + upqs(kn,i)).le.0._r8) then + qtovqs = 0._r8 else + qtovqs = (upqt(k,i) + upqt(kn,i))/(upqs(k,i) + upqs(kn,i)) + end if + qtovqs = min(1._r8,qtovqs) + sevap = ke*(1._r8 - qtovqs)*sqrt(max(uprr(k,i),0._r8)) + + ! limit evaporation to available precip + sevap = min(sevap,( uprr(k,i)/(rho_zt(kt)*dzt(kt)) - supqt(k,i)*(1._r8-clubb_mf_fdd) )) + + ! get rain rate + uprr(kn,i) = uprr(k,i) & + - rho_zt(kt)*dzt(kt)*( supqt(k,i)*(1._r8-clubb_mf_fdd) + sevap ) + + ! update source terms + lmixt = 0.5_r8*(uplmix(k,i)+uplmix(kn,i)) + supqt(k,i) = supqt(k,i) + sevap + supthl(k,i) = supthl(k,i) - lmixt*sevap*iexner_zt(kt)/cpair + end do + end do + end if + + ! --------------------------------------------------------- ! + ! begin computing downdrafts ! + ! --------------------------------------------------------- ! + if (do_clubb_mf_precip .and. clubb_mf_fdd > 0._r8) then + + do i=1,clubb_mf_nup + + ! find cloud base + do k = ksfcm, ktopm, kdir + if (upqc(k,i) > 0._r8) then + ddbot(i) = k exit end if - enddo - enddo - - ! writing updraft properties for output - do k=nzm,1,-1 + end do - ! first sum over all i-updrafts - do i=1,clubb_mf_nup - if (upqc(k,i)>0._r8) then - moist_a(k) = moist_a(k) + upa(k,i) - moist_w(k) = moist_w(k) + upa(k,i)*upw(k,i) - moist_qt(k) = moist_qt(k) + upa(k,i)*upqt(k,i) - moist_thl(k) = moist_thl(k) + upa(k,i)*upthl(k,i) - moist_u(k) = moist_u(k) + upa(k,i)*upu(k,i) - moist_v(k) = moist_v(k) + upa(k,i)*upv(k,i) - moist_qc(k) = moist_qc(k) + upa(k,i)*upqc(k,i) + ! find cloud top + ddtop = 0 + do k = ksfcm, ktopm, kdir + if (uprr(k,i) > 0._r8) ddtop = k + end do + + if (ddtop /= 0) then + ! initilaize downdrafts + + ! Kay initializes using negative of the updraft velocity + ! this causes anomalouly large downdrafts at the initializaiton level + ! I am intializing with zero velocity as that is more physically defensible + dnw(ddtop,i) = -1._r8*mindnw + dna(ddtop,i) = upa(ddtop,i) + dnu(ddtop,i) = 0.5_r8*(u(ddtop - (1-kdir)/2)+u(ddtop - (1+kdir)/2)) + dnv(ddtop,i) = 0.5_r8*(v(ddtop - (1-kdir)/2)+v(ddtop - (1+kdir)/2)) + dnqt(ddtop,i) = qt_zm(ddtop) + + ! no cloud in downdrafts, set to cloud free thl + dnthl(ddtop,i) = thl_zm(ddtop) + dnthv(ddtop,i) = thv_zm(ddtop) ! includes condensate loading (!) + + ! get rain generated in the updraft, appropriate it to the downdraft + dnrr(ddtop,i) = -1._r8*dzt(ddtop - (1+kdir)/2)*rho_zt(ddtop - (1+kdir)/2)*upauto(ddtop,i)*clubb_mf_fdd + + if (fixent) then + entn = fixent_ent else - dry_a(k) = dry_a(k) + upa(k,i) - dry_w(k) = dry_w(k) + upa(k,i)*upw(k,i) - dry_qt(k) = dry_qt(k) + upa(k,i)*upqt(k,i) - dry_thl(k) = dry_thl(k) + upa(k,i)*upthl(k,i) - dry_u(k) = dry_u(k) + upa(k,i)*upu(k,i) - dry_v(k) = dry_v(k) + upa(k,i)*upv(k,i) - endif - enddo - - if ( dry_a(k) > 0._r8 ) then - dry_w(k) = dry_w(k) / dry_a(k) - dry_qt(k) = dry_qt(k) / dry_a(k) - dry_thl(k) = dry_thl(k) / dry_a(k) - dry_u(k) = dry_u(k) / dry_a(k) - dry_v(k) = dry_v(k) / dry_a(k) - else - dry_w(k) = 0._r8 - dry_qt(k) = 0._r8 - dry_thl(k) = 0._r8 - dry_u(k) = 0._r8 - dry_v(k) = 0._r8 - endif - - if ( moist_a(k) > 0._r8 ) then - moist_w(k) = moist_w(k) / moist_a(k) - moist_qt(k) = moist_qt(k) / moist_a(k) - moist_thl(k) = moist_thl(k) / moist_a(k) - moist_u(k) = moist_u(k) / moist_a(k) - moist_v(k) = moist_v(k) / moist_a(k) - moist_qc(k) = moist_qc(k) / moist_a(k) + ! use deterministic mean entrainment + entn = clubb_mf_ent0/dynamic_L0(i) + end if + + ! downdraft qsat + call qsat(dnthl(ddtop,i)/iexner_zm(ddtop),p_zm(ddtop),es,dnqs(ddtop,i)) + + do k = ddtop, ksfcm+kdir, -kdir + + kt = k - (1+kdir)/2 + kn = k - kdir + + ! assume fixed area with height + dna(kn,i) = dna(k,i) + + ! get rain evaporation in integrated form + taum1 = ke*sqrt(dnrr(k,i))/dnqs(k,i) + alphint = exp(dzt(kt)*taum1/dnw(k,i)) + sqtint = max( (dnqs(k,i) - dnqt(k,i))*(1._r8 - alphint) ,0._r8) + + ! limit to available rain + sqtint = min( sqtint, -1._r8*dnrr(k,i) / (rho_zt(kt)*dzt(kt)*dnw(k,i)) ) + sthlint = -1._r8*latvap*sqtint*iexner_zt(kt)/cpair + + ! get rain evaporation in tendency form + sdnqt(kn,i) = max( (dnqs(k,i) - dnqt(k,i))*taum1, 0._r8 ) + sdnthl(kn,i) = -1._r8*latvap*sdnqt(kn,i)*iexner_zt(kt)/cpair + + ! compute rain rate (rain above - evaporation + appropriate updraft rain) + dnrr(kn,i) = max( dnrr(k,i) & + - rho_zt(kt)*dzt(kt)*(sdnqt(kn,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) + + ! include eturb? + entexp = exp(-1._r8*entn*eturb*dzt(kt)) + entexpu = exp(-1._r8*entn*dzt(kt)/3._r8) + + ! integrate downward + dnu(kn,i) = u(kt) *(1._r8-entexpu) + dnu (k,i)*entexpu + dnv(kn,i) = v(kt) *(1._r8-entexpu) + dnv (k,i)*entexpu + dnqt(kn,i) = qt(kt) *(1._r8-entexp ) + dnqt (k,i)*entexp + sqtint + dnthl(kn,i) = thl(kt)*(1._r8-entexp ) + dnthl(k,i)*entexp + sthlint + + ! get qsat + call qsat(dnthl(kn,i)/iexner_zm(kn),p_zm(kn),es,dnqs(kn,i)) + + ! no supersaturation in downdrafts + if (dnqt(kn,i) > dnqs(kn,i)) then + ! set qt to saturation vapor pressure + dnqt(kn,i) = dnqs(kn,i) + + ! find evaporation that gives saturation vapor pressure + sqtint = dnqt(kn,i) - (qt(kt) *(1._r8-entexp ) + dnqt (k,i)*entexp) + + ! limit to available rain + sqtint = min( sqtint, -1._r8*dnrr(k,i) / (rho_zt(kt)*dzt(kt)*dnw(k,i)) ) + sthlint = -1._r8*latvap*sqtint*iexner_zt(kt)/cpair + + ! find new evap tendency + if ((alphint - 1._r8) /= 0._r8) then + qtmp = dnqs(k,i) + sqtint/(alphint - 1._r8) + sdnqt(kn,i) = max( (dnqs(k,i) - qtmp)*taum1, 0._r8 ) + else + sdnqt(kn,i) = 0._r8 + end if + sdnthl(kn,i) = -1._r8*latvap*sdnqt(kn,i)*iexner_zt(kt)/cpair + + ! re-compute thl with new evaporation rate + dnthl(kn,i) = thl(kt)*(1._r8-entexp ) + dnthl(k,i)*entexp + sthlint + + ! adjust rain + dnrr(kn,i) = max( dnrr(k,i) & + - rho_zt(kt)*dzt(kt)*(sdnqt(kn,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) + end if + + ! get virtual temperature + dnthv(kn,i) = dnthl(kn,i)*(1._r8+zvir*dnqt(kn,i)) + + if ((kn - ddbot(i))*kdir > 0) then + ! get virtual temperature + dnthv(kn,i) = dnthl(kn,i)*(1._r8+zvir*dnqt(kn,i)) + + ! get buoyancy + ! (midpoint k is surrounded by interface k and k-1, + ! and therefore we can't compute B at the midpoint properly) + B = gravit*(dnthv(kn,i)/thv(kn + kdir)-1._r8) + + ! get wn2 + wp = wb*entn*eturb & + + clubb_mf_pwfac/( 2._r8*zm(kn + kdir)+tinynum ) * max( 1._r8 - exp( zm(kn + kdir)/z00dn-1._r8), 0._r8 ) + if (wp==0._r8) then + wn2 = dnw(k,i)**2._r8-2._r8*wa*B*dzt(kt) + else + entw = exp(-2._r8*wp*dzt(kt)) + wn2 = entw*dnw(k,i)**2._r8-(1._r8-entw)*wa*B/wp + end if + wn2 = max(wn2,mindnw**2._r8) + dnw(kn,i) = -1._r8*sqrt(wn2) + + else + zsub = zm(ddbot(i)+kdir) + wcb = dnw(ddbot(i)+kdir,i) + dnw(kn,i) = wcb - (wcb/(zsub**clubb_mf_ddexp))*(zsub - zm(kn))**clubb_mf_ddexp + dnw(kn,i) = min(dnw(kn,i),-1._r8*mindnw) + end if + + end do!k + + end if + + end do!i + +!+++ARH this should be changed to only zero out above the downdraft (dnw<-mindw) +!+++ARH also this should zero out dna as well + ! zero out downdraft fluxes for dnw == -mindnw + do i=1,clubb_mf_nup + do k=ksfcm, ktopm, kdir + if ( dnw(k,i) == -1._r8*mindnw ) then + dnw(k,i) = 0._r8 + dna(k,i) = 0._r8 + end if + end do + end do + + end if + ! end computing downdrafts + + ! --------------------------------------------------------- ! + ! AS.pd limiter ! + ! --------------------------------------------------------- ! + if (do_aspd) then + do k = ksfcm, ktopm-kdir, kdir + kt = k - (1-kdir)/2 + kn = k + kdir + do i=1,clubb_mf_nup + if (upw(kn,i)>0._r8) then + ! diagnose detrainment + Mn = rho_zm(k)*upa(k,i)*upw(k,i) + det = upent(kn,i)*eturb - (rho_zm(kn)*upa(kn,i)*upw(kn,i) - Mn) & + /(Mn*dzt(kt)) + if (det < 0._r8) then + ! diagnose area to eliminate detrainment and conserve mass + Mn = rho_zm(k)*upa(k,i)*upw(k,i)*exp(upent(kn,i)*eturb*dzt(kt)) + upa(kn,i) = Mn/(rho_zm(kn)*upw(kn,i)) + end if + end if + end do + end do + end if + + ! --------------------------------------------------------- ! + ! integrate for total convective area ! + ! --------------------------------------------------------- ! + do k=ksfcm, ktopm-kdir, kdir + do i=1,clubb_mf_nup + aup(k) = aup(k) + upa(k,i) + adn(k) = adn(k) + dna(k,i) + end do + ac(k) = aup(k) + adn(k) + if (limarea .and. ac(k) > amax) then + upa(k,:) = upa(k,:)*amax/ac(k) + ac(k) = amax + end if + ae(k) = ae(k) - ac(k) + end do + + ! --------------------------------------------------------- ! + ! updraft properties for output ! + ! --------------------------------------------------------- ! + do k=ksfcm, ktopm, kdir + + ! first sum over all i-updrafts + do i=1,clubb_mf_nup + if (upqc(k,i)>0._r8) then + moist_a(k) = moist_a(k) + upa(k,i) + moist_w(k) = moist_w(k) + upa(k,i)*upw(k,i) + moist_qt(k) = moist_qt(k) + upa(k,i)*upqt(k,i) + moist_thl(k) = moist_thl(k) + upa(k,i)*upthl(k,i) + moist_u(k) = moist_u(k) + upa(k,i)*upu(k,i) + moist_v(k) = moist_v(k) + upa(k,i)*upv(k,i) + moist_qc(k) = moist_qc(k) + upa(k,i)*upqc(k,i) else - moist_w(k) = 0._r8 - moist_qt(k) = 0._r8 - moist_thl(k) = 0._r8 - moist_u(k) = 0._r8 - moist_v(k) = 0._r8 - moist_qc(k) = 0._r8 + dry_a(k) = dry_a(k) + upa(k,i) + dry_w(k) = dry_w(k) + upa(k,i)*upw(k,i) + dry_qt(k) = dry_qt(k) + upa(k,i)*upqt(k,i) + dry_thl(k) = dry_thl(k) + upa(k,i)*upthl(k,i) + dry_u(k) = dry_u(k) + upa(k,i)*upu(k,i) + dry_v(k) = dry_v(k) + upa(k,i)*upv(k,i) endif - enddo - - do k=nzm,1,-1 - do i=1,clubb_mf_nup - ae (k) = ae (k) - upa(k,i) - aw (k) = aw (k) + upa(k,i)*upw(k,i) - awu (k) = awu (k) + upa(k,i)*upw(k,i)*upu(k,i) - awv (k) = awv (k) + upa(k,i)*upw(k,i)*upv(k,i) - awthl(k)= awthl(k)+ upa(k,i)*upw(k,i)*upthl(k,i) - awqt(k) = awqt(k) + upa(k,i)*upw(k,i)*upqt(k,i) - awqv(k) = awqv(k) + upa(k,i)*upw(k,i)*upqv(k,i) - awql(k) = awql(k) + upa(k,i)*upw(k,i)*upql(k,i) - awqi(k) = awqi(k) + upa(k,i)*upw(k,i)*upqi(k,i) - enddo - enddo - - do k=nzm,1,-1 - thlflx(k)= awthl(k) - aw(k)*thl_zm(k) - qtflx(k)= awqt(k) - aw(k)*qt_zm(k) - enddo - - end if ! ( wthv > 0.0 ) - - end subroutine integrate_mf - - subroutine condensation_mf( qt, thl, p, iex, thv, qc, th, ql, qi, qs, lmix ) - ! =============================================================================== ! - ! zero or one condensation for edmf: calculates thv and qc ! - ! =============================================================================== ! - use physconst, only: cpair, zvir, h2otrip - use wv_saturation, only : qsat - - real(r8),intent(in) :: qt,thl,p,iex - real(r8),intent(out):: thv,qc,th,ql,qi,qs,lmix - - !local variables - integer :: niter,i - real(r8) :: diff,t,qstmp,qcold,es,wf - - ! max number of iterations - niter=50 - ! minimum difference - diff=2.e-5_r8 - - qc=0._r8 - t=thl/iex - - !by definition: - ! T = Th*Exner, Exner=(p/p0)^(R/cp) (1) - ! Thl = Th - L/cp*ql/Exner (2) - !so: - ! Th = Thl + L/cp*ql/Exner (3) - ! T = Th*Exner=(Thl+L/cp*ql/Exner)*Exner (4) - ! = Thl*Exner + L/cp*ql - do i=1,niter - wf = get_watf(t) - t = thl/iex+get_alhl(wf)/cpair*qc !as in (4) - - ! qsat, p is in pascal (check!) - call qsat(t,p,es,qstmp) - qcold = qc - qc = max(0.5_r8*qc+0.5_r8*(qt-qstmp),0._r8) - if (abs(qc-qcold)tmax) then - get_watf=1._r8 - else if (tc 0._r8 ) then + dry_w(k) = dry_w(k) / dry_a(k) + dry_qt(k) = dry_qt(k) / dry_a(k) + dry_thl(k) = dry_thl(k) / dry_a(k) + dry_u(k) = dry_u(k) / dry_a(k) + dry_v(k) = dry_v(k) / dry_a(k) else - get_watf=(tc-tmin)/(tmax-tmin); - end if - - end function get_watf - - - function get_alhl(wf) - !latent heat of the mixture based on water fraction - use physconst, only : latvap , latice - real(r8) :: get_alhl,wf - - get_alhl = wf*latvap+(1._r8-wf)*(latvap+latice) - - end function get_alhl - - end subroutine condensation_mf - - subroutine precip_mf(qs,qt,w,dz,dzcld,Supqt) - !********************************************************************** - ! Precipitation microphysics - ! By Adam Herrington, after Kay Suselj - !********************************************************************** - - real(r8),intent(in) :: qs,qt,w,dz,dzcld - real(r8),intent(out) :: Supqt - ! - ! local vars - real(r8) :: tauwgt, tau, & ! time-scale vars - qstar ! excess cloud liquid - - real(r8),parameter :: tau0 = 15._r8, & ! base time-scale - zmin = 300._r8, & ! small cloud thick - zmax = 3000._r8, & ! large cloud thick - qcmin = 0.00125_r8 ! supersat threshold - - qstar = qs+qcmin - - if (qt > qstar) then - ! get precip efficiency - tauwgt = (dzcld-zmin)/(zmax-zmin) - tauwgt = min(max(tauwgt,0._r8),1._r8) - tau = tauwgt/tau0 - - ! get source for updraft - Supqt = (qstar-qt)*(1._r8 - exp(-1._r8*tau*dz/w)) + dry_w(k) = 0._r8 + dry_qt(k) = 0._r8 + dry_thl(k) = 0._r8 + dry_u(k) = 0._r8 + dry_v(k) = 0._r8 + endif + + if ( moist_a(k) > 0._r8 ) then + moist_w(k) = moist_w(k) / moist_a(k) + moist_qt(k) = moist_qt(k) / moist_a(k) + moist_thl(k) = moist_thl(k) / moist_a(k) + moist_u(k) = moist_u(k) / moist_a(k) + moist_v(k) = moist_v(k) / moist_a(k) + moist_qc(k) = moist_qc(k) / moist_a(k) else - Supqt = 0._r8 - end if - - end subroutine precip_mf - - subroutine poisson(nz,nup,lambda,poi,state) - !********************************************************************** - ! Set a unique (but reproduceble) seed for the kiss RNG - ! Call Poisson deviate - ! By Adam Herrington - !********************************************************************** - use shr_RandNum_mod, only: ShrKissRandGen - - integer, intent(in) :: nz,nup - real(r8), dimension(4), intent(in) :: state - real(r8), dimension(nz,nup), intent(in) :: lambda - integer, dimension(nz,nup), intent(out) :: poi - integer, dimension(1,4) :: tmpseed - integer :: i,j - type(ShrKissRandGen) :: kiss_gen - - ! Compute seed - tmpseed(1,1) = int((state(1) - int(state(1))) * 1000000000._r8) - tmpseed(1,2) = int((state(2) - int(state(2))) * 1000000000._r8) - tmpseed(1,3) = int((state(3) - int(state(3))) * 1000000000._r8) - tmpseed(1,4) = int((state(4) - int(state(4))) * 1000000000._r8) - - ! Set seed - kiss_gen = ShrKissRandGen(tmpseed) - - do i=nz,1,-1 - do j=1,nup - call knuth(kiss_gen,lambda(i,j),poi(i,j)) - enddo + moist_w(k) = 0._r8 + moist_qt(k) = 0._r8 + moist_thl(k) = 0._r8 + moist_u(k) = 0._r8 + moist_v(k) = 0._r8 + moist_qc(k) = 0._r8 + endif + + enddo + ! --------------------------------------------------------- ! + ! get ensemble mean ! + ! --------------------------------------------------------- ! + + ! 1. Momentum Grid Accumulations (Interfaces) + ! Iterates over all interfaces (1 to 59) + do k=ksfcm, ktopm, kdir + do i=1,clubb_mf_nup + awup(k) = awup(k) + upa(k,i)*upw(k,i) + awdn(k) = awdn(k) + dna(k,i)*dnw(k,i) + + awwup(k) = awwup(k) + upa(k,i)*upw(k,i)*upw(k,i) + awwdn(k) = awwdn(k) + dna(k,i)*dnw(k,i)*dnw(k,i) + + awuup(k) = awuup(k) + upa(k,i)*upw(k,i)*upu(k,i) + awudn(k) = awudn(k) + dna(k,i)*dnw(k,i)*dnu(k,i) + awvup(k) = awvup(k) + upa(k,i)*upw(k,i)*upv(k,i) + awvdn(k) = awvdn(k) + dna(k,i)*dnw(k,i)*dnv(k,i) + + awthvdn(k)= awthvdn(k)+ dna(k,i)*dnw(k,i)*dnthv(k,i) + awthldn(k)= awthldn(k)+ dna(k,i)*dnw(k,i)*dnthl(k,i) + awqtdn(k) = awqtdn(k) + dna(k,i)*dnw(k,i)*dnqt(k,i) + + awthvup(k)= awthvup(k)+ upa(k,i)*upw(k,i)*upthv(k,i) + awthlup(k)= awthlup(k)+ upa(k,i)*upw(k,i)*upthl(k,i) + awqtup(k) = awqtup(k) + upa(k,i)*upw(k,i)*upqt(k,i) enddo - - end subroutine poisson - - subroutine knuth(kiss_gen,lambda,kout) - !********************************************************************** - ! Discrete random poisson from Knuth - ! The Art of Computer Programming, v2, 137-138 - ! By Adam Herrington - !********************************************************************** - use shr_RandNum_mod, only: ShrKissRandGen - - type(ShrKissRandGen), intent(inout) :: kiss_gen - real(r8), intent(in) :: lambda - integer, intent(out) :: kout - - ! Local variables - real(r8), dimension(1,1) :: tmpuni - real(r8) :: puni, explam - integer :: k - - k = 0 - explam = exp(-1._r8*lambda) - puni = 1._r8 - do while (puni > explam) - k = k + 1 - call kiss_gen%random(tmpuni) - puni = puni*tmpuni(1,1) + + aw (k) = awup(k)+ awdn(k) + aww(k) = awwup(k)+ awwdn(k) + if (aloft) awu(k) = 1._r8 + + awv(k) = awvup(k)+ awvdn(k) + enddo + + ! 2. Thermodynamic Grid Accumulations (Cells) + ! Iterates over active atmospheric cells only + ! Top-Down: 58 down to 1. Bottom-Up: 2 up to nzm. + do k = ksfcm+kdir, ktopm, kdir + ! The interface directly BELOW the current cell + ! In top-down (-1): cell 58 -> interface 59 + ! In bottom-up (1): cell 2 -> interface 1 + kn = k - kdir + + do i=1,clubb_mf_nup + sqtup(k) = sqtup(k) + upa(kn,i)*supqt(k,i) + sthlup(k) = sthlup(k) + upa(kn,i)*supthl(k,i) + + sqtdn(k) = sqtdn(k) + dna(kn,i)*sdnqt(k,i) + sthldn(k) = sthldn(k) + dna(kn,i)*sdnthl(k,i) end do - kout = k - 1 - - end subroutine knuth - - end module clubb_mf - + + sqt(k) = sqtup(k) + sqtdn(k) + sthl(k) = sthlup(k) + sthldn(k) + enddo + ! --------------------------------------------------------- ! + ! ztopm1 calculation ! + ! --------------------------------------------------------- ! + do i=1,clubb_mf_nup + do k=kstart, ktopm, kdir + ! return if no convection at first level above surface + if (k == (ksfcm+kdir) .and. ac(k) == 0._r8 .and. .not.aloft) then + sqt(k) = 0._r8 + sthl(k) = 0._r8 + ztopm1(:) = zm(ksfcm) + ddcp(:) = 0._r8 + return + end if + ! height of the plume ensemble + if (do_clubb_mf_lscale_perplume) then + if ((upa(k,i)+dna(k,i)) > 0._r8) ztopm1(i) = zm(k) + else + if (ac(k) > 0._r8) ztopm1(:) = zm(k) + end if + end do + end do + + !subtract init level from ztop for aloft plumes + if (aloft) then + ztopm1 = ztopm1 - zm(kstart-nbot*kdir) + do i=1,clubb_mf_nup + if (ztopm1(i) < zm(ksfcm)) ztopm1(i) = zm(ksfcm) + end do + end if + + ! --------------------------------------------------------- ! + ! cloud base / mixing depth calculation ! + ! --------------------------------------------------------- ! + cbm1 = 0._r8 + do i=1,clubb_mf_nup + kcbarr(i) = 0 + do k=kstart, ktopm, kdir + if (upqc(k,i) > 0._r8) then + kcbarr(i) = k + exit + end if + end do + + ! find height of dry plumes + if (kcbarr(i) == 0) then + do k=kstart, ktopm, kdir + if (upw(k,i) <= 0._r8) then + kcbarr(i) = k + exit + end if + end do + end if + + cbm1 = cbm1 + zm(kcbarr(i)) + + end do + cbm1 = cbm1/REAL(clubb_mf_nup) + + ! --------------------------------------------------------- ! + ! bulk downdraft velocity for coldpool parameterization ! + ! --------------------------------------------------------- ! +!+++ARH +! ! reset ddcp +! ddcp = 0._r8 +! do i=1,clubb_mf_nup +! ! find cloud base +! kcb = 0 +! do k=1,nz +! if (upqc(k,i) > 0._r8) then +! kcb = k +! exit +! end if +! end do +! +! ! reset iddcp +! iddcp = 0._r8 +! if (kcb == 0) then +! continue +! else if (kcb == 1) then +! iddcp = iddcp + dna(k,i)*dnw(k,i) +! continue +! else +! ddint = 0._r8 +! do k=1,kcb-1 +! ddint = ddint + dna(k,i)*dnw(k,i)*dzt(k+1) +! end do +! iddcp = iddcp + -1._r8*ddint/zm(kcb) +! end if +! ddcp = ddcp + iddcp +! ! +! end do +! + + ddcp(:) = 0._r8 + if (do_clubb_mf_coldpool .and. clubb_mf_fdd > 0._r8) then + ! use single level for cold pool param. + ! reset ddcp + do i=1,clubb_mf_nup + if (ddbot(i) == 0) then + continue + else + if (do_clubb_mf_coldpool_perplume) then + ddcp(i) = -1._r8*dnw(ddbot(i)+kdir,i) + else + ddcp(:) = ddcp(:) + -1._r8*dna(ddbot(i)+kdir,i)*dnw(ddbot(i)+kdir,i) + end if + end if + end do + end if + + ! --------------------------------------------------------- ! + ! downward sweep to get ensemble mean precip ! + ! --------------------------------------------------------- ! + do k = ktopm, ksfcm+kdir, -kdir + kt_dn = k - (1+kdir)/2 + precc(k-kdir) = precc(k) - rho_zt(kt_dn)*dzt(kt_dn)*sqt(k) + end do + + ! --------------------------------------------------------- ! + ! get turbulent fluxes ! + ! --------------------------------------------------------- ! + kstart = ksfcm + kdir + if (scalesrf) then + kstart = ksfcm + end if + + do k=kstart, ktopm-kdir, kdir + + ! Secure boundary cells to prevent array out-of-bounds on zero-flux boundaries + kt_up = max(1, min(nzt, k - (1-kdir)/2)) + kt_dn = max(1, min(nzt, k - (1+kdir)/2)) + + thvflxup(k)= awthvup(k) - awup(k)*thv(kt_up) + thlflxup(k)= awthlup(k) - awup(k)*thl(kt_up) + qtflxup (k)= awqtup (k) - awup(k)*qt(kt_up) + + uflxup (k)= awuup(k) - awup(k)*u(kt_up) + vflxup (k)= awvup(k) - awup(k)*v(kt_up) + + thvflxdn(k)= awthvdn(k) - awdn(k)*thv(kt_dn) + thlflxdn(k)= awthldn(k) - awdn(k)*thl(kt_dn) + qtflxdn (k)= awqtdn (k) - awdn(k)*qt(kt_dn) + + uflxdn (k)= awudn(k) - awdn(k)*u(kt_dn) + vflxdn (k)= awvdn(k) - awdn(k)*v(kt_dn) + + thvflx(k) = thvflxup(k) + thvflxdn(k) + thlflx(k) = thlflxup(k) + thlflxdn(k) + qtflx (k) = qtflxup (k) + qtflxdn (k) + + uflx(k) = uflxup(k) + uflxdn(k) + vflx(k) = vflxup(k) + vflxdn(k) + enddo + else + ddcp(:) = 0._r8 + ztopm1(:) = zm(ksfcm) + end if + + end subroutine integrate_mf + + + subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, th, & + wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, wa, wb, & + do_condensation, qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1, dynamic_L0, ztop, mcape) + ! --------------------------------------------------------- ! + ! Calculate ztop and dynamic_L based on value of namelist ! + ! --------------------------------------------------------- ! + integer, intent(in) :: nzt, nzm + real(r8), dimension(nzt), intent(in) :: thl, thv, & + th, & + qt, qv, & + p_zt, iexner_zt, & + dzt, zt + + real(r8), dimension(nzm), intent(in) :: p_zm, iexner_zm, & + zm, tke, wpthlp_env + + real(r8), intent(in) :: wmax, wmin, tpert, & + sigmaw, sigmaqt, sigmathv, & + cwqt, cwthv, zcb_unset, & + wa, wb, ztopm1, & + pblh, convh, rhinv + + logical, intent(in) :: do_condensation + + real(r8), intent(out) :: dynamic_L0, ztop, mcape + + ! local variables + ! =============================================================================== ! + ! GRID ORIENTATION GENERALIZATION VARIABLES + ! ------------------------------------------------------------------------------- ! + ! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without + ! duplicating code, these variables abstract the vertical loop bounds and slices. + ! + ! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. + ! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. + ! kdir : Directional step (+1 for moving up, -1 for moving down). + ! + ! STAGGERED GRID INDEXING + ! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative + ! index of the cell center (zt) to the interface (zm) flips depending on whether + ! memory is loaded top-down or bottom-up. These variables dynamically map them: + ! + ! kt : The active thermodynamic cell center associated with the current step. + ! Upward Sweep: kt = k - (1-kdir)/2 + ! Downward Sweep: kt = k - (1+kdir)/2 + ! + ! kn : The NEXT momentum interface in the direction of the current sweep. + ! Upward Sweep: kn = k + kdir + ! Downward Sweep: kn = k - kdir + ! + ! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. + ! kt_up = k - (1-kdir)/2 + ! + ! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. + ! kt_dn = k - (1+kdir)/2 + ! =============================================================================== ! + integer :: ksfc, ktop, kdir + + + real(r8), dimension(nzt) :: t_zt + real(r8), dimension(nzt) :: tp, qstp + real(r8), dimension(nzt,1) :: dmpdz + real(r8), dimension(1) :: tl, & + cape, cin + integer, dimension(1) :: lcl, lel + real(r8) :: landfrac + integer :: kpbl, msg, & + lon, mx, & + k + + ! intialize local variables + cape = 0._r8 + mcape = 0._r8 + dmpdz = 0._r8 + + if (zt(1) < zt(nzt)) then + ksfc = 1 + ktop = nzt + kdir = 1 + else + ksfc = nzt + ktop = 1 + kdir = -1 + end if + + if (clubb_mf_Lopt==0) then + !Constant L0 + dynamic_L0 = clubb_mf_L0 + ztop = clubb_mf_L0 + else if (clubb_mf_Lopt==1) then + !TKE + do k = ktop-2*kdir, ksfc+kdir, -kdir + if (zm(k) < 20000 .and. tke(k) - tke(k+kdir) > 1e-5) then + ztop = zm(k) + exit + endif + enddo + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + + else if (clubb_mf_Lopt==2) then + !Heat flux + do k = ktop-2*kdir, ksfc+kdir, -kdir + if (zm(k) < 20000 .and. abs(abs(wpthlp_env(k))-abs(wpthlp_env(k-kdir))) > 1e-4) then + ztop = zm(k) + exit + endif + enddo + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + + else if (clubb_mf_Lopt==3) then + !Test plume + call oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, & + wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, & + wa, wb, tke, do_condensation, do_clubb_mf_precip, ztop ) + + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + !ztop = ztop - 1600._r8 + !if (ztop < 1._r8) then + ! dynamic_L0 = clubb_mf_a0 + !else + ! dynamic_L0 = min(35._r8,clubb_mf_a0*(ztop**clubb_mf_b0)) + !end if + else if (clubb_mf_Lopt==4 .or. clubb_mf_Lopt==5) then + !dilute cape calculation + !dmpdz = -1._r8*ent_zt(2:nz,:) + dmpdz(:,:) = -1.E-3_r8 + t_zt = th/iexner_zt + landfrac = 1._r8 + + do k = ksfc+kdir, ktop, kdir + if (zt(k-kdir) <= pblh) then + kpbl = k + end if + end do + + do k = ksfc, ktop, kdir + if (p_zt(k) > 40.e2_r8) then + msg = k + end if + end do + + call buoyan_dilute(nzt, nzm, 1 ,dmpdz , & + qv ,t_zt ,p_zt*0.01_r8 ,zt ,p_zm*0.01_r8 , & + tp ,qstp ,tl ,cape ,cin , & + kpbl-kdir ,lcl ,lel ,lon ,mx , & + msg-kdir ,tpert ,landfrac ) + + !do i=1,clubb_mf_nup + ! mcape = mcape + cape(i) + !end do + !mcape = mcape/REAL(clubb_mf_nup) + mcape = max(cape(1),25._r8) + + if (clubb_mf_Lopt==4) then + ztop = max(zt(lel(1)+kdir),convh) + else if (clubb_mf_Lopt==5) then + ztop = mcape + end if + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + + else if (clubb_mf_Lopt==6) then + ! grab ztop from max height of ensemble in prior time-step(s) + ztop = ztopm1 + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + else if (clubb_mf_Lopt==7 .or. clubb_mf_Lopt==8) then + ztop = rhinv + dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) + end if + + end subroutine get_Lscale + + subroutine condensation_mf( qt, thl, p, iex, thv, qc, th, ql, qi, qs, lmix ) + ! =============================================================================== ! + ! zero or one condensation for edmf: calculates thv and qc ! + ! =============================================================================== ! + use physconst, only: cpair, zvir, h2otrip + use wv_saturation, only : qsat + + real(r8),intent(in) :: qt,thl,p,iex + real(r8),intent(out):: thv,qc,th,ql,qi,qs,lmix + + !local variables + integer :: niter,i + real(r8) :: diff,t,qstmp,qcold,es,wf + logical :: noice = .true. + ! max number of iterations + niter=50 + ! minimum difference + diff=2.e-5_r8 + + qc=0._r8 + t=thl/iex + + !by definition: + ! T = Th*Exner, Exner=(p/p0)^(R/cp) (1) + ! Thl = Th - L/cp*ql/Exner (2) + !so: + ! Th = Thl + L/cp*ql/Exner (3) + ! T = Th*Exner=(Thl+L/cp*ql/Exner)*Exner (4) + ! = Thl*Exner + L/cp*ql + do i=1,niter + + if (noice) then + wf = 1._r8 + else + wf = get_watf(t) + end if + t = thl/iex+get_alhl(wf)/cpair*qc !as in (4) + + ! qsat, p is in pascal (check!) + call qsat(t,p,es,qstmp) + qcold = qc + qc = max(0.5_r8*qc+0.5_r8*(qt-qstmp),0._r8) + if (abs(qc-qcold)tmax) then + get_watf=1._r8 + else if (tc qstar) then + ! get precip efficiency + tauwgt = (dzcld-zmin)/(zmax-zmin) + tauwgt = min(max(tauwgt,0._r8),1._r8) + tau = tauwgt/tau0 + + ! get source for updraft + Supqt = (qstar-qt)*(1._r8 - exp(-1._r8*tau*dz/w)) + else + Supqt = 0._r8 + end if + + end subroutine precip_mf + + subroutine poisson(nz, nup, ksfc, ktop, kdir, lambda, poi, state) + !********************************************************************** + ! Set a unique (but reproduceble) seed for the kiss RNG + ! Call Poisson deviate + ! By Adam Herrington + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + integer, intent(in) :: nz, nup, ksfc, ktop, kdir + real(r8), dimension(4), intent(in) :: state + real(r8), dimension(nz,nup), intent(in) :: lambda + integer, dimension(nz,nup), intent(out) :: poi + integer, dimension(1,4) :: tmpseed + integer :: i,j + type(ShrKissRandGen) :: kiss_gen + + ! Compute seed + tmpseed(1,1) = int((state(1) - int(state(1))) * 1000000000._r8) + tmpseed(1,2) = int((state(2) - int(state(2))) * 1000000000._r8) + tmpseed(1,3) = int((state(3) - int(state(3))) * 1000000000._r8) + tmpseed(1,4) = int((state(4) - int(state(4))) * 1000000000._r8) + + ! Set seed + kiss_gen = ShrKissRandGen(tmpseed) + + ! Loop from the SURFACE to the TOP to preserve the exact PRNG sequence + do i = ksfc, ktop, kdir + do j = 1, nup + call hybridRNG(kiss_gen, lambda(i,j), poi(i,j)) + enddo + enddo + + end subroutine poisson + + + subroutine hybridRNG(kiss_gen,lambda,kout) + !********************************************************************** + ! Interface for the two poisson rng subroutines + ! chooses the appropriate subroutine based on the value of lambda + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + type(ShrKissRandGen), intent(inout) :: kiss_gen + real(r8), intent(in) :: lambda + integer, intent(out) :: kout + + if (lambda < 10._r8) then + call knuth(kiss_gen,lambda,kout) + else + call hormann(kiss_gen,lambda,kout) + end if + + end subroutine hybridRNG + + + subroutine knuth(kiss_gen,lambda,kout) + !********************************************************************** + ! Discrete random poisson from Knuth + ! The Art of Computer Programming, v2, 137-138 + ! By Adam Herrington + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + type(ShrKissRandGen), intent(inout) :: kiss_gen + real(r8), intent(in) :: lambda + integer, intent(out) :: kout + + ! Local variables + real(r8), dimension(1,1) :: tmpuni + real(r8) :: puni, explam + integer :: k + + k = 0 + explam = exp(-1._r8*lambda) + puni = 1._r8 + do while (puni > explam) + k = k + 1 + call kiss_gen%random(tmpuni) + puni = puni*tmpuni(1,1) + end do + kout = k - 1 + + end subroutine knuth + + + subroutine hormann(kiss_gen,lambda,kout) + !********************************************************************** + ! Discrete random poisson + ! Implements Poisson Transformed Rejection with Squeeze (PTRS) + ! from W. Hormann Insurance: Mathematics and Economics 12, 39-45 (1993) + ! By Jake Reschke + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + type(ShrKissRandGen), intent(inout) :: kiss_gen + real(r8), intent(in) :: lambda + integer, intent(out) :: kout + + ! Local variables + real(r8), dimension(1,1) :: U,V + real(r8) :: a,b,vr,alphinv,us,loggam + integer :: k,i + + b = 0.931_r8 + 2.53_r8*sqrt(lambda) + a = -0.059_r8 + 0.02483_r8*b + vr = 0.9277_r8 - 3.6224_r8/(b - 2._r8) + alphinv = 1.1239_r8 + 1.1328_r8/(b - 3.4_r8) + + do + call kiss_gen%random(U) + call kiss_gen%random(V) + U(1,1) = U(1,1) - 0.5_r8 + us = 0.5_r8 - abs(U(1,1)) + k = floor( (2._r8*a/us + b)*U(1,1) + lambda + 0.43_r8 ) + if (us >= 0.07_r8 .and. V(1,1) <= vr) then + kout = k + exit + end if + if (k <= 0 .or. (us < 0.013_r8 .and. V(1,1) > us)) then + cycle + end if + ! compute log(k!). If k >=10 use stirling's approximation + if (k < 10) then + loggam = 0._r8 + do i = 1, k + loggam = loggam + log(1._r8*i) + end do + else + loggam = log(sqrt(2._r8*pi)) + (k + 0.5_r8)*log(1._r8*k) - k + (1._r8/12._r8 - 1._r8/(360._r8*k*k))/k + end if + if (log( V(1,1)*alphinv/(a/(us*us) + b) ) <= -1._r8*lambda + k*log(lambda) - loggam) then + kout = k + exit + end if + end do + + end subroutine hormann + + subroutine roots(a,b,c,r1,r2,status) + ! --------------------------------------------------------- ! + ! Subroutine to solve the second order polynomial equation. ! + ! after uwshcu.F90 ! + ! --------------------------------------------------------- ! + real(r8), intent(in) :: a + real(r8), intent(in) :: b + real(r8), intent(in) :: c + real(r8), intent(out) :: r1 + real(r8), intent(out) :: r2 + integer , intent(out) :: status + real(r8) :: q + + status = 0 + + if( a .eq. 0._r8 ) then ! Form b*x + c = 0 + if( b .eq. 0._r8 ) then ! Failure: c = 0 + status = 1 + else ! b*x + c = 0 + r1 = -c/b + endif + r2 = r1 + else + if( b .eq. 0._r8 ) then ! Form a*x**2 + c = 0 + if( a*c .gt. 0._r8 ) then ! Failure: x**2 = -c/a < 0 + status = 2 + else ! x**2 = -c/a + r1 = sqrt(-c/a) + endif + r2 = -r1 + else ! Form a*x**2 + b*x + c = 0 + if( (b**2 - 4._r8*a*c) .lt. 0._r8 ) then ! Failure, no real roots + status = 3 + else + q = -0.5_r8*(b + sign(1.0_r8,b)*sqrt(b**2 - 4._r8*a*c)) + r1 = q/a + r2 = c/q + endif + endif + endif + + return + + end subroutine roots + + + subroutine oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, & + wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, & + wa, wb, tke, do_condensation, do_precip, plumeheight ) + !********************************************************************** + ! Calculate a single plume with fixed entrainment + ! to be used for a dynamic mixing length calculation + ! By Rachel Storer + !********************************************************************** + use physconst, only: cpair, gravit, zvir + + integer, intent(in) :: nzm, nzt + real(r8), dimension(nzt), intent(in) :: dzt, iexner_zt, & + qt, thv, thl + real(r8), dimension(nzm), intent(in) :: zm, p_zm, iexner_zm, tke + + real(r8), intent(in) :: wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, & + cwthv, zcb_unset, wa, wb + logical, intent(in) :: do_condensation, do_precip + + real(r8), intent(inout) :: plumeheight + + !local variables + + ! =============================================================================== ! + ! GRID ORIENTATION GENERALIZATION VARIABLES + ! ------------------------------------------------------------------------------- ! + ! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without + ! duplicating code, these variables abstract the vertical loop bounds and slices. + ! + ! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. + ! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. + ! kdir : Directional step (+1 for moving up, -1 for moving down). + ! + ! STAGGERED GRID INDEXING + ! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative + ! index of the cell center (zt) to the interface (zm) flips depending on whether + ! memory is loaded top-down or bottom-up. These variables dynamically map them: + ! + ! kt : The active thermodynamic cell center associated with the current step. + ! Upward Sweep: kt = k - (1-kdir)/2 + ! Downward Sweep: kt = k - (1+kdir)/2 + ! + ! kn : The NEXT momentum interface in the direction of the current sweep. + ! Upward Sweep: kn = k + kdir + ! Downward Sweep: kn = k - kdir + ! + ! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. + ! kt_up = k - (1-kdir)/2 + ! + ! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. + ! kt_dn = k - (1+kdir)/2 + ! =============================================================================== ! + integer :: ksfcm, ktopm, kdir, kt, kn + integer :: k + real(r8) :: thvn, qtn, thln, qcn, thn, qln, qin, qsn, lmixn, zcb, B, wn2, pentexp, pturb, pentw, wp + real(r8), dimension(nzm) :: upw, upa, upqt, upthv, upthl, upth, upqs, & + upqc, upql, upqi + real(r8), dimension(nzt) :: supqt, supthl + ! ! fractional entrainment rate + real(r8), parameter :: pent = 1.E-3_r8 + ! ! use tke enhanced entrainment + logical :: do_tptke = .false. + + if (zm(1) < zm(nzm)) then + ksfcm = 1 + ktopm = nzm + kdir = 1 + else + ksfcm = nzm + ktopm = 1 + kdir = -1 + end if + + zcb = zcb_unset + + upw(ksfcm) = 0.5_r8 * wmax + upa(ksfcm) = 0.5_r8 * erf( wmax/(sqrt(2._r8)*sigmaw) ) + + upqt(ksfcm) = cwqt * upw(ksfcm) * sigmaqt/sigmaw + upthv(ksfcm) = cwthv * upw(ksfcm) * sigmathv/sigmaw + + upqt(ksfcm) = qt(ksfcm)+upqt(ksfcm) + upthv(ksfcm) = thv(ksfcm)+upthv(ksfcm) + upthl(ksfcm) = upthv(ksfcm) / (1._r8+zvir*upqt(ksfcm)) + upth(ksfcm) = upthl(ksfcm) + + ! get cloud, lowest momentum level + if (do_condensation) then + call condensation_mf(upqt(ksfcm), upthl(ksfcm), p_zm(ksfcm), iexner_zm(ksfcm), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + upthv(ksfcm) = thvn + upqc(ksfcm) = qcn + upql(ksfcm) = qln + upqi(ksfcm) = qin + upqs(ksfcm) = qsn + upth(ksfcm) = thn + if (qcn > 0._r8) zcb = zm(ksfcm) + else + ! assume no cldliq + upqc(ksfcm) = 0._r8 + end if + + do k = ksfcm, ktopm-kdir, kdir + kt = k - (1-kdir)/2 + kn = k + kdir + + ! get microphysics, autoconversion + if (do_precip .and. upqc(k) > 0._r8) then + call precip_mf(upqs(k),upqt(k),upw(k),dzt(kt),abs(zm(kn)-zcb),supqt(kt)) + supthl(kt) = -1._r8*lmixn*supqt(kt)*iexner_zt(kt)/cpair + else + supqt(kt) = 0._r8 + supthl(kt) = 0._r8 + end if + ! integrate updraft + if (do_tptke) then + pturb = (1._r8 + clubb_mf_alphturb*sqrt(tke(k))/upw(k)) + else + pturb = 1._r8 + end if + pentexp = exp(-pent*pturb*dzt(kt)) + qtn = qt(kt) *(1._r8-pentexp ) + upqt (k)*pentexp + supqt(kt) + thln = thl(kt)*(1._r8-pentexp ) + upthl(k)*pentexp + supthl(kt) + + ! convert source terms to a tendency + supqt(kt) = supqt(kt)*upw(k)/dzt(kt) + supthl(kt) = supthl(kt)*upw(k)/dzt(kt) + + ! get cloud, momentum levels + if (do_condensation) then + call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + if (zcb.eq.zcb_unset .and. qcn > 0._r8) zcb = zm(kn) + else + thvn = thln*(1._r8+zvir*qtn) + end if + ! get buoyancy + B=gravit*(0.5_r8*(thvn + upthv(k))/thv(kt)-1._r8) + + ! get wn^2 + wp = wb*pent*pturb + if (wp==0._r8) then + wn2 = upw(k)**2._r8+2._r8*wa*B*dzt(kt) + else + pentw = exp(-2._r8*wp*dzt(kt)) + wn2 = pentw*upw(k)**2._r8+(1._r8-pentw)*wa*B/wp + end if + + if (wn2>0._r8) then + upw(kn) = sqrt(wn2) + upthv(kn) = thvn + upthl(kn) = thln + upqt(kn) = qtn + upqc(kn) = qcn + upqs(kn) = qsn + upa(kn) = upa(k) + upql(kn) = qln + upqi(kn) = qin + upth(kn) = thn + else + plumeheight = zm(k) + exit + end if + enddo + + end subroutine oneplume + + +subroutine buoyan_dilute( nzt, nzm, nup, dmpdz, q, t, p, z, pf, & + tp, qstp, tl, cape, cin, pblt, lcl, lel, lon, mx, & + msg, tpert, landfrac ) +!----------------------------------------------------------------------- +! Calculates CAPE the lifting condensation level and the convective top +! where buoyancy is first -ve. +! Method: Calculates the parcel temperature based on a simple constant +! entraining plume model. CAPE is integrated from buoyancy. +! 09/09/04 - Simplest approach using an assumed entrainment rate for +! testing (dmpdp). +! 08/04/05 - Swap to convert dmpdz to dmpdp +! +! SCAM Logical Switches - DILUTE:RBN - Now Disabled +! --------------------- +! switch(1) = .T. - Uses the dilute parcel calculation to obtain tendencies. +! switch(2) = .T. - Includes entropy/q changes due to condensate loss and freezing. +! switch(3) = .T. - Adds the PBL Tpert for the parcel temperature at all levels. +! +! References: +! Raymond and Blythe (1992) JAS +! +! Author: +! Richard Neale - September 2004 +! +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! input arguments +! + integer, intent(in) :: nzt, nzm ! vertical grid sizes + integer, intent(in) :: nup ! number of plumes + + real(r8), intent(in) :: dmpdz(nzt,nup)! Parcel fractional mass entrainment rate (/m) 3D + + real(r8), intent(in) :: q(nzt) ! spec. humidity + real(r8), intent(in) :: t(nzt) ! temperature + real(r8), intent(in) :: p(nzt) ! pressure + real(r8), intent(in) :: z(nzt) ! height + real(r8), intent(in) :: pf(nzm) ! pressure at interfaces + integer, intent(in) :: pblt ! index of pbl depth + integer, intent(in) :: msg + real(r8), intent(in) :: tpert ! perturbation temperature by pbl processes + real(r8), intent(in) :: landfrac + +! output arguments + real(r8), intent(out) :: tp(nzt,nup) ! parcel temperature + real(r8), intent(out) :: qstp(nzt,nup) ! saturation mixing ratio of parcel (only above lcl, just q below). + real(r8), intent(out) :: tl(nup) ! parcel temperature at lcl + real(r8), intent(out) :: cape(nup) ! convective aval. pot. energy. + real(r8), intent(out) :: cin (nup) ! CIN + integer, intent(out) :: lcl(nup) ! + integer, intent(out) :: lel(nup) ! + integer, intent(out) :: lon ! level of onset of deep convection + integer, intent(out) :: mx ! level of max moist static energy + + !--------------------------Local Variables------------------------------ + + ! =============================================================================== ! + ! GRID ORIENTATION GENERALIZATION VARIABLES + ! ------------------------------------------------------------------------------- ! + ! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without + ! duplicating code, these variables abstract the vertical loop bounds and slices. + ! + ! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. + ! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. + ! kdir : Directional step (+1 for moving up, -1 for moving down). + ! + ! STAGGERED GRID INDEXING + ! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative + ! index of the cell center (zt) to the interface (zm) flips depending on whether + ! memory is loaded top-down or bottom-up. These variables dynamically map them: + ! + ! kt : The active thermodynamic cell center associated with the current step. + ! Upward Sweep: kt = k - (1-kdir)/2 + ! Downward Sweep: kt = k - (1+kdir)/2 + ! + ! kn : The NEXT momentum interface in the direction of the current sweep. + ! Upward Sweep: kn = k + kdir + ! Downward Sweep: kn = k - kdir + ! + ! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. + ! kt_up = k - (1-kdir)/2 + ! + ! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. + ! kt_dn = k - (1+kdir)/2 + ! =============================================================================== ! + integer :: ksfct, ktopt, kdir, kn + integer lelten(nup,mf_num_cin) + real(r8) capeten(nup,mf_num_cin) ! provisional value of cape + real(r8) cinten(nup,mf_num_cin) ! provisional value of CIN + real(r8) tv(nzt) + real(r8) tpv(nzt,nup) + real(r8) buoy(nzt,nup) + real(r8) pl(nup) + + real(r8) a1, a2, estp, plexp, hmax, hmn, y + logical plge600(nup) + integer knt(nup) + real(r8) e + integer i, k, n + + real(r8), parameter :: tiedke_add = 0.5_r8 +!----------------------------------------------------------------------- + if (z(1) < z(nzt)) then + ksfct = 1 + ktopt = nzt + kdir = 1 + else + ksfct = nzt + ktopt = 1 + kdir = -1 + end if + + do n = 1,mf_num_cin + do i = 1,nup + lelten(i,n) = ksfct + capeten(i,n) = 0._r8 + cinten (i,n) = 0._r8 + end do + end do + + lon = ksfct + mx = lon + hmax = 0._r8 + + do i = 1,nup + knt(i) = 0 + lel(i) = ksfct + cape(i) = 0._r8 + tp(:,i) = t(:) + qstp(:,i) = q(:) + end do + +!!! RBN - Initialize tv and buoy for output. +!!! tv=tv : tpv=tpv : qstp=q : buoy=0. + if (tht_tweaks) then + tv (:) = t(:) *(1._r8+q(:)/epsilo)/ (1._r8+q(:)) + else + tv (:) = t(:) *(1._r8+1.608_r8*q(:))/ (1._r8+q(:)) + endif +!-tht + do i = 1,nup + tpv (:,i) = tv(:) + end do + buoy(:,:) = 0._r8 + +! set "launching" level(mx) to be at maximum moist static energy. +! search for this level stops at planetary boundary layer top. + do k = ksfct, msg-kdir, kdir + hmn =(cpair+q(k)*cpliq)*t(k)/(1._r8+q(k)) + (1._r8+q(k)/epsilo)/(1._r8+q(k))*gravit*z(k) & + +(latvap-(cpliq-cpwv)*(t(k)-tmelt))*q(k) + if ((k - pblt)*kdir <= 0 .and. (k - lon)*kdir >= 0 .and. hmn > hmax) then + hmax = hmn + mx = k + end if + end do + +! LCL dilute calculation - initialize to mx(i) +! Determine lcl in parcel_dilute and get pl,tl after parcel_dilute +! Original code actually sets LCL as level above wher condensate forms. +! Therefore in parcel_dilute lcl(i) will be at first level where qsmix < qtmix. + + do i = 1,nup ! Initialise LCL variables. + lcl(i) = mx + tl(i) = t(mx) + pl(i) = p(mx) + end do + +! +! main buoyancy calculation. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! DILUTE PLUME CALCULATION USING ENTRAINING PLUME !!! + call parcel_dilute(nzt, nzm, nup, msg, mx, p, z, t, q, & + tpert, tp, tpv, qstp, pl, tl, lcl, & + landfrac, dmpdz) + +! If lcl is above the nominal level of non-divergence (600 mbs), +! no deep convection is permitted (ensuing calculations +! skipped and cape retains initialized value of zero). +! + do i = 1,nup + plge600(i) = pl(i).ge.600._r8 ! Just change to always allow buoy calculation. + end do + +! Main buoyancy calculation. + do k = ksfct, msg-kdir, kdir + do i=1,nup + if ((k - mx)*kdir >= 0 .and. plge600(i)) then + if (tht_tweaks) then + tv(k) = t(k)* (1._r8+q(k)/epsilo)/ (1._r8+q(k)) !+tht + else + tv(k) = t(k)* (1._r8+1.608_r8*q(k))/ (1._r8+q(k)) !orig + endif +! +0.5K or not? (arbitrary at this point - introduce in parcel_dilute instead? tht) + buoy(k,i) = tpv(k,i) - tv(k) + tiedke_add ! +0.5K or not? + else + qstp(k,i) = q(k) + tp(k,i) = t(k) + tpv(k,i) = tv(k) + endif + end do + end do + +!------------------------------------------------------------------------------- +! beginning from one below top (first level p>40hPa, msg) check for at most +! num_cin levels of neutral buoyancy (LELten) and compute CAPEten between LCL + do k = msg-2*kdir, ksfct, -kdir + do i = 1,nup + if ((k - lcl(i))*kdir > 0 .and. plge600(i)) then + if (buoy(k-kdir,i) > 0._r8 .and. buoy(k,i) <= 0._r8) then + knt(i) = min(mf_num_cin,knt(i) + 1) + lelten(i,knt(i)) = k + end if + end if + end do + end do + +! calculate convective available potential energy (cape). + do n = 1,mf_num_cin + do k = msg-kdir, ksfct, -kdir + do i = 1,nup + if (plge600(i) .and. (k - mx)*kdir >= 0 .and. (k - lelten(i,n))*kdir < 0) then + ! Using pf(k) and pf(k+kdir). Since pf is on momentum grid (nzm=nzt+1), + ! if k ranges from 1 to nzt, k+1 ranges from 2 to nzm (valid). + ! For top-down (kdir=-1), k-1 ranges from nzt-1 to 0. + ! The interface pressure above thermo layer k is k - (1-kdir)/2 + kn = k - (1-kdir)/2 + capeten(i,n) = capeten(i,n) + rair*buoy(k,i)*abs(log(pf(kn)/pf(kn+kdir))) + cinten (i,n) = cinten (i,n) - rair*min(buoy(k,i),0._r8)*abs(log(pf(kn)/pf(kn+kdir))) + end if + end do + end do + end do + +! find maximum cape from all possible tentative capes from one sounding + do n = 1,mf_num_cin + do i = 1,nup + if (capeten(i,n) > cape(i)) then + cape(i) = capeten(i,n) + cin (i) = cinten (i,n) !+tht CIN + lel(i) = lelten(i,n) + end if + end do + end do + +! put lower bound on cape for diagnostic purposes. + do i = 1,nup + cape(i) = max(cape(i), 0._r8) + end do + +return +end subroutine buoyan_dilute + + + subroutine parcel_dilute (nzt, nzm, nup, msg, klaunch, p, z, t, q, & + tpert, tp, tpv, qstp, pl, tl, lcl, & + landfrac, dmpdz) +!-tht + +! Routine to determine +! 1. Tp - Parcel temperature +! 2. qstp - Saturated mixing ratio at the parcel temperature. + +!-------------------- +implicit none +!-------------------- + +integer, intent(in) :: nzt, nzm +integer, intent(in) :: nup +integer, intent(in) :: msg +integer, intent(in) :: klaunch + +real(r8), intent(in) :: tpert ! PBL temperature perturbation. +real(r8), intent(in) :: landfrac +real(r8), intent(in), dimension(nzt) :: p +real(r8), intent(in), dimension(nzt) :: z +real(r8), intent(in), dimension(nzt) :: t +real(r8), intent(in), dimension(nzt) :: q + +real(r8), intent(inout), dimension(nzt,nup) :: tp ! Parcel temp. +real(r8), intent(inout), dimension(nzt,nup) :: qstp ! Parcel water vapour (sat value above lcl). +real(r8), intent(inout), dimension(nup) :: tl ! Actual temp of LCL. +real(r8), intent(inout), dimension(nup) :: pl ! Actual pressure of LCL. +integer, intent(inout), dimension(nup) :: lcl ! Lifting condesation level (first model level with saturation). + +real(r8), intent(out), dimension(nzt,nup) :: tpv ! Define tpv within this routine. + +real(r8), dimension(nzt,nup) :: dmpdz ! Parcel fractional mass entrainment rate (/m) 3D + +! =============================================================================== ! +! GRID ORIENTATION GENERALIZATION VARIABLES +! ------------------------------------------------------------------------------- ! +! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without +! duplicating code, these variables abstract the vertical loop bounds and slices. +! +! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. +! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. +! kdir : Directional step (+1 for moving up, -1 for moving down). +! +! STAGGERED GRID INDEXING +! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative +! index of the cell center (zt) to the interface (zm) flips depending on whether +! memory is loaded top-down or bottom-up. These variables dynamically map them: +! +! kt : The active thermodynamic cell center associated with the current step. +! Upward Sweep: kt = k - (1-kdir)/2 +! Downward Sweep: kt = k - (1+kdir)/2 +! +! kn : The NEXT momentum interface in the direction of the current sweep. +! Upward Sweep: kn = k + kdir +! Downward Sweep: kn = k - kdir +! +! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. +! kt_up = k - (1-kdir)/2 +! +! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. +! kt_dn = k - (1+kdir)/2 +! =============================================================================== ! +integer :: ksfct, ktopt, kdir + +real(r8) tmix(nzt,nup) ! Tempertaure of the entraining parcel. +real(r8) qtmix(nzt,nup) ! Total water of the entraining parcel. +real(r8) qsmix(nzt,nup) ! Saturated mixing ratio at the tmix. +real(r8) smix(nzt,nup) ! Entropy of the entraining parcel. +real(r8) xsh2o(nzt,nup) ! Precipitate lost from parcel. +real(r8) ds_xsh2o(nzt,nup) ! Entropy change due to loss of condensate. +real(r8) ds_freeze(nzt,nup) ! Entropy change sue to freezing of precip. +real(r8) dmpdz2d(nzt,nup) ! variable detrainment rate + +real(r8) zl(nup) ! lcl + +real(r8) mp(nup) ! Parcel mass flux. +real(r8) qtp(nup) ! Parcel total water. +real(r8) sp(nup) ! Parcel entropy. +real(r8) sp0(nup) ! Parcel launch entropy. +real(r8) qtp0(nup) ! Parcel launch total water. +real(r8) mp0(nup) ! Parcel launch relative mass flux. + +real(r8) lwmax ! Maximum condesate that can be held in cloud before rainout. +real(r8) dmpdp ! Parcel fractional mass entrainment rate (/mb). +real(r8) dpdz,dzdp ! Hydrstatic relation and inverse of. +real(r8) senv ! Environmental entropy at each grid point. +real(r8) qtenv ! Environmental total water " " ". +real(r8) penv ! Environmental total pressure " " ". +real(r8) zenv +real(r8) tenv ! Environmental total temperature " " ". +real(r8) new_s ! Hold value for entropy after condensation/freezing adjustments. +real(r8) new_q ! Hold value for total water after condensation/freezing adjustments. +real(r8) dp ! Layer thickness (center to center) +real(r8) tfguess ! First guess for entropy inversion - crucial for efficiency! +real(r8) tscool ! Super cooled temperature offset (in degC) (eg -35). + +real(r8) qxsk, qxskp1 ! LCL excess water (k, k+1) +real(r8) dsdp, dqtdp, dqxsdp ! LCL s, qt, p gradients (k, k+1) +real(r8) slcl,qtlcl,qslcl ! LCL s, qt, qs values. +real(r8) dmpdz_lnd, dmpdz_mask + +integer rcall ! Number of ientropy call for errors recording +integer nit_lheat ! Number of iterations for condensation/freezing loop. +integer i,k,ii ! Loop counters. + +real(r8) est + +if (z(1) < z(nzt)) then + ksfct = 1 + ktopt = nzt + kdir = 1 +else + ksfct = nzt + ktopt = 1 + kdir = -1 +end if + +nit_lheat = 2 ! iterations for ds,dq changes from condensation freezing. + +lwmax = 1.e10_r8 ! tht: don't precipitate +tscool =-10._r8 ! tht: allow even just mild supercooling?! + +qtmix=0._r8 +smix=0._r8 + +qtenv = 0._r8 +senv = 0._r8 +tenv = 0._r8 +penv = 0._r8 +zenv = 0._r8 + +qtp0 = 0._r8 +sp0 = 0._r8 +mp0 = 0._r8 + +qtp = 0._r8 +sp = 0._r8 +mp = 0._r8 + +new_q = 0._r8 +new_s = 0._r8 + +zl(:)=0._r8 + +! **** Begin loops **** + +do k = ksfct, msg-kdir, kdir + do i=1,nup + +! Initialize parcel values at launch level. + + if (k == klaunch) then + qtp0(i) = q(k) ! Parcel launch total water (assuming subsaturated) - OK????. + +!+tht: formulate dilution on enthalpy not on entropy + if (tht_tweaks) then + sp0(i) = enthalpy(t(k),p(k),qtp0(i),z(k)) ! Parcel launch enthalpy. + else + sp0(i) = entropy (t(k),p(k),qtp0(i)) ! Parcel launch entropy. + endif +!-tht + mp0(i) = 1._r8 ! Parcel launch relative mass (=1 for dmpdp=0 i.e. undilute). + smix(k,i) = sp0(i) + qtmix(k,i) = qtp0(i) +!+tht: since the function to invert for T is *identical* with sp0(i)=entropy(t), unless there is +! a coding error (likely, given the mess) the result must be t(i,k) (verified 21/2/2014) + if (tht_tweaks) then + tmix(k,i) = t(k) + call qsat_hPa(tmix(k,i),p(k), est, qsmix(k,i)) + else + tfguess = t(k) + rcall = 1 + call ientropy (rcall,smix(k,i),p(k),qtmix(k,i),tmix(k,i),qsmix(k,i),tfguess) + endif +!-tht + end if + + if ((k - klaunch)*kdir > 0) then + + dp = -abs(p(k)-p(k-kdir)) + qtenv = 0.5_r8*(q(k)+q(k-kdir)) + tenv = 0.5_r8*(t(k)+t(k-kdir)) + penv = 0.5_r8*(p(k)+p(k-kdir)) + zenv = 0.5_r8*(z(k)+z(k-kdir)) + + if (tht_tweaks) then + senv = enthalpy(tenv,penv,qtenv,zenv) ! Enthalpy of environment. + else + senv = entropy (tenv,penv,qtenv) ! Entropy of environment. + endif + +! Determine fractional entrainment rate /pa given value /m. + + dpdz = -(penv*gravit)/(rair*tenv) ! in mb/m since p in mb. + dzdp = 1._r8/dpdz ! in m/mb +!+tht +! NB: land fudge makes no sense to me - make dmpdz_lnd=dmpdz (as per default code, hard-wired to 1e-3) + !dmpdp = dmpdz*dzdp + !dmpdp = dmpdz(i)*dzdp ! /mb Fractional entrainment 2D + dmpdp = dmpdz(k,i)*dzdp ! /mb Fractional entrainment 3D +!-tht + +! Sum entrainment to current level +! entrains q,s out of intervening dp layers, in which linear variation is assumed +! so really it entrains the mean of the 2 stored values. + + sp(i) = sp(i) - dmpdp*dp*senv + qtp(i) = qtp(i) - dmpdp*dp*qtenv + mp(i) = mp(i) - dmpdp*dp + +! Entrain s and qt to next level. + + smix(k,i) = (sp0(i) + sp(i)) / (mp0(i) + mp(i)) + qtmix(k,i) = (qtp0(i) + qtp(i)) / (mp0(i) + mp(i)) + + tfguess = tmix(k-kdir,i) + rcall = 2 + + if (tht_tweaks) then + call ienthalpy(rcall,smix(k,i),p(k),z(k),qtmix(k,i),tmix(k,i),qsmix(k,i),tfguess) + else + call ientropy (rcall,smix(k,i),p(k),qtmix(k,i),tmix(k,i),qsmix(k,i),tfguess) + endif + + if (qsmix(k,i) <= qtmix(k,i) .and. qsmix(k-kdir,i) > qtmix(k-kdir,i)) then + lcl(i) = k + qxsk = qtmix(k,i) - qsmix(k,i) + qxskp1 = qtmix(k-kdir,i) - qsmix(k-kdir,i) + dqxsdp = (qxsk - qxskp1)/dp + pl(i) = p(k-kdir) - qxskp1/dqxsdp + zl(i) = z(k-kdir) - qxskp1/dqxsdp *dzdp + dsdp = (smix(k,i) - smix(k-kdir,i))/dp + dqtdp = (qtmix(k,i) - qtmix(k-kdir,i))/dp + slcl = smix(k-kdir,i) + dsdp* (pl(i)-p(k-kdir)) + qtlcl = qtmix(k-kdir,i) + dqtdp*(pl(i)-p(k-kdir)) + + tfguess = tmix(k,i) + rcall = 3 + + if (tht_tweaks) then + call ienthalpy(rcall,slcl,pl(i),zl(i),qtlcl,tl(i),qslcl,tfguess) + else + call ientropy (rcall,slcl,pl(i),qtlcl,tl(i),qslcl,tfguess) + endif + endif +! + end if ! k < klaunch + + + end do ! Levels loop +end do ! Columns loop + + +! if ( masterproc ) then +! do k = 1,msg-1 +! do i = 1,nup +! write(iulog,*) "after, k, nup, dmpdz ", k, i, dmpdz(k,i) +! end do +! end do +! end if + + +!!!!!!!!!!!!!!!!!!!!!!!!!!END ENTRAINMENT LOOP!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!! Could stop now and test with this as it will provide some estimate of buoyancy +!! without the effects of freezing/condensation taken into account for tmix. + +!! So we now have a profile of entropy and total water of the entraining parcel +!! Varying with height from the launch level klaunch parcel=environment. To the +!! top allowed level for the existence of convection. + +!! Now we have to adjust these values such that the water held in vaopor is < or +!! = to qsmix. Therefore, we assume that the cloud holds a certain amount of +!! condensate (lwmax) and the rest is rained out (xsh2o). This, obviously +!! provides latent heating to the mixed parcel and so this has to be added back +!! to it. But does this also increase qsmix as well? Also freezing processes + + +xsh2o = 0._r8 +ds_xsh2o = 0._r8 +ds_freeze = 0._r8 + +!!!!!!!!!!!!!!!!!!!!!!!!!PRECIPITATION/FREEZING LOOP!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Iterate solution twice for accuracy + + +do k = ksfct, msg-kdir, kdir + do i=1,nup + +! Initialize variables at k=klaunch + + if (k == klaunch) then + +! Set parcel values at launch level assume no liquid water. + + tp(k,i) = tmix(k,i) + qstp(k,i) = q(k) + if (tht_tweaks) then + tpv(k,i) = (tp(k,i) + tpert) * (1._r8+qstp(k,i)/epsilo) / (1._r8+qstp(k,i)) !+tht OK with mx ratio + else + tpv(k,i) = (tp(k,i) + tpert) * (1._r8+1.608_r8*qstp(k,i)) / (1._r8+qstp(k,i)) + endif + end if + + if ((k - klaunch)*kdir > 0) then + + if (tht_tweaks) then + smix(k,i)=entropy(tmix(k,i),p(k),qtmix(k,i)) !+tht make sure to use entropy here + endif + +!---- +! Initiate loop if switch(2) = .T. - RBN:DILUTE - TAKEN OUT BUT COULD BE RETURNED LATER. +! Iterate nit_lheat times for s,qt changes. + do ii=0,nit_lheat-1 + +! Rain (xsh2o) is excess condensate, bar LWMAX (Accumulated loss from qtmix). + xsh2o(k,i) = max (0._r8, qtmix(k,i) - qsmix(k,i) - lwmax) + ds_xsh2o(k,i) = ds_xsh2o(k-kdir,i) - cpliq * log (tmix(k,i)/tmelt) * max(0._r8,(xsh2o(k,i)-xsh2o(k-kdir,i))) + + if (tmix(k,i) <= tmelt+tscool .and. ds_freeze(k-kdir,i) == 0._r8) then + ds_freeze(k,i) = (latice/tmix(k,i)) * max(0._r8,qtmix(k,i)-qsmix(k,i)-xsh2o(k,i)) + end if + + if (tmix(k,i) <= tmelt+tscool .and. ds_freeze(k-kdir,i) /= 0._r8) then + ds_freeze(k,i) = ds_freeze(k-kdir,i)+(latice/tmix(k,i)) * max(0._r8,(qsmix(k-kdir,i)-qsmix(k,i))) + end if + +! Adjust entropy and accordingly to sum of ds (be careful of signs). + new_s = smix(k,i) + ds_xsh2o(k,i) + ds_freeze(k,i) + +! Adjust liquid water and accordingly to xsh2o. + new_q = qtmix(k,i) - xsh2o(k,i) + +! Invert entropy to get updated Tmix and qsmix of parcel. + + tfguess = tmix(k,i) + rcall =4 + call ientropy (rcall,new_s, p(k), new_q, tmix(k,i), qsmix(k,i), tfguess) + + end do ! Iteration loop for freezing processes. + +! tp - Parcel temp is temp of mixture. +! tpv - Parcel v. temp should be density temp with new_q total water. + + tp(k,i) = tmix(k,i) + +! tpv = tprho in the presence of condensate (i.e. when new_q > qsmix) + if (new_q > qsmix(k,i)) then ! Super-saturated so condensate present - reduces buoyancy. + qstp(k,i) = qsmix(k,i) + else ! Just saturated/sub-saturated - no condensate virtual effects. + qstp(k,i) = new_q + end if + + if (tht_tweaks) then + tpv(k,i) = (tp(k,i)+tpert)* (1._r8+qstp(k,i)/epsilo) / (1._r8+ new_q) !+tht + else + tpv(k,i) = (tp(k,i)+tpert)* (1._r8+1.608_r8*qstp(k,i)) / (1._r8+ new_q) + endif + + end if ! k > klaunch + + end do ! Loop for columns + +end do ! Loop for vertical levels. + + +return +end subroutine parcel_dilute + +!----------------------------------------------------------------------------------------- +real(r8) function entropy(TK,p,qtot) +!----------------------------------------------------------------------------------------- +! +! TK(K),p(mb),qtot(kg/kg) +! from Raymond and Blyth 1992 +! + real(r8), intent(in) :: p,qtot,TK + real(r8) :: qv,qst,e,est,L + real(r8), parameter :: pref = 1000._r8 + +L = latvap - (cpliq - cpwv)*(TK-tmelt) ! T IN CENTIGRADE + +call qsat_hPa(TK, p, est, qst) + +qv = min(qtot,qst) ! Partition qtot into vapor part only. +e = qv*p / (epsilo +qv) + +entropy = (cpair + qtot*cpliq)*log( TK/tmelt) - rair*log( (p-e)/pref ) + & + L*qv/TK - qv*rh2o*log(qv/qst) + +end FUNCTION entropy + +!----------------------------------------------------------------------------------------- +SUBROUTINE ientropy (rcall,s,p,qt,T,qst,Tfg) +!----------------------------------------------------------------------------------------- +! +! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). +! Inverts entropy, pressure and total water qt +! for T and saturated vapor mixing ratio +! + + integer, intent(in) :: rcall + real(r8), intent(in) :: s, p, Tfg, qt + real(r8), intent(out) :: qst, T + real(r8) :: est + real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol + integer :: i + + logical :: converged + + ! Max number of iteration loops. + integer, parameter :: LOOPMAX = 100 + real(r8), parameter :: EPS = 3.e-8_r8 + + converged = .false. + + ! Invert the entropy equation -- use Brent's method + ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. + + T = Tfg ! Better first guess based on Tprofile from conv. + + a = Tfg-10 !low bracket + b = Tfg+10 !high bracket + + fa = entropy(a, p, qt) - s + fb = entropy(b, p, qt) - s + + c=b + fc=fb + tol=0.001_r8 + + converge: do i=0, LOOPMAX + if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & + (fb < 0.0_r8 .and. fc < 0.0_r8)) then + c=a + fc=fa + d=b-a + ebr=d + end if + if (abs(fc) < abs(fb)) then + a=b + b=c + c=a + fa=fb + fb=fc + fc=fa + end if + + tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol + xm=0.5_r8*(c-b) + converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) + if (converged) exit converge + + if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then + sbr=fb/fa + if (a == c) then + pbr=2.0_r8*xm*sbr + qbr=1.0_r8-sbr + else + qbr=fa/fc + rbr=fb/fc + pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) + qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) + end if + if (pbr > 0.0_r8) qbr=-qbr + pbr=abs(pbr) + if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then + ebr=d + d=pbr/qbr + else + d=xm + ebr=d + end if + else + d=xm + ebr=d + end if + a=b + fa=fb + b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) + + fb = entropy(b, p, qt) - s + + end do converge + + T = b + call qsat_hPa(T, p, est, qst) + + if (.not. converged) then + call endrun('**** ZM_CONV IENTROPY: Tmix did not converge ****') + end if + +100 format (A,I1,I4,I4,7(A,F6.2)) + +end SUBROUTINE ientropy + +! Wrapper for qsat_water that does translation between Pa and hPa +! qsat_water uses Pa internally, so get it right, need to pass in Pa. +! Afterward, set es back to hPa. +subroutine qsat_hPa(t, p, es, qm) + use wv_saturation, only: qsat_water + + ! Inputs + real(r8), intent(in) :: t ! Temperature (K) + real(r8), intent(in) :: p ! Pressure (hPa) + ! Outputs + real(r8), intent(out) :: es ! Saturation vapor pressure (hPa) + real(r8), intent(out) :: qm ! Saturation mass mixing ratio + ! (vapor mass over dry mass, kg/kg) + + call qsat_water(t, p*100._r8, es, qm) + + es = es*0.01_r8 + +end subroutine qsat_hPa + +!----------------------------------------------------------------------------------------- +real(r8) function enthalpy(TK,p,qtot,z) +!----------------------------------------------------------------------------------------- +! +! TK(K),p(mb),qtot(kg/kg) +! + real(r8), intent(in) :: p,qtot,TK,z + real(r8) :: qv,qst,e,est,L + +L = latvap - (cpliq - cpwv)*(TK-tmelt) + +call qsat_hPa(TK, p, est, qst) +qv = min(qtot,qst) ! Partition qtot into vapor part only. + + enthalpy = (cpair + qtot*cpliq)* TK + L*qv + (1._r8+qtot)*gravit*z + +return +end FUNCTION enthalpy + +!----------------------------------------------------------------------------------------- + SUBROUTINE ienthalpy (rcall,s,p,z,qt,T,qst,Tfg) !identical with iENTROPY, only function calls swapped +!----------------------------------------------------------------------------------------- +! +! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). +! Inverts entropy, pressure and total water qt +! for T and saturated vapor mixing ratio +! + + integer, intent(in) :: rcall + real(r8), intent(in) :: s, p, z, Tfg, qt + real(r8), intent(out) :: qst, T + real(r8) :: est + real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol + integer :: i + + logical :: converged + + ! Max number of iteration loops. + integer, parameter :: LOOPMAX = 100 + real(r8), parameter :: EPS = 3.e-8_r8 + + converged = .false. + + ! Invert the entropy equation -- use Brent's method + ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. + + T = Tfg ! Better first guess based on Tprofile from conv. + + a = Tfg-10 !low bracket + b = Tfg+10 !high bracket + + fa = enthalpy(a, p, qt,z) - s + fb = enthalpy(b, p, qt,z) - s + + c=b + fc=fb + tol=0.001_r8 + + converge: do i=0, LOOPMAX + if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & + (fb < 0.0_r8 .and. fc < 0.0_r8)) then + c=a + fc=fa + d=b-a + ebr=d + end if + if (abs(fc) < abs(fb)) then + a=b + b=c + c=a + fa=fb + fb=fc + fc=fa + end if + + tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol + xm=0.5_r8*(c-b) + converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) + if (converged) exit converge + + if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then + sbr=fb/fa + if (a == c) then + pbr=2.0_r8*xm*sbr + qbr=1.0_r8-sbr + else + qbr=fa/fc + rbr=fb/fc + pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) + qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) + end if + if (pbr > 0.0_r8) qbr=-qbr + pbr=abs(pbr) + if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then + ebr=d + d=pbr/qbr + else + d=xm + ebr=d + end if + else + d=xm + ebr=d + end if + a=b + fa=fb + b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) + + fb = enthalpy(b, p, qt,z) - s + + end do converge + + T = b + call qsat_hPa(T, p, est, qst) + + if (.not. converged) then + call endrun('**** ZM_CONV IENTHALPY: Tmix did not converge ****') + end if + +100 format (A,I1,I4,I4,7(A,F6.2)) + + end SUBROUTINE ienthalpy + +end module clubb_mf From e656abd9d06d2febeab12ce1de772f814f215880 Mon Sep 17 00:00:00 2001 From: jtruesdal Date: Wed, 10 Jun 2026 12:13:14 -0600 Subject: [PATCH 03/63] Potential fix for pull request finding Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> --- src/physics/cam/clubb_intr.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 2c3e8bc4ef..3f3e51278e 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -689,8 +689,8 @@ subroutine clubb_register_cam( ) call pbuf_add_field('RCM_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), rcm_macmic_idx) call pbuf_add_field('CLDFRAC_CLUBB_macmic','physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), cldfrac_macmic_idx) call pbuf_add_field('WPTHLP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthlp_macmic_idx) - call pbuf_add_field('WPRTP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) - call pbuf_add_field('WPTHVP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) + call pbuf_add_field('WPRTP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) + call pbuf_add_field('WPTHVP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) if (do_clubb_mf) then call pbuf_add_field('edmf_thlflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthlp_macmic_idx) From 3ebb9149f6b999c678e7587293a731238807624f Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 10 Jun 2026 12:32:40 -0600 Subject: [PATCH 04/63] copilot suggested fixes --- bld/namelist_files/namelist_defaults_cam.xml | 2 +- bld/namelist_files/namelist_definition.xml | 19 +++++++++++++------ src/physics/cam/clubb_intr.F90 | 8 ++++---- 3 files changed, 18 insertions(+), 11 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 5a776a753b..224c20f224 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2366,7 +2366,7 @@ 10 10.e3 0.0 - .false + .false. 2.e2 1.0 1.0 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 71665711f7..6cfbccd737 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -2530,7 +2530,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP ISCCP data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). +gridcell's longitude (t_local = t_UTC - longitude * 24/360). Default: none @@ -2538,7 +2538,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP MISR data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). +gridcell's longitude (t_local = t_UTC - longitude * 24/360). Default: none @@ -2546,7 +2546,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP MODIS data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). +gridcell's longitude (t_local = t_UTC - longitude * 24/360). Default: none @@ -2554,7 +2554,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP CloudSat-CALIPSO data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). +gridcell's longitude (t_local = t_UTC - longitude * 24/360). Default: none @@ -2562,7 +2562,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP PARASOL data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). +gridcell's longitude (t_local = t_UTC - longitude * 24/360). Default: none @@ -2570,7 +2570,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP ATLID data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell?s longitude (t_local = t_UTC ? longitude * 24/360). +gridcell's longitude (t_local = t_UTC - longitude * 24/360). Default: none @@ -4671,6 +4671,7 @@ Default: 0.22 group="clubb_mf_nl" valid_values="" > Weighting factor for CLUBB TKE on plume entrainment Default: 0.0 + @@ -4688,6 +4689,7 @@ Default: 10.e3 group="clubb_mf_nl" valid_values="" > Fraction of autoconversion partitioned to downdrafts (zero means no downdrafts) Default: 0.0 + @@ -4699,26 +4701,31 @@ Default: .false. group="clubb_mf_nl" valid_values="" > Linear enhancement factor to the downdrafts used for the cold pool calculations Default: 200.0 + Exponent enhancement factor to the downdrafts used for the cold pool calculations Default: 1.0 + Enhancement factor for the near surface pressure drag term in downdraft equation Default: 1.0 + Elevation power law exponent for downdrafts velocities in the subcloud layer Default: 3.0 + Factor to increase the ensemble MF plume cloud fractions Default: 1.0 + diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 2c3e8bc4ef..b8083a8a40 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -689,8 +689,8 @@ subroutine clubb_register_cam( ) call pbuf_add_field('RCM_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), rcm_macmic_idx) call pbuf_add_field('CLDFRAC_CLUBB_macmic','physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), cldfrac_macmic_idx) call pbuf_add_field('WPTHLP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthlp_macmic_idx) - call pbuf_add_field('WPRTP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) - call pbuf_add_field('WPTHVP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) + call pbuf_add_field('WPRTP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) + call pbuf_add_field('WPTHVP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) if (do_clubb_mf) then call pbuf_add_field('edmf_thlflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthlp_macmic_idx) @@ -1958,8 +1958,8 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_upmf' , (/ 'ilev', 'nens' /), 'A', 'kg/m2/s' , 'Plume updraft mass flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_upqt' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume updraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_upthl' , (/ 'ilev', 'nens' /), 'A', 'K' , 'Plume updraft liquid potential temperature (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_upthv' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume updraft virtual potential temperature (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_upth' , (/ 'ilev', 'nens' /), 'A', 'm/s' , 'Plume updraft potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upthv' , (/ 'ilev', 'nens' /), 'A', 'K' , 'Plume updraft virtual potential temperature (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_upth' , (/ 'ilev', 'nens' /), 'A', 'K' , 'Plume updraft potential temperature (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_upqc' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume updraft condensate mixing ratio (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_upent' , (/ 'ilev', 'nens' /), 'A', '1/m' , 'Plume updraft entrainment rate (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_updet' , (/ 'ilev', 'nens' /), 'A', '1/m' , 'Plume updraft dettrainment rate (EDMF)', sampled_on_subcycle=.true. ) From 6b9ff96a2946df9668bb229f528090136657dd37 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 10 Jun 2026 12:50:30 -0600 Subject: [PATCH 05/63] added clubb_mf_cldfrac_fac and do_clubb_mf_aloft to namelist --- bld/build-namelist | 2 ++ 1 file changed, 2 insertions(+) diff --git a/bld/build-namelist b/bld/build-namelist index e655e70405..f014ce8091 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3708,6 +3708,7 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_mf_ddbeta'); add_default($nl, 'clubb_mf_pwfac'); add_default($nl, 'clubb_mf_ddexp'); + add_default($nl, 'clubb_mf_cldfrac_fac'); add_default($nl, 'do_clubb_mf_ustar'); add_default($nl, 'do_clubb_mf_mixd'); add_default($nl, 'clubb_mf_up_ndt'); @@ -3718,6 +3719,7 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'do_clubb_mf_lscale_perplume'); add_default($nl, 'do_clubb_mf_coldpool_perplume'); add_default($nl, 'do_clubb_mf_coldpool_init'); + add_default($nl, 'do_clubb_mf_aloft'); } # Tuning for wet scavenging of modal aerosols From 819c4afc09378cc1e1523127908e4c2906313298 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 10 Jun 2026 14:45:12 -0600 Subject: [PATCH 06/63] update prec_sh with clubb_mf --- src/physics/cam/physpkg.F90 | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 6ee5ecaf6d..b1dfe6b908 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -42,6 +42,8 @@ module physpkg use offline_driver, only: offline_driver_dorun + use clubb_mf, only: do_clubb_mf + implicit none private save @@ -1987,7 +1989,7 @@ subroutine tphysac (ztodt, cam_in, & ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. - moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') + moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3').or. dycore_is('SENH') ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers @@ -2670,6 +2672,12 @@ subroutine tphysbc (ztodt, state, & prec_pcw_macmic = 0._r8 snow_pcw_macmic = 0._r8 + if (do_clubb_mf) then + ! CLUBB+MF + prec_sh_macmic = 0._r8 + snow_sh_macmic = 0._r8 + end if + ! contrail parameterization ! see Chen et al., 2012: Global contrail coverage simulated ! by CAM5 with the inventory of 2006 global aircraft emissions, JAMES @@ -2750,7 +2758,12 @@ subroutine tphysbc (ztodt, state, & ! Since we "added" the reserved liquid back in this routine, we need ! to account for it in the energy checker - flx_cnd(:ncol) = -1._r8*rliq(:ncol) + if (do_clubb_mf) then + ! CLUBB+MF: add MF precip to flx_cnd [m/s] + flx_cnd(:ncol) = -1._r8*rliq(:ncol) + prec_sh(:ncol) + else + flx_cnd(:ncol) = -1._r8*rliq(:ncol) + end if flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol) ! Unfortunately, physics_update does not know what time period @@ -2785,6 +2798,12 @@ subroutine tphysbc (ztodt, state, & call t_stopf('macrop_tend') + if (do_clubb_mf) then + ! CLUBB+MF + prec_sh_macmic(:ncol) = prec_sh_macmic(:ncol) + prec_sh(:ncol) + snow_sh_macmic(:ncol) = snow_sh_macmic(:ncol) + snow_sh(:ncol) + end if + !=================================================== ! Calculate cloud microphysics !=================================================== @@ -2938,6 +2957,12 @@ subroutine tphysbc (ztodt, state, & prec_str(:ncol) = prec_pcw(:ncol) + prec_sed(:ncol) snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol) + if (do_clubb_mf) then + ! CLUBB+MF + prec_sh(:ncol) = prec_sh_macmic(:ncol)/cld_macmic_num_steps + snow_sh(:ncol) = snow_sh_macmic(:ncol)/cld_macmic_num_steps + end if + endif ! Add the precipitation from CARMA to the precipitation from stratiform. From 42bbb3ff0ca7be042022e12445b8d65f023ac1af Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 10 Jun 2026 16:06:02 -0600 Subject: [PATCH 07/63] put clubb_mf gate around mf additions of prec --- src/physics/cam/physpkg.F90 | 4 ++++ src/physics/cam7/physpkg.F90 | 39 ++++++++++++++++++++++++++++++++++-- 2 files changed, 41 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index b1dfe6b908..e6f59f91ed 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -2291,6 +2291,10 @@ subroutine tphysbc (ztodt, state, & real(r8) :: prec_sed_macmic(pcols) real(r8) :: snow_sed_macmic(pcols) + ! CLUBB+MF + real(r8) :: prec_sh_macmic(pcols) + real(r8) :: snow_sh_macmic(pcols) + ! energy checking variables real(r8) :: zero(pcols) ! array of zeros real(r8) :: zero_sc(pcols*psubcols) ! array of zeros diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index fe6e867bce..9dadfe8f01 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -36,6 +36,7 @@ module physpkg use modal_aero_wateruptake, only: modal_aero_wateruptake_init, modal_aero_wateruptake_dr, modal_aero_wateruptake_reg use offline_driver, only: offline_driver_dorun + use clubb_mf, only: do_clubb_mf implicit none private @@ -1518,6 +1519,10 @@ subroutine tphysac (ztodt, cam_in, & real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation + ! CLUBB+MF + real(r8),pointer :: prec_sh(:) ! total precipitation from Hack convection + real(r8),pointer :: snow_sh(:) ! snow from Hack convection + ! Local copies for substepping real(r8) :: prec_pcw_macmic(pcols) real(r8) :: snow_pcw_macmic(pcols) @@ -1528,6 +1533,10 @@ subroutine tphysac (ztodt, cam_in, & real(r8) :: prec_sed_carma(pcols) ! total precip from cloud sedimentation (CARMA) real(r8) :: snow_sed_carma(pcols) ! snow from cloud ice sedimentation (CARMA) + ! CLUBB+MF + real(r8) :: prec_sh_macmic(pcols) + real(r8) :: snow_sh_macmic(pcols) + logical :: labort ! abort flag real(r8) tvm(pcols,pver) ! virtual temperature @@ -1625,6 +1634,11 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, snow_str_idx, snow_str_sc, col_type=col_type_subcol) end if + if (do_clubb_mf) then + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) + call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) + end if + if (dlfzm_idx > 0) then call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) dlf(:ncol,:) = dlfzm(:ncol,:) @@ -1750,6 +1764,12 @@ subroutine tphysac (ztodt, cam_in, & prec_pcw_macmic = 0._r8 snow_pcw_macmic = 0._r8 + if (do_clubb_mf) then + ! CLUBB+MF + prec_sh_macmic = 0._r8 + snow_sh_macmic = 0._r8 + end if + ! contrail parameterization ! see Chen et al., 2012: Global contrail coverage simulated ! by CAM5 with the inventory of 2006 global aircraft emissions, JAMES @@ -1784,7 +1804,11 @@ subroutine tphysac (ztodt, cam_in, & ! Since we "added" the reserved liquid back in this routine, we need ! to account for it in the energy checker - flx_cnd(:ncol) = -1._r8*rliq(:ncol) + if (do_clubb_mf) then + flx_cnd(:ncol) = -1._r8*rliq(:ncol) + prec_sh(:ncol) + else + flx_cnd(:ncol) = -1._r8*rliq(:ncol) + end if flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol) ! Unfortunately, physics_update does not know what time period @@ -1817,6 +1841,12 @@ subroutine tphysac (ztodt, cam_in, & call t_stopf('macrop_tend') + if (do_clubb_mf) then + ! CLUBB+MF + prec_sh_macmic(:ncol) = prec_sh_macmic(:ncol) + prec_sh(:ncol) + snow_sh_macmic(:ncol) = snow_sh_macmic(:ncol) + snow_sh(:ncol) + end if + !=================================================== ! Calculate cloud microphysics !=================================================== @@ -1964,6 +1994,11 @@ subroutine tphysac (ztodt, cam_in, & prec_str(:ncol) = prec_pcw(:ncol) + prec_sed(:ncol) snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol) + if (do_clubb_mf) then + ! CLUBB+MF + prec_sh(:ncol) = prec_sh_macmic(:ncol)/cld_macmic_num_steps + snow_sh(:ncol) = snow_sh_macmic(:ncol)/cld_macmic_num_steps + end if endif ! Add the precipitation from CARMA to the precipitation from stratiform. @@ -2497,7 +2532,7 @@ subroutine tphysac (ztodt, cam_in, & ! ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. - moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') + moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3').or. dycore_is('SENH') ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers if (.not.moist_mixing_ratio_dycore) then From e64cf8badfa869860bce114997819e5fb2e4c52a Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 10 Jun 2026 16:27:43 -0600 Subject: [PATCH 08/63] git rid of nonhydro flags --- src/physics/cam/physpkg.F90 | 2 +- src/physics/cam7/physpkg.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index e6f59f91ed..7530c954cf 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1989,7 +1989,7 @@ subroutine tphysac (ztodt, cam_in, & ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. - moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3').or. dycore_is('SENH') + moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index 9dadfe8f01..b9b18b9a5d 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -2532,7 +2532,7 @@ subroutine tphysac (ztodt, cam_in, & ! ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. - moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3').or. dycore_is('SENH') + moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers if (.not.moist_mixing_ratio_dycore) then From 20c5b77b7aecfa1fa5f0efaa7dfade780c8ceb59 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 16 Jun 2026 00:53:25 -0600 Subject: [PATCH 09/63] fix gt than roundoff error --- src/physics/cam/clubb_intr.F90 | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index f96be286ae..3ff1264c18 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -686,11 +686,11 @@ subroutine clubb_register_cam( ) call add_hist_coord('ncyc', cld_macmic_num_steps, 'macro/micro cycle index') call add_hist_coord('nens', clubb_mf_nup, 'clubb+mf ensemble size') - call pbuf_add_field('RCM_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), rcm_macmic_idx) - call pbuf_add_field('CLDFRAC_CLUBB_macmic','physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), cldfrac_macmic_idx) - call pbuf_add_field('WPTHLP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthlp_macmic_idx) - call pbuf_add_field('WPRTP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) - call pbuf_add_field('WPTHVP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) + call pbuf_add_field('RCM_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), rcm_macmic_idx) + call pbuf_add_field('CLDFRAC_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), cldfrac_macmic_idx) + call pbuf_add_field('WPTHLP_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthlp_macmic_idx) + call pbuf_add_field('WPRTP_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) + call pbuf_add_field('WPTHVP_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) if (do_clubb_mf) then call pbuf_add_field('edmf_thlflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthlp_macmic_idx) @@ -4781,9 +4781,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Use correct qflux from cam_in, not lhf/latvap as was done previously te_b = te_b + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime -!jt check with Adam These are not bfb with nonclubbmf run -!jt ! subtract enthalpy of falling precip from tb - te_b = te_b - prec_sh(i)*1000._r8*latice*hdtime + if (do_clubb_mf) then + ! subtract enthalpy of falling precip from tb + te_b = te_b - prec_sh(i)*1000._r8*latice*hdtime + end if ! Compute the disbalance of total energy, over depth where CLUBB is active se_dis(i) = ( te_a - te_b ) / ( state_loc%pint(i,pverp) - state_loc%pint(i,clubbtop_pbuf(i)) ) @@ -5430,7 +5431,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists troplev(:) = 0 !REMOVECAM_END - call tropopause_findChemTrop( state_loc, troplev ) + call tropopause_findChemTrop( state, troplev ) aist_pbuf(:,:top_lev-1) = 0._r8 qsatfac_pbuf(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below @@ -5813,7 +5814,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do do k = 1, top_lev-1 - do i = 1, ncol + do i = 1, ncol mf_dry_a_output(i,k) = 0._r8 mf_moist_a_output(i,k) = 0._r8 mf_dry_w_output(i,k) = 0._r8 From 5d62b25002a4f8a6ae3365155133f1349f806059 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 30 Jun 2026 13:11:58 -0600 Subject: [PATCH 10/63] fixed minor PR issues --- bld/namelist_files/namelist_definition.xml | 6 +- src/physics/cam/clubb_intr.F90 | 181 ++++++++++----------- src/physics/cam/clubb_mf.F90 | 2 +- 3 files changed, 92 insertions(+), 97 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 6cfbccd737..c4cbef3c96 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4656,7 +4656,7 @@ Default: 2.0 -Real: expoential coefficient relating ztop/cape to entrainment length scale +Real: exponential coefficient relating ztop/cape to entrainment length scale Default: 0.5 @@ -4771,7 +4771,7 @@ Default: .false. -If .true. let cold pool feedback impact plume intialization +If .true. let cold pool feedback impact plume initialization Default: .false. @@ -4789,7 +4789,7 @@ Default: 1 -If .true. turn on elevated convective initiliazation +If .true. turn on elevated convective initialization Default: .false. diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 3ff1264c18..328c88efe4 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -47,10 +47,6 @@ module clubb_intr implicit none -#ifdef CLUBB_SGS - -#endif - private save @@ -640,8 +636,6 @@ subroutine clubb_register_cam( ) call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,nzm_clubb/), vprcp_idx) call pbuf_add_field('RC_COEF_ZM', 'global', dtype_r8, (/pcols,nzm_clubb/), rc_coef_zm_idx) call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,nzm_clubb/), wp4_idx) - call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wpup2_idx) - call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wpvp2_idx) call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2up2_idx) call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2vp2_idx) @@ -682,15 +676,15 @@ subroutine clubb_register_cam( ) call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), cloud_frac_idx) - ! these extrra coord vars don't seem to work for interpolate_output=.true. + ! these extra coord vars don't seem to work for interpolate_output=.true. call add_hist_coord('ncyc', cld_macmic_num_steps, 'macro/micro cycle index') call add_hist_coord('nens', clubb_mf_nup, 'clubb+mf ensemble size') - call pbuf_add_field('RCM_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), rcm_macmic_idx) - call pbuf_add_field('CLDFRAC_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), cldfrac_macmic_idx) - call pbuf_add_field('WPTHLP_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthlp_macmic_idx) - call pbuf_add_field('WPRTP_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) - call pbuf_add_field('WPTHVP_CLUBB_macmic', 'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) + call pbuf_add_field('RCM_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), rcm_macmic_idx) + call pbuf_add_field('CLDFRAC_CLUBB_macmic','physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), cldfrac_macmic_idx) + call pbuf_add_field('WPTHLP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthlp_macmic_idx) + call pbuf_add_field('WPRTP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) + call pbuf_add_field('WPTHVP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) if (do_clubb_mf) then call pbuf_add_field('edmf_thlflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthlp_macmic_idx) @@ -1829,68 +1823,68 @@ subroutine clubb_ini_cam(pbuf_ini) ! ----------------------------------------------------------------- ! ! These are default CLUBB output. Not the higher order history budgets - call addfld ('RHO_CLUBB', (/ 'lev' /), 'A', 'kg/m3', 'Air Density', sampled_on_subcycle = .true. ) + call addfld ('RHO_CLUBB', (/ 'lev ' /), 'A', 'kg/m3', 'Air Density', sampled_on_subcycle = .true. ) call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance', sampled_on_subcycle = .true. ) call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance', sampled_on_subcycle = .true. ) call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance', sampled_on_subcycle = .true. ) - call addfld ('WP2_ZT_CLUBB', (/ 'lev' /), 'A', 'm2/s2', 'Vert Vel Variance on zt grid', sampled_on_subcycle = .true. ) + call addfld ('WP2_ZT_CLUBB', (/ 'lev ' /), 'A', 'm2/s2', 'Vert Vel Variance on zt grid', sampled_on_subcycle = .true. ) call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux', sampled_on_subcycle = .true. ) call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux', sampled_on_subcycle = .true. ) - call addfld ('WP3_CLUBB', (/ 'lev' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity', sampled_on_subcycle = .true. ) + call addfld ('WP3_CLUBB', (/ 'lev ' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity', sampled_on_subcycle = .true. ) call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Heat Flux', sampled_on_subcycle = .true. ) call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux', sampled_on_subcycle = .true. ) call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2', 'Moisture Variance', sampled_on_subcycle = .true. ) - call addfld ('RTP2_ZT_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2', 'Moisture Variance on zt grid', sampled_on_subcycle = .true. ) + call addfld ('RTP2_ZT_CLUBB', (/ 'lev ' /), 'A', 'kg^2/kg^2', 'Moisture Variance on zt grid', sampled_on_subcycle = .true. ) call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance', sampled_on_subcycle = .true. ) - call addfld ('THLP2_ZT_CLUBB', (/ 'lev' /), 'A', 'K^2', 'Temperature Variance on zt grid', sampled_on_subcycle = .true. ) + call addfld ('THLP2_ZT_CLUBB', (/ 'lev ' /), 'A', 'K^2', 'Temperature Variance on zt grid', sampled_on_subcycle = .true. ) call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K kg/kg', 'Temp. Moist. Covariance', sampled_on_subcycle = .true. ) - call addfld ('RCM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water Mixing Ratio', sampled_on_subcycle = .true. ) - call addfld ('RTM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Total Water Mixing Ratio', sampled_on_subcycle = .true. ) - call addfld ('THLM_CLUBB', (/ 'lev' /), 'A', 'K', 'Liquid Water Potential Temperature', sampled_on_subcycle = .true. ) + call addfld ('RCM_CLUBB', (/ 'lev ' /), 'A', 'kg/kg', 'Cloud Water Mixing Ratio', sampled_on_subcycle = .true. ) + call addfld ('RTM_CLUBB', (/ 'lev ' /), 'A', 'kg/kg', 'Total Water Mixing Ratio', sampled_on_subcycle = .true. ) + call addfld ('THLM_CLUBB', (/ 'lev ' /), 'A', 'K', 'Liquid Water Potential Temperature', sampled_on_subcycle = .true. ) call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux', sampled_on_subcycle = .true. ) - call addfld ('CLOUDFRAC_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Fraction', sampled_on_subcycle = .true. ) - call addfld ('RCMINLAYER_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water in Layer', sampled_on_subcycle = .true. ) - call addfld ('CLOUDCOVER_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Cover', sampled_on_subcycle = .true. ) + call addfld ('CLOUDFRAC_CLUBB', (/ 'lev ' /), 'A', 'fraction', 'Cloud Fraction', sampled_on_subcycle = .true. ) + call addfld ('RCMINLAYER_CLUBB', (/ 'lev ' /), 'A', 'kg/kg', 'Cloud Water in Layer', sampled_on_subcycle = .true. ) + call addfld ('CLOUDCOVER_CLUBB', (/ 'lev ' /), 'A', 'fraction', 'Cloud Cover', sampled_on_subcycle = .true. ) call addfld ('WPTHVP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Buoyancy Flux', sampled_on_subcycle = .true. ) - call addfld ('RVMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Water vapor tendency', sampled_on_subcycle = .true. ) - call addfld ('STEND_CLUBB', (/ 'lev' /), 'A', 'J/(kg s)', 'Static energy tendency', sampled_on_subcycle = .true. ) - call addfld ('RCMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Liquid Water Tendency', sampled_on_subcycle = .true. ) - call addfld ('RIMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Ice Tendency', sampled_on_subcycle = .true. ) - call addfld ('UTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'U-wind Tendency', sampled_on_subcycle = .true. ) - call addfld ('VTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'V-wind Tendency', sampled_on_subcycle = .true. ) - call addfld ('ZT_CLUBB', (/ 'lev' /), 'A', 'm', 'Thermodynamic Heights', sampled_on_subcycle = .true. ) + call addfld ('RVMTEND_CLUBB', (/ 'lev ' /), 'A', 'kg/kg /s', 'Water vapor tendency', sampled_on_subcycle = .true. ) + call addfld ('STEND_CLUBB', (/ 'lev ' /), 'A', 'J/(kg s)', 'Static energy tendency', sampled_on_subcycle = .true. ) + call addfld ('RCMTEND_CLUBB', (/ 'lev ' /), 'A', 'kg/kg /s', 'Cloud Liquid Water Tendency', sampled_on_subcycle = .true. ) + call addfld ('RIMTEND_CLUBB', (/ 'lev ' /), 'A', 'kg/kg /s', 'Cloud Ice Tendency', sampled_on_subcycle = .true. ) + call addfld ('UTEND_CLUBB', (/ 'lev ' /), 'A', 'm/s /s', 'U-wind Tendency', sampled_on_subcycle = .true. ) + call addfld ('VTEND_CLUBB', (/ 'lev ' /), 'A', 'm/s /s', 'V-wind Tendency', sampled_on_subcycle = .true. ) + call addfld ('ZT_CLUBB', (/ 'lev ' /), 'A', 'm', 'Thermodynamic Heights', sampled_on_subcycle = .true. ) call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights', sampled_on_subcycle = .true. ) - call addfld ('UM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Zonal Wind', sampled_on_subcycle = .true. ) - call addfld ('VM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Meridional Wind', sampled_on_subcycle = .true. ) - call addfld ('WM_ZT_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Vertical Velocity', sampled_on_subcycle = .true. ) - call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction', sampled_on_subcycle = .true. ) - call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection', sampled_on_subcycle = .true. ) - call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) - call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) - call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) - call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) + call addfld ('UM_CLUBB', (/ 'lev ' /), 'A', 'm/s', 'Zonal Wind', sampled_on_subcycle = .true. ) + call addfld ('VM_CLUBB', (/ 'lev ' /), 'A', 'm/s', 'Meridional Wind', sampled_on_subcycle = .true. ) + call addfld ('WM_ZT_CLUBB', (/ 'lev ' /), 'A', 'm/s', 'Vertical Velocity', sampled_on_subcycle = .true. ) + call addfld ('CLDST', (/ 'lev ' /), 'A', 'fraction', 'Stratus cloud fraction', sampled_on_subcycle = .true. ) + call addfld ('ZMDLF', (/ 'lev ' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection', sampled_on_subcycle = .true. ) + call addfld ('TTENDICE', (/ 'lev ' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) + call addfld ('QVTENDICE', (/ 'lev ' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) + call addfld ('QITENDICE', (/ 'lev ' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) + call addfld ('NITENDICE', (/ 'lev ' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height', sampled_on_subcycle=.true.) - call addfld ('PDFP_RTP2_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2', 'PDF Rtot Variance', sampled_on_subcycle=.true.) + call addfld ('PDFP_RTP2_CLUBB', (/ 'lev ' /), 'A', 'kg^2/kg^2', 'PDF Rtot Variance', sampled_on_subcycle=.true.) - call addfld ('QCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) - call addfld ('NCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) - call addfld ('FQTENDICE', (/ 'lev' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('QCTENDICE', (/ 'lev ' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('NCTENDICE', (/ 'lev ' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('FQTENDICE', (/ 'lev ' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment', sampled_on_subcycle=.true.) - call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection', sampled_on_subcycle=.true.) - call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection', sampled_on_subcycle=.true.) - call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment', sampled_on_subcycle=.true.) - call addfld ('RELVAR', (/ 'lev' /), 'A', '-', 'Relative cloud water variance', sampled_on_subcycle=.true.) + call addfld ('DPDLFLIQ', (/ 'lev ' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection', sampled_on_subcycle=.true.) + call addfld ('DPDLFICE', (/ 'lev ' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection', sampled_on_subcycle=.true.) + call addfld ('DPDLFT', (/ 'lev ' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment', sampled_on_subcycle=.true.) + call addfld ('RELVAR', (/ 'lev ' /), 'A', '-', 'Relative cloud water variance', sampled_on_subcycle=.true.) call addfld ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB', sampled_on_subcycle=.true.) - call addfld ('ZMDLFI', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice water from ZM convection', sampled_on_subcycle=.true.) - call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover', sampled_on_subcycle=.true.) - call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud', sampled_on_subcycle=.true.) - call addfld ('DETNLIQTND', (/ 'lev' /), 'A', '1/kg/s', 'CLDNUM tendency in detrained water', sampled_on_subcycle=.true.) + call addfld ('ZMDLFI', (/ 'lev ' /), 'A', 'kg/kg/s', 'Detrained ice water from ZM convection', sampled_on_subcycle=.true.) + call addfld ('CONCLD', (/ 'lev ' /), 'A', 'fraction', 'Convective cloud cover', sampled_on_subcycle=.true.) + call addfld ('CMELIQ', (/ 'lev ' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud', sampled_on_subcycle=.true.) + call addfld ('DETNLIQTND', (/ 'lev ' /), 'A', '1/kg/s', 'CLDNUM tendency in detrained water', sampled_on_subcycle=.true.) call addfld ('KVH_CLUBB', (/ 'ilev' /), 'A', 'm2/s', 'CLUBB vertical diffusivity of heat/moisture on interface levels', sampled_on_subcycle=.true.) - call addfld ('QSATFAC', (/ 'lev' /), 'A', '-', 'Subgrid cloud water saturation scaling factor', sampled_on_subcycle=.true.) + call addfld ('QSATFAC', (/ 'lev ' /), 'A', '-', 'Subgrid cloud water saturation scaling factor', sampled_on_subcycle=.true.) call addfld ('ELEAK_CLUBB', horiz_only, 'A', 'W/m2', 'CLUBB energy leak', sampled_on_subcycle=.true.) call addfld ('TFIX_CLUBB', horiz_only, 'A', 'K', 'Temperature increment to conserve energy', sampled_on_subcycle=.true.) @@ -1923,18 +1917,18 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_S_AWQV' , (/ 'ilev' /), 'A', 'kgm/kgs' , 'Sum of a_i*w_i*q_vi (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_S_AWU' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*u_i (EDMF)', sampled_on_subcycle=.true.) call addfld ( 'edmf_S_AWV' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*v_i (EDMF)', sampled_on_subcycle=.true.) - call addfld ( 'edmf_thlforcup', (/ 'lev' /), 'A', 'K/s' , 'thl updraft forcing (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtforcup' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt updraft forcing (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_thlforcdn', (/ 'lev' /), 'A', 'K/s' , 'thl downdraft forcing (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtforcdn' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt downdraft forcing (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_thlforc' , (/ 'lev' /), 'A', 'K/s' , 'thl forcing (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtforc' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt forcing (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_thlflxup' , (/ 'ilev' /), 'A', 'K m/s' , 'thl updraft flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtflxup' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt updraft flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_thlflxdn' , (/ 'ilev' /), 'A', 'K m/s' , 'thl downdraft flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtflxdn' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt downdraft flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'K m/s' , 'thl flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlforcup', (/ 'lev ' /), 'A', 'K/s' , 'thl updraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtforcup' , (/ 'lev ' /), 'A', 'kg/kg/s' , 'qt updraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlforcdn', (/ 'lev ' /), 'A', 'K/s' , 'thl downdraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtforcdn' , (/ 'lev ' /), 'A', 'kg/kg/s' , 'qt downdraft forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlforc' , (/ 'lev ' /), 'A', 'K/s' , 'thl forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtforc' , (/ 'lev ' /), 'A', 'kg/kg/s' , 'qt forcing (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflxup' , (/ 'ilev' /), 'A', 'W/m2' , 'thl updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflxup' , (/ 'ilev' /), 'A', 'W/m2', 'qt updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflxdn' , (/ 'ilev' /), 'A', 'W/m2' , 'thl downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflxdn' , (/ 'ilev' /), 'A', 'W/m2', 'qt downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'W/m2' , 'thl flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'W/m2', 'qt flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_thvflx' , (/ 'ilev' /), 'A', 'K m/s' , 'thv flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_uflxup' , (/ 'ilev' /), 'A', 'm2/s2' , 'u updraft flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_vflxup' , (/ 'ilev' /), 'A', 'm2/s2' , 'v updraft flux (EDMF)', sampled_on_subcycle=.true. ) @@ -1942,11 +1936,11 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_vflxdn' , (/ 'ilev' /), 'A', 'm2/s2' , 'v downdraft flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_uflx' , (/ 'ilev' /), 'A', 'm2/s2' , 'u flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_vflx' , (/ 'ilev' /), 'A', 'm2/s2' , 'v flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_sqtup' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Plume updraft microphysics tendency (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_sqtdn' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Plume downdraft microphysics tendency (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_sqtup' , (/ 'lev ' /), 'A', 'kg/kg/s' , 'Plume updraft microphysics tendency (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_sqtdn' , (/ 'lev ' /), 'A', 'kg/kg/s' , 'Plume downdraft microphysics tendency (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_rcm' , (/ 'ilev' /), 'A', 'kg/kg' , 'grid mean cloud (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_cloudfrac', (/ 'lev' /), 'A', 'fraction', 'grid mean cloud fraction (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_ent' , (/ 'lev' /), 'A', '1/m' , 'ensemble mean entrainment (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_cloudfrac', (/ 'lev ' /), 'A', 'fraction', 'grid mean cloud fraction (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_ent' , (/ 'lev ' /), 'A', '1/m' , 'ensemble mean entrainment (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_ztop' , horiz_only, 'A', 'm' , 'edmf ztop', flag_xyfill=.True., sampled_on_subcycle=.true.) call addfld ( 'edmf_ddcp' , horiz_only, 'A', 'm/s' , 'edmf ddcp', flag_xyfill=.True., sampled_on_subcycle=.true.) call addfld ( 'edmf_L0' , horiz_only, 'A', 'm' , 'edmf dynamic L0', flag_xyfill=.True., sampled_on_subcycle=.true.) @@ -1969,18 +1963,18 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_dnqt' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume downdraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true. ) end if - call addfld ('RCM_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'kg/kg' , 'RCM CLUBB at macro/micro substep', sampled_on_subcycle=.true.) - call addfld ('CLDFRAC_CLUBB_macmic', (/ 'ilev', 'ncyc' /), 'A', 'fraction', 'CLDFRAC CLUBB at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('RCM_CLUBB_macmic' , (/ 'lev ', 'ncyc' /), 'A', 'kg/kg' , 'RCM CLUBB at macro/micro substep', sampled_on_subcycle=.true.) + call addfld ('CLDFRAC_CLUBB_macmic', (/ 'lev ', 'ncyc' /), 'A', 'fraction', 'CLDFRAC CLUBB at macro/micro substep', sampled_on_subcycle=.true.) call addfld ('WPTHLP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Heat Flux at macro/micro substep', sampled_on_subcycle=.true.) call addfld ('WPRTP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Moisture Flux at macro/micro substep', sampled_on_subcycle=.true.) call addfld ('WPTHVP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Buoyancy Flux at macro/micro substep', sampled_on_subcycle=.true.) if (do_clubb_mf) then - call addfld( 'PRECSH', horiz_only, 'A', 'm/s', 'Shallow Convection precipitation rate' ) +!jt call addfld( 'PRECSH', horiz_only, 'A', 'm/s', 'Shallow Convection precipitation rate' ) call addfld( 'SNOWSH', horiz_only, 'A', 'm/s', 'CLUBB-MF Snow precipitation rate' ) - call addfld ( 'edmf_thlflx_macmic', (/ 'ilev', 'ncyc' /), 'A', 'K m/s' , 'thl flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflx_macmic', (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'thl flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) call addfld ( 'edmf_thvflx_macmic', (/ 'ilev', 'ncyc' /), 'A', 'K m/s' , 'thv flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtflx_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'kg/kg m/s' , 'qt flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflx_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'qt flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) end if if ( trim(subcol_scheme) /= 'SILHS' ) then @@ -2476,6 +2470,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_sqtup_output, mf_sqtdn_output, & ! thermodynamic grid mf_qc_output, mf_cloudfrac_output ! thermodynamic grid +#ifdef CLUBB_SGS + ! MF plume level outputs real(r8), dimension(pcols,pverp,clubb_mf_nup) :: mf_upa_flip, & mf_upw_flip, & @@ -2531,7 +2527,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,pverp,clubb_mf_nup) :: flip real(r8), dimension(state%ncol,pverp) :: rho, wpthvp_diag - +#endif ! ---------------------------------------------------- ! ! Local Variables ! ! ---------------------------------------------------- ! @@ -2739,8 +2735,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & upwp_output, & vpwp_output, & rtp2_output, & - wprcp_clubb_output, & - wpthvp_clubb_output, & + wprcp_output, & + wpthvp_output, & thlp2_output, & dlf_liq_out, & ! Detrained liquid water from ZM [kg/kg/s] dlf_ice_out, & ! Detrained ice water from ZM [kg/kg/s] @@ -2871,6 +2867,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & icnt, & stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] + real(r8), dimension(state%ncol,clubb_mf_nup) :: mf_ztop, mf_ztop_nadv, & + mf_ztopm1, mf_ztopm1_nadv, & + mf_L0, mf_L0_nadv, & + mf_ddcp, mf_ddcp_nadv, & + mf_cape, mf_cape_nadv #endif ! CFL limiter vars @@ -2882,16 +2883,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & logical :: cfllim - real(r8), dimension(state%ncol) :: mf_precc_nadv, mf_snow_nadv,& + real(r8), dimension(state%ncol) :: mf_precc_nadv, mf_snow_nadv,& mf_cbm1, mf_cbm1_nadv, & mf_freq_nadv - real(r8), dimension(state%ncol,clubb_mf_nup) :: mf_ztop, mf_ztop_nadv, & - mf_ztopm1, mf_ztopm1_nadv, & - mf_L0, mf_L0_nadv, & - mf_ddcp, mf_ddcp_nadv, & - mf_cape, mf_cape_nadv - real(r8), dimension(state%ncol,pver) :: esat, rh real(r8), dimension(state%ncol,pver) :: mq, mqsat real(r8), dimension(state%ncol) :: rhlev, rhinv @@ -4680,7 +4675,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - if (do_clubb_mf_addtke) then + if (do_clubb_mf .and. do_clubb_mf_addtke) then !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol @@ -5584,9 +5579,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & upwp_output(i,k) = upwp_pbuf(i,k_clubb) vpwp_output(i,k) = vpwp_pbuf(i,k_clubb) rtp2_output(i,k) = rtp2_pbuf(i,k_clubb) - wprcp_clubb_output(i,k) = wprcp(i,k_clubb) * latvap - wpthvp_clubb_output(i,k) = wpthvp_pbuf(i,k_clubb) * cpair - thlp2_output(i,k) = thlp2_pbuf(i,k_clubb) + wprcp_output(i,k) = wprcp(i,k_clubb) * latvap + wpthvp_output(i,k) = wpthvp_pbuf(i,k_clubb) * cpair + thlp2_output(i,k) = thlp2_pbuf(i,k_clubb) wpthlp_output(i,k) = ( wpthlp_pbuf(i,k_clubb) - (apply_const * wpthlp_const) ) & * rho_zm(i,k_clubb) * cpair ! liquid water potential temperature flux @@ -5599,11 +5594,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - rcm_macmic(:ncol,nzt_clubb*(macmic_it-1)+1:nzt_clubb*macmic_it) = rcm(:ncol,:nzt_clubb) + rcm_macmic(:ncol,pver*(macmic_it-1)+1:pver*macmic_it) = rcm(:ncol,:pver) cldfrac_macmic(:ncol,pver*(macmic_it-1)+1:pver*macmic_it) = cld_pbuf(:ncol,:pver) wpthlp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wpthlp_output(:ncol,:pverp) wprtp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wprtp_output(:ncol,:pverp) - wpthvp_macmic(:ncol,nzm_clubb*(macmic_it-1)+1:nzm_clubb*macmic_it) = wpthvp_pbuf(:ncol,:nzm_clubb) + wpthvp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wpthvp_output(:ncol,:pverp) if (do_clubb_mf) then mf_thlflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_thlflx_output(:ncol,:pverp) mf_qtflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_qtflx_output(:ncol,:pverp) @@ -5683,8 +5678,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprtp_output(i,k) = 0._r8 upwp_output(i,k) = 0._r8 vpwp_output(i,k) = 0._r8 - wprcp_clubb_output(i,k) = 0._r8 - wpthvp_clubb_output(i,k) = 0._r8 + wprcp_output(i,k) = 0._r8 + wpthvp_output(i,k) = 0._r8 end do end do @@ -5702,8 +5697,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'RCM_CLUBB', rcm_output, pcols, lchnk ) call outfld( 'RTM_CLUBB', rtm_output, pcols, lchnk ) call outfld( 'THLM_CLUBB', thlm_output, pcols, lchnk ) - call outfld( 'WPRCP_CLUBB', wprcp_clubb_output, pcols, lchnk ) - call outfld( 'WPTHVP_CLUBB', wpthvp_clubb_output, pcols, lchnk ) + call outfld( 'WPRCP_CLUBB', wprcp_output, pcols, lchnk ) + call outfld( 'WPTHVP_CLUBB', wpthvp_output, pcols, lchnk ) call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_output, pcols, lchnk ) call outfld( 'THLP2_ZT_CLUBB', thl2_zt_output, pcols, lchnk ) call outfld( 'WP2_ZT_CLUBB', wp2_zt_output, pcols, lchnk ) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 8c1dc8cac3..76bba553b3 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1596,7 +1596,7 @@ subroutine integrate_mf( nzm, nzt, if (do_clubb_mf_coldpool_perplume) then ddcp(i) = -1._r8*dnw(ddbot(i)+kdir,i) else - ddcp(:) = ddcp(:) + -1._r8*dna(ddbot(i)+kdir,i)*dnw(ddbot(i)+kdir,i) + ddcp(:) = -1._r8*dna(ddbot(i)+kdir,i)*dnw(ddbot(i)+kdir,i) + ddcp(:) end if end if end do From 192f90d51ea2b7c28cd4a9511bf2c5b8cb3fb284 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 30 Jun 2026 13:34:50 -0600 Subject: [PATCH 11/63] copilot spelling fixes --- bld/namelist_files/namelist_definition.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index c4cbef3c96..172e635068 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4681,7 +4681,7 @@ Default: 10 -Real: limiter on entrainmnet length scale + threshold to diable TKE enhanced entrainmnet +Real: limiter on entrainmnet length scale + threshold to disable TKE enhanced entrainmnet Default: 10.e3 From fcbaaf060134f385eccf127f3179c284345f5b3d Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 2 Jul 2026 16:28:20 -0600 Subject: [PATCH 12/63] First part of Adams PR recommended changes. --- bld/namelist_files/namelist_defaults_cam.xml | 7 +- bld/namelist_files/namelist_definition.xml | 4 +- src/physics/cam/clubb_intr.F90 | 79 ++++---------------- 3 files changed, 18 insertions(+), 72 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 224c20f224..9abcdb5cd3 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2358,13 +2358,13 @@ .false. .false. 50.0 - 0.22 + 0.2 0.0 0 2.0 0.5 10 - 10.e3 + 1.e3 0.0 .false. 2.e2 @@ -2495,9 +2495,6 @@ 1 2 1 - - 6 - 6 1.0D0 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 172e635068..2929d085ad 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4664,7 +4664,7 @@ Default: 0.5 group="clubb_mf_nl" valid_values="" > Entrainment efficiency for individual plumes. Not used if do_clubb_mf=FALSE. -Default: 0.22 +Default: 0.20 Real: limiter on entrainmnet length scale + threshold to disable TKE enhanced entrainmnet -Default: 10.e3 +Default: 1.e3 @@ -443,7 +439,6 @@ module clubb_intr 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 ast_idx, & ! Stratiform cloud fraction @@ -466,10 +461,8 @@ module clubb_intr naai_idx, & ! ice number concentration prer_evap_idx, & ! rain evaporation rate qrl_idx, & ! longwave cooling rate - radf_idx, & qsatfac_idx, & ! subgrid cloud water saturation scaling factor ice_supersat_idx, & ! ice cloud fraction for SILHS - ztodt_idx,& ! physics timestep for SILHS clubbtop_idx ! level index for CLUBB top ! For Gravity Wave code @@ -505,11 +498,6 @@ module clubb_intr cmfmc_sh_idx = 0 integer :: & - rcm_macmic_idx, & - cldfrac_macmic_idx, & - wpthlp_macmic_idx, & - wprtp_macmic_idx, & - wpthvp_macmic_idx, & mf_wpthlp_macmic_idx, & mf_wprtp_macmic_idx, & mf_wpthvp_macmic_idx @@ -518,14 +506,15 @@ module clubb_intr prec_sh_idx, & snow_sh_idx - integer :: ztopmn_idx - integer :: ztopma_idx - integer :: ztopm1_macmic_idx - integer :: ddcp_idx - integer :: ddcp_macmic_idx - integer :: ddcpmn_idx - integer :: cbm1_idx - integer :: cbm1_macmic_idx + integer :: & + ztopmn_idx, & + ztopma_idx, & + ztopm1_macmic_idx, & + ddcp_idx, & + ddcp_macmic_idx, & + ddcpmn_idx, & + cbm1_idx, & + cbm1_macmic_idx contains @@ -601,10 +590,9 @@ subroutine clubb_register_cam( ) call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx) call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx) - call pbuf_add_field('FICE', 'global', dtype_r8, (/pcols,pver/), fice_idx) - call pbuf_add_field('RAD_CLUBB', 'global', dtype_r8, (/pcols,pver/), radf_idx) - call pbuf_add_field('CMELIQ', 'global', dtype_r8, (/pcols,pver/), cmeliq_idx) - call pbuf_add_field('QSATFAC', 'global', dtype_r8, (/pcols,pver/), qsatfac_idx) + call pbuf_add_field('FICE', 'global', dtype_r8, (/pcols,pver/), fice_idx) + call pbuf_add_field('CMELIQ', 'global', dtype_r8, (/pcols,pver/), cmeliq_idx) + call pbuf_add_field('QSATFAC', 'global', dtype_r8, (/pcols,pver/), qsatfac_idx) ! pbuf fields for Gravity Wave scheme call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver /), ttend_clubb_idx ) @@ -673,19 +661,10 @@ subroutine clubb_register_cam( ) ! Only in clubb_intr.F90 or SILHS call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), ice_supersat_idx) - call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) - call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), cloud_frac_idx) - ! these extra coord vars don't seem to work for interpolate_output=.true. call add_hist_coord('ncyc', cld_macmic_num_steps, 'macro/micro cycle index') call add_hist_coord('nens', clubb_mf_nup, 'clubb+mf ensemble size') - call pbuf_add_field('RCM_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), rcm_macmic_idx) - call pbuf_add_field('CLDFRAC_CLUBB_macmic','physpkg', dtype_r8, (/pcols,pver*cld_macmic_num_steps/), cldfrac_macmic_idx) - call pbuf_add_field('WPTHLP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthlp_macmic_idx) - call pbuf_add_field('WPRTP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wprtp_macmic_idx) - call pbuf_add_field('WPTHVP_CLUBB_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), wpthvp_macmic_idx) - if (do_clubb_mf) then call pbuf_add_field('edmf_thlflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthlp_macmic_idx) call pbuf_add_field('edmf_qtflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wprtp_macmic_idx) @@ -1963,12 +1942,6 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_dnqt' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume downdraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true. ) end if - call addfld ('RCM_CLUBB_macmic' , (/ 'lev ', 'ncyc' /), 'A', 'kg/kg' , 'RCM CLUBB at macro/micro substep', sampled_on_subcycle=.true.) - call addfld ('CLDFRAC_CLUBB_macmic', (/ 'lev ', 'ncyc' /), 'A', 'fraction', 'CLDFRAC CLUBB at macro/micro substep', sampled_on_subcycle=.true.) - call addfld ('WPTHLP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Heat Flux at macro/micro substep', sampled_on_subcycle=.true.) - call addfld ('WPRTP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Moisture Flux at macro/micro substep', sampled_on_subcycle=.true.) - call addfld ('WPTHVP_CLUBB_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'Buoyancy Flux at macro/micro substep', sampled_on_subcycle=.true.) - if (do_clubb_mf) then !jt call addfld( 'PRECSH', horiz_only, 'A', 'm/s', 'Shallow Convection precipitation rate' ) call addfld( 'SNOWSH', horiz_only, 'A', 'm/s', 'CLUBB-MF Snow precipitation rate' ) @@ -2171,7 +2144,6 @@ subroutine clubb_ini_cam(pbuf_ini) call pbuf_set_field(pbuf_ini, thlpthvp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, tke_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, kvh_idx, 0.0_r8) - call pbuf_set_field(pbuf_ini, radf_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, wp2rtp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, wp2thlp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, uprcp_idx, 0.0_r8) @@ -2448,11 +2420,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer :: cbm1(:) real(r8), pointer :: cbm1_macmic(:) - real(r8), pointer :: rcm_macmic(:,:) - real(r8), pointer :: cldfrac_macmic(:,:) - real(r8), pointer :: wpthlp_macmic(:,:) - real(r8), pointer :: wprtp_macmic(:,:) - real(r8), pointer :: wpthvp_macmic(:,:) real(r8), pointer :: mf_thlflx_macmic(:,:) real(r8), pointer :: mf_qtflx_macmic(:,:) real(r8), pointer :: mf_thvflx_macmic(:,:) @@ -2883,7 +2850,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & logical :: cfllim - real(r8), dimension(state%ncol) :: mf_precc_nadv, mf_snow_nadv,& + real(r8), dimension(state%ncol) :: mf_precc_nadv, mf_snow_nadv,& mf_cbm1, mf_cbm1_nadv, & mf_freq_nadv @@ -3000,12 +2967,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) - call pbuf_get_field(pbuf, rcm_macmic_idx, rcm_macmic) - call pbuf_get_field(pbuf, cldfrac_macmic_idx, cldfrac_macmic) - call pbuf_get_field(pbuf, wpthlp_macmic_idx, wpthlp_macmic) - call pbuf_get_field(pbuf, wprtp_macmic_idx, wprtp_macmic) - call pbuf_get_field(pbuf, wpthvp_macmic_idx, wpthvp_macmic) - if (do_clubb_mf) then call pbuf_get_field(pbuf, mf_wpthlp_macmic_idx, mf_thlflx_macmic) call pbuf_get_field(pbuf, mf_wprtp_macmic_idx, mf_qtflx_macmic) @@ -5594,11 +5555,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - rcm_macmic(:ncol,pver*(macmic_it-1)+1:pver*macmic_it) = rcm(:ncol,:pver) - cldfrac_macmic(:ncol,pver*(macmic_it-1)+1:pver*macmic_it) = cld_pbuf(:ncol,:pver) - wpthlp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wpthlp_output(:ncol,:pverp) - wprtp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wprtp_output(:ncol,:pverp) - wpthvp_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = wpthvp_output(:ncol,:pverp) if (do_clubb_mf) then mf_thlflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_thlflx_output(:ncol,:pverp) mf_qtflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_qtflx_output(:ncol,:pverp) @@ -5946,13 +5902,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if if (macmic_it==cld_macmic_num_steps) then - - call outfld( 'RCM_CLUBB_macmic' , rcm_macmic, pcols, lchnk ) - call outfld( 'CLDFRAC_CLUBB_macmic' , cldfrac_macmic, pcols, lchnk ) - - call outfld( 'WPTHLP_CLUBB_macmic' , wpthlp_macmic, pcols, lchnk ) - call outfld( 'WPRTP_CLUBB_macmic' , wprtp_macmic, pcols, lchnk ) - call outfld( 'WPTHVP_CLUBB_macmic' , wpthvp_macmic, pcols, lchnk ) if (do_clubb_mf) then call outfld( 'edmf_thlflx_macmic' , mf_thlflx_macmic, pcols, lchnk ) call outfld( 'edmf_qtflx_macmic' , mf_qtflx_macmic, pcols, lchnk ) From 87d0b66f4173db9c25d97e12327f0c00749f2be9 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 6 Jul 2026 15:57:58 -0600 Subject: [PATCH 13/63] second set of Adams PR changes. --- src/physics/cam/clubb_intr.F90 | 139 ++++++++++----------------------- 1 file changed, 40 insertions(+), 99 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 87d97def26..43d96a475b 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -497,11 +497,6 @@ module clubb_intr integer :: & cmfmc_sh_idx = 0 - integer :: & - mf_wpthlp_macmic_idx, & - mf_wprtp_macmic_idx, & - mf_wpthvp_macmic_idx - integer :: & prec_sh_idx, & snow_sh_idx @@ -666,9 +661,6 @@ subroutine clubb_register_cam( ) call add_hist_coord('nens', clubb_mf_nup, 'clubb+mf ensemble size') if (do_clubb_mf) then - call pbuf_add_field('edmf_thlflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthlp_macmic_idx) - call pbuf_add_field('edmf_qtflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wprtp_macmic_idx) - call pbuf_add_field('edmf_thvflx_macmic' ,'physpkg', dtype_r8, (/pcols,pverp*cld_macmic_num_steps/), mf_wpthvp_macmic_idx) call pbuf_add_field('ZTOPMN' ,'global' , dtype_r8, (/clubb_mf_up_ndt,pcols,clubb_mf_nup/), ztopmn_idx) call pbuf_add_field('ZTOPMA' ,'global' , dtype_r8, (/pcols,clubb_mf_nup/), ztopma_idx) call pbuf_add_field('ZTOP_MACMIC' ,'physpkg', dtype_r8, (/pcols,clubb_mf_nup/), ztopm1_macmic_idx) @@ -1867,8 +1859,6 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ('ELEAK_CLUBB', horiz_only, 'A', 'W/m2', 'CLUBB energy leak', sampled_on_subcycle=.true.) call addfld ('TFIX_CLUBB', horiz_only, 'A', 'K', 'Temperature increment to conserve energy', sampled_on_subcycle=.true.) - call addfld ('TKE_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'CLUBB tke on interface levels', sampled_on_subcycle=.true.) - ! ---------------------------------------------------------------------------- ! ! Below are for detailed analysis of EDMF Scheme ! ! ---------------------------------------------------------------------------- ! @@ -1945,9 +1935,6 @@ subroutine clubb_ini_cam(pbuf_ini) if (do_clubb_mf) then !jt call addfld( 'PRECSH', horiz_only, 'A', 'm/s', 'Shallow Convection precipitation rate' ) call addfld( 'SNOWSH', horiz_only, 'A', 'm/s', 'CLUBB-MF Snow precipitation rate' ) - call addfld ( 'edmf_thlflx_macmic', (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'thl flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_thvflx_macmic', (/ 'ilev', 'ncyc' /), 'A', 'K m/s' , 'thv flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtflx_macmic' , (/ 'ilev', 'ncyc' /), 'A', 'W/m2' , 'qt flux (EDMF) at macro/micro substep', sampled_on_subcycle=.true. ) end if if ( trim(subcol_scheme) /= 'SILHS' ) then @@ -2094,10 +2081,6 @@ subroutine clubb_ini_cam(pbuf_ini) call add_default( 'edmf_freq' , 1, ' ') call add_default( 'edmf_cape' , 1, ' ') call add_default( 'edmf_cfl' , 1, ' ') - - call add_default( 'edmf_thlflx_macmic' , 1, ' ') - call add_default( 'edmf_qtflx_macmic' , 1, ' ') - call add_default( 'edmf_thvflx_macmic' , 1, ' ') end if if (history_budget) then @@ -2352,14 +2335,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wp2thlp_pbuf ! w'^2 thl' (thermodynamic levels) real(r8), pointer, dimension(:,:) :: uprcp_pbuf ! < u' r_c' > (momentum levels) real(r8), pointer, dimension(:,:) :: vprcp_pbuf ! < v' r_c' > (momentum levels) - real(r8), pointer, dimension(:,:) :: rc_coef_pbuf ! Coef. of X'r_c' in Eq. (34) (t-levs.) real(r8), pointer, dimension(:,:) :: rc_coef_zm_pbuf ! Coef. of X'r_c' in Eq. (34) (t-levs.) real(r8), pointer, dimension(:,:) :: wp4_pbuf ! w'^4 (momentum levels real(r8), pointer, dimension(:,:) :: wpup2_pbuf ! w'u'^2 (thermodynamic levels) real(r8), pointer, dimension(:,:) :: wpvp2_pbuf ! w'v'^2 (thermodynamic levels) real(r8), pointer, dimension(:,:) :: wp2up2_pbuf ! w'^2 u'^2 (momentum levels) real(r8), pointer, dimension(:,:) :: wp2vp2_pbuf ! w'^2 v'^2 (momentum levels) - real(r8), pointer, dimension(:) :: ztodtptr_pbuf ! timestep to send to SILHS real(r8), pointer, dimension(:,:) :: cld_pbuf ! cloud fraction [fraction] real(r8), pointer, dimension(:,:) :: concld_pbuf ! convective cloud fraction [fraction] real(r8), pointer, dimension(:,:) :: ast_pbuf ! stratiform cloud fraction [fraction] @@ -2384,7 +2365,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: npccn_pbuf real(r8), pointer, dimension(:,:) :: prer_evap_pbuf real(r8), pointer, dimension(:,:) :: qrl_pbuf - real(r8), pointer, dimension(:,:) :: radf_clubb_pbuf ! SILHS covariance contributions real(r8), pointer, dimension(:,:) :: rtp2_mc_zt_pbuf @@ -2420,10 +2400,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer :: cbm1(:) real(r8), pointer :: cbm1_macmic(:) - real(r8), pointer :: mf_thlflx_macmic(:,:) - real(r8), pointer :: mf_qtflx_macmic(:,:) - real(r8), pointer :: mf_thvflx_macmic(:,:) - + ! ---------------------------------------------------- ! + ! Local Variables ! + ! ---------------------------------------------------- ! ! ! MF outputs to outfld real(r8), dimension(pcols) :: mf_ztop_output, mf_L0_output, & @@ -2437,48 +2416,46 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_sqtup_output, mf_sqtdn_output, & ! thermodynamic grid mf_qc_output, mf_cloudfrac_output ! thermodynamic grid -#ifdef CLUBB_SGS + integer :: i,l !Must be delcared outside "CLUBB_SGS" ifdef for det_s and det_ice zero-ing loops - ! MF plume level outputs - real(r8), dimension(pcols,pverp,clubb_mf_nup) :: mf_upa_flip, & - mf_upw_flip, & - mf_upmf_flip, & - mf_upqt_flip, & - mf_upthl_flip, & - mf_upthv_flip, & - mf_upth_flip, & - mf_upqc_flip, & - mf_upbuoy_flip, & - mf_upent_flip, & - mf_updet_flip - ! MF plume level outputs to outfld - real(r8), dimension(pcols,pverp*clubb_mf_nup) :: mf_upa_output, & - mf_upw_output, & - mf_upmf_output, & - mf_upqt_output, & - mf_upthl_output, & - mf_upthv_output, & - mf_upth_output, & - mf_upqc_output, & - mf_upent_output, & - mf_updet_output, & - mf_upbuoy_output - ! MF plume level outputs - real(r8), dimension(pcols,pverp,clubb_mf_nup) :: mf_dnw_flip, & - mf_dnthl_flip, & - mf_dnqt_flip +#ifdef CLUBB_SGS ! MF plume level outputs to outfld - real(r8), dimension(pcols,pverp*clubb_mf_nup) :: mf_dnw_output, & - mf_dnthl_output, & - mf_dnqt_output + real(r8), dimension(pcols,pverp*clubb_mf_nup) :: & + mf_upa_output, & + mf_upw_output, & + mf_upmf_output, & + mf_upqt_output, & + mf_upthl_output, & + mf_upthv_output, & + mf_upth_output, & + mf_upqc_output, & + mf_upent_output, & + mf_updet_output, & + mf_upbuoy_output, & + mf_dnw_output, & + mf_dnthl_output, & + mf_dnqt_output + + ! MF plume level work arrays + real(r8), dimension(pcols,pverp,clubb_mf_nup) :: & + mf_upa_flip, & + mf_upw_flip, & + mf_upmf_flip, & + mf_upqt_flip, & + mf_upthl_flip, & + mf_upthv_flip, & + mf_upth_flip, & + mf_upqc_flip, & + mf_upbuoy_flip, & + mf_upent_flip, & + mf_updet_flip, & + mf_dnw_flip, & + mf_dnthl_flip, & + mf_dnqt_flip - ! MF Plume real(r8), pointer :: tpert(:) - ! MF outputs to outfld - ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines - real(r8), dimension(state%ncol,nzm_clubb,clubb_mf_nup) :: & mf_upa, mf_dna, & mf_upw, mf_dnw, & @@ -2492,17 +2469,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_updet, & mf_upent - real(r8), dimension(state%ncol,pverp,clubb_mf_nup) :: flip - real(r8), dimension(state%ncol,pverp) :: rho, wpthvp_diag -#endif - ! ---------------------------------------------------- ! - ! Local Variables ! - ! ---------------------------------------------------- ! - - integer :: i,l !Must be delcared outside "CLUBB_SGS" ifdef for det_s and det_ice zero-ing loops - -#ifdef CLUBB_SGS - real(r8), parameter :: & rad2deg=180.0_r8/pi @@ -2589,6 +2555,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dz_g, & ! thickness of layer [m] invrs_dz_g, & ! Inverse of layer thickness [1/m] invrs_exner_zt, & ! thermodynamic grid + !MF Plume Variables on the thermodynamic grid. kappa_zt, & ! thermodynamic grid qc_zt, & ! thermodynamic grid th_zt, & ! thermodynamic grid @@ -2624,7 +2591,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtpthlp_mc, & zi_g, & ! Momentum grid of CLUBB [m] - ! MF Plume + ! MF Plume variables on momentum levels. mf_dry_a, mf_moist_a, & mf_dry_w, mf_moist_w, & mf_dry_qt, mf_moist_qt, & @@ -2786,7 +2753,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & clubb_s ! diagnosed dry static energy from clubb real(r8) :: & - inv_exner_tmp, & ! Inverse exner function consistent with CLUBB [-] dlf2, & ! Detraining cld H20 from shallow convection [kg/kg/day] dum1, & ! dummy variable [units vary] invrs_hdtime, & @@ -2858,9 +2824,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,pver) :: mq, mqsat real(r8), dimension(state%ncol) :: rhlev, rhinv - real(r8) :: inv_rh2o ! To reduce the number of divisions in clubb_tend - - call t_startf('clubb_tend_cam') do i = 1, pcols @@ -2968,9 +2931,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) if (do_clubb_mf) then - call pbuf_get_field(pbuf, mf_wpthlp_macmic_idx, mf_thlflx_macmic) - call pbuf_get_field(pbuf, mf_wprtp_macmic_idx, mf_qtflx_macmic) - call pbuf_get_field(pbuf, mf_wpthvp_macmic_idx, mf_thvflx_macmic) call pbuf_get_field(pbuf, tpert_idx, tpert) call pbuf_get_field(pbuf, ztopmn_idx, ztopmn) @@ -3925,11 +3885,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! pressure,exner on momentum grid needed for mass flux calc. - th_sfc(:) = 0._r8 th_sfc(1:ncol) = cam_in%ts(1:ncol)*invrs_exner_zm(1:ncol,nzm_clubb) - - !call calc_ustar( ncol, state_loc%t(:ncol,pver), state_loc%pmid(:ncol,pver), cam_in%wsx(:ncol), cam_in%wsy(:ncol), & - ! rrho(:ncol), ustar2(:ncol) ) ustar2(1:ncol) = calc_friction_velocity(cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), rrho(1:ncol)) if (t>1) then @@ -4611,7 +4567,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:do_cldcool') - end if + end if ! Check to see if stats should be output, here stats are read into ! output arrays to make them conformable to CAM output @@ -5555,12 +5511,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - if (do_clubb_mf) then - mf_thlflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_thlflx_output(:ncol,:pverp) - mf_qtflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_qtflx_output(:ncol,:pverp) - mf_thvflx_macmic(:ncol,pverp*(macmic_it-1)+1:pverp*macmic_it) = mf_thvflx_output(:ncol,:pverp) - end if - ! Convert RTP2 and THLP2 to thermo grid for output rtp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_pbuf(:ncol,:) ) thl2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_pbuf(:ncol,:) ) @@ -5677,7 +5627,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) call outfld( 'QSATFAC', qsatfac_pbuf, pcols, lchnk ) - call outfld( 'TKE_CLUBB', tke_pbuf, pcols, lchnk ) ! --------------------------------------------------------------- ! ! Writing state variables after EDMF scheme for detailed analysis ! @@ -5901,14 +5850,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'ICWMRSH' , sh_icwmr_pbuf, pcols, lchnk ) end if - if (macmic_it==cld_macmic_num_steps) then - if (do_clubb_mf) then - call outfld( 'edmf_thlflx_macmic' , mf_thlflx_macmic, pcols, lchnk ) - call outfld( 'edmf_qtflx_macmic' , mf_qtflx_macmic, pcols, lchnk ) - call outfld( 'edmf_thvflx_macmic' , mf_thvflx_macmic, pcols, lchnk ) - end if - end if - ! Output CLUBB history here if (stats_metadata%l_stats) then From e3bd61ad1521b080041bd52dd1d2cce0957a3b3a Mon Sep 17 00:00:00 2001 From: adamrher Date: Tue, 28 Jul 2026 11:49:57 -0600 Subject: [PATCH 14/63] cleaned up function arguments to integrate_mf --- src/physics/cam/clubb_intr.F90 | 90 +++++++++++++++++----------------- src/physics/cam/clubb_mf.F90 | 8 +-- 2 files changed, 51 insertions(+), 47 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 43d96a475b..519b399f77 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -3917,50 +3917,52 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & trop_mf = troplev(i) - call integrate_mf( nzm_clubb, nzt_clubb, & ! input - rho_zm(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - rho_zt(i,:), dz_g(i,:), zt_g(i,:), p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input - um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input - trop_mf, wm_zm(i,:), th_zt(i,:), qv_zt(i,:), qc_zt(i,:), & ! input - thlm_zm(i,:), rtm_zm(i,:), thv_ds_zm(i,:), & ! input - th_zm(i,:), qv_zm(i,:), qc_zm(i,:), & ! input - ustar2(i), th_sfc(i), wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input - wpthlp_pbuf(i,:), tke_pbuf(i,:), tpert(i), mf_ztopm1(i,:), rhinv(i), & ! input - wpthvp_pbuf(i,:), wprtp_pbuf(i,:), mf_cape(i,:), mf_ddcp(i,:), mf_cbm1(i), & ! output - plume diagnostics - mf_upa(i,:,:), mf_dna(i,:,:), & ! output - plume diagnostics - mf_upw(i,:,:), mf_dnw(i,:,:), & ! output - plume diagnostics - mf_upmf(i,:,:), & ! output - plume diagnostics - mf_upqt(i,:,:), mf_dnqt(i,:,:), & ! output - plume diagnostics - mf_upthl(i,:,:), mf_dnthl(i,:,:), & ! output - plume diagnostics - mf_upthv(i,:,:), mf_dnthv(i,:,:), & ! output - plume diagnostics - mf_upth(i,:,:), mf_dnth(i,:,:), & ! output - plume diagnostics - mf_upqc(i,:,:), mf_dnqc(i,:,:), & ! output - plume diagnostics - mf_upbuoy(i,:,:), & ! output - plume diagnostics - mf_upent(i,:,:), & ! output - plume diagnostics - mf_updet(i,:,:), & ! output - plume diagnostics - 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,:), & ! output - plume diagnostics - s_ac(i,:), s_aup(i,:), s_adn(i,:), & ! output - plume diagnostics - s_aw(i,:), s_awup(i,:), s_awdn(i,:), & ! output - plume diagnostics - s_aww(i,:), s_awwup(i,:), s_awwdn(i,:), & ! output - plume diagnostics - s_awthlup(i,:), s_awqtup(i,:), s_awuup(i,:), s_awvup(i,:), & ! output - plume diagnostics - s_awthldn(i,:), s_awqtdn(i,:), s_awudn(i,:), s_awvdn(i,:), & ! output - plume diagnostics - s_awthl(i,:), s_awqt(i,:), & ! output - plume diagnostics - s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics - mf_thlflxup(i,:), mf_qtflxup(i,:), mf_uflxup(i,:), mf_vflxup(i,:), & ! output - plume diagnostics - mf_thlflxdn(i,:), mf_qtflxdn(i,:), mf_uflxdn(i,:), mf_vflxdn(i,:), & ! output - plume diagnostics - mf_thlflx(i,:), mf_qtflx(i,:), mf_uflx(i,:), mf_vflx(i,:), & ! output - variables needed for solver - mf_thvflx(i,:), & ! output - plume diagnostics - mf_sqtup(i,:), mf_sthlup(i,:), & ! output - plume diagnostics - mf_sqtdn(i,:), mf_sthldn(i,:), & ! output - plume diagnostics - mf_sqt(i,:), mf_sthl(i,:), & ! output - variables needed for solver - mf_precc(i,:), & ! output - plume diagnostics + call integrate_mf( nzm_clubb, nzt_clubb, & ! input + rho_zm(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + rho_zt(i,:), dz_g(i,:), zt_g(i,:), p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input + trop_mf, wm_zm(i,:), th_zt(i,:), qv_zt(i,:), qc_zt(i,:), & ! input + thlm_zm(i,:), rtm_zm(i,:), thv_ds_zm(i,:), & ! input + th_zm(i,:), qv_zm(i,:), qc_zm(i,:), & ! input + ustar2(i), th_sfc(i), wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input + tke_pbuf(i,:), tpert(i), rhinv(i), & ! input + wpthlp_pbuf(i,:), wpthvp_pbuf(i,:), wprtp_pbuf(i,:), & ! input + mf_ztopm1(i,:), mf_ddcp(i,:), mf_cbm1(i), & ! in-out + mf_cape(i,:), & ! output + mf_upa(i,:,:), mf_dna(i,:,:), & ! output + mf_upw(i,:,:), mf_dnw(i,:,:), & ! output + mf_upmf(i,:,:), & ! output + mf_upqt(i,:,:), mf_dnqt(i,:,:), & ! output + mf_upthl(i,:,:), mf_dnthl(i,:,:), & ! output + mf_upthv(i,:,:), mf_dnthv(i,:,:), & ! output + mf_upth(i,:,:), mf_dnth(i,:,:), & ! output + mf_upqc(i,:,:), mf_dnqc(i,:,:), & ! output + mf_upbuoy(i,:,:), & ! output + mf_upent(i,:,:), & ! output + mf_updet(i,:,:), & ! output + mf_dry_a(i,:), mf_moist_a(i,:), & ! output + mf_dry_w(i,:), mf_moist_w(i,:), & ! output + mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output + mf_dry_thl(i,:), mf_moist_thl(i,:), & ! output + mf_dry_u(i,:), mf_moist_u(i,:), & ! output + mf_dry_v(i,:), mf_moist_v(i,:), & ! output + mf_moist_qc(i,:), & ! output + s_ae(i,:), & ! output + s_ac(i,:), s_aup(i,:), s_adn(i,:), & ! output + s_aw(i,:), s_awup(i,:), s_awdn(i,:), & ! output + s_aww(i,:), s_awwup(i,:), s_awwdn(i,:), & ! output + s_awthlup(i,:), s_awqtup(i,:), s_awuup(i,:), s_awvup(i,:), & ! output + s_awthldn(i,:), s_awqtdn(i,:), s_awudn(i,:), s_awvdn(i,:), & ! output + s_awthl(i,:), s_awqt(i,:), & ! output + s_awu(i,:), s_awv(i,:), & ! output + mf_thlflxup(i,:), mf_qtflxup(i,:), mf_uflxup(i,:), mf_vflxup(i,:), & ! output + mf_thlflxdn(i,:), mf_qtflxdn(i,:), mf_uflxdn(i,:), mf_vflxdn(i,:), & ! output + mf_thlflx(i,:), mf_qtflx(i,:), mf_uflx(i,:), mf_vflx(i,:), & ! output + mf_thvflx(i,:), & ! output + mf_sqtup(i,:), mf_sthlup(i,:), & ! output + mf_sqtdn(i,:), mf_sthldn(i,:), & ! output + mf_sqt(i,:), mf_sthl(i,:), & ! output + mf_precc(i,:), & ! output mf_ztop(i,:), mf_L0(i,:) ) end do diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 76bba553b3..214d7c730b 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -189,9 +189,11 @@ subroutine integrate_mf( nzm, nzt, ktropo, w, th, qv, qc, & ! input thl_zm, qt_zm, thv_zm, & ! input th_zm, qv_zm, qc_zm, & ! input - ustar, ths, wthl_sfc, wqt_sfc, pblh, & ! input - wpthlp_env, tke, tpert, ztopm1, rhinv, & ! input - wpthvp_env, wpqtp_env, mcape, ddcp, cbm1, & ! output + ustar, ths, wthl_sfc,wqt_sfc, pblh, & ! input + tke, tpert, rhinv, & ! input + wpthlp_env, wpthvp_env, wpqtp_env, & ! input + ztopm1, ddcp, cbm1, & ! inout + mcape, & ! output upa, dna, & ! output upw, dnw, & ! output upmf, & ! output From 923dcbbeace057414c1ac6c75b459ad1a0505075 Mon Sep 17 00:00:00 2001 From: adamrher Date: Wed, 29 Jul 2026 19:00:25 -0600 Subject: [PATCH 15/63] bug fixes needed to compile/run in debug mode --- bld/build-namelist | 2 + bld/namelist_files/namelist_defaults_cam.xml | 2 + bld/namelist_files/namelist_definition.xml | 12 + src/physics/cam/clubb_intr.F90 | 23 +- src/physics/cam/clubb_mf.F90 | 249 ++++++++++--------- 5 files changed, 159 insertions(+), 129 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index f014ce8091..ee5c2c0baa 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3708,6 +3708,8 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_mf_ddbeta'); add_default($nl, 'clubb_mf_pwfac'); add_default($nl, 'clubb_mf_ddexp'); + add_default($nl, 'clubb_mf_pwmin'); + add_default($nl, 'clubb_mf_pwmax'); add_default($nl, 'clubb_mf_cldfrac_fac'); add_default($nl, 'do_clubb_mf_ustar'); add_default($nl, 'do_clubb_mf_mixd'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 9abcdb5cd3..0390b6aa8e 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2371,6 +2371,8 @@ 1.0 1.0 3.0 + 1.5 + 3.0 1.0 .false. .false. diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 2929d085ad..a845b7631f 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4721,6 +4721,18 @@ Elevation power law exponent for downdrafts velocities in the subcloud layer Default: 3.0 + +Standardized lower limit of subgrid distribution for initializing plumes +Default: 1.5 + + + +Standarized upper limit of subgrid distribution for initializing plumes +Default: 3.0 + + Factor to increase the ensemble MF plume cloud fractions diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 519b399f77..838359721b 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1933,8 +1933,9 @@ subroutine clubb_ini_cam(pbuf_ini) end if if (do_clubb_mf) then +!+++arh PRECSH addfld is already in convect_shallow.F90 !jt call addfld( 'PRECSH', horiz_only, 'A', 'm/s', 'Shallow Convection precipitation rate' ) - call addfld( 'SNOWSH', horiz_only, 'A', 'm/s', 'CLUBB-MF Snow precipitation rate' ) +!arh call addfld( 'SNOWSH', horiz_only, 'A', 'm/s', 'CLUBB-MF Snow precipitation rate' ) end if if ( trim(subcol_scheme) /= 'SILHS' ) then @@ -2025,8 +2026,9 @@ subroutine clubb_ini_cam(pbuf_ini) end if if (do_clubb_mf_diag) then - call add_default('PRECSH', 1, ' ') - call add_default('SNOWSH', 1, ' ') +!+++arh PRECSH issue + !call add_default('PRECSH', 1, ' ') + !call add_default('SNOWSH', 1, ' ') call add_default( 'edmf_DRY_A' , 1, ' ') call add_default( 'edmf_MOIST_A' , 1, ' ') call add_default( 'edmf_DRY_W' , 1, ' ') @@ -2550,8 +2552,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pre, & ! input for precip evaporation qrl_clubb, & qclvar, & ! cloud water variance [kg^2/kg^2] + Lscale, & ! Length scale [m] zt_g, & ! Thermodynamic grid of CLUBB [m] - Lscale, & dz_g, & ! thickness of layer [m] invrs_dz_g, & ! Inverse of layer thickness [1/m] invrs_exner_zt, & ! thermodynamic grid @@ -2589,6 +2591,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprtp_mc, & wpthlp_mc, & rtpthlp_mc, & + Lscale_zm, & ! Length scale [m] zi_g, & ! Momentum grid of CLUBB [m] ! MF Plume variables on momentum levels. @@ -3349,6 +3352,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_ztop_nadv = 0._r8 mf_ztopm1 = 0._r8 mf_ztopm1_nadv = 0._r8 + mf_cape = 0._r8 mf_cape_nadv = 0._r8 mf_ddcp_nadv = 0._r8 mf_cbm1 = 0._r8 @@ -4595,12 +4599,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do if (do_clubb_mf .and. do_clubb_mf_addtke) then + Lscale_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, Lscale ) !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k khzm_pbuf(i,k_cam) = khzm(i,k) + & - clubb_params(i,ic_K) * Lscale(i,k) * sqrt(0.5_r8 * s_aww(i,k)) + clubb_params(i,ic_K) * Lscale_zm(i,k) * sqrt(0.5_r8 * s_aww(i,k)) end do end do else @@ -5779,8 +5784,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - call outfld( 'PRECSH' , prec_sh(:ncol), pcols, lchnk ) - call outfld( 'SNOWSH' , snow_sh(:ncol), pcols, lchnk ) +!+++arh PRECSH issue + !call outfld( 'PRECSH' , prec_sh(:ncol), pcols, lchnk ) + !call outfld( 'SNOWSH' , snow_sh(:ncol), pcols, lchnk ) call outfld( 'edmf_DRY_A' , mf_dry_a_output, pcols, lchnk ) call outfld( 'edmf_MOIST_A' , mf_moist_a_output, pcols, lchnk ) call outfld( 'edmf_DRY_W' , mf_dry_w_output, pcols, lchnk ) @@ -5849,7 +5855,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'edmf_freq' , mf_freq_output, pcols, lchnk ) call outfld( 'edmf_cape' , mf_cape_output, pcols, lchnk ) call outfld( 'edmf_cfl' , mf_cfl_output, pcols, lchnk ) - call outfld( 'ICWMRSH' , sh_icwmr_pbuf, pcols, lchnk ) +!+++arh no corresponding addfld call for ICWMRSH + !call outfld( 'ICWMRSH' , sh_icwmr_pbuf, pcols, lchnk ) end if ! Output CLUBB history here diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 214d7c730b..86fa14bbcc 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -53,6 +53,8 @@ module clubb_mf real(r8) :: clubb_mf_ddbeta = 0._r8 real(r8) :: clubb_mf_pwfac = 0._r8 real(r8) :: clubb_mf_ddexp = 0._r8 + real(r8) :: clubb_mf_pwmin = 0._r8 + real(r8) :: clubb_mf_pwmax = 0._r8 real(r8) :: clubb_mf_cldfrac_fac = 1._r8 integer :: clubb_mf_up_ndt = 1 integer :: clubb_mf_cp_ndt = 1 @@ -98,7 +100,7 @@ subroutine clubb_mf_readnl(nlfile) clubb_mf_fdd, do_clubb_mf_coldpool, clubb_mf_ddalph, clubb_mf_ddbeta, clubb_mf_pwfac, do_clubb_mf_ustar, & clubb_mf_ddexp, do_clubb_mf_mixd, clubb_mf_up_ndt, clubb_mf_cp_ndt, do_clubb_mf_rhtke, do_clubb_mf_cmt, & do_clubb_mf_coldpool_init, do_clubb_mf_coldpool_perplume, do_clubb_mf_lscale_perplume, clubb_mf_kseed, & - do_clubb_mf_addtke, do_clubb_mf_aloft, clubb_mf_cldfrac_fac + do_clubb_mf_addtke, do_clubb_mf_aloft, clubb_mf_pwmin, clubb_mf_pwmax, clubb_mf_cldfrac_fac if (masterproc) then open( newunit=iunit, file=trim(nlfile), status='old' ) @@ -172,6 +174,10 @@ subroutine clubb_mf_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_addtke") call mpi_bcast(do_clubb_mf_aloft, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_aloft") + call mpi_bcast(clubb_mf_pwmin, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_pwmin") + call mpi_bcast(clubb_mf_pwmax, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_pwmax") call mpi_bcast(clubb_mf_cldfrac_fac, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_cldfrac_fac") @@ -258,22 +264,22 @@ subroutine integrate_mf( nzm, nzt, integer, intent(in) :: nzm, nzt, ktropo real(r8), dimension(nzt), intent(in) :: u, v, & ! thermodynamic grid - thl, thv, & ! thermodynamic grid - th, qv, & ! thermodynamic grid - qt, qc, & ! thermodynamic grid - p_zt, iexner_zt, & ! thermodynamic grid - dzt, rho_zt, & ! thermodynamic grid - zt + thl, thv, & ! thermodynamic grid + th, qv, & ! thermodynamic grid + qt, qc, & ! thermodynamic grid + p_zt, iexner_zt, & ! thermodynamic grid + dzt, rho_zt, & ! thermodynamic grid + zt real(r8), dimension(nzm), intent(in) :: thl_zm, thv_zm, & ! momentum grid - w, & - th_zm, qv_zm, & - qt_zm, qc_zm, & ! momentum grid - p_zm, iexner_zm, & ! momentum grid - rho_zm, & ! momentum grid - zm, & ! momentum grid - tke, wpthlp_env, & ! momentum grid - wpthvp_env, wpqtp_env + w, & + th_zm, qv_zm, & + qt_zm, qc_zm, & ! momentum grid + p_zm, iexner_zm, & ! momentum grid + rho_zm, & ! momentum grid + zm, & ! momentum grid + tke, wpthlp_env, & ! momentum grid + wpthvp_env, wpqtp_env real(r8), intent(in) :: wthl_sfc,wqt_sfc real(r8), intent(in) :: pblh,tpert @@ -284,49 +290,49 @@ subroutine integrate_mf( nzm, nzt, real(r8),dimension(clubb_mf_nup), intent(inout) :: ztopm1,ddcp real(r8),dimension(nzm,clubb_mf_nup), intent(out) :: upa, & ! momentum grid - upw, & ! momentum grid - upmf, & ! momentum grid - upqt, & ! momentum grid - upthl, & ! momentum grid - upthv, & ! momentum grid - upth, & ! momentum grid - upqc, & ! momentum grid - upbuoy, & ! momentum grid - upent, & ! momentum grid - updet + upw, & ! momentum grid + upmf, & ! momentum grid + upqt, & ! momentum grid + upthl, & ! momentum grid + upthv, & ! momentum grid + upth, & ! momentum grid + upqc, & ! momentum grid + upbuoy, & ! momentum grid + upent, & ! momentum grid + updet real(r8),dimension(nzm,clubb_mf_nup), intent(out) :: dna, & ! momentum grid - dnw, & ! momentum grid - dnqt, & ! momentum grid - dnthl, & ! momentum grid - dnthv, & ! momentum grid - dnth, & ! momentum grid - dnqc + dnw, & ! momentum grid + dnqt, & ! momentum grid + dnthl, & ! momentum grid + dnthv, & ! momentum grid + dnth, & ! momentum grid + dnqc real(r8),dimension(nzm), intent(out) :: dry_a, moist_a, & ! momentum grid - dry_w, moist_w, & ! momentum grid - dry_qt, moist_qt, & ! momentum grid - dry_thl, moist_thl, & ! momentum grid - dry_u, moist_u, & ! momentum grid - dry_v, moist_v, & ! momentum grid - moist_qc ! momentum grid + dry_w, moist_w, & ! momentum grid + dry_qt, moist_qt, & ! momentum grid + dry_thl, moist_thl, & ! momentum grid + dry_u, moist_u, & ! momentum grid + dry_v, moist_v, & ! momentum grid + moist_qc ! momentum grid real(r8),dimension(nzm), intent(out) :: ae, & - ac, aup, adn, & - aw, awup, awdn, & - aww, awwup, awwdn, & - awthlup, awqtup, awuup, awvup, & ! momentum grid - awthldn, awqtdn, awudn, awvdn, & ! momentum grid - awthl, awqt, & ! momentum grid - awu, awv, & ! momentum grid - thlflxup,qtflxup, uflxup, vflxup, & ! momentum grid - thlflxdn,qtflxdn, uflxdn, vflxdn, & ! momentum grid - thlflx, qtflx, uflx, vflx, & ! momentum grid - thvflx, precc + ac, aup, adn, & + aw, awup, awdn, & + aww, awwup, awwdn, & + awthlup, awqtup, awuup, awvup, & ! momentum grid + awthldn, awqtdn, awudn, awvdn, & ! momentum grid + awthl, awqt, & ! momentum grid + awu, awv, & ! momentum grid + thlflxup,qtflxup, uflxup, vflxup, & ! momentum grid + thlflxdn,qtflxdn, uflxdn, vflxdn, & ! momentum grid + thlflx, qtflx, uflx, vflx, & ! momentum grid + thvflx, precc real(r8),dimension(nzt), intent(out) :: sqtup, sthlup, & ! thermodynamic grid - sqtdn, sthldn, & ! thermodynamic grid - sqt, sthl ! thermodynamic grid + sqtdn, sthldn, & ! thermodynamic grid + sqt, sthl ! thermodynamic grid real(r8),dimension(clubb_mf_nup), intent(out) :: ztop, dynamic_L0, mcape @@ -366,29 +372,31 @@ subroutine integrate_mf( nzm, nzt, integer :: ksfcm, ktopm, ksfct, ktopt, kdir, kt, kn, kt_up, kt_dn ! sums over all plumes - real(r8), dimension(nzm) :: moist_th, dry_th, & - thl_env, qt_env, & - thv_env, & - thvflxup, thvflxdn, & - awthvup, awthvdn + real(r8), dimension(nzm) :: moist_th, dry_th, & + thl_env, qt_env, & + thv_env, & + thvflxup, thvflxdn, & + awthvup, awthvdn ! updraft properties - real(r8), dimension(nzm,clubb_mf_nup) :: upqv, upqs, & ! momentum grid - upql, upqi, & ! momentum grid - upu, upv, & ! momentum grid - uplmix, upauto ! momentum grid + real(r8), dimension(nzm,clubb_mf_nup) :: upqv, upqs, & ! momentum grid + upql, upqi, & ! momentum grid + upu, upv, & ! momentum grid + uplmix, upauto ! momentum grid ! downdraft properties - real(r8), dimension(nzm,clubb_mf_nup) :: dnqs, & ! momentum grid - dnql, dnqi, & ! momentum grid - dnu, dnv, & ! momentum grid - dnlmix ! momentum grid + real(r8), dimension(nzm,clubb_mf_nup) :: dnqs, & ! momentum grid + dnql, dnqi, & ! momentum grid + dnu, dnv, & ! momentum grid + dnlmix ! momentum grid ! microphyiscs terms - real(r8), dimension(nzt,clubb_mf_nup) :: supqt, supthl, & ! thermodynamic grid - sdnqt, sdnthl, & ! thermodynamic grid - uprr, dnrr + real(r8), dimension(nzt,clubb_mf_nup) :: supqt, supthl, & ! thermodynamic grid + sdnqt, sdnthl ! thermodynamic grid + ! precipitation rates + real(r8), dimension(nzm,clubb_mf_nup) :: uprr, dnrr ! momentum grid + ! ! entrainment profiles - real(r8), dimension(nzt,clubb_mf_nup) :: entf, mix ! thermodynamic grid - integer, dimension(nzt,clubb_mf_nup) :: enti ! thermodynamic grid - + real(r8), dimension(nzt,clubb_mf_nup) :: entf, mix ! thermodynamic grid + integer, dimension(nzt,clubb_mf_nup) :: enti ! thermodynamic grid + ! ! other variables integer :: k,i,kstart,ddtop,kcb,kpbl,kmid,nbot integer, dimension(clubb_mf_nup) :: ddbot,kcbarr @@ -418,13 +426,6 @@ subroutine integrate_mf( nzm, nzt, zsub, wcb, rh_L0, & dzext - real(r8), dimension(nzt-1,1) :: dmpdz - real(r8), dimension(1) :: tl, & - cape, cin - integer, dimension(1) :: lcl, lel - real(r8) :: landfrac - integer :: msg, & - lon, mx ! limit convective area logical :: limarea = .false. real(r8),parameter :: amax = 0.6_r8 @@ -444,56 +445,63 @@ subroutine integrate_mf( nzm, nzt, thln0, qtn0, wn0, & entn, detn, mfn, & ee2, ud2 - + ! aloft trigger flag + logical :: aloft = .false. + ! rng seed real(r8), dimension(4) :: u_seed - - ! parameters defining initial conditions for updrafts - real(r8),parameter :: pwmin = 1.5_r8, & - pwmax = 3._r8 - + ! alpha relates star qunataties to stddev after Suselj etal 2019 - real(r8),parameter :: alphw = 0.572_r8, & - alphqt = 2.890_r8, & - alphthv = 2.890_r8 + real(r8),parameter :: alphw = 0.572_r8, & + alphqt = 2.890_r8, & + alphthv = 2.890_r8 ! w' covariance after Suselj etal 2019 - real(r8),parameter :: cwqt = 0.32_r8, & - cwthv = 0.58_r8 + real(r8),parameter :: cwqt = 0.32_r8, & + cwthv = 0.58_r8 ! virtual mass coefficients for w-eqn after Suselj etal 2019 - real(r8),parameter :: wa = 1.0_r8, & - wb = 1.5_r8 + real(r8),parameter :: wa = 1.0_r8, & + wb = 1.5_r8 ! min values to avoid singularities - real(r8),parameter :: wstarmin = 1.e-3_r8, & - pblhmin = 100._r8 + real(r8),parameter :: wstarmin = 1.e-3_r8, & + pblhmin = 100._r8 ! evaporation efficiency after Suselj etal 2019 - real(r8),parameter :: ke = 2.5e-4_r8 + real(r8),parameter :: ke = 2.5e-4_r8 + ! ! height here downdrafts feel the surface - real(r8),parameter :: z00dn = 1.e3_r8, & - tinynum = 1.e-7_r8 + real(r8),parameter :: z00dn = 1.e3_r8, & + tinynum = 1.e-7_r8 ! to fix entrainmnet rate - logical :: fixent = .false. + logical :: fixent = .false. + ! ! fixed entrainment rate - real(r8),parameter :: fixent_ent = 2.e-4_r8 + real(r8),parameter :: fixent_ent = 2.e-4_r8 + ! ! Arakawa and Schubert detrainment limiter - logical :: do_aspd = .false. + logical :: do_aspd = .false. + ! ! Lower limit on entrainment length scale - real(r8),parameter :: min_L0 = 0.5_r8 + real(r8),parameter :: min_L0 = 0.5_r8 + ! ! limiter for tke enahnced fractional entrainment ! (only used when do_aspd = .true.) - real(r8),parameter :: max_eturb = 10._r8 + real(r8),parameter :: max_eturb = 10._r8 + ! ! to condensate or not to condensate - logical :: do_condensation = .true. + logical :: do_condensation = .true. + ! ! use implicit method for plume updraft velocity - logical :: do_implicit = .false. + logical :: do_implicit = .false. + ! ! to scale surface fluxes - logical :: scalesrf = .false. + logical :: scalesrf = .false. + ! ! minimum downdraft speed - real(r8),parameter :: mindnw = 1.E-2_r8 + real(r8),parameter :: mindnw = 1.E-2_r8 + ! ! limiter on cold pool effects - real(r8),parameter :: max_cpfac = 5._r8 + real(r8),parameter :: max_cpfac = 5._r8 + ! ! max limiter on cold pool init effects - real(r8),parameter :: max_cpinit = 0.5_r8 - ! to scale surface fluxes - logical :: aloft = .false. + real(r8),parameter :: max_cpinit = 0.5_r8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! @@ -733,8 +741,8 @@ subroutine integrate_mf( nzm, nzt, sigmathv = alphthv * abs(thvstar) end if - wmin = sigmaw * pwmin - wmax = sigmaw * pwmax + wmin = sigmaw * clubb_mf_pwmin + wmax = sigmaw * clubb_mf_pwmax wlv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * (real(i-1, r8)) wtv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * real(i,r8) @@ -1161,16 +1169,16 @@ subroutine integrate_mf( nzm, nzt, sevap = ke*(1._r8 - qtovqs)*sqrt(max(uprr(k,i),0._r8)) ! limit evaporation to available precip - sevap = min(sevap,( uprr(k,i)/(rho_zt(kt)*dzt(kt)) - supqt(k,i)*(1._r8-clubb_mf_fdd) )) + sevap = min(sevap,( uprr(k,i)/(rho_zt(kt)*dzt(kt)) - supqt(kt,i)*(1._r8-clubb_mf_fdd) )) ! get rain rate uprr(kn,i) = uprr(k,i) & - - rho_zt(kt)*dzt(kt)*( supqt(k,i)*(1._r8-clubb_mf_fdd) + sevap ) + - rho_zt(kt)*dzt(kt)*( supqt(kt,i)*(1._r8-clubb_mf_fdd) + sevap ) ! update source terms lmixt = 0.5_r8*(uplmix(k,i)+uplmix(kn,i)) - supqt(k,i) = supqt(k,i) + sevap - supthl(k,i) = supthl(k,i) - lmixt*sevap*iexner_zt(kt)/cpair + supqt(kt,i) = supqt(kt,i) + sevap + supthl(kt,i) = supthl(kt,i) - lmixt*sevap*iexner_zt(kt)/cpair end do end do end if @@ -1243,12 +1251,12 @@ subroutine integrate_mf( nzm, nzt, sthlint = -1._r8*latvap*sqtint*iexner_zt(kt)/cpair ! get rain evaporation in tendency form - sdnqt(kn,i) = max( (dnqs(k,i) - dnqt(k,i))*taum1, 0._r8 ) - sdnthl(kn,i) = -1._r8*latvap*sdnqt(kn,i)*iexner_zt(kt)/cpair + sdnqt(kt,i) = max( (dnqs(k,i) - dnqt(k,i))*taum1, 0._r8 ) + sdnthl(kt,i) = -1._r8*latvap*sdnqt(kt,i)*iexner_zt(kt)/cpair ! compute rain rate (rain above - evaporation + appropriate updraft rain) dnrr(kn,i) = max( dnrr(k,i) & - - rho_zt(kt)*dzt(kt)*(sdnqt(kn,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) + - rho_zt(kt)*dzt(kt)*(sdnqt(kt,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) ! include eturb? entexp = exp(-1._r8*entn*eturb*dzt(kt)) @@ -1278,18 +1286,18 @@ subroutine integrate_mf( nzm, nzt, ! find new evap tendency if ((alphint - 1._r8) /= 0._r8) then qtmp = dnqs(k,i) + sqtint/(alphint - 1._r8) - sdnqt(kn,i) = max( (dnqs(k,i) - qtmp)*taum1, 0._r8 ) + sdnqt(kt,i) = max( (dnqs(k,i) - qtmp)*taum1, 0._r8 ) else - sdnqt(kn,i) = 0._r8 + sdnqt(kt,i) = 0._r8 end if - sdnthl(kn,i) = -1._r8*latvap*sdnqt(kn,i)*iexner_zt(kt)/cpair + sdnthl(kt,i) = -1._r8*latvap*sdnqt(kt,i)*iexner_zt(kt)/cpair ! re-compute thl with new evaporation rate dnthl(kn,i) = thl(kt)*(1._r8-entexp ) + dnthl(k,i)*entexp + sthlint ! adjust rain dnrr(kn,i) = max( dnrr(k,i) & - - rho_zt(kt)*dzt(kt)*(sdnqt(kn,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) + - rho_zt(kt)*dzt(kt)*(sdnqt(kt,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) end if ! get virtual temperature @@ -1727,7 +1735,6 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, ! intialize local variables cape = 0._r8 - mcape = 0._r8 dmpdz = 0._r8 if (zt(1) < zt(nzt)) then From c1f47721c5c3669a93ed224fdc8f83581f7f3a77 Mon Sep 17 00:00:00 2001 From: adamrher Date: Wed, 29 Jul 2026 19:25:47 -0600 Subject: [PATCH 16/63] corrected upauto array to be on thermo levels -- changes are bfb --- src/physics/cam/clubb_mf.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 86fa14bbcc..0b611726c6 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -381,7 +381,7 @@ subroutine integrate_mf( nzm, nzt, real(r8), dimension(nzm,clubb_mf_nup) :: upqv, upqs, & ! momentum grid upql, upqi, & ! momentum grid upu, upv, & ! momentum grid - uplmix, upauto ! momentum grid + uplmix ! momentum grid ! downdraft properties real(r8), dimension(nzm,clubb_mf_nup) :: dnqs, & ! momentum grid dnql, dnqi, & ! momentum grid @@ -389,7 +389,8 @@ subroutine integrate_mf( nzm, nzt, dnlmix ! momentum grid ! microphyiscs terms real(r8), dimension(nzt,clubb_mf_nup) :: supqt, supthl, & ! thermodynamic grid - sdnqt, sdnthl ! thermodynamic grid + sdnqt, sdnthl, & ! thermodynamic grid + upauto ! thermodynamic grid ! precipitation rates real(r8), dimension(nzm,clubb_mf_nup) :: uprr, dnrr ! momentum grid ! @@ -1055,7 +1056,7 @@ subroutine integrate_mf( nzm, nzt, ! convert source terms to a tendency (convert from S*dz/w to S) supqt(kt,i) = supqt(kt,i)*upw(k,i)/dzt(kt) - upauto(kn,i) = supqt(kt,i) + upauto(kt,i) = supqt(kt,i) supthl(kt,i) = supthl(kt,i)*upw(k,i)/dzt(kt) ! get cloud, momentum levels @@ -1221,7 +1222,7 @@ subroutine integrate_mf( nzm, nzt, dnthv(ddtop,i) = thv_zm(ddtop) ! includes condensate loading (!) ! get rain generated in the updraft, appropriate it to the downdraft - dnrr(ddtop,i) = -1._r8*dzt(ddtop - (1+kdir)/2)*rho_zt(ddtop - (1+kdir)/2)*upauto(ddtop,i)*clubb_mf_fdd + dnrr(ddtop,i) = -1._r8*dzt(ddtop - (1+kdir)/2)*rho_zt(ddtop - (1+kdir)/2)*upauto(ddtop - (1+kdir)/2,i)*clubb_mf_fdd if (fixent) then entn = fixent_ent @@ -1256,7 +1257,7 @@ subroutine integrate_mf( nzm, nzt, ! compute rain rate (rain above - evaporation + appropriate updraft rain) dnrr(kn,i) = max( dnrr(k,i) & - - rho_zt(kt)*dzt(kt)*(sdnqt(kt,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) + - rho_zt(kt)*dzt(kt)*(sdnqt(kt,i) + upauto(kt,i)*clubb_mf_fdd) , 0._r8 ) ! include eturb? entexp = exp(-1._r8*entn*eturb*dzt(kt)) @@ -1297,7 +1298,7 @@ subroutine integrate_mf( nzm, nzt, ! adjust rain dnrr(kn,i) = max( dnrr(k,i) & - - rho_zt(kt)*dzt(kt)*(sdnqt(kt,i) + upauto(k,i)*clubb_mf_fdd) , 0._r8 ) + - rho_zt(kt)*dzt(kt)*(sdnqt(kt,i) + upauto(kt,i)*clubb_mf_fdd) , 0._r8 ) end if ! get virtual temperature From 7845522c8b43b9f364bb951df22779155897e525 Mon Sep 17 00:00:00 2001 From: adamrher Date: Thu, 30 Jul 2026 11:40:42 -0600 Subject: [PATCH 17/63] fix longstanding bug in initializing dnrr --- src/physics/cam/clubb_mf.F90 | 47 ++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 23 deletions(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 0b611726c6..1228a0ae26 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -399,8 +399,8 @@ subroutine integrate_mf( nzm, nzt, integer, dimension(nzt,clubb_mf_nup) :: enti ! thermodynamic grid ! ! other variables - integer :: k,i,kstart,ddtop,kcb,kpbl,kmid,nbot - integer, dimension(clubb_mf_nup) :: ddbot,kcbarr + integer :: k,i,kstart,ddtopm,kcb,kpbl,kmid,nbot + integer, dimension(clubb_mf_nup) :: ddbotm,kcbarr real(r8), dimension(clubb_mf_nup) :: zcb,cpfac real(r8) :: zcb_unset, & wthv_sfc, wthv, wqt, & @@ -641,7 +641,7 @@ subroutine integrate_mf( nzm, nzt, dynamic_L0 = 0._r8 ztop = 0._r8 - ddbot= 0 + ddbotm = 0 if (bsort) then niter_xc = 3 @@ -1194,35 +1194,36 @@ subroutine integrate_mf( nzm, nzt, ! find cloud base do k = ksfcm, ktopm, kdir if (upqc(k,i) > 0._r8) then - ddbot(i) = k + ddbotm(i) = k exit end if end do ! find cloud top - ddtop = 0 + ddtopm = 0 do k = ksfcm, ktopm, kdir - if (uprr(k,i) > 0._r8) ddtop = k + if (uprr(k,i) > 0._r8) ddtopm = k end do - if (ddtop /= 0) then + if (ddtopm /= 0) then ! initilaize downdrafts ! Kay initializes using negative of the updraft velocity ! this causes anomalouly large downdrafts at the initializaiton level ! I am intializing with zero velocity as that is more physically defensible - dnw(ddtop,i) = -1._r8*mindnw - dna(ddtop,i) = upa(ddtop,i) - dnu(ddtop,i) = 0.5_r8*(u(ddtop - (1-kdir)/2)+u(ddtop - (1+kdir)/2)) - dnv(ddtop,i) = 0.5_r8*(v(ddtop - (1-kdir)/2)+v(ddtop - (1+kdir)/2)) - dnqt(ddtop,i) = qt_zm(ddtop) + dnw(ddtopm,i) = -1._r8*mindnw + dna(ddtopm,i) = upa(ddtopm,i) + dnu(ddtopm,i) = 0.5_r8*(u(ddtopm - (1-kdir)/2)+u(ddtopm - (1+kdir)/2)) + dnv(ddtopm,i) = 0.5_r8*(v(ddtopm - (1-kdir)/2)+v(ddtopm - (1+kdir)/2)) + dnqt(ddtopm,i) = qt_zm(ddtopm) ! no cloud in downdrafts, set to cloud free thl - dnthl(ddtop,i) = thl_zm(ddtop) - dnthv(ddtop,i) = thv_zm(ddtop) ! includes condensate loading (!) + dnthl(ddtopm,i) = thl_zm(ddtopm) + dnthv(ddtopm,i) = thv_zm(ddtopm) ! includes condensate loading (!) ! get rain generated in the updraft, appropriate it to the downdraft - dnrr(ddtop,i) = -1._r8*dzt(ddtop - (1+kdir)/2)*rho_zt(ddtop - (1+kdir)/2)*upauto(ddtop - (1+kdir)/2,i)*clubb_mf_fdd + ! (we are using an upward sweep notation to be consistent with how uprr(ddtop) was computed) + dnrr(ddtopm,i) = -1._r8*dzt(ddtopm - (1-kdir)/2)*rho_zt(ddtopm - (1-kdir)/2)*upauto(ddtopm - (1-kdir)/2,i)*clubb_mf_fdd if (fixent) then entn = fixent_ent @@ -1232,9 +1233,9 @@ subroutine integrate_mf( nzm, nzt, end if ! downdraft qsat - call qsat(dnthl(ddtop,i)/iexner_zm(ddtop),p_zm(ddtop),es,dnqs(ddtop,i)) + call qsat(dnthl(ddtopm,i)/iexner_zm(ddtopm),p_zm(ddtopm),es,dnqs(ddtopm,i)) - do k = ddtop, ksfcm+kdir, -kdir + do k = ddtopm, ksfcm+kdir, -kdir kt = k - (1+kdir)/2 kn = k - kdir @@ -1304,7 +1305,7 @@ subroutine integrate_mf( nzm, nzt, ! get virtual temperature dnthv(kn,i) = dnthl(kn,i)*(1._r8+zvir*dnqt(kn,i)) - if ((kn - ddbot(i))*kdir > 0) then + if ((kn - ddbotm(i))*kdir > 0) then ! get virtual temperature dnthv(kn,i) = dnthl(kn,i)*(1._r8+zvir*dnqt(kn,i)) @@ -1326,8 +1327,8 @@ subroutine integrate_mf( nzm, nzt, dnw(kn,i) = -1._r8*sqrt(wn2) else - zsub = zm(ddbot(i)+kdir) - wcb = dnw(ddbot(i)+kdir,i) + zsub = zm(ddbotm(i)+kdir) + wcb = dnw(ddbotm(i)+kdir,i) dnw(kn,i) = wcb - (wcb/(zsub**clubb_mf_ddexp))*(zsub - zm(kn))**clubb_mf_ddexp dnw(kn,i) = min(dnw(kn,i),-1._r8*mindnw) end if @@ -1601,13 +1602,13 @@ subroutine integrate_mf( nzm, nzt, ! use single level for cold pool param. ! reset ddcp do i=1,clubb_mf_nup - if (ddbot(i) == 0) then + if (ddbotm(i) == 0) then continue else if (do_clubb_mf_coldpool_perplume) then - ddcp(i) = -1._r8*dnw(ddbot(i)+kdir,i) + ddcp(i) = -1._r8*dnw(ddbotm(i)+kdir,i) else - ddcp(:) = -1._r8*dna(ddbot(i)+kdir,i)*dnw(ddbot(i)+kdir,i) + ddcp(:) + ddcp(:) = -1._r8*dna(ddbotm(i)+kdir,i)*dnw(ddbotm(i)+kdir,i) + ddcp(:) end if end if end do From 0a1cd7ec163cf3c79918f8f38c0d2a4f59686da9 Mon Sep 17 00:00:00 2001 From: adamrher Date: Thu, 30 Jul 2026 13:59:26 -0600 Subject: [PATCH 18/63] fix awu output --- src/physics/cam/clubb_intr.F90 | 8 +------- src/physics/cam/clubb_mf.F90 | 3 +-- 2 files changed, 2 insertions(+), 9 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 838359721b..c8b4e9a244 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2625,8 +2625,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qc, mf_cloudfrac, & mf_qc_nadv, mf_cloudfrac_nadv, & mf_qc_zt, mf_cloudfrac_zt, & - mf_rcm, mf_rcm_nadv, & - mf_ent_nadv, & + mf_rcm, mf_rcm_nadv ! MF local momentum vars rtm_zm, thlm_zm, & ! momentum grid @@ -3387,7 +3386,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qtforcdn_nadv(:ncol,:nzt_clubb) = 0._r8 mf_thlforc_nadv(:ncol,:nzt_clubb) = 0._r8 mf_qtforc_nadv(:ncol,:nzt_clubb) = 0._r8 - mf_ent_nadv(:ncol,:nzm_clubb) = 0._r8 max_cfl_nadv(:ncol) = 0._r8 end if @@ -4088,8 +4086,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thlforc_nadv(i,:nzt_clubb) = mf_thlforc_nadv(i,:nzt_clubb) + thlm_forcing(i,:nzt_clubb) mf_qtforc_nadv(i,:nzt_clubb) = mf_qtforc_nadv(i,:nzt_clubb) + rtm_forcing(i,:nzt_clubb) - mf_ent_nadv(i,:nzm_clubb) = mf_ent_nadv(i,:nzm_clubb) + s_awu(i,:nzm_clubb) - max_cfl_nadv(i) = MAX(max_cfl(i),max_cfl_nadv(i)) end do call t_stopf('clubb_tend_cam:do_clubb_mf') @@ -5071,8 +5067,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thlforc_nadv(:ncol,:nzt_clubb) = mf_thlforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_ent_nadv(:ncol,:nzm_clubb) = mf_ent_nadv(:ncol,:nzm_clubb)/REAL(nadv) - end if !clubbmf ! Need moist_qc and cloudfrac on thermo grid for output diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 1228a0ae26..2cd1d16e8e 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1479,8 +1479,7 @@ subroutine integrate_mf( nzm, nzt, aw (k) = awup(k)+ awdn(k) aww(k) = awwup(k)+ awwdn(k) - if (aloft) awu(k) = 1._r8 - + awu(k) = awuup(k)+ awudn(k) awv(k) = awvup(k)+ awvdn(k) enddo From f911cf4ec280da3fc5f8e3b8eaabd6da2b46ee80 Mon Sep 17 00:00:00 2001 From: adamrher Date: Thu, 30 Jul 2026 14:11:47 -0600 Subject: [PATCH 19/63] remove xx_forcing variables from being flipped for clubb call --- src/physics/cam/clubb_intr.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index c8b4e9a244..53b947441e 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -4105,10 +4105,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:ascending_grid_flip') - thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) - rtm_forcing = rtm_forcing(:,nzt_clubb:1:-1) - um_forcing = um_forcing(:,nzt_clubb:1:-1) - vm_forcing = vm_forcing(:,nzt_clubb:1:-1) wm_zt = wm_zt(:,nzt_clubb:1:-1) rho_zt = rho_zt(:,nzt_clubb:1:-1) rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) @@ -4340,10 +4336,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! so we need to flip them back. This section should flip every array that was flipped ! before the advance_clubb_core call. - thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) - rtm_forcing = rtm_forcing(:,nzt_clubb:1:-1) - um_forcing = um_forcing(:,nzt_clubb:1:-1) - vm_forcing = vm_forcing(:,nzt_clubb:1:-1) wm_zt = wm_zt(:,nzt_clubb:1:-1) rho_zt = rho_zt(:,nzt_clubb:1:-1) rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) From 39958d26e26c83483cf618dba972b3a27b0ef192 Mon Sep 17 00:00:00 2001 From: adamrher Date: Thu, 30 Jul 2026 18:45:16 -0600 Subject: [PATCH 20/63] fix bug added in last commit --- src/physics/cam/clubb_intr.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 53b947441e..b1b27d3cc1 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2625,7 +2625,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qc, mf_cloudfrac, & mf_qc_nadv, mf_cloudfrac_nadv, & mf_qc_zt, mf_cloudfrac_zt, & - mf_rcm, mf_rcm_nadv + mf_rcm, mf_rcm_nadv, & ! MF local momentum vars rtm_zm, thlm_zm, & ! momentum grid From 981825f0c48b3347941540ed9f7f208b27fb0b3a Mon Sep 17 00:00:00 2001 From: adamrher Date: Sat, 1 Aug 2026 09:40:07 -0600 Subject: [PATCH 21/63] mods to run clubb-mf w/ ascending + debug=T, although still not bfb w/ descending --- src/physics/cam/clubb_intr.F90 | 792 +++++++++++++++++++++------------ src/physics/cam/clubb_mf.F90 | 21 +- 2 files changed, 507 insertions(+), 306 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index b1b27d3cc1..3d1d92e168 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2557,6 +2557,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dz_g, & ! thickness of layer [m] invrs_dz_g, & ! Inverse of layer thickness [1/m] invrs_exner_zt, & ! thermodynamic grid + !MF Plume Variables on the thermodynamic grid. kappa_zt, & ! thermodynamic grid qc_zt, & ! thermodynamic grid @@ -2566,7 +2567,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thlforcdn, mf_qtforcdn, & !applied to a mean state variable (like $\theta_l$ or $q_t$) mf_thlforcup_nadv,mf_qtforcup_nadv, & !fundamentally represents the volumetric change inside a cell. mf_thlforcdn_nadv,mf_qtforcdn_nadv, & !All forcing variables belong strictly on the - mf_thlforc_nadv, mf_qtforc_nadv !thermodynamic grid (nzt_clubb). + mf_thlforc_nadv, mf_qtforc_nadv, & !thermodynamic grid (nzt_clubb). + mf_sqtup, mf_sthlup, & + mf_sqtdn, mf_sthldn, & + mf_sqt, mf_sthl real(r8), dimension(state%ncol,nzm_clubb) :: & thlp2_rad, & @@ -2612,9 +2616,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_awthldn, s_awqtdn, s_awudn, s_awvdn, & s_awthl, s_awqt, & s_awu, s_awv, & - mf_sqtup, mf_sthlup, & - mf_sqtdn, mf_sthldn, & - mf_sqt, mf_sthl, & mf_precc, & ! MF work arrays (of size NCOL) @@ -2632,6 +2633,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & th_zm, qv_zm, & ! momentum grid qc_zm, & ! momentum grid kappa_zm, p_in_Pa_zm, & ! momentum grid + tke_zm, & ! momentum grid invrs_exner_zm ! momentum grid real(r8), dimension(state%ncol,nzt_clubb,sclr_dim) :: & @@ -2795,6 +2797,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & errflg, & j, k, t, ixind, nadv, n, & ! Loop variables k_cam, k_clubb, sclr, iedsclr, & ! Loop variables + k_above, k_below, & ! Interfaces bounding thermo level k (MF precip sweep) ixcldice, ixcldliq, ixnumliq, & ixnumice, ixq, & itim_old, & @@ -2811,7 +2814,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! CFL limiter vars real(r8), parameter :: cflval = 1._r8 - integer :: trop_mf real(r8) :: lambda real(r8), dimension(state%ncol) :: cflfac, max_cfl, & th_sfc, max_cfl_nadv @@ -3612,7 +3614,22 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k - p_in_Pa_zm(i,k) = state_loc%pint(i,k_cam) + p_in_Pa_zm(i,k) = state_loc%pint(i,k_cam) + + ! NOTE: the 'tke' pbuf field is dimensioned (pcols,pverp) rather than + ! (pcols,nzm_clubb), so unlike every other input to integrate_mf it is + ! NOT already restricted to the CLUBB sub-column. The physically + ! correct index would be k_cam, but the legacy call passed + ! tke_pbuf(i,:) into an nzm-sized dummy, which sequence-associates + ! elements 1..nzm_clubb. Indexing with k reproduces that exactly, so + ! descending-grid results stay bit-for-bit for any top_lev, and the + ! ascending grid becomes its exact mirror image. + ! + ! TODO: for top_lev > 1 this is misaligned by top_lev-1 levels (and + ! the top top_lev-1 entries are never written by the fill loop over + ! k = top_lev, pverp). Switch to tke_pbuf(i,k_cam) as a separate, + ! deliberately non-bit-for-bit commit. + tke_zm(i,k) = tke_pbuf(i,k) end do end do @@ -3854,29 +3871,207 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & stats_metadata ) endif + if ( clubb_l_ascending_grid ) then + + ! CLUBB is to be run in ascending mode, which has the surface at k=1, which is + ! the opposite of the cam grid that the rest of clubb_intr uses, so + ! we need to flip the fields (in the vertical dimensions) before calling advance_clubb_core + ! + ! NOTE: We do not neccesarily flip all arrays, only ones that are used within this + ! subroutine (advance_clubb_core). For example, only the pdf_params fields that + ! are used within this subroutine (or used in a subroutine we call) need to + ! be flipped. + + call t_startf('clubb_tend_cam:ascending_grid_flip') + + wm_zt = wm_zt(:,nzt_clubb:1:-1) + rho_zt = rho_zt(:,nzt_clubb:1:-1) + rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) + invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) + thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) + khzt = khzt(:,nzt_clubb:1:-1) + rtm_ref = rtm_ref(:,nzt_clubb:1:-1) + thlm_ref = thlm_ref(:,nzt_clubb:1:-1) + um_ref = um_ref(:,nzt_clubb:1:-1) + vm_ref = vm_ref(:,nzt_clubb:1:-1) + ug = ug(:,nzt_clubb:1:-1) + vg = vg(:,nzt_clubb:1:-1) + p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) + exner = exner(:,nzt_clubb:1:-1) + rfrzm = rfrzm(:,nzt_clubb:1:-1) + um = um(:,nzt_clubb:1:-1) + vm = vm(:,nzt_clubb:1:-1) + up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) + vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) + wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) + rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) + thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) + rcm = rcm(:,nzt_clubb:1:-1) + cloud_frac = cloud_frac(:,nzt_clubb:1:-1) + wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) + wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) + wp2rtp_pbuf = wp2rtp_pbuf(:,nzt_clubb:1:-1) + wp2thlp_pbuf = wp2thlp_pbuf(:,nzt_clubb:1:-1) + ice_supersat_frac_pbuf = ice_supersat_frac_pbuf(:,nzt_clubb:1:-1) + um_pert = um_pert(:,nzt_clubb:1:-1) + vm_pert = vm_pert(:,nzt_clubb:1:-1) + wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) + wp2up_pbuf = wp2up_pbuf(:,nzt_clubb:1:-1) + rtm = rtm(:,nzt_clubb:1:-1) + thlm = thlm(:,nzt_clubb:1:-1) + + ! flipping grid defintion + zt_g = zt_g(:,nzt_clubb:1:-1) + + if (do_clubb_mf) then + dz_g = dz_g(:,nzt_clubb:1:-1) + invrs_dz_g = invrs_dz_g(:,nzt_clubb:1:-1) + th_zt = th_zt(:,nzt_clubb:1:-1) + qv_zt = qv_zt(:,nzt_clubb:1:-1) + qc_zt = qc_zt(:,nzt_clubb:1:-1) + kappa_zt = kappa_zt(:,nzt_clubb:1:-1) + invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) + end if + + wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) + wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) + rtp2_forcing = rtp2_forcing(:,nzm_clubb:1:-1) + thlp2_forcing = thlp2_forcing(:,nzm_clubb:1:-1) + rtpthlp_forcing = rtpthlp_forcing(:,nzm_clubb:1:-1) + wm_zm = wm_zm(:,nzm_clubb:1:-1) + rho_zm = rho_zm(:,nzm_clubb:1:-1) + rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) + invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) + thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) + upwp_pbuf = upwp_pbuf(:,nzm_clubb:1:-1) + vpwp_pbuf = vpwp_pbuf(:,nzm_clubb:1:-1) + up2_pbuf = up2_pbuf(:,nzm_clubb:1:-1) + vp2_pbuf = vp2_pbuf(:,nzm_clubb:1:-1) + wprtp_pbuf = wprtp_pbuf(:,nzm_clubb:1:-1) + wpthlp_pbuf = wpthlp_pbuf(:,nzm_clubb:1:-1) + wp2_pbuf = wp2_pbuf(:,nzm_clubb:1:-1) + rtp2_pbuf = rtp2_pbuf(:,nzm_clubb:1:-1) + thlp2_pbuf = thlp2_pbuf(:,nzm_clubb:1:-1) + rtpthlp_pbuf = rtpthlp_pbuf(:,nzm_clubb:1:-1) + wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) + rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) + thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) + uprcp_pbuf = uprcp_pbuf(:,nzm_clubb:1:-1) + vprcp_pbuf = vprcp_pbuf(:,nzm_clubb:1:-1) + rc_coef_zm_pbuf = rc_coef_zm_pbuf(:,nzm_clubb:1:-1) + wp4_pbuf = wp4_pbuf(:,nzm_clubb:1:-1) + wp2up2_pbuf = wp2up2_pbuf(:,nzm_clubb:1:-1) + wp2vp2_pbuf = wp2vp2_pbuf(:,nzm_clubb:1:-1) + upwp_pert = upwp_pert(:,nzm_clubb:1:-1) + vpwp_pert = vpwp_pert(:,nzm_clubb:1:-1) + + ! flipping grid defintion + zi_g = zi_g(:,nzm_clubb:1:-1) + + if (do_clubb_mf) then + p_in_Pa_zm = p_in_Pa_zm(:,nzm_clubb:1:-1) + tke_zm = tke_zm(:,nzm_clubb:1:-1) + end if + + if ( edsclr_dim > 0 ) then + edsclr = edsclr(:,nzt_clubb:1:-1,:) + edsclrm_forcing = edsclrm_forcing(:,nzt_clubb:1:-1,:) + end if + + if ( sclr_dim > 0 ) then + + sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) + sclrm = sclrm(:,nzt_clubb:1:-1,:) + sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) + + sclrp2 = sclrp2(:,nzm_clubb:1:-1,:) + sclrprtp = sclrprtp(:,nzm_clubb:1:-1,:) + sclrpthlp = sclrpthlp(:,nzm_clubb:1:-1,:) + wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) + sclrpthvp = sclrpthvp(:,nzm_clubb:1:-1,:) + end if + + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. + ! only because these are need to be stored for restarts + if ( clubb_config_flags%l_call_pdf_closure_twice ) then + pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + end if + + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. + ! only for pdfp_rtp2_output calc + pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) + + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. + ! only for update_xp2_mc_api call + pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) + + ! These are flipped for silhs, which uses a cam grid + pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cloud_frac_1 = pdf_params_chnk(lchnk)%cloud_frac_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cloud_frac_2 = pdf_params_chnk(lchnk)%cloud_frac_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%chi_1 = pdf_params_chnk(lchnk)%chi_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%chi_2 = pdf_params_chnk(lchnk)%chi_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%stdev_chi_1 = pdf_params_chnk(lchnk)%stdev_chi_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%stdev_chi_2 = pdf_params_chnk(lchnk)%stdev_chi_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%crt_1 = pdf_params_chnk(lchnk)%crt_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%crt_2 = pdf_params_chnk(lchnk)%crt_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cthl_1 = pdf_params_chnk(lchnk)%cthl_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cthl_2 = pdf_params_chnk(lchnk)%cthl_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%ice_supersat_frac_1 = pdf_params_chnk(lchnk)%ice_supersat_frac_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%ice_supersat_frac_2 = pdf_params_chnk(lchnk)%ice_supersat_frac_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_chi_eta_1 = pdf_params_chnk(lchnk)%corr_chi_eta_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2 (:,nzt_clubb:1:-1) + + + call cleanup_grid_api( gr ) + + ! we are in ascending mode, need to recalculate gr in ascending mode + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + clubb_l_ascending_grid, grid_type, & ! intent(in) + deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) + zi_g, zt_g, & ! intent(in) + gr, err_info ) ! intent(inout) + + call t_stopf('clubb_tend_cam:ascending_grid_flip') + + end if + !####################################################################### !###################### CALL MF DIAGNOSTIC PLUMES ###################### !####################################################################### if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') - !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists - troplev(:) = 0 - !REMOVECAM_END - call tropopause_findChemTrop( state_loc, troplev ) - rtm_zm(:,:) = 0._r8 + rtm_zm(:,:) = 0._r8 thlm_zm(:,:) = 0._r8 - th_zm(:,:) = 0._r8 - qv_zm(:,:) = 0._r8 - qc_zm(:,:) = 0._r8 + th_zm(:,:) = 0._r8 + qv_zm(:,:) = 0._r8 + qc_zm(:,:) = 0._r8 + ! fields on momentum grid needed for mass flux calc. rtm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm(:ncol,:) ) thlm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm(:ncol,:) ) th_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, th_zt(:ncol,:) ) qv_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qv_zt(:ncol,:) ) qc_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qc_zt(:ncol,:) ) - - ! exner on momentum grid needed for mass flux calc. kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt ) do k = 1, nzm_clubb @@ -3885,14 +4080,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - ! pressure,exner on momentum grid needed for mass flux calc. + ! theta at surface needed for plume initialization. + ! gr%k_lb_zm is the surface (lower boundary) momentum index: 1 for an + ! ascending grid, nzm_clubb for a descending grid. + th_sfc(1:ncol) = cam_in%ts(1:ncol)*invrs_exner_zm(1:ncol,gr%k_lb_zm) - th_sfc(1:ncol) = cam_in%ts(1:ncol)*invrs_exner_zm(1:ncol,nzm_clubb) + ! friction velocity needed for clubb-mf ustar2(1:ncol) = calc_friction_velocity(cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), rrho(1:ncol)) + ! update thv if clubb is subcycled if (t>1) then - ! update thv if clubb is subcycled - do i = 1, ncol + do i = 1, ncol thv_ds_zt(i,:) = thlm(i,:) & + latvap*rcm(i,:)*invrs_exner_zt(i,:)/cpair thv_ds_zt(i,:) = thv_ds_zt(i,:) & @@ -3901,10 +4099,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thv_ds_zm(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thv_ds_zt(1:ncol,:) ) end if + ! set memory terms mf_ztopm1(1:ncol,:) = ztopma(1:ncol,:) mf_ddcp(1:ncol,:) = ddcp(1:ncol,:) mf_cbm1(1:ncol) = cbm1(1:ncol) + ! inverse rh needed for entrainment rate rhinv(1:ncol) = 0._r8 do i = 1, ncol if (rhlev(i) >= 1._r8) rhlev(i) = 0.990_r8 @@ -3917,17 +4117,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol - trop_mf = troplev(i) - call integrate_mf( nzm_clubb, nzt_clubb, & ! input rho_zm(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input rho_zt(i,:), dz_g(i,:), zt_g(i,:), p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input - trop_mf, wm_zm(i,:), th_zt(i,:), qv_zt(i,:), qc_zt(i,:), & ! input + wm_zm(i,:), th_zt(i,:), qv_zt(i,:), qc_zt(i,:), & ! input thlm_zm(i,:), rtm_zm(i,:), thv_ds_zm(i,:), & ! input th_zm(i,:), qv_zm(i,:), qc_zm(i,:), & ! input ustar2(i), th_sfc(i), wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input - tke_pbuf(i,:), tpert(i), rhinv(i), & ! input + tke_zm(i,:), tpert(i), rhinv(i), & ! input wpthlp_pbuf(i,:), wpthvp_pbuf(i,:), wprtp_pbuf(i,:), & ! input mf_ztopm1(i,:), mf_ddcp(i,:), mf_cbm1(i), & ! in-out mf_cape(i,:), & ! output @@ -3972,7 +4170,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! CFL limiter cfllim = .true. cflfac(:ncol) = 1._r8 - s_aw(:ncol,nzm_clubb) = 0._r8 + ! no mass flux through the ground; gr%k_lb_zm is the surface momentum + ! index (1 ascending, nzm_clubb descending) + s_aw(:ncol,gr%k_lb_zm) = 0._r8 max_cfl(:ncol)= 0._r8 do i=1,ncol do k=1,nzt_clubb @@ -3996,12 +4196,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - ! Recalculate precip using new microphys forcing + ! Recalculate precip using new microphys forcing. + ! Precip accumulates downward across the interfaces, starting from zero + ! at the model top, so the sweep must run top-to-bottom in ALTITUDE + ! rather than in index order: from gr%k_ub_zt to gr%k_lb_zt with a step + ! of -gr%grid_dir_indx (+1 descending, -1 ascending). For thermodynamic + ! level k the bounding interfaces are k+(1+kdir)/2 above and + ! k+(1-kdir)/2 below, which reduce to k and k+1 on a descending grid, + ! recovering the original loop exactly. mf_precc(:ncol,:) = 0._r8 - do k = 1, nzt_clubb + do k = gr%k_ub_zt, gr%k_lb_zt, -gr%grid_dir_indx + k_above = k + ( 1 + gr%grid_dir_indx ) / 2 + k_below = k + ( 1 - gr%grid_dir_indx ) / 2 do i = 1, ncol - ! Precip accumulates downward across the interfaces - mf_precc(i,k+1) = mf_precc(i,k) - rho_zt(i,k)*dz_g(i,k)*mf_sqt(i,k) + mf_precc(i,k_below) = mf_precc(i,k_above) - rho_zt(i,k)*dz_g(i,k)*mf_sqt(i,k) end do end do @@ -4018,43 +4226,43 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! pass MF turbulent advection term as CLUBB explicit forcing term do k = 1, nzt_clubb do i = 1, ncol - rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflx(i,k+1))) & + rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_qtflx(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflx(i,k))) & + mf_sqt(i,k) - thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflx(i,k+1))) & + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_thlflx(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflx(i,k))) & + mf_sthl(i,k) - mf_qtforcup(i,k) = mf_qtforcup(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k) * mf_qtflxup(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflxup(i,k+1))) & + mf_qtforcup(i,k) = mf_qtforcup(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_qtflxup(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflxup(i,k))) & + mf_sqtup(i,k) - mf_thlforcup(i,k) = mf_thlforcup(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k) * mf_thlflxup(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflxup(i,k+1))) & + mf_thlforcup(i,k) = mf_thlforcup(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_thlflxup(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflxup(i,k))) & + mf_sthlup(i,k) - mf_qtforcdn(i,k) = mf_qtforcdn(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k) * mf_qtflxdn(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflxdn(i,k+1))) & + mf_qtforcdn(i,k) = mf_qtforcdn(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_qtflxdn(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflxdn(i,k))) & + mf_sqtdn(i,k) - mf_thlforcdn(i,k) = mf_thlforcdn(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k) * mf_thlflxdn(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflxdn(i,k+1))) & + mf_thlforcdn(i,k) = mf_thlforcdn(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_thlflxdn(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflxdn(i,k))) & + mf_sthldn(i,k) end do end do + ! convective momentum transport if (do_clubb_mf_cmt) then - ! convective momentum transport um_forcing(:ncol,:) = 0._r8 vm_forcing(:ncol,:) = 0._r8 do k = 1, nzt_clubb do i = 1, ncol - um_forcing(i,k) = um_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k) * mf_uflx(i,k)) - (rho_ds_zm(i,k+1) * mf_uflx(i,k+1))) + um_forcing(i,k) = um_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_uflx(i,k+1)) - (rho_ds_zm(i,k) * mf_uflx(i,k))) - vm_forcing(i,k) = vm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k) * mf_vflx(i,k)) - (rho_ds_zm(i,k+1) * mf_vflx(i,k+1))) + vm_forcing(i,k) = vm_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_vflx(i,k+1)) - (rho_ds_zm(i,k) * mf_vflx(i,k))) end do end do end if @@ -4065,8 +4273,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_rcm_nadv(i,:nzm_clubb) = mf_rcm_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb)*mf_moist_qc(i,:nzm_clubb) mf_cloudfrac_nadv(i,:nzm_clubb) = mf_cloudfrac_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb) - ! [kg/m2/s]->[m/s] - mf_precc_nadv(i) = mf_precc_nadv(i) + mf_precc(i,nzm_clubb)/1000._r8 + ! surface precip, [kg/m2/s]->[m/s] + mf_precc_nadv(i) = mf_precc_nadv(i) + mf_precc(i,gr%k_lb_zm)/1000._r8 mf_snow_nadv(i) = 0._r8 ! accumulate over nadv subcycles @@ -4091,169 +4299,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:do_clubb_mf') end if - - if ( clubb_l_ascending_grid ) then - - ! CLUBB is to be run in ascending mode, which has the surface at k=1, which is - ! the opposite of the cam grid that the rest of clubb_intr uses, so - ! we need to flip the fields (in the vertical dimensions) before calling advance_clubb_core - ! - ! NOTE: We do not neccesarily flip all arrays, only ones that are used within this - ! subroutine (advance_clubb_core). For example, only the pdf_params fields that - ! are used within this subroutine (or used in a subroutine we call) need to - ! be flipped. - - call t_startf('clubb_tend_cam:ascending_grid_flip') - - wm_zt = wm_zt(:,nzt_clubb:1:-1) - rho_zt = rho_zt(:,nzt_clubb:1:-1) - rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) - invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) - thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) - khzt = khzt(:,nzt_clubb:1:-1) - rtm_ref = rtm_ref(:,nzt_clubb:1:-1) - thlm_ref = thlm_ref(:,nzt_clubb:1:-1) - um_ref = um_ref(:,nzt_clubb:1:-1) - vm_ref = vm_ref(:,nzt_clubb:1:-1) - ug = ug(:,nzt_clubb:1:-1) - vg = vg(:,nzt_clubb:1:-1) - p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) - exner = exner(:,nzt_clubb:1:-1) - rfrzm = rfrzm(:,nzt_clubb:1:-1) - um = um(:,nzt_clubb:1:-1) - vm = vm(:,nzt_clubb:1:-1) - up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) - vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) - wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) - rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) - thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) - rcm = rcm(:,nzt_clubb:1:-1) - cloud_frac = cloud_frac(:,nzt_clubb:1:-1) - wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) - wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) - wp2rtp_pbuf = wp2rtp_pbuf(:,nzt_clubb:1:-1) - wp2thlp_pbuf = wp2thlp_pbuf(:,nzt_clubb:1:-1) - ice_supersat_frac_pbuf = ice_supersat_frac_pbuf(:,nzt_clubb:1:-1) - um_pert = um_pert(:,nzt_clubb:1:-1) - vm_pert = vm_pert(:,nzt_clubb:1:-1) - wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) - wp2up_pbuf = wp2up_pbuf(:,nzt_clubb:1:-1) - rtm = rtm(:,nzt_clubb:1:-1) - thlm = thlm(:,nzt_clubb:1:-1) - - wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) - wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) - rtp2_forcing = rtp2_forcing(:,nzm_clubb:1:-1) - thlp2_forcing = thlp2_forcing(:,nzm_clubb:1:-1) - rtpthlp_forcing = rtpthlp_forcing(:,nzm_clubb:1:-1) - wm_zm = wm_zm(:,nzm_clubb:1:-1) - rho_zm = rho_zm(:,nzm_clubb:1:-1) - rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) - invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) - thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) - upwp_pbuf = upwp_pbuf(:,nzm_clubb:1:-1) - vpwp_pbuf = vpwp_pbuf(:,nzm_clubb:1:-1) - up2_pbuf = up2_pbuf(:,nzm_clubb:1:-1) - vp2_pbuf = vp2_pbuf(:,nzm_clubb:1:-1) - wprtp_pbuf = wprtp_pbuf(:,nzm_clubb:1:-1) - wpthlp_pbuf = wpthlp_pbuf(:,nzm_clubb:1:-1) - wp2_pbuf = wp2_pbuf(:,nzm_clubb:1:-1) - rtp2_pbuf = rtp2_pbuf(:,nzm_clubb:1:-1) - thlp2_pbuf = thlp2_pbuf(:,nzm_clubb:1:-1) - rtpthlp_pbuf = rtpthlp_pbuf(:,nzm_clubb:1:-1) - wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) - rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) - thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) - uprcp_pbuf = uprcp_pbuf(:,nzm_clubb:1:-1) - vprcp_pbuf = vprcp_pbuf(:,nzm_clubb:1:-1) - rc_coef_zm_pbuf = rc_coef_zm_pbuf(:,nzm_clubb:1:-1) - wp4_pbuf = wp4_pbuf(:,nzm_clubb:1:-1) - wp2up2_pbuf = wp2up2_pbuf(:,nzm_clubb:1:-1) - wp2vp2_pbuf = wp2vp2_pbuf(:,nzm_clubb:1:-1) - upwp_pert = upwp_pert(:,nzm_clubb:1:-1) - vpwp_pert = vpwp_pert(:,nzm_clubb:1:-1) - - if ( edsclr_dim > 0 ) then - edsclr = edsclr(:,nzt_clubb:1:-1,:) - edsclrm_forcing = edsclrm_forcing(:,nzt_clubb:1:-1,:) - end if - - if ( sclr_dim > 0 ) then - - sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) - sclrm = sclrm(:,nzt_clubb:1:-1,:) - sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) - - sclrp2 = sclrp2(:,nzm_clubb:1:-1,:) - sclrprtp = sclrprtp(:,nzm_clubb:1:-1,:) - sclrpthlp = sclrpthlp(:,nzm_clubb:1:-1,:) - wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) - sclrpthvp = sclrpthvp(:,nzm_clubb:1:-1,:) - end if - - ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. - ! only because these are need to be stored for restarts - if ( clubb_config_flags%l_call_pdf_closure_twice ) then - pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) - end if - - ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. - ! only for pdfp_rtp2_output calc - pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) - - ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. - ! only for update_xp2_mc_api call - pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) - - ! These are flipped for silhs, which uses a cam grid - pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%cloud_frac_1 = pdf_params_chnk(lchnk)%cloud_frac_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%cloud_frac_2 = pdf_params_chnk(lchnk)%cloud_frac_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%chi_1 = pdf_params_chnk(lchnk)%chi_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%chi_2 = pdf_params_chnk(lchnk)%chi_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%stdev_chi_1 = pdf_params_chnk(lchnk)%stdev_chi_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%stdev_chi_2 = pdf_params_chnk(lchnk)%stdev_chi_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%crt_1 = pdf_params_chnk(lchnk)%crt_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%crt_2 = pdf_params_chnk(lchnk)%crt_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%cthl_1 = pdf_params_chnk(lchnk)%cthl_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%cthl_2 = pdf_params_chnk(lchnk)%cthl_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%ice_supersat_frac_1 = pdf_params_chnk(lchnk)%ice_supersat_frac_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%ice_supersat_frac_2 = pdf_params_chnk(lchnk)%ice_supersat_frac_2(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%corr_chi_eta_1 = pdf_params_chnk(lchnk)%corr_chi_eta_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2 (:,nzt_clubb:1:-1) - - - call cleanup_grid_api( gr ) - - ! we are in ascending mode, need to recalculate gr in ascending mode - call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - clubb_l_ascending_grid, grid_type, & ! intent(in) - deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) - zi_g(:,nzm_clubb:1:-1), zt_g(:,nzt_clubb:1:-1), & ! intent(in) - gr, err_info ) ! intent(inout) - - call t_stopf('clubb_tend_cam:ascending_grid_flip') - - end if - ! Advance CLUBB CORE one timestep in the future call t_startf('clubb_tend_cam:advance_clubb_core_api') @@ -4336,6 +4381,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! so we need to flip them back. This section should flip every array that was flipped ! before the advance_clubb_core call. +!+++ arh -- reverting this as I think they do need to be flipped to descending grid for correct diagnostic output + thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) + rtm_forcing = rtm_forcing(:,nzt_clubb:1:-1) + um_forcing = um_forcing(:,nzt_clubb:1:-1) + vm_forcing = vm_forcing(:,nzt_clubb:1:-1) + +!+++ arh -- I think we should do the array flipping for all clubb-mf variables here, around a do_clubb_mf if statement + mf_qtforcup = mf_qtforcup(:,nzt_clubb:1:-1) + mf_thlforcup = mf_thlforcup(:,nzt_clubb:1:-1) + mf_qtforcdn = mf_qtforcdn(:,nzt_clubb:1:-1) + mf_thlforcdn = mf_thlforcdn(:,nzt_clubb:1:-1) + wm_zt = wm_zt(:,nzt_clubb:1:-1) rho_zt = rho_zt(:,nzt_clubb:1:-1) rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) @@ -4380,6 +4437,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlm = thlm(:,nzt_clubb:1:-1) Lscale = Lscale(:,nzt_clubb:1:-1) + ! flipping grid definition + zt_g = zt_g(:,nzt_clubb:1:-1) + + if (do_clubb_mf) then + dz_g = dz_g(:,nzt_clubb:1:-1) + invrs_dz_g = invrs_dz_g(:,nzt_clubb:1:-1) + th_zt = th_zt(:,nzt_clubb:1:-1) + qv_zt = qv_zt(:,nzt_clubb:1:-1) + qc_zt = qc_zt(:,nzt_clubb:1:-1) + kappa_zt = kappa_zt(:,nzt_clubb:1:-1) + invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) + end if + wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) rtp2_forcing = rtp2_forcing(:,nzm_clubb:1:-1) @@ -4416,6 +4486,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprcp = wprcp(:,nzm_clubb:1:-1) invrs_tau_zm = invrs_tau_zm(:,nzm_clubb:1:-1) + ! flipping grid definition + zi_g = zi_g(:,nzm_clubb:1:-1) + + if (do_clubb_mf) then + p_in_Pa_zm = p_in_Pa_zm(:,nzm_clubb:1:-1) + tke_zm = tke_zm(:,nzm_clubb:1:-1) + end if + if ( edsclr_dim > 0 ) then edsclr = edsclr(:,nzt_clubb:1:-1,:) edsclrm_forcing = edsclrm_forcing(:,nzt_clubb:1:-1,:) @@ -4577,6 +4655,108 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ! end time loop !----------------------------------------- END substepping loop ----------------------------------------- + if ( clubb_l_ascending_grid .and. do_clubb_mf ) then + + ! integrate_mf leaves its output in ascending order, but the diagnostic + ! mapping further down (mf_*_output(i,k) = mf_*(i,k_clubb), with + ! k_clubb = k + 1 - top_lev) assumes the descending host-model convention. + ! Restore descending order here so that everything downstream of the + ! substepping loop can assume the host convention, as the rest of this + ! module does. + ! + ! This is done once per physics step rather than inside the per-substep + ! flip-back block, because only the final substep's values reach the + ! output mapping. Note that some of those expressions pair an MF flux with + ! rho_zm, which is already restored to descending, so flipping here also + ! fixes that mixed-orientation product. + + call t_startf('clubb_tend_cam:ascending_grid_flip') + + ! MF plume ensemble means on momentum levels + mf_dry_a = mf_dry_a(:,nzm_clubb:1:-1) + mf_moist_a = mf_moist_a(:,nzm_clubb:1:-1) + mf_dry_w = mf_dry_w(:,nzm_clubb:1:-1) + mf_moist_w = mf_moist_w(:,nzm_clubb:1:-1) + mf_dry_qt = mf_dry_qt(:,nzm_clubb:1:-1) + mf_moist_qt = mf_moist_qt(:,nzm_clubb:1:-1) + mf_dry_thl = mf_dry_thl(:,nzm_clubb:1:-1) + mf_moist_thl = mf_moist_thl(:,nzm_clubb:1:-1) + mf_dry_u = mf_dry_u(:,nzm_clubb:1:-1) + mf_moist_u = mf_moist_u(:,nzm_clubb:1:-1) + mf_dry_v = mf_dry_v(:,nzm_clubb:1:-1) + mf_moist_v = mf_moist_v(:,nzm_clubb:1:-1) + mf_moist_qc = mf_moist_qc(:,nzm_clubb:1:-1) + + ! Sub-plume moment sums on momentum levels + s_ae = s_ae(:,nzm_clubb:1:-1) + s_aw = s_aw(:,nzm_clubb:1:-1) + s_aww = s_aww(:,nzm_clubb:1:-1) + s_awthl = s_awthl(:,nzm_clubb:1:-1) + s_awthlup = s_awthlup(:,nzm_clubb:1:-1) + s_awthldn = s_awthldn(:,nzm_clubb:1:-1) + s_awqt = s_awqt(:,nzm_clubb:1:-1) + s_awqtup = s_awqtup(:,nzm_clubb:1:-1) + s_awqtdn = s_awqtdn(:,nzm_clubb:1:-1) + s_awu = s_awu(:,nzm_clubb:1:-1) + s_awuup = s_awuup(:,nzm_clubb:1:-1) + s_awudn = s_awudn(:,nzm_clubb:1:-1) + s_awv = s_awv(:,nzm_clubb:1:-1) + s_awvup = s_awvup(:,nzm_clubb:1:-1) + s_awvdn = s_awvdn(:,nzm_clubb:1:-1) + + ! MF fluxes on momentum levels + mf_thlflx = mf_thlflx(:,nzm_clubb:1:-1) + mf_thlflxup = mf_thlflxup(:,nzm_clubb:1:-1) + mf_thlflxdn = mf_thlflxdn(:,nzm_clubb:1:-1) + mf_qtflx = mf_qtflx(:,nzm_clubb:1:-1) + mf_qtflxup = mf_qtflxup(:,nzm_clubb:1:-1) + mf_qtflxdn = mf_qtflxdn(:,nzm_clubb:1:-1) + mf_uflx = mf_uflx(:,nzm_clubb:1:-1) + mf_uflxup = mf_uflxup(:,nzm_clubb:1:-1) + mf_uflxdn = mf_uflxdn(:,nzm_clubb:1:-1) + mf_vflx = mf_vflx(:,nzm_clubb:1:-1) + mf_vflxup = mf_vflxup(:,nzm_clubb:1:-1) + mf_vflxdn = mf_vflxdn(:,nzm_clubb:1:-1) + mf_thvflx = mf_thvflx(:,nzm_clubb:1:-1) + + mf_precc = mf_precc(:,nzm_clubb:1:-1) + + ! Plume microphysics source terms on thermodynamic levels, needed for + ! edmf_sqtup / edmf_sqtdn. + mf_sqtup = mf_sqtup(:,nzt_clubb:1:-1) + mf_sqtdn = mf_sqtdn(:,nzt_clubb:1:-1) + + ! NOTE: mf_rcm needs no flip here -- it is overwritten from mf_rcm_nadv + ! below, and that accumulator is flipped at the end of this block. + + ! Per-plume profiles on momentum levels + mf_upa = mf_upa(:,nzm_clubb:1:-1,:) + mf_upw = mf_upw(:,nzm_clubb:1:-1,:) + mf_upmf = mf_upmf(:,nzm_clubb:1:-1,:) + mf_upqt = mf_upqt(:,nzm_clubb:1:-1,:) + mf_upthl = mf_upthl(:,nzm_clubb:1:-1,:) + mf_upthv = mf_upthv(:,nzm_clubb:1:-1,:) + mf_upth = mf_upth(:,nzm_clubb:1:-1,:) + mf_upqc = mf_upqc(:,nzm_clubb:1:-1,:) + mf_upbuoy = mf_upbuoy(:,nzm_clubb:1:-1,:) + mf_upent = mf_upent(:,nzm_clubb:1:-1,:) + mf_updet = mf_updet(:,nzm_clubb:1:-1,:) + mf_dnw = mf_dnw(:,nzm_clubb:1:-1,:) + mf_dnthl = mf_dnthl(:,nzm_clubb:1:-1,:) + mf_dnqt = mf_dnqt(:,nzm_clubb:1:-1,:) + + ! Substep accumulators for the cloud fields. These are flipped so that the + ! zm2zt_api call below sees descending data against the descending gr that + ! was restored at the end of the last substep; without this the + ! interpolation weights would not match the data. + mf_qc_nadv = mf_qc_nadv(:,nzm_clubb:1:-1) + mf_rcm_nadv = mf_rcm_nadv(:,nzm_clubb:1:-1) + mf_cloudfrac_nadv = mf_cloudfrac_nadv(:,nzm_clubb:1:-1) + + call t_stopf('clubb_tend_cam:ascending_grid_flip') + + end if + !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb @@ -4647,6 +4827,95 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + ! process clubb-mf accumulated arrays + if (do_clubb_mf) then + ! average over nadv + mf_L0_nadv = mf_L0_nadv/REAL(nadv) + mf_ztop_nadv = mf_ztop_nadv/REAL(nadv) + mf_ztopm1_nadv = mf_ztopm1_nadv/REAL(nadv) + mf_cape_nadv = mf_cape_nadv/REAL(nadv) + mf_ddcp_nadv = mf_ddcp_nadv/REAL(nadv) + mf_cbm1_nadv = mf_cbm1_nadv/REAL(nadv) + mf_freq_nadv = mf_freq_nadv/REAL(nadv) + + ! accumulate in buffer + ztopm1_macmic(:ncol,:) = ztopm1_macmic(:ncol,:) + mf_ztopm1_nadv(:ncol,:) + ddcp_macmic(:ncol,:) = ddcp_macmic(:ncol,:) + mf_ddcp_nadv(:ncol,:) + cbm1_macmic(:ncol) = cbm1_macmic(:ncol) + mf_cbm1_nadv(:ncol) + + if (macmic_it == cld_macmic_num_steps) then + + cbm1(:ncol) = cbm1_macmic(:ncol)/REAL(cld_macmic_num_steps) + + if (clubb_mf_up_ndt == 1) then + ztopma(:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + else + ztopmn(2:clubb_mf_up_ndt,:ncol,:) = ztopmn(1:clubb_mf_up_ndt-1,:ncol,:) + ztopmn(1,:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ztopma(:ncol,:) = 0._r8 + do t=1,clubb_mf_up_ndt + ztopma(:ncol,:) = ztopma(:ncol,:) + ztopmn(t,:ncol,:) + end do + ztopma(:ncol,:) = ztopma(:ncol,:)/REAL(clubb_mf_up_ndt) + end if + + if (clubb_mf_cp_ndt == 1) then + ddcp(:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + else + ddcpmn(2:clubb_mf_cp_ndt,:ncol,:) = ddcpmn(1:clubb_mf_cp_ndt-1,:ncol,:) + ddcpmn(1,:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ddcp(:ncol,:) = 0._r8 + do t=1,clubb_mf_cp_ndt + ddcp(:ncol,:) = ddcp(:ncol,:) + ddcpmn(t,:ncol,:) + end do + ddcp(:ncol,:) = ddcp(:ncol,:)/REAL(clubb_mf_cp_ndt) + end if + + ddcp(:ncol,:) = clubb_mf_ddalph*ddcp(:ncol,:) + + end if + + mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv) + prec_sh(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) + snow_sh(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) + + mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_thlforcdn_nadv(:ncol,:nzt_clubb) = mf_thlforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforcdn_nadv(:ncol,:nzt_clubb) = mf_qtforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_thlforc_nadv(:ncol,:nzt_clubb) = mf_thlforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) + + ! Need moist_qc and cloudfrac on thermo grid for output + mf_qc_zt(:,:) = 0._r8 + mf_cloudfrac_zt(:,:) = 0._r8 + mf_qc_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_qc) + mf_cloudfrac_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_cloudfrac) + + ! No orientation branch needed: the substep accumulators were restored to + ! descending order after the substepping loop, so mf_qc_zt and + ! mf_cloudfrac_zt are already on the host convention here. + do i=1,ncol + do k=1,pver + mf_cloudfrac_output(i,k) = mf_cloudfrac_zt(i,k) + mf_qc_output(i,k) = mf_qc_zt(i,k) + end do + end do + + do i=1,ncol + mf_ztop_output(i) = MAXVAL(ztopma(i,:)) + mf_cape_output(i) = MAXVAL(mf_cape_nadv(i,:)) + mf_ddcp_output(i) = MAXVAL(ddcp(i,:)) + mf_L0_output(i) = MAXVAL(mf_L0_nadv(i,:)) + end do + + mf_cfl_output(:ncol) = max_cfl_nadv(:ncol) + mf_freq_output(:ncol) = mf_freq_nadv(:ncol) + + end if !clubbmf + !$acc parallel loop gang vector default(present) do i = 1, ncol @@ -4999,91 +5268,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_cam_tend:do_liqsupersat') end if - if (do_clubb_mf) then - ! average over nadv - mf_L0_nadv = mf_L0_nadv/REAL(nadv) - mf_ztop_nadv = mf_ztop_nadv/REAL(nadv) - mf_ztopm1_nadv = mf_ztopm1_nadv/REAL(nadv) - mf_cape_nadv = mf_cape_nadv/REAL(nadv) - mf_ddcp_nadv = mf_ddcp_nadv/REAL(nadv) - mf_cbm1_nadv = mf_cbm1_nadv/REAL(nadv) - mf_freq_nadv = mf_freq_nadv/REAL(nadv) - - ! accumulate in buffer - ztopm1_macmic(:ncol,:) = ztopm1_macmic(:ncol,:) + mf_ztopm1_nadv(:ncol,:) - ddcp_macmic(:ncol,:) = ddcp_macmic(:ncol,:) + mf_ddcp_nadv(:ncol,:) - cbm1_macmic(:ncol) = cbm1_macmic(:ncol) + mf_cbm1_nadv(:ncol) - - if (macmic_it == cld_macmic_num_steps) then - - cbm1(:ncol) = cbm1_macmic(:ncol)/REAL(cld_macmic_num_steps) - - if (clubb_mf_up_ndt == 1) then - ztopma(:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - else - ztopmn(2:clubb_mf_up_ndt,:ncol,:) = ztopmn(1:clubb_mf_up_ndt-1,:ncol,:) - ztopmn(1,:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - ztopma(:ncol,:) = 0._r8 - do t=1,clubb_mf_up_ndt - ztopma(:ncol,:) = ztopma(:ncol,:) + ztopmn(t,:ncol,:) - end do - ztopma(:ncol,:) = ztopma(:ncol,:)/REAL(clubb_mf_up_ndt) - end if - - if (clubb_mf_cp_ndt == 1) then - ddcp(:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - else - ddcpmn(2:clubb_mf_cp_ndt,:ncol,:) = ddcpmn(1:clubb_mf_cp_ndt-1,:ncol,:) - ddcpmn(1,:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - ddcp(:ncol,:) = 0._r8 - do t=1,clubb_mf_cp_ndt - ddcp(:ncol,:) = ddcp(:ncol,:) + ddcpmn(t,:ncol,:) - end do - ddcp(:ncol,:) = ddcp(:ncol,:)/REAL(clubb_mf_cp_ndt) - end if - - ddcp(:ncol,:) = clubb_mf_ddalph*ddcp(:ncol,:) - - end if - - mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv) - mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv) - mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv) - prec_sh(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) - snow_sh(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) - - mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_thlforcdn_nadv(:ncol,:nzt_clubb) = mf_thlforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_qtforcdn_nadv(:ncol,:nzt_clubb) = mf_qtforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_thlforc_nadv(:ncol,:nzt_clubb) = mf_thlforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) - - end if !clubbmf - - ! Need moist_qc and cloudfrac on thermo grid for output - mf_qc_zt(:,:) = 0._r8 - mf_cloudfrac_zt(:,:) = 0._r8 - - - if (do_clubb_mf) then - mf_qc_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_qc) - mf_cloudfrac_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_cloudfrac) - !mf_qc_zt(1:ncol,:) = zm2zt_api( pverp+1-top_lev, ncol, gr, mf_qc(1:ncol,:)) - !mf_cloudfrac_zt(1:ncol,:) = zm2zt_api( pverp+1-top_lev, ncol, gr, mf_cloudfrac(1:ncol,:)) - - do i=1,ncol - mf_ztop_output(i) = MAXVAL(ztopma(i,:)) - mf_cape_output(i) = MAXVAL(mf_cape_nadv(i,:)) - mf_ddcp_output(i) = MAXVAL(ddcp(i,:)) - mf_L0_output(i) = MAXVAL(mf_L0_nadv(i,:)) - end do - - mf_cfl_output(:ncol) = max_cfl_nadv(:ncol) - mf_freq_output(:ncol) = mf_freq_nadv(:ncol) - - end if !clubbmf - !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzt_clubb do i=1, ncol @@ -5341,6 +5525,22 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & aist_pbuf(:,:top_lev-1) = 0._r8 qsatfac_pbuf(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below +!+++arh -- debug statements +! if (iam == 444) then +! write(iam+1000,*) '------------ lchnk=',lchnk,'------------' +! write(iam+1000,*) 'nstep=',get_nstep(),' macmic_it=',macmic_it +! do i=1,ncol +! do k = top_lev,pver +! write(iam+1000,*) 'i=',i,' k=',k +! write(iam+1000,*) 'state_loc%q(i,k,ixq) = ',state_loc%q(i,k,ixq) +! write(iam+1000,*) 'state_loc%q(i,k,ixcldice) = ',state_loc%q(i,k,ixcldice) +! !write(iam+1000,*) 'state_loc%q(i,k,ixnumice) = ',state_loc%q(i,k,ixnumice) +! write(iam+1000,*) 'state_loc%t(i,k) = ',state_loc%t(i,k) +! write(iam+1000,*) 'state_loc%pmid(i,k) = ',state_loc%pmid(i,k) +! end do +! end do +! end if + do k = top_lev, pver ! For Type II PSC and for thin cirrus, the clouds can be thin, but diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 2cd1d16e8e..50e76dca41 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -188,11 +188,11 @@ subroutine clubb_mf_readnl(nlfile) end subroutine clubb_mf_readnl - subroutine integrate_mf( nzm, nzt, & ! input + subroutine integrate_mf( nzm, nzt, & ! input rho_zm, zm, p_zm, iexner_zm, & ! input rho_zt, dzt, zt, p_zt, iexner_zt, & ! input u, v, thl, qt, thv, & ! input - ktropo, w, th, qv, qc, & ! input + w, th, qv, qc, & ! input thl_zm, qt_zm, thv_zm, & ! input th_zm, qv_zm, qc_zm, & ! input ustar, ths, wthl_sfc,wqt_sfc, pblh, & ! input @@ -262,7 +262,7 @@ subroutine integrate_mf( nzm, nzt, use wv_saturation, only : qsat - integer, intent(in) :: nzm, nzt, ktropo + integer, intent(in) :: nzm, nzt real(r8), dimension(nzt), intent(in) :: u, v, & ! thermodynamic grid thl, thv, & ! thermodynamic grid th, qv, & ! thermodynamic grid @@ -1491,17 +1491,18 @@ subroutine integrate_mf( nzm, nzt, ! In top-down (-1): cell 58 -> interface 59 ! In bottom-up (1): cell 2 -> interface 1 kn = k - kdir + kt_dn = k - (1+kdir)/2 do i=1,clubb_mf_nup - sqtup(k) = sqtup(k) + upa(kn,i)*supqt(k,i) - sthlup(k) = sthlup(k) + upa(kn,i)*supthl(k,i) + sqtup(kt_dn) = sqtup(kt_dn) + upa(kn,i)*supqt(kt_dn,i) + sthlup(kt_dn) = sthlup(kt_dn) + upa(kn,i)*supthl(kt_dn,i) - sqtdn(k) = sqtdn(k) + dna(kn,i)*sdnqt(k,i) - sthldn(k) = sthldn(k) + dna(kn,i)*sdnthl(k,i) + sqtdn(kt) = sqtdn(kt_dn) + dna(k,i)*sdnqt(kt_dn,i) + sthldn(kt) = sthldn(kt_dn) + dna(k,i)*sdnthl(kt_dn,i) end do - sqt(k) = sqtup(k) + sqtdn(k) - sthl(k) = sthlup(k) + sthldn(k) + sqt(kt_dn) = sqtup(kt_dn) + sqtdn(kt_dn) + sthl(kt_dn) = sthlup(kt_dn) + sthldn(kt_dn) enddo ! --------------------------------------------------------- ! ! ztopm1 calculation ! @@ -1618,7 +1619,7 @@ subroutine integrate_mf( nzm, nzt, ! --------------------------------------------------------- ! do k = ktopm, ksfcm+kdir, -kdir kt_dn = k - (1+kdir)/2 - precc(k-kdir) = precc(k) - rho_zt(kt_dn)*dzt(kt_dn)*sqt(k) + precc(k-kdir) = precc(k) - rho_zt(kt_dn)*dzt(kt_dn)*sqt(kt_dn) end do ! --------------------------------------------------------- ! From 0169d49e87f4e543186fa1b8cf4160dfdbfa5aea Mon Sep 17 00:00:00 2001 From: adamrher Date: Sun, 2 Aug 2026 14:17:42 -0600 Subject: [PATCH 22/63] fixed 2 bugs, recovering bfb clubb-mf for ascending/descending --- src/physics/cam/clubb_mf.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 50e76dca41..d972e917c9 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1312,7 +1312,7 @@ subroutine integrate_mf( nzm, nzt, ! get buoyancy ! (midpoint k is surrounded by interface k and k-1, ! and therefore we can't compute B at the midpoint properly) - B = gravit*(dnthv(kn,i)/thv(kn + kdir)-1._r8) + B = gravit*(dnthv(kn,i)/thv(kt)-1._r8) ! get wn2 wp = wb*entn*eturb & @@ -1497,8 +1497,8 @@ subroutine integrate_mf( nzm, nzt, sqtup(kt_dn) = sqtup(kt_dn) + upa(kn,i)*supqt(kt_dn,i) sthlup(kt_dn) = sthlup(kt_dn) + upa(kn,i)*supthl(kt_dn,i) - sqtdn(kt) = sqtdn(kt_dn) + dna(k,i)*sdnqt(kt_dn,i) - sthldn(kt) = sthldn(kt_dn) + dna(k,i)*sdnthl(kt_dn,i) + sqtdn(kt_dn) = sqtdn(kt_dn) + dna(k,i)*sdnqt(kt_dn,i) + sthldn(kt_dn) = sthldn(kt_dn) + dna(k,i)*sdnthl(kt_dn,i) end do sqt(kt_dn) = sqtup(kt_dn) + sqtdn(kt_dn) From 11bdaf0208b50b05428237bfe83d42b7f59596d7 Mon Sep 17 00:00:00 2001 From: adamrher Date: Sun, 2 Aug 2026 19:42:13 -0600 Subject: [PATCH 23/63] fix run time errors for top_lev>1 w/ clubb-mf. maintained bfb ascending vs. descending --- src/physics/cam/clubb_intr.F90 | 52 +++++++++++++++++----------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 3d1d92e168..f95d2bd068 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2570,7 +2570,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thlforc_nadv, mf_qtforc_nadv, & !thermodynamic grid (nzt_clubb). mf_sqtup, mf_sthlup, & mf_sqtdn, mf_sthldn, & - mf_sqt, mf_sthl + mf_sqt, mf_sthl, & + mf_qc_zt, mf_cloudfrac_zt real(r8), dimension(state%ncol,nzm_clubb) :: & thlp2_rad, & @@ -2625,8 +2626,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thvflx, & mf_qc, mf_cloudfrac, & mf_qc_nadv, mf_cloudfrac_nadv, & - mf_qc_zt, mf_cloudfrac_zt, & - mf_rcm, mf_rcm_nadv, & + mf_rcm, mf_rcm_nadv, & ! MF local momentum vars rtm_zm, thlm_zm, & ! momentum grid @@ -3618,18 +3618,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! NOTE: the 'tke' pbuf field is dimensioned (pcols,pverp) rather than ! (pcols,nzm_clubb), so unlike every other input to integrate_mf it is - ! NOT already restricted to the CLUBB sub-column. The physically - ! correct index would be k_cam, but the legacy call passed - ! tke_pbuf(i,:) into an nzm-sized dummy, which sequence-associates - ! elements 1..nzm_clubb. Indexing with k reproduces that exactly, so - ! descending-grid results stay bit-for-bit for any top_lev, and the - ! ascending grid becomes its exact mirror image. - ! - ! TODO: for top_lev > 1 this is misaligned by top_lev-1 levels (and - ! the top top_lev-1 entries are never written by the fill loop over - ! k = top_lev, pverp). Switch to tke_pbuf(i,k_cam) as a separate, - ! deliberately non-bit-for-bit commit. - tke_zm(i,k) = tke_pbuf(i,k) + ! NOT already restricted to the CLUBB sub-column and must be indexed + ! with k_cam. (This differs from the legacy code, which sequence- + ! associated tke_pbuf(i,:) into an nzm-sized dummy — a top_lev-1 + ! level misalignment whenever top_lev > 1; bit-identical for + ! top_lev = 1.) + tke_zm(i,k) = tke_pbuf(i,k_cam) end do end do @@ -4202,8 +4196,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! rather than in index order: from gr%k_ub_zt to gr%k_lb_zt with a step ! of -gr%grid_dir_indx (+1 descending, -1 ascending). For thermodynamic ! level k the bounding interfaces are k+(1+kdir)/2 above and - ! k+(1-kdir)/2 below, which reduce to k and k+1 on a descending grid, - ! recovering the original loop exactly. + ! k+(1-kdir)/2 below, which reduce to k and k+1 on a descending grid. mf_precc(:ncol,:) = 0._r8 do k = gr%k_ub_zt, gr%k_lb_zt, -gr%grid_dir_indx k_above = k + ( 1 + gr%grid_dir_indx ) / 2 @@ -4381,7 +4374,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! so we need to flip them back. This section should flip every array that was flipped ! before the advance_clubb_core call. -!+++ arh -- reverting this as I think they do need to be flipped to descending grid for correct diagnostic output thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) rtm_forcing = rtm_forcing(:,nzt_clubb:1:-1) um_forcing = um_forcing(:,nzt_clubb:1:-1) @@ -4664,7 +4656,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! substepping loop can assume the host convention, as the rest of this ! module does. ! - ! This is done once per physics step rather than inside the per-substep + ! This is done once per macmic step rather than inside nadv ! flip-back block, because only the final substep's values reach the ! output mapping. Note that some of those expressions pair an MF flux with ! rho_zm, which is already restored to descending, so flipping here also @@ -4894,13 +4886,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qc_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_qc) mf_cloudfrac_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, mf_cloudfrac) - ! No orientation branch needed: the substep accumulators were restored to - ! descending order after the substepping loop, so mf_qc_zt and - ! mf_cloudfrac_zt are already on the host convention here. + ! Select output arrays are set to pbuf variables and need to be on the CAM grid do i=1,ncol - do k=1,pver - mf_cloudfrac_output(i,k) = mf_cloudfrac_zt(i,k) - mf_qc_output(i,k) = mf_qc_zt(i,k) + do k=1,top_lev-1 + mf_cloudfrac_output(i,k) = 0._r8 + mf_qc_output(i,k) = 0._r8 + end do + do k=top_lev,pver + k_clubb = k + 1 - top_lev + mf_cloudfrac_output(i,k) = mf_cloudfrac_zt(i,k_clubb) + mf_qc_output(i,k) = mf_qc_zt(i,k_clubb) end do end do @@ -5493,7 +5488,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! "cloud_frac") and CLUBB+MF cloud fraction ("shalcu") compute the convective cloud ! fraction. This follows the formulation found in macrophysics code. Assumes that convective ! cloud is all nonstratiform cloud from CLUBB or CLUBB+MF plus the deep convective cloud fraction - concld_pbuf(i,k) = min(cloud_frac(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k)+shalcu_pbuf(i,k),0.80_r8) + ! NOTE: concld_pbuf used to be calculated in the commented-out version below, but since we + ! set alst_pbuf=cloud_frac_pbuf, this simplifies to only using deepcu_pbuf and shalcu_pbuf. + ! This is potentially a bug, but there's not really a "right" way to combine the different + ! cloud factions, so it has been left to only use deepcu_pbuf and shalcu_pbuf for now + !concld_pbuf(i,k) = min(cloud_frac(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k)+shalcu_pbuf(i,k),0.80_r8) + concld_pbuf(i,k) = min(deepcu_pbuf(i,k)+shalcu_pbuf(i,k),0.80_r8) enddo enddo end if From be230be5fdd9c868329a62d80f9202feaa7c5037 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 6 Aug 2026 14:12:23 -0600 Subject: [PATCH 24/63] before removing flip arrays --- bld/namelist_files/namelist_definition.xml | 2 +- src/physics/cam/clubb_intr.F90 | 385 ++++++++++++++------- src/physics/cam/clubb_mf.F90 | 7 +- 3 files changed, 266 insertions(+), 128 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index a845b7631f..0e790d7fda 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4729,7 +4729,7 @@ Default: 1.5 -Standarized upper limit of subgrid distribution for initializing plumes +Standardized upper limit of subgrid distribution for initializing plumes Default: 3.0 diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index f95d2bd068..efd32ef048 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1932,12 +1932,6 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_dnqt' , (/ 'ilev', 'nens' /), 'A', 'kg/kg' , 'Plume downdraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true. ) end if - if (do_clubb_mf) then -!+++arh PRECSH addfld is already in convect_shallow.F90 -!jt call addfld( 'PRECSH', horiz_only, 'A', 'm/s', 'Shallow Convection precipitation rate' ) -!arh call addfld( 'SNOWSH', horiz_only, 'A', 'm/s', 'CLUBB-MF Snow precipitation rate' ) - end if - if ( trim(subcol_scheme) /= 'SILHS' ) then ! hm_metadata is set up by calling init_pdf_hydromet_arrays_api in subcol_init_SILHS. ! So if we are not using silhs, we allocate the parts of hm_metadata that need allocating @@ -2026,9 +2020,6 @@ subroutine clubb_ini_cam(pbuf_ini) end if if (do_clubb_mf_diag) then -!+++arh PRECSH issue - !call add_default('PRECSH', 1, ' ') - !call add_default('SNOWSH', 1, ' ') call add_default( 'edmf_DRY_A' , 1, ' ') call add_default( 'edmf_MOIST_A' , 1, ' ') call add_default( 'edmf_DRY_W' , 1, ' ') @@ -2389,8 +2380,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc_pbuf ! CLUBB-MF pointers - real(r8),pointer :: prec_sh(:) ! total precipitation from MF - real(r8),pointer :: snow_sh(:) ! snow from MF + real(r8),pointer :: prec_sh_pbuf(:) ! total precipitation from MF + real(r8),pointer :: snow_sh_pbuf(:) ! snow from MF real(r8), pointer :: ztopmn(:,:,:) real(r8), pointer :: ztopma(:,:) @@ -2406,56 +2397,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Local Variables ! ! ---------------------------------------------------- ! ! - ! MF outputs to outfld - real(r8), dimension(pcols) :: mf_ztop_output, mf_L0_output, & - mf_cape_output, mf_cfl_output, & - mf_ddcp_output, mf_freq_output - - real(r8), dimension(pcols,pver) :: mf_thlforcup_output, mf_qtforcup_output, & ! thermodynamic grid - mf_thlforcdn_output, mf_qtforcdn_output, & ! thermodynamic grid - mf_thlforc_output, mf_qtforc_output, & ! thermodynamic grid - mf_ent_output, & ! thermodynamic grid - mf_sqtup_output, mf_sqtdn_output, & ! thermodynamic grid - mf_qc_output, mf_cloudfrac_output ! thermodynamic grid - integer :: i,l !Must be delcared outside "CLUBB_SGS" ifdef for det_s and det_ice zero-ing loops #ifdef CLUBB_SGS - ! MF plume level outputs to outfld - real(r8), dimension(pcols,pverp*clubb_mf_nup) :: & - mf_upa_output, & - mf_upw_output, & - mf_upmf_output, & - mf_upqt_output, & - mf_upthl_output, & - mf_upthv_output, & - mf_upth_output, & - mf_upqc_output, & - mf_upent_output, & - mf_updet_output, & - mf_upbuoy_output, & - mf_dnw_output, & - mf_dnthl_output, & - mf_dnqt_output - - ! MF plume level work arrays - real(r8), dimension(pcols,pverp,clubb_mf_nup) :: & - mf_upa_flip, & - mf_upw_flip, & - mf_upmf_flip, & - mf_upqt_flip, & - mf_upthl_flip, & - mf_upthv_flip, & - mf_upth_flip, & - mf_upqc_flip, & - mf_upbuoy_flip, & - mf_upent_flip, & - mf_updet_flip, & - mf_dnw_flip, & - mf_dnthl_flip, & - mf_dnqt_flip - real(r8), pointer :: tpert(:) real(r8), dimension(state%ncol,nzm_clubb,clubb_mf_nup) :: & @@ -2627,6 +2572,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qc, mf_cloudfrac, & mf_qc_nadv, mf_cloudfrac_nadv, & mf_rcm, mf_rcm_nadv, & + mf_ent, mf_ent_nadv, & ! MF local momentum vars rtm_zm, thlm_zm, & ! momentum grid @@ -2700,6 +2646,52 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thvflx_output, & mf_rcm_output, mf_precc_output + real(r8), dimension(pcols) :: & + mf_ztop_output, mf_L0_output, & + mf_cape_output, mf_cfl_output, & + mf_ddcp_output, mf_freq_output + + real(r8), dimension(pcols,pver) :: & + mf_thlforcup_output, mf_qtforcup_output, & ! thermodynamic grid + mf_thlforcdn_output, mf_qtforcdn_output, & ! thermodynamic grid + mf_thlforc_output, mf_qtforc_output, & ! thermodynamic grid + mf_ent_output, & ! thermodynamic grid + mf_sqtup_output, mf_sqtdn_output, & ! thermodynamic grid + mf_qc_output, mf_cloudfrac_output ! thermodynamic grid + + real(r8), dimension(pcols,pverp*clubb_mf_nup) :: & + mf_upa_output, & + mf_upw_output, & + mf_upmf_output, & + mf_upqt_output, & + mf_upthl_output, & + mf_upthv_output, & + mf_upth_output, & + mf_upqc_output, & + mf_upent_output, & + mf_updet_output, & + mf_upbuoy_output, & + mf_dnw_output, & + mf_dnthl_output, & + mf_dnqt_output + + ! MF plume level work arrays + real(r8), dimension(pcols,pverp,clubb_mf_nup) :: & + mf_upa_flip, & + mf_upw_flip, & + mf_upmf_flip, & + mf_upqt_flip, & + mf_upthl_flip, & + mf_upthv_flip, & + mf_upth_flip, & + mf_upqc_flip, & + mf_upbuoy_flip, & + mf_upent_flip, & + mf_updet_flip, & + mf_dnw_flip, & + mf_dnthl_flip, & + mf_dnqt_flip + ! Variables used for output (zt) real(r8), dimension(pcols,pver) :: & rvmtend_clubb_output, & @@ -2796,7 +2788,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & integer :: & errflg, & j, k, t, ixind, nadv, n, & ! Loop variables - k_cam, k_clubb, sclr, iedsclr, & ! Loop variables + k_cam, k_clubb, k_clubb_pver, sclr, iedsclr, & ! Loop variables k_above, k_below, & ! Interfaces bounding thermo level k (MF precip sweep) ixcldice, ixcldliq, ixnumliq, & ixnumice, ixq, & @@ -2931,8 +2923,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, icwmrsh_idx, sh_icwmr_pbuf) call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh_pbuf) - call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) - call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh_pbuf ) + call pbuf_get_field(pbuf, snow_sh_idx, snow_sh_pbuf ) if (do_clubb_mf) then call pbuf_get_field(pbuf, tpert_idx, tpert) @@ -3380,6 +3372,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_cloudfrac(:ncol,:nzm_clubb) = 0._r8 mf_qc_nadv(:ncol,:nzm_clubb) = 0._r8 mf_rcm_nadv(:ncol,:nzm_clubb) = 0._r8 + mf_ent_nadv(:ncol,:nzm_clubb) = 0._r8 mf_cloudfrac_nadv(:ncol,:nzm_clubb) = 0._r8 mf_thlforcup_nadv(:ncol,:nzt_clubb) = 0._r8 @@ -4066,7 +4059,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & th_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, th_zt(:ncol,:) ) qv_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qv_zt(:ncol,:) ) qc_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qc_zt(:ncol,:) ) - kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt ) + kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt(:ncol,:) ) do k = 1, nzm_clubb do i = 1, ncol @@ -4161,6 +4154,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do + !--------------------------------------- END integrate_mf call --------------------------------------- + ! CFL limiter cfllim = .true. cflfac(:ncol) = 1._r8 @@ -4206,7 +4201,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - !--------------------------------------- END integrate_mf call --------------------------------------- ! pass MF turbulent advection term as CLUBB explicit forcing term rtm_forcing(:ncol,:) = 0._r8 thlm_forcing(:ncol,:) = 0._r8 @@ -4215,7 +4209,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qtforcdn(:ncol,:) = 0._r8 mf_thlforcdn(:ncol,:) = 0._r8 - ! pass MF turbulent advection term as CLUBB explicit forcing term do k = 1, nzt_clubb do i = 1, ncol @@ -4286,8 +4279,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qtforcdn_nadv(i,:nzt_clubb) = mf_qtforcdn_nadv(i,:nzt_clubb) + mf_qtforcdn(i,:nzt_clubb) mf_thlforc_nadv(i,:nzt_clubb) = mf_thlforc_nadv(i,:nzt_clubb) + thlm_forcing(i,:nzt_clubb) mf_qtforc_nadv(i,:nzt_clubb) = mf_qtforc_nadv(i,:nzt_clubb) + rtm_forcing(i,:nzt_clubb) - - max_cfl_nadv(i) = MAX(max_cfl(i),max_cfl_nadv(i)) + mf_ent_nadv(i,:nzm_clubb) = mf_ent_nadv(i,:nzm_clubb) + s_awu(i,:nzm_clubb) + max_cfl_nadv(i) = MAX(max_cfl(i),max_cfl_nadv(i)) end do call t_stopf('clubb_tend_cam:do_clubb_mf') end if @@ -4759,23 +4752,23 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do if (do_clubb_mf .and. do_clubb_mf_addtke) then - Lscale_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, Lscale ) - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzm_clubb - do i = 1, ncol - k_cam = top_lev - 1 + k - khzm_pbuf(i,k_cam) = khzm(i,k) + & - clubb_params(i,ic_K) * Lscale_zm(i,k) * sqrt(0.5_r8 * s_aww(i,k)) - end do - end do + Lscale_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, Lscale ) + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + khzm_pbuf(i,k_cam) = khzm(i,k) + & + clubb_params(i,ic_K) * Lscale_zm(i,k) * sqrt(0.5_r8 * s_aww(i,k)) + end do + end do else - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzm_clubb - do i = 1, ncol - k_cam = top_lev - 1 + k - khzm_pbuf(i,k_cam) = khzm(i,k) + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + khzm_pbuf(i,k_cam) = khzm(i,k) + end do end do - end do end if ! pdf_params_zm_chnk is already persistent across calls, but we @@ -4830,6 +4823,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_cbm1_nadv = mf_cbm1_nadv/REAL(nadv) mf_freq_nadv = mf_freq_nadv/REAL(nadv) + mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv) + prec_sh_pbuf(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) + snow_sh_pbuf(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) + + mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_thlforcdn_nadv(:ncol,:nzt_clubb) = mf_thlforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforcdn_nadv(:ncol,:nzt_clubb) = mf_qtforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_thlforc_nadv(:ncol,:nzt_clubb) = mf_thlforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_ent_nadv(:ncol,:nzm_clubb) = mf_ent_nadv(:ncol,:nzm_clubb)/REAL(nadv) + ! accumulate in buffer ztopm1_macmic(:ncol,:) = ztopm1_macmic(:ncol,:) + mf_ztopm1_nadv(:ncol,:) ddcp_macmic(:ncol,:) = ddcp_macmic(:ncol,:) + mf_ddcp_nadv(:ncol,:) @@ -4867,19 +4874,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv) - mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv) - mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv) - prec_sh(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) - snow_sh(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) - - mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_thlforcdn_nadv(:ncol,:nzt_clubb) = mf_thlforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_qtforcdn_nadv(:ncol,:nzt_clubb) = mf_qtforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_thlforc_nadv(:ncol,:nzt_clubb) = mf_thlforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) - ! Need moist_qc and cloudfrac on thermo grid for output mf_qc_zt(:,:) = 0._r8 mf_cloudfrac_zt(:,:) = 0._r8 @@ -4954,7 +4948,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then ! subtract enthalpy of falling precip from tb - te_b = te_b - prec_sh(i)*1000._r8*latice*hdtime + te_b = te_b - prec_sh_pbuf(i)*1000._r8*latice*hdtime end if ! Compute the disbalance of total energy, over depth where CLUBB is active @@ -5302,28 +5296,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !jt check with Adam end do !jt check with Adam end do - ! Fill up arrays needed for McICA. Note we do not want the ghost point, - ! thus why the second loop is needed. - !$acc parallel loop gang vector default(present) - do i=1, pcols - zi_output(i,1) = 0._r8 - end do - - ! enforce zero tracer tendencies above the top_lev level -- no change - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, top_lev-1 - do i=1, ncol - edsclr(i,k,icnt) = state_loc%q(i,k,ixind) - end do - end do - - end if - end do ! ------------------------------------------------------------ ! ! The rest of the code deals with diagnosing variables ! @@ -5464,7 +5436,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! NOTE: concld_pbuf used to be calculated in the commented-out version below, but since we ! set alst_pbuf=cloud_frac_pbuf, this simplifies to only using deepcu_pbuf. ! This is potentially a bug, but there's not really a "right" way to combine the different - ! cloud factions, so it has been left to only use deepcu_pbuf for now + ! cloud fractions, so it has been left to only use deepcu_pbuf for now !concld_pbuf(i,k) = min(cloud_frac_pbuf(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k),0.80_r8) concld_pbuf(i,k) = min(deepcu_pbuf(i,k),0.80_r8) enddo @@ -5491,7 +5463,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! NOTE: concld_pbuf used to be calculated in the commented-out version below, but since we ! set alst_pbuf=cloud_frac_pbuf, this simplifies to only using deepcu_pbuf and shalcu_pbuf. ! This is potentially a bug, but there's not really a "right" way to combine the different - ! cloud factions, so it has been left to only use deepcu_pbuf and shalcu_pbuf for now + ! cloud fractions, so it has been left to only use deepcu_pbuf and shalcu_pbuf for now !concld_pbuf(i,k) = min(cloud_frac(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k)+shalcu_pbuf(i,k),0.80_r8) concld_pbuf(i,k) = min(deepcu_pbuf(i,k)+shalcu_pbuf(i,k),0.80_r8) enddo @@ -5825,8 +5797,29 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Writing state variables after EDMF scheme for detailed analysis ! ! --------------------------------------------------------------- ! if (do_clubb_mf) then - - do k = top_lev, pverp + if (.false.) then + mf_thlforc_output (:ncol,:) = 0._r8 + mf_qtforc_output (:ncol,:) = 0._r8 + mf_thlforcup_output (:ncol,:) = 0._r8 + mf_qtforcup_output (:ncol,:) = 0._r8 + mf_thlforcdn_output (:ncol,:) = 0._r8 + mf_qtforcdn_output (:ncol,:) = 0._r8 + mf_ent_output (:ncol,:) = 0._r8 + mf_sqtup_output (:ncol,:) = 0._r8 + mf_sqtdn_output (:ncol,:) = 0._r8 + + k_clubb_pver = pver - top_lev + 1 + mf_thlforc_output (:ncol,top_lev:pver) = mf_thlforc_nadv (:ncol,1:k_clubb_pver) + mf_qtforc_output (:ncol,top_lev:pver) = mf_qtforc_nadv (:ncol,1:k_clubb_pver) + mf_thlforcup_output (:ncol,top_lev:pver) = mf_thlforcup_nadv (:ncol,1:k_clubb_pver) + mf_qtforcup_output (:ncol,top_lev:pver) = mf_qtforcup_nadv (:ncol,1:k_clubb_pver) + mf_thlforcdn_output (:ncol,top_lev:pver) = mf_thlforcdn_nadv (:ncol,1:k_clubb_pver) + mf_qtforcdn_output (:ncol,top_lev:pver) = mf_qtforcdn_nadv (:ncol,1:k_clubb_pver) + mf_ent_output (:ncol,top_lev:pver) = mf_ent_nadv (:ncol,1:k_clubb_pver) + mf_sqtup_output (:ncol,top_lev:pver) = mf_sqtup (:ncol,1:k_clubb_pver) + mf_sqtdn_output (:ncol,top_lev:pver) = mf_sqtdn (:ncol,1:k_clubb_pver) + + do k = top_lev, pverp do i = 1, ncol k_clubb = k + 1 - top_lev mf_dry_a_output(i,k) = mf_dry_a(i,k_clubb) @@ -5969,10 +5962,154 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do end do + else + ! Initialize Output arrays + mf_dry_a_output(:ncol,:) = 0._r8 + mf_moist_a_output(:ncol,:) = 0._r8 + mf_dry_w_output(:ncol,:) = 0._r8 + mf_moist_w_output(:ncol,:) = 0._r8 + mf_dry_qt_output(:ncol,:) = 0._r8 + mf_moist_qt_output(:ncol,:) = 0._r8 + mf_dry_thl_output(:ncol,:) = 0._r8 + mf_moist_thl_output(:ncol,:) = 0._r8 + mf_dry_u_output(:ncol,:) = 0._r8 + mf_moist_u_output(:ncol,:) = 0._r8 + mf_dry_v_output(:ncol,:) = 0._r8 + mf_moist_v_output(:ncol,:) = 0._r8 + mf_moist_qc_output(:ncol,:) = 0._r8 + s_ae_output(:ncol,:) = 0._r8 + s_aw_output(:ncol,:) = 0._r8 + s_awthl_output(:ncol,:) = 0._r8 + s_awqt_output(:ncol,:) = 0._r8 + s_awu_output(:ncol,:) = 0._r8 + s_awv_output(:ncol,:) = 0._r8 + mf_thlflx_output(:ncol,:) = 0._r8 + mf_qtflx_output(:ncol,:) = 0._r8 + s_awthlup_output(:ncol,:) = 0._r8 + s_awqtup_output(:ncol,:) = 0._r8 + s_awuup_output(:ncol,:) = 0._r8 + s_awvup_output(:ncol,:) = 0._r8 + s_awthldn_output(:ncol,:) = 0._r8 + s_awqtdn_output(:ncol,:) = 0._r8 + s_awudn_output(:ncol,:) = 0._r8 + s_awvdn_output(:ncol,:) = 0._r8 + s_aww_output(:ncol,:) = 0._r8 + mf_thlflxup_output(:ncol,:) = 0._r8 + mf_qtflxup_output(:ncol,:) = 0._r8 + mf_uflxup_output(:ncol,:) = 0._r8 + mf_vflxup_output(:ncol,:) = 0._r8 + mf_thlflxdn_output(:ncol,:) = 0._r8 + mf_qtflxdn_output(:ncol,:) = 0._r8 + mf_uflxdn_output(:ncol,:) = 0._r8 + mf_vflxdn_output(:ncol,:) = 0._r8 + mf_uflx_output(:ncol,:) = 0._r8 + mf_vflx_output(:ncol,:) = 0._r8 + mf_thvflx_output(:ncol,:) = 0._r8 + mf_rcm_output(:ncol,:) = 0._r8 + mf_precc_output(:ncol,:) = 0._r8 + mf_upa_output(:ncol,:) = 0._r8 + mf_upw_output(:ncol,:) = 0._r8 + mf_upmf_output(:ncol,:) = 0._r8 + mf_upqt_output(:ncol,:) = 0._r8 + mf_upthl_output(:ncol,:) = 0._r8 + mf_upthv_output(:ncol,:) = 0._r8 + mf_upth_output(:ncol,:) = 0._r8 + mf_upqc_output(:ncol,:) = 0._r8 + mf_upent_output(:ncol,:) = 0._r8 + mf_updet_output(:ncol,:) = 0._r8 + mf_upbuoy_output(:ncol,:) = 0._r8 + mf_dnw_output(:ncol,:) = 0._r8 + mf_dnthl_output(:ncol,:) = 0._r8 + mf_dnqt_output(:ncol,:) = 0._r8 + + mf_thlforc_output (:ncol,:) = 0._r8 + mf_qtforc_output (:ncol,:) = 0._r8 + mf_thlforcup_output (:ncol,:) = 0._r8 + mf_qtforcup_output (:ncol,:) = 0._r8 + mf_thlforcdn_output (:ncol,:) = 0._r8 + mf_qtforcdn_output (:ncol,:) = 0._r8 + mf_ent_output (:ncol,:) = 0._r8 + mf_sqtup_output (:ncol,:) = 0._r8 + mf_sqtdn_output (:ncol,:) = 0._r8 + + !array section fill toplev to pver for thermo grid variables + k_clubb_pver = pver - top_lev + 1 + mf_thlforc_output (:ncol,top_lev:pver) = mf_thlforc_nadv (:ncol,1:k_clubb_pver) + mf_qtforc_output (:ncol,top_lev:pver) = mf_qtforc_nadv (:ncol,1:k_clubb_pver) + mf_thlforcup_output (:ncol,top_lev:pver) = mf_thlforcup_nadv (:ncol,1:k_clubb_pver) + mf_qtforcup_output (:ncol,top_lev:pver) = mf_qtforcup_nadv (:ncol,1:k_clubb_pver) + mf_thlforcdn_output (:ncol,top_lev:pver) = mf_thlforcdn_nadv (:ncol,1:k_clubb_pver) + mf_qtforcdn_output (:ncol,top_lev:pver) = mf_qtforcdn_nadv (:ncol,1:k_clubb_pver) + mf_ent_output (:ncol,top_lev:pver) = mf_ent_nadv (:ncol,1:k_clubb_pver) + mf_sqtup_output (:ncol,top_lev:pver) = mf_sqtup (:ncol,1:k_clubb_pver) + mf_sqtdn_output (:ncol,top_lev:pver) = mf_sqtdn (:ncol,1:k_clubb_pver) + + !array section fill toplev to pverp for momentum grid variables + k_clubb = pverp - top_lev + 1 + + mf_dry_a_output (:ncol, top_lev:pverp) = mf_dry_a (:ncol, 1:k_clubb) + mf_moist_a_output(:ncol, top_lev:pverp) = mf_moist_a(:ncol, 1:k_clubb) + mf_dry_w_output (:ncol, top_lev:pverp) = mf_dry_w (:ncol, 1:k_clubb) + mf_moist_w_output(:ncol, top_lev:pverp) = mf_moist_w(:ncol, 1:k_clubb) + mf_dry_qt_output(:ncol, top_lev:pverp) = mf_dry_qt(:ncol, 1:k_clubb) + mf_moist_qt_output(:ncol, top_lev:pverp) = mf_moist_qt(:ncol, 1:k_clubb) + mf_dry_thl_output(:ncol, top_lev:pverp) = mf_dry_thl(:ncol, 1:k_clubb) + mf_moist_thl_output(:ncol, top_lev:pverp) = mf_moist_thl(:ncol, 1:k_clubb) + mf_dry_u_output(:ncol, top_lev:pverp) = mf_dry_u(:ncol, 1:k_clubb) + mf_moist_u_output(:ncol, top_lev:pverp) = mf_moist_u(:ncol, 1:k_clubb) + mf_dry_v_output(:ncol, top_lev:pverp) = mf_dry_v(:ncol, 1:k_clubb) + mf_moist_v_output(:ncol, top_lev:pverp) = mf_moist_v(:ncol, 1:k_clubb) + mf_moist_qc_output(:ncol, top_lev:pverp) = mf_moist_qc(:ncol, 1:k_clubb) + s_ae_output(:ncol, top_lev:pverp) = s_ae(:ncol, 1:k_clubb) + s_aw_output(:ncol, top_lev:pverp) = s_aw(:ncol, 1:k_clubb) + s_awthl_output(:ncol, top_lev:pverp) = s_awthl(:ncol, 1:k_clubb) + s_awqt_output(:ncol, top_lev:pverp) = s_awqt(:ncol, 1:k_clubb) + s_awu_output(:ncol, top_lev:pverp) = s_awu(:ncol, 1:k_clubb) + s_awv_output(:ncol, top_lev:pverp) = s_awv(:ncol, 1:k_clubb) + mf_thlflx_output(:ncol, top_lev:pverp) = mf_thlflx(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * cpair + mf_qtflx_output(:ncol, top_lev:pverp) = mf_qtflx(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * latvap + s_awthlup_output(:ncol, top_lev:pverp) = s_awthlup(:ncol, 1:k_clubb) + s_awqtup_output(:ncol, top_lev:pverp) = s_awqtup(:ncol, 1:k_clubb) + s_awuup_output(:ncol, top_lev:pverp) = s_awuup(:ncol, 1:k_clubb) + s_awvup_output(:ncol, top_lev:pverp) = s_awvup(:ncol, 1:k_clubb) + s_awthldn_output(:ncol, top_lev:pverp) = s_awthldn(:ncol, 1:k_clubb) + s_awqtdn_output(:ncol, top_lev:pverp) = s_awqtdn(:ncol, 1:k_clubb) + s_awudn_output(:ncol, top_lev:pverp) = s_awudn(:ncol, 1:k_clubb) + s_awvdn_output(:ncol, top_lev:pverp) = s_awvdn(:ncol, 1:k_clubb) + s_aww_output(:ncol, top_lev:pverp) = s_aww(:ncol, 1:k_clubb) + mf_thlflxup_output(:ncol, top_lev:pverp) = mf_thlflxup(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * cpair + mf_qtflxup_output(:ncol, top_lev:pverp) = mf_qtflxup(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * latvap + mf_uflxup_output(:ncol, top_lev:pverp) = mf_uflxup(:ncol, 1:k_clubb) + mf_vflxup_output(:ncol, top_lev:pverp) = mf_vflxup(:ncol, 1:k_clubb) + mf_thlflxdn_output(:ncol, top_lev:pverp) = mf_thlflxdn(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * cpair + mf_qtflxdn_output(:ncol, top_lev:pverp) = mf_qtflxdn(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * latvap + mf_uflxdn_output(:ncol, top_lev:pverp) = mf_uflxdn(:ncol, 1:k_clubb) + mf_vflxdn_output(:ncol, top_lev:pverp) = mf_vflxdn(:ncol, 1:k_clubb) + mf_uflx_output(:ncol, top_lev:pverp) = mf_uflx(:ncol, 1:k_clubb) + mf_vflx_output(:ncol, top_lev:pverp) = mf_vflx(:ncol, 1:k_clubb) + mf_thvflx_output(:ncol, top_lev:pverp) = mf_thvflx(:ncol, 1:k_clubb) + mf_rcm_output(:ncol, top_lev:pverp) = mf_rcm(:ncol, 1:k_clubb) + mf_precc_output(:ncol, top_lev:pverp) = mf_precc(:ncol, 1:k_clubb) + + ! fill plume output arrays + do k = 1, clubb_mf_nup + mf_upa_output (:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_upa (:ncol, 1:pverp-top_lev+1, k) + mf_upw_output (:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_upw (:ncol, 1:pverp-top_lev+1, k) + mf_upmf_output (:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_upmf (:ncol, 1:pverp-top_lev+1, k) + mf_upqt_output (:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_upqt (:ncol, 1:pverp-top_lev+1, k) + mf_upthl_output(:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_upthl (:ncol, 1:pverp-top_lev+1, k) + mf_upthv_output(:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_upthv (:ncol, 1:pverp-top_lev+1, k) + mf_upth_output (:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_upth (:ncol, 1:pverp-top_lev+1, k) + mf_upqc_output (:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_upqc (:ncol, 1:pverp-top_lev+1, k) + mf_upent_output(:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_upent (:ncol, 1:pverp-top_lev+1, k) + mf_updet_output(:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_updet (:ncol, 1:pverp-top_lev+1, k) + mf_upbuoy_output(:ncol,pverp*(k-1)+top_lev : pverp*k) = mf_upbuoy(:ncol, 1:pverp-top_lev+1, k) + mf_dnw_output (:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_dnw (:ncol, 1:pverp-top_lev+1, k) + mf_dnthl_output(:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_dnthl (:ncol, 1:pverp-top_lev+1, k) + mf_dnqt_output (:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_dnqt (:ncol, 1:pverp-top_lev+1, k) + end do + end if -!+++arh PRECSH issue - !call outfld( 'PRECSH' , prec_sh(:ncol), pcols, lchnk ) - !call outfld( 'SNOWSH' , snow_sh(:ncol), pcols, lchnk ) call outfld( 'edmf_DRY_A' , mf_dry_a_output, pcols, lchnk ) call outfld( 'edmf_MOIST_A' , mf_moist_a_output, pcols, lchnk ) call outfld( 'edmf_DRY_W' , mf_dry_w_output, pcols, lchnk ) @@ -6041,8 +6178,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'edmf_freq' , mf_freq_output, pcols, lchnk ) call outfld( 'edmf_cape' , mf_cape_output, pcols, lchnk ) call outfld( 'edmf_cfl' , mf_cfl_output, pcols, lchnk ) -!+++arh no corresponding addfld call for ICWMRSH - !call outfld( 'ICWMRSH' , sh_icwmr_pbuf, pcols, lchnk ) end if ! Output CLUBB history here diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index d972e917c9..6e7cc5b17b 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -53,8 +53,8 @@ module clubb_mf real(r8) :: clubb_mf_ddbeta = 0._r8 real(r8) :: clubb_mf_pwfac = 0._r8 real(r8) :: clubb_mf_ddexp = 0._r8 - real(r8) :: clubb_mf_pwmin = 0._r8 - real(r8) :: clubb_mf_pwmax = 0._r8 + real(r8) :: clubb_mf_pwmin = 1.5_r8 + real(r8) :: clubb_mf_pwmax = 3.0_r8 real(r8) :: clubb_mf_cldfrac_fac = 1._r8 integer :: clubb_mf_up_ndt = 1 integer :: clubb_mf_cp_ndt = 1 @@ -641,6 +641,7 @@ subroutine integrate_mf( nzm, nzt, dynamic_L0 = 0._r8 ztop = 0._r8 + mcape = 0._r8 ddbotm = 0 if (bsort) then @@ -1737,6 +1738,8 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, ! intialize local variables cape = 0._r8 + mcape = 0._r8 + ztop = 0._r8 dmpdz = 0._r8 if (zt(1) < zt(nzt)) then From 35c36760b3ca9ad44679a4fce9a46a9e50ad2032 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 6 Aug 2026 14:14:32 -0600 Subject: [PATCH 25/63] remove flip arrays, use array syntax --- src/physics/cam/clubb_intr.F90 | 184 --------------------------------- 1 file changed, 184 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index efd32ef048..9bbc96b59d 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2675,23 +2675,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_dnthl_output, & mf_dnqt_output - ! MF plume level work arrays - real(r8), dimension(pcols,pverp,clubb_mf_nup) :: & - mf_upa_flip, & - mf_upw_flip, & - mf_upmf_flip, & - mf_upqt_flip, & - mf_upthl_flip, & - mf_upthv_flip, & - mf_upth_flip, & - mf_upqc_flip, & - mf_upbuoy_flip, & - mf_upent_flip, & - mf_updet_flip, & - mf_dnw_flip, & - mf_dnthl_flip, & - mf_dnqt_flip - ! Variables used for output (zt) real(r8), dimension(pcols,pver) :: & rvmtend_clubb_output, & @@ -5797,172 +5780,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Writing state variables after EDMF scheme for detailed analysis ! ! --------------------------------------------------------------- ! if (do_clubb_mf) then - if (.false.) then - mf_thlforc_output (:ncol,:) = 0._r8 - mf_qtforc_output (:ncol,:) = 0._r8 - mf_thlforcup_output (:ncol,:) = 0._r8 - mf_qtforcup_output (:ncol,:) = 0._r8 - mf_thlforcdn_output (:ncol,:) = 0._r8 - mf_qtforcdn_output (:ncol,:) = 0._r8 - mf_ent_output (:ncol,:) = 0._r8 - mf_sqtup_output (:ncol,:) = 0._r8 - mf_sqtdn_output (:ncol,:) = 0._r8 - - k_clubb_pver = pver - top_lev + 1 - mf_thlforc_output (:ncol,top_lev:pver) = mf_thlforc_nadv (:ncol,1:k_clubb_pver) - mf_qtforc_output (:ncol,top_lev:pver) = mf_qtforc_nadv (:ncol,1:k_clubb_pver) - mf_thlforcup_output (:ncol,top_lev:pver) = mf_thlforcup_nadv (:ncol,1:k_clubb_pver) - mf_qtforcup_output (:ncol,top_lev:pver) = mf_qtforcup_nadv (:ncol,1:k_clubb_pver) - mf_thlforcdn_output (:ncol,top_lev:pver) = mf_thlforcdn_nadv (:ncol,1:k_clubb_pver) - mf_qtforcdn_output (:ncol,top_lev:pver) = mf_qtforcdn_nadv (:ncol,1:k_clubb_pver) - mf_ent_output (:ncol,top_lev:pver) = mf_ent_nadv (:ncol,1:k_clubb_pver) - mf_sqtup_output (:ncol,top_lev:pver) = mf_sqtup (:ncol,1:k_clubb_pver) - mf_sqtdn_output (:ncol,top_lev:pver) = mf_sqtdn (:ncol,1:k_clubb_pver) - - do k = top_lev, pverp - do i = 1, ncol - k_clubb = k + 1 - top_lev - mf_dry_a_output(i,k) = mf_dry_a(i,k_clubb) - mf_moist_a_output(i,k) = mf_moist_a(i,k_clubb) - mf_dry_w_output(i,k) = mf_dry_w(i,k_clubb) - mf_moist_w_output(i,k) = mf_moist_w(i,k_clubb) - mf_dry_qt_output(i,k) = mf_dry_qt(i,k_clubb) - mf_moist_qt_output(i,k) = mf_moist_qt(i,k_clubb) - mf_dry_thl_output(i,k) = mf_dry_thl(i,k_clubb) - mf_moist_thl_output(i,k) = mf_moist_thl(i,k_clubb) - mf_dry_u_output(i,k) = mf_dry_u(i,k_clubb) - mf_moist_u_output(i,k) = mf_moist_u(i,k_clubb) - mf_dry_v_output(i,k) = mf_dry_v(i,k_clubb) - mf_moist_v_output(i,k) = mf_moist_v(i,k_clubb) - mf_moist_qc_output(i,k) = mf_moist_qc(i,k_clubb) - s_ae_output(i,k) = s_ae(i,k_clubb) - s_aw_output(i,k) = s_aw(i,k_clubb) - s_awthl_output(i,k) = s_awthl(i,k_clubb) - s_awqt_output(i,k) = s_awqt(i,k_clubb) - s_awu_output(i,k) = s_awu(i,k_clubb) - s_awv_output(i,k) = s_awv(i,k_clubb) - mf_thlflx_output(i,k) = mf_thlflx(i,k_clubb) * rho_zm(i,k_clubb) * cpair - mf_qtflx_output(i,k) = mf_qtflx(i,k_clubb) * rho_zm(i,k_clubb) * latvap - s_awthlup_output(i,k) = s_awthlup(i,k_clubb) - s_awqtup_output(i,k) = s_awqtup(i,k_clubb) - s_awuup_output(i,k) = s_awuup(i,k_clubb) - s_awvup_output(i,k) = s_awvup(i,k_clubb) - s_awthldn_output(i,k) = s_awthldn(i,k_clubb) - s_awqtdn_output(i,k) = s_awqtdn(i,k_clubb) - s_awudn_output(i,k) = s_awudn(i,k_clubb) - s_awvdn_output(i,k) = s_awvdn(i,k_clubb) - s_aww_output(i,k) = s_aww(i,k_clubb) - mf_thlflxup_output(i,k) = mf_thlflxup(i,k_clubb) * rho_zm(i,k_clubb) * cpair - mf_qtflxup_output(i,k) = mf_qtflxup(i,k_clubb) * rho_zm(i,k_clubb) * latvap - mf_uflxup_output(i,k) = mf_uflxup(i,k_clubb) - mf_vflxup_output(i,k) = mf_vflxup(i,k_clubb) - mf_thlflxdn_output(i,k) = mf_thlflxdn(i,k_clubb) * rho_zm(i,k_clubb) * cpair - mf_qtflxdn_output(i,k) = mf_qtflxdn(i,k_clubb) * rho_zm(i,k_clubb) * latvap - mf_uflxdn_output(i,k) = mf_uflxdn(i,k_clubb) - mf_vflxdn_output(i,k) = mf_vflxdn(i,k_clubb) - mf_uflx_output(i,k) = mf_uflx(i,k_clubb) - mf_vflx_output(i,k) = mf_vflx(i,k_clubb) - mf_thvflx_output(i,k) = mf_thvflx(i,k_clubb) - mf_rcm_output(i,k) = mf_rcm(i,k_clubb) - mf_precc_output(i,k) = mf_precc(i,k_clubb) - mf_upa_flip(i,k,:clubb_mf_nup) = mf_upa(i,k_clubb,:clubb_mf_nup) - mf_upw_flip(i,k,:clubb_mf_nup) = mf_upw(i,k_clubb,:clubb_mf_nup) - mf_upmf_flip(i,k,:clubb_mf_nup) = mf_upmf(i,k_clubb,:clubb_mf_nup) - mf_upqt_flip(i,k,:clubb_mf_nup) = mf_upqt(i,k_clubb,:clubb_mf_nup) - mf_upthl_flip(i,k,:clubb_mf_nup) = mf_upthl(i,k_clubb,:clubb_mf_nup) - mf_upthv_flip(i,k,:clubb_mf_nup) = mf_upthv(i,k_clubb,:clubb_mf_nup) - mf_upth_flip(i,k,:clubb_mf_nup) = mf_upth(i,k_clubb,:clubb_mf_nup) - mf_upqc_flip(i,k,:clubb_mf_nup) = mf_upqc(i,k_clubb,:clubb_mf_nup) - mf_upent_flip(i,k,:clubb_mf_nup) = mf_upent(i,k_clubb,:clubb_mf_nup) - mf_updet_flip(i,k,:clubb_mf_nup) = mf_updet(i,k_clubb,:clubb_mf_nup) - mf_upbuoy_flip(i,k,:clubb_mf_nup) = mf_upbuoy(i,k_clubb,:clubb_mf_nup) - mf_dnw_flip(i,k,:clubb_mf_nup) = mf_dnw(i,k_clubb,:clubb_mf_nup) - mf_dnthl_flip(i,k,:clubb_mf_nup) = mf_dnthl(i,k_clubb,:clubb_mf_nup) - mf_dnqt_flip(i,k,:clubb_mf_nup) = mf_dnqt(i,k_clubb,:clubb_mf_nup) - end do - end do - - do k=1,clubb_mf_nup - mf_upa_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upa_flip(:ncol,:pverp,k) - mf_upw_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upw_flip(:ncol,:pverp,k) - mf_upmf_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upmf_flip(:ncol,:pverp,k) - mf_upqt_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upqt_flip(:ncol,:pverp,k) - mf_upthl_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upthl_flip(:ncol,:pverp,k) - mf_upthv_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upthv_flip(:ncol,:pverp,k) - mf_upth_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upth_flip(:ncol,:pverp,k) - mf_upqc_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upqc_flip(:ncol,:pverp,k) - mf_upent_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_upent_flip(:ncol,:pverp,k) - mf_updet_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_updet_flip(:ncol,:pverp,k) - mf_upbuoy_output(:ncol,pverp*(k-1)+1:pverp*k)= mf_upbuoy_flip(:ncol,:pverp,k) - mf_dnw_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_dnw_flip(:ncol,:pverp,k) - mf_dnthl_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_dnthl_flip(:ncol,:pverp,k) - mf_dnqt_output(:ncol,pverp*(k-1)+1:pverp*k) = mf_dnqt_flip(:ncol,:pverp,k) - end do - - do k = 1, top_lev-1 - do i = 1, ncol - mf_dry_a_output(i,k) = 0._r8 - mf_moist_a_output(i,k) = 0._r8 - mf_dry_w_output(i,k) = 0._r8 - mf_moist_w_output(i,k) = 0._r8 - mf_dry_qt_output(i,k) = 0._r8 - mf_moist_qt_output(i,k) = 0._r8 - mf_dry_thl_output(i,k) = 0._r8 - mf_moist_thl_output(i,k) = 0._r8 - mf_dry_u_output(i,k) = 0._r8 - mf_moist_u_output(i,k) = 0._r8 - mf_dry_v_output(i,k) = 0._r8 - mf_moist_v_output(i,k) = 0._r8 - mf_moist_qc_output(i,k) = 0._r8 - s_ae_output(i,k) = 0._r8 - s_aw_output(i,k) = 0._r8 - s_awthl_output(i,k) = 0._r8 - s_awqt_output(i,k) = 0._r8 - s_awu_output(i,k) = 0._r8 - s_awv_output(i,k) = 0._r8 - mf_thlflx_output(i,k) = 0._r8 - mf_qtflx_output(i,k) = 0._r8 - s_awthlup_output(i,k) = 0._r8 - s_awqtup_output(i,k) = 0._r8 - s_awuup_output(i,k) = 0._r8 - s_awvup_output(i,k) = 0._r8 - s_awthldn_output(i,k) = 0._r8 - s_awqtdn_output(i,k) = 0._r8 - s_awudn_output(i,k) = 0._r8 - s_awvdn_output(i,k) = 0._r8 - s_aww_output(i,k) = 0._r8 - mf_thlflxup_output(i,k) = 0._r8 - mf_qtflxup_output(i,k) = 0._r8 - mf_uflxup_output(i,k) = 0._r8 - mf_vflxup_output(i,k) = 0._r8 - mf_thlflxdn_output(i,k) = 0._r8 - mf_qtflxdn_output(i,k) = 0._r8 - mf_uflxdn_output(i,k) = 0._r8 - mf_vflxdn_output(i,k) = 0._r8 - mf_uflx_output(i,k) = 0._r8 - mf_vflx_output(i,k) = 0._r8 - mf_thvflx_output(i,k) = 0._r8 - mf_rcm_output(i,k) = 0._r8 - mf_precc_output(i,k) = 0._r8 - do l=1,clubb_mf_nup - mf_upa_output(i,pverp*(l-1)+k) = 0._r8 - mf_upw_output(i,pverp*(l-1)+k) = 0._r8 - mf_upmf_output(i,pverp*(l-1)+k) = 0._r8 - mf_upqt_output(i,pverp*(l-1)+k) = 0._r8 - mf_upthl_output(i,pverp*(l-1)+k) = 0._r8 - mf_upthv_output(i,pverp*(l-1)+k) = 0._r8 - mf_upth_output(i,pverp*(l-1)+k) = 0._r8 - mf_upqc_output(i,pverp*(l-1)+k) = 0._r8 - mf_upent_output(i,pverp*(l-1)+k) = 0._r8 - mf_updet_output(i,pverp*(l-1)+k) = 0._r8 - mf_upbuoy_output(i,pverp*(l-1)+k) = 0._r8 - mf_dnw_output(i,pverp*(l-1)+k) = 0._r8 - mf_dnthl_output(i,pverp*(l-1)+k) = 0._r8 - mf_dnqt_output(i,pverp*(l-1)+k) = 0._r8 - end do - end do - end do - else ! Initialize Output arrays mf_dry_a_output(:ncol,:) = 0._r8 mf_moist_a_output(:ncol,:) = 0._r8 @@ -6108,7 +5925,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_dnthl_output(:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_dnthl (:ncol, 1:pverp-top_lev+1, k) mf_dnqt_output (:ncol, pverp*(k-1)+top_lev : pverp*k) = mf_dnqt (:ncol, 1:pverp-top_lev+1, k) end do - end if call outfld( 'edmf_DRY_A' , mf_dry_a_output, pcols, lchnk ) call outfld( 'edmf_MOIST_A' , mf_moist_a_output, pcols, lchnk ) From 70774d7e190be5326d47ab34e58a773b639488ff Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Aug 2026 12:36:51 -0600 Subject: [PATCH 26/63] PR request mods for variable initializations, removed one set, allowed another. --- src/physics/cam/clubb_intr.F90 | 52 +++++++++++++++------------------- 1 file changed, 23 insertions(+), 29 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 9bbc96b59d..927ac7e62e 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -4030,12 +4030,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') - rtm_zm(:,:) = 0._r8 - thlm_zm(:,:) = 0._r8 - th_zm(:,:) = 0._r8 - qv_zm(:,:) = 0._r8 - qc_zm(:,:) = 0._r8 - ! fields on momentum grid needed for mass flux calc. rtm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm(:ncol,:) ) thlm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm(:ncol,:) ) @@ -4096,7 +4090,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & th_zm(i,:), qv_zm(i,:), qc_zm(i,:), & ! input ustar2(i), th_sfc(i), wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input tke_zm(i,:), tpert(i), rhinv(i), & ! input - wpthlp_pbuf(i,:), wpthvp_pbuf(i,:), wprtp_pbuf(i,:), & ! input + wpthlp_pbuf(i,:), wpthvp_pbuf(i,:), wprtp_pbuf(i,:), & ! input mf_ztopm1(i,:), mf_ddcp(i,:), mf_cbm1(i), & ! in-out mf_cape(i,:), & ! output mf_upa(i,:,:), mf_dna(i,:,:), & ! output @@ -4131,7 +4125,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thvflx(i,:), & ! output mf_sqtup(i,:), mf_sthlup(i,:), & ! output mf_sqtdn(i,:), mf_sthldn(i,:), & ! output - mf_sqt(i,:), mf_sthl(i,:), & ! output + mf_sqt(i,:), mf_sthl(i,:), & ! output mf_precc(i,:), & ! output mf_ztop(i,:), mf_L0(i,:) ) @@ -4840,10 +4834,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ztopma(:ncol,:) = ztopma(:ncol,:)/REAL(clubb_mf_up_ndt) end if - + if (clubb_mf_cp_ndt == 1) then ddcp(:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - else + else ddcpmn(2:clubb_mf_cp_ndt,:ncol,:) = ddcpmn(1:clubb_mf_cp_ndt-1,:ncol,:) ddcpmn(1,:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) ddcp(:ncol,:) = 0._r8 @@ -5259,25 +5253,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) ) end do end do -!jt check with Adam These are not bfb with nonclubbmf run -!jt check with Adam ! Values to use above top_lev, for variables that have not already been -!jt check with Adam ! set up there. These are mostly fill values that should not actually be -!jt check with Adam ! used in the run, but may end up in diagnostic output. -!jt check with Adam !$acc parallel loop gang vector collapse(2) default(present) -!jt check with Adam do k=1, top_lev-1 -!jt check with Adam do i=1, ncol -!jt check with Adam upwp_pbuf(i,k) = 0._r8 -!jt check with Adam vpwp_pbuf(i,k) = 0._r8 -!jt check with Adam rcm(i,k) = 0._r8 -!jt check with Adam wprcp(i,k) = 0._r8 -!jt check with Adam cloud_frac(i,k) = 0._r8 -!jt check with Adam rcm_in_layer(i,k) = 0._r8 -!jt check with Adam zt_output(i,k) = 0._r8 -!jt check with Adam zi_output(i,k) = 0._r8 -!jt check with Adam khzm_pbuf(i,k) = 0._r8 -!jt check with Adam qclvar(i,k) = 2._r8 -!jt check with Adam end do -!jt check with Adam end do + + ! 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. + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, top_lev-1 + do i=1, ncol + upwp_pbuf(i,k) = 0._r8 + vpwp_pbuf(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_output(i,k) = 0._r8 + zi_output(i,k) = 0._r8 + khzm_pbuf(i,k) = 0._r8 + qclvar(i,k) = 2._r8 + end do + end do ! ------------------------------------------------------------ ! From f4d40ee9838c21d016c3a18cd8b858b31e26082c Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Aug 2026 12:38:55 -0600 Subject: [PATCH 27/63] removed Claude comment as requested in PR --- src/physics/cam/clubb_intr.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 927ac7e62e..02dea3284a 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -3591,14 +3591,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol k_cam = top_lev - 1 + k p_in_Pa_zm(i,k) = state_loc%pint(i,k_cam) - - ! NOTE: the 'tke' pbuf field is dimensioned (pcols,pverp) rather than - ! (pcols,nzm_clubb), so unlike every other input to integrate_mf it is - ! NOT already restricted to the CLUBB sub-column and must be indexed - ! with k_cam. (This differs from the legacy code, which sequence- - ! associated tke_pbuf(i,:) into an nzm-sized dummy — a top_lev-1 - ! level misalignment whenever top_lev > 1; bit-identical for - ! top_lev = 1.) tke_zm(i,k) = tke_pbuf(i,k_cam) end do end do From 834c3c2586bf0af6bef59652af31e6bda2f9c0a4 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Aug 2026 14:26:34 -0600 Subject: [PATCH 28/63] minor PR updates some spelling corrections, remove commented code, get rid of unused variables --- bld/namelist_files/namelist_definition.xml | 4 +- src/physics/cam/clubb_intr.F90 | 52 ++++++---------------- 2 files changed, 16 insertions(+), 40 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 0e790d7fda..92c8fc36e6 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4681,7 +4681,7 @@ Default: 10 -Real: limiter on entrainmnet length scale + threshold to disable TKE enhanced entrainmnet +Real: limiter on entrainment length scale + threshold to disable TKE enhanced entrainment Default: 1.e3 @@ -9236,7 +9236,7 @@ Default: 0.125 -Mix full theta and u fields, or mix perturbation from intitial state in +Mix full theta and u fields, or mix perturbation from initial state in MPAS dycore. Default: TRUE diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 02dea3284a..6962732e92 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1543,8 +1543,6 @@ subroutine clubb_ini_cam(pbuf_ini) ! The similar name to clubb_history is unfortunate... logical :: history_amwg, history_clubb - integer :: cld_macmic_num_steps - type(err_info_type) :: & err_info ! err_info struct used in CLUBB containing err_code and err_header @@ -1604,8 +1602,7 @@ subroutine clubb_ini_cam(pbuf_ini) call phys_getopts(history_amwg_out=history_amwg, & history_clubb_out=history_clubb, & - do_hb_above_clubb_out=do_hb_above_clubb, & - cld_macmic_num_steps_out=cld_macmic_num_steps) + do_hb_above_clubb_out=do_hb_above_clubb) ! Select variables to apply tendencies back to CAM @@ -2403,19 +2400,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer :: tpert(:) - real(r8), dimension(state%ncol,nzm_clubb,clubb_mf_nup) :: & - mf_upa, mf_dna, & - mf_upw, mf_dnw, & - mf_upmf, & - mf_upqt, mf_dnqt, & - mf_upthl, mf_dnthl, & - mf_upthv, mf_dnthv, & - mf_upth, mf_dnth, & - mf_upqc, mf_dnqc, & - mf_upbuoy, & - mf_updet, & - mf_upent - real(r8), parameter :: & rad2deg=180.0_r8/pi @@ -2582,6 +2566,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & tke_zm, & ! momentum grid invrs_exner_zm ! momentum grid + real(r8), dimension(state%ncol,nzm_clubb,clubb_mf_nup) :: & + mf_upa, mf_dna, & + mf_upw, mf_dnw, & + mf_upmf, & + mf_upqt, mf_dnqt, & + mf_upthl, mf_dnthl, & + mf_upthv, mf_dnthv, & + mf_upth, mf_dnth, & + mf_upqc, mf_dnqc, & + mf_upbuoy, & + mf_updet, & + mf_upent + real(r8), dimension(state%ncol,nzt_clubb,sclr_dim) :: & sclrm_forcing, & ! Passive scalar forcing [{units vary}/s] sclrm, & ! Passive scalar mean (thermo. levels) [units vary] @@ -2624,9 +2621,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlp2_output, & dlf_liq_out, & ! Detrained liquid water from ZM [kg/kg/s] dlf_ice_out, & ! Detrained ice water from ZM [kg/kg/s] - - ! MF outputs to outfld - ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines mf_dry_a_output, mf_moist_a_output, & mf_dry_w_output, mf_moist_w_output, & mf_dry_qt_output, mf_moist_qt_output, & @@ -4711,11 +4705,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb do i = 1, ncol - k_cam = top_lev - 1 + k qclvar(i,k) = min( 1._r8, qclvar(i,k) ) ! We should move this clipping inside clubb end do end do @@ -5466,22 +5458,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & aist_pbuf(:,:top_lev-1) = 0._r8 qsatfac_pbuf(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below -!+++arh -- debug statements -! if (iam == 444) then -! write(iam+1000,*) '------------ lchnk=',lchnk,'------------' -! write(iam+1000,*) 'nstep=',get_nstep(),' macmic_it=',macmic_it -! do i=1,ncol -! do k = top_lev,pver -! write(iam+1000,*) 'i=',i,' k=',k -! write(iam+1000,*) 'state_loc%q(i,k,ixq) = ',state_loc%q(i,k,ixq) -! write(iam+1000,*) 'state_loc%q(i,k,ixcldice) = ',state_loc%q(i,k,ixcldice) -! !write(iam+1000,*) 'state_loc%q(i,k,ixnumice) = ',state_loc%q(i,k,ixnumice) -! write(iam+1000,*) 'state_loc%t(i,k) = ',state_loc%t(i,k) -! write(iam+1000,*) 'state_loc%pmid(i,k) = ',state_loc%pmid(i,k) -! end do -! end do -! end if - do k = top_lev, pver ! For Type II PSC and for thin cirrus, the clouds can be thin, but From c91ab4100356d7d9f43f054217269483989577f6 Mon Sep 17 00:00:00 2001 From: adamrher Date: Sat, 22 Aug 2026 19:21:52 -0600 Subject: [PATCH 29/63] modifcations for MF code to conserve mass --- src/physics/cam/clubb_intr.F90 | 32 +++------- src/physics/cam/clubb_mf.F90 | 103 ++++++++++++++++++++++++++++++++- 2 files changed, 108 insertions(+), 27 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 6962732e92..7c0880661f 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2766,7 +2766,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & errflg, & j, k, t, ixind, nadv, n, & ! Loop variables k_cam, k_clubb, k_clubb_pver, sclr, iedsclr, & ! Loop variables - k_above, k_below, & ! Interfaces bounding thermo level k (MF precip sweep) ixcldice, ixcldliq, ixnumliq, & ixnumice, ixq, & itim_old, & @@ -2784,6 +2783,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! CFL limiter vars real(r8), parameter :: cflval = 1._r8 real(r8) :: lambda + character(len=256) :: lambda_errmsg real(r8), dimension(state%ncol) :: cflfac, max_cfl, & th_sfc, max_cfl_nadv logical :: cfllim @@ -4067,7 +4067,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol - call integrate_mf( nzm_clubb, nzt_clubb, & ! input + call integrate_mf( nzm_clubb, nzt_clubb, dtime, & ! input rho_zm(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input rho_zt(i,:), dz_g(i,:), zt_g(i,:), p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input @@ -4133,37 +4133,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (max_cfl(i).gt.cflval.and.cfllim) cflfac(i) = cflval/max_cfl(i) end do - ! Scale microphys so it can't drive qt negative + ! check for mass conservation do k=1,nzt_clubb do i=1,ncol if ((-1._r8*mf_sqt(i,k)*dtime) > rtm(i,k)) then lambda = -1._r8*rtm(i,k)/(mf_sqt(i,k)*dtime) - mf_sqt(i,k) = lambda*mf_sqt(i,k) - mf_sthl(i,k) = lambda*mf_sthl(i,k) - mf_sqtup(i,k) = lambda*mf_sqtup(i,k) - mf_sthlup(i,k) = lambda*mf_sthlup(i,k) - mf_sqtdn(i,k) = lambda*mf_sqtdn(i,k) - mf_sthldn(i,k) = lambda*mf_sthldn(i,k) + write(lambda_errmsg,'(a,3i6,4es16.8)') & + 'MF drying exceeds rtm. lchnk,i,k,lambda,mf_sqt,rtm,dtime = ', & + lchnk, i, k, lambda, mf_sqt(i,k), rtm(i,k), dtime + call endrun('clubb_tend_cam: '//trim(lambda_errmsg)) end if end do end do - ! Recalculate precip using new microphys forcing. - ! Precip accumulates downward across the interfaces, starting from zero - ! at the model top, so the sweep must run top-to-bottom in ALTITUDE - ! rather than in index order: from gr%k_ub_zt to gr%k_lb_zt with a step - ! of -gr%grid_dir_indx (+1 descending, -1 ascending). For thermodynamic - ! level k the bounding interfaces are k+(1+kdir)/2 above and - ! k+(1-kdir)/2 below, which reduce to k and k+1 on a descending grid. - mf_precc(:ncol,:) = 0._r8 - do k = gr%k_ub_zt, gr%k_lb_zt, -gr%grid_dir_indx - k_above = k + ( 1 + gr%grid_dir_indx ) / 2 - k_below = k + ( 1 - gr%grid_dir_indx ) / 2 - do i = 1, ncol - mf_precc(i,k_below) = mf_precc(i,k_above) - rho_zt(i,k)*dz_g(i,k)*mf_sqt(i,k) - end do - end do - ! pass MF turbulent advection term as CLUBB explicit forcing term rtm_forcing(:ncol,:) = 0._r8 thlm_forcing(:ncol,:) = 0._r8 diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 6e7cc5b17b..fa23e0c87e 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -188,7 +188,7 @@ subroutine clubb_mf_readnl(nlfile) end subroutine clubb_mf_readnl - subroutine integrate_mf( nzm, nzt, & ! input + subroutine integrate_mf( nzm, nzt, dtime, & ! input rho_zm, zm, p_zm, iexner_zm, & ! input rho_zt, dzt, zt, p_zt, iexner_zt, & ! input u, v, thl, qt, thv, & ! input @@ -262,7 +262,8 @@ subroutine integrate_mf( nzm, nzt, use wv_saturation, only : qsat - integer, intent(in) :: nzm, nzt + integer, intent(in) :: nzm, nzt + real(r8), intent(in) :: dtime ! host-model physics timestep [s] real(r8), dimension(nzt), intent(in) :: u, v, & ! thermodynamic grid thl, thv, & ! thermodynamic grid th, qv, & ! thermodynamic grid @@ -393,6 +394,16 @@ subroutine integrate_mf( nzm, nzt, upauto ! thermodynamic grid ! precipitation rates real(r8), dimension(nzm,clubb_mf_nup) :: uprr, dnrr ! momentum grid + ! + ! grid-mean (area-weighted) rain reservoirs. uprr/dnrr above are + ! per-unit-plume-area and drive the local evaporation physics; uprg/dnrg carry + ! the same budgets in grid-mean units (weighted by the plume areas used in the + ! sqtup/sqtdn accumulations) so that the area-weighted evaporation can never + ! exceed the area-weighted rain supply. This guarantees the column integral of + ! sqt (and hence surface precc / PRECC) is non-negative. + real(r8), dimension(nzm,clubb_mf_nup) :: uprg, dnrg ! momentum grid + real(r8) :: drytot, lamk, sdnmax + real(r8), parameter :: mf_dry_frac_max = 0.9_r8 ! max fractional total water removable per timestep ! ! entrainment profiles real(r8), dimension(nzt,clubb_mf_nup) :: entf, mix ! thermodynamic grid @@ -616,6 +627,7 @@ subroutine integrate_mf( nzm, nzt, upbuoy= 0._r8 uplmix= 0._r8 uprr = 0._r8 + uprg = 0._r8 supqt = 0._r8 supthl= 0._r8 upent = 0._r8 @@ -630,6 +642,7 @@ subroutine integrate_mf( nzm, nzt, dnthl = 0._r8 dnthv = 0._r8 dnrr = 0._r8 + dnrg = 0._r8 dnth = 0._r8 dnqc = 0._r8 dnql = 0._r8 @@ -1152,6 +1165,42 @@ subroutine integrate_mf( nzm, nzt, enddo enddo + ! ---------------------------------------------------------- ! + ! In-scheme production limiter ! + ! Cap the area-weighted plume drying at each level so the ! + ! grid-mean microphysical sink cannot remove more than ! + ! mf_dry_frac_max of the grid-cell total water in a timestep.! + ! Because the cap is applied BEFORE the rain/evaporation ! + ! sweeps and the downdraft section, all downstream rain ! + ! accounting is consistent with the limited production. A ! + ! common per-level factor lamk preserves the relative ! + ! weighting of the plumes in the ensemble. The limiter ! + ! establishes the invariant -sqt*dtime <= mf_dry_frac_max*qt ! + ! (asserted in clubb_intr.F90); the margin below 1.0 leaves ! + ! room for other same-step moisture sinks and puts the ! + ! assertion safely beyond roundoff. ! + ! ---------------------------------------------------------- ! + if (do_clubb_mf_precip) then + do k = ksfcm+kdir, ktopm, kdir + kt = k - (1+kdir)/2 + kn = k - kdir + drytot = 0._r8 + do i=1,clubb_mf_nup + drytot = drytot + upa(kn,i)*max(-1._r8*supqt(kt,i), 0._r8) + end do + if (drytot*dtime > mf_dry_frac_max*max(qt(kt),0._r8)) then + lamk = mf_dry_frac_max*max(qt(kt),0._r8)/(drytot*dtime) + do i=1,clubb_mf_nup + if (supqt(kt,i) < 0._r8) then + supqt(kt,i) = lamk*supqt(kt,i) + supthl(kt,i) = lamk*supthl(kt,i) + upauto(kt,i) = lamk*upauto(kt,i) + end if + end do + end if + end do + end if + ! --------------------------------------------------------- ! ! downward sweep for rain evaporation, snow melting ! ! --------------------------------------------------------- ! @@ -1173,10 +1222,24 @@ subroutine integrate_mf( nzm, nzt, ! limit evaporation to available precip sevap = min(sevap,( uprr(k,i)/(rho_zt(kt)*dzt(kt)) - supqt(kt,i)*(1._r8-clubb_mf_fdd) )) + ! further limit the area-weighted evaporation to the + ! area-weighted (grid-mean) rain supply. Weight is upa + ! at the interface below the cell, matching the sqtup accumulation + if (upa(kn,i) > 0._r8) then + sevap = min(sevap, uprg(k,i)/(rho_zt(kt)*dzt(kt)*upa(kn,i)) & + - supqt(kt,i)*(1._r8-clubb_mf_fdd) ) + end if + sevap = max(sevap, 0._r8) + ! get rain rate uprr(kn,i) = uprr(k,i) & - rho_zt(kt)*dzt(kt)*( supqt(kt,i)*(1._r8-clubb_mf_fdd) + sevap ) + ! grid-mean rain reservoir (max() only guards roundoff; + ! the cap above keeps this non-negative by construction) + uprg(kn,i) = max( uprg(k,i) & + - rho_zt(kt)*dzt(kt)*upa(kn,i)*( supqt(kt,i)*(1._r8-clubb_mf_fdd) + sevap ), 0._r8 ) + ! update source terms lmixt = 0.5_r8*(uplmix(k,i)+uplmix(kn,i)) supqt(kt,i) = supqt(kt,i) + sevap @@ -1226,6 +1289,13 @@ subroutine integrate_mf( nzm, nzt, ! (we are using an upward sweep notation to be consistent with how uprr(ddtop) was computed) dnrr(ddtopm,i) = -1._r8*dzt(ddtopm - (1-kdir)/2)*rho_zt(ddtopm - (1-kdir)/2)*upauto(ddtopm - (1-kdir)/2,i)*clubb_mf_fdd + ! grid-mean downdraft rain reservoir seed. area weight is + ! upa at the interface below the generating cell, which is ddtopm + ! itself (matching the sqtup accumulation weighting of the + ! production that this rain came from). + dnrg(ddtopm,i) = -1._r8*dzt(ddtopm - (1-kdir)/2)*rho_zt(ddtopm - (1-kdir)/2) & + *upa(ddtopm,i)*upauto(ddtopm - (1-kdir)/2,i)*clubb_mf_fdd + if (fixent) then entn = fixent_ent else @@ -1255,6 +1325,17 @@ subroutine integrate_mf( nzm, nzt, ! get rain evaporation in tendency form sdnqt(kt,i) = max( (dnqs(k,i) - dnqt(k,i))*taum1, 0._r8 ) + + ! cap the tendency-form downdraft evaporation by the + ! area-weighted rain actually available to the downdraft. + ! weights: dna at the interface above the cell + ! (matching the sqtdn accumulation), upa at the interface below + ! (matching sqtup). + if (dna(k,i) > 0._r8) then + sdnmax = ( dnrg(k,i)/(rho_zt(kt)*dzt(kt)) & + - upa(kn,i)*upauto(kt,i)*clubb_mf_fdd ) / dna(k,i) + sdnqt(kt,i) = min( sdnqt(kt,i), max(sdnmax, 0._r8) ) + end if sdnthl(kt,i) = -1._r8*latvap*sdnqt(kt,i)*iexner_zt(kt)/cpair ! compute rain rate (rain above - evaporation + appropriate updraft rain) @@ -1293,6 +1374,14 @@ subroutine integrate_mf( nzm, nzt, else sdnqt(kt,i) = 0._r8 end if + + ! apply the same area-weighted available-rain cap to + ! the recomputed (saturation-adjusted) evaporation tendency + if (dna(k,i) > 0._r8) then + sdnmax = ( dnrg(k,i)/(rho_zt(kt)*dzt(kt)) & + - upa(kn,i)*upauto(kt,i)*clubb_mf_fdd ) / dna(k,i) + sdnqt(kt,i) = min( sdnqt(kt,i), max(sdnmax, 0._r8) ) + end if sdnthl(kt,i) = -1._r8*latvap*sdnqt(kt,i)*iexner_zt(kt)/cpair ! re-compute thl with new evaporation rate @@ -1303,6 +1392,13 @@ subroutine integrate_mf( nzm, nzt, - rho_zt(kt)*dzt(kt)*(sdnqt(kt,i) + upauto(kt,i)*clubb_mf_fdd) , 0._r8 ) end if + ! grid-mean downdraft rain reservoir, using the final + ! (capped) evaporation tendency. max() only guards roundoff; the + ! sdnqt cap keeps this non-negative by construction. + dnrg(kn,i) = max( dnrg(k,i) & + - rho_zt(kt)*dzt(kt)*( dna(k,i)*sdnqt(kt,i) & + + upa(kn,i)*upauto(kt,i)*clubb_mf_fdd ), 0._r8 ) + ! get virtual temperature dnthv(kn,i) = dnthl(kn,i)*(1._r8+zvir*dnqt(kn,i)) @@ -1623,6 +1719,9 @@ subroutine integrate_mf( nzm, nzt, precc(k-kdir) = precc(k) - rho_zt(kt_dn)*dzt(kt_dn)*sqt(kt_dn) end do + ! this clamp only removes roundoff (upstream limiters conserve mass) + precc(ksfcm) = max( precc(ksfcm), 0._r8 ) + ! --------------------------------------------------------- ! ! get turbulent fluxes ! ! --------------------------------------------------------- ! From a70356b0cb629e18eca9879ab1c492fbbad924e2 Mon Sep 17 00:00:00 2001 From: adamrher Date: Fri, 28 Aug 2026 14:16:07 -0600 Subject: [PATCH 30/63] bugfix to wp2_pbuf (missing MF contribution) --- src/physics/cam/clubb_intr.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 7c0880661f..1a16db5b3d 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -4700,6 +4700,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k + wp2_pbuf(i,k_cam) = wp2_pbuf(i,k_cam) + s_aww(i,k) khzm_pbuf(i,k_cam) = khzm(i,k) + & clubb_params(i,ic_K) * Lscale_zm(i,k) * sqrt(0.5_r8 * s_aww(i,k)) end do @@ -4709,7 +4710,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k - khzm_pbuf(i,k_cam) = khzm(i,k) + khzm_pbuf(i,k_cam) = khzm(i,k) end do end do end if From f29d8b23c2dfe61a1bf3700d2d2e1c6f5a071e81 Mon Sep 17 00:00:00 2001 From: adamrher Date: Fri, 28 Aug 2026 14:57:32 -0600 Subject: [PATCH 31/63] setup clubb-mf namelist defaults (part 1) --- bld/build-namelist | 85 +++++++++++++--------- bld/namelist_files/namelist_definition.xml | 32 ++++---- src/physics/cam/clubb_mf.F90 | 42 +++++------ 3 files changed, 89 insertions(+), 70 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index ee5c2c0baa..ffb50fe9bb 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3303,8 +3303,17 @@ if (($chem ne 'none') and ($chem ne 'terminator') and !($chem =~ /geoschem/)) { add_default($nl, 'chem_use_chemtrop'); } +# clubb-mf unified convection scheme +add_default($nl, 'do_clubb_mf'); +my $clubb_mf = $nl->get_value('do_clubb_mf'); + +if ($clubb_mf eq '.true.') { + add_default($nl, 'deep_scheme', 'val'=>'off'); +} else { + add_default($nl, 'deep_scheme'); +} + # Deep convection scheme -add_default($nl, 'deep_scheme'); my $deep_scheme = $nl->get_value('deep_scheme'); # Aerosol convective processes @@ -3690,38 +3699,48 @@ if ($clubb_sgs =~ /$TRUE/io) { #CLUBB+MF options add_default($nl, 'do_clubb_mf'); - add_default($nl, 'do_clubb_mf_diag'); - add_default($nl, 'do_clubb_mf_rad'); - add_default($nl, 'do_clubb_mf_precip'); - add_default($nl, 'do_clubb_mf_addtke'); - add_default($nl, 'clubb_mf_L0'); - add_default($nl, 'clubb_mf_ent0'); - add_default($nl, 'clubb_mf_alphturb'); - add_default($nl, 'clubb_mf_Lopt'); - add_default($nl, 'clubb_mf_a0'); - add_default($nl, 'clubb_mf_b0'); - add_default($nl, 'clubb_mf_nup'); - add_default($nl, 'clubb_mf_max_L0'); - add_default($nl, 'clubb_mf_fdd'); - add_default($nl, 'do_clubb_mf_coldpool'); - add_default($nl, 'clubb_mf_ddalph'); - add_default($nl, 'clubb_mf_ddbeta'); - add_default($nl, 'clubb_mf_pwfac'); - add_default($nl, 'clubb_mf_ddexp'); - add_default($nl, 'clubb_mf_pwmin'); - add_default($nl, 'clubb_mf_pwmax'); - add_default($nl, 'clubb_mf_cldfrac_fac'); - add_default($nl, 'do_clubb_mf_ustar'); - add_default($nl, 'do_clubb_mf_mixd'); - add_default($nl, 'clubb_mf_up_ndt'); - add_default($nl, 'clubb_mf_cp_ndt'); - add_default($nl, 'do_clubb_mf_rhtke'); - add_default($nl, 'do_clubb_mf_cmt'); - add_default($nl, 'clubb_mf_kseed'); - add_default($nl, 'do_clubb_mf_lscale_perplume'); - add_default($nl, 'do_clubb_mf_coldpool_perplume'); - add_default($nl, 'do_clubb_mf_coldpool_init'); - add_default($nl, 'do_clubb_mf_aloft'); + my $clubb_mf = $nl->get_value('do_clubb_mf'); + if ($clubb_sgs =~ /$TRUE/io) { + + #CLUBB+MF tunings + add_default($nl, 'clubb_l_do_expldiff_rtm_thlm', 'val'=>'.false.'); + add_default($nl, 'microp_aero_wsub_scale', 'val'=>'0.5'); + add_default($nl, 'microp_aero_wsubi_scale', 'val'=>'0.5'); + add_default($nl, 'clubb_l_predict_upwp_vpwp', 'val'=>'.false.'); + + add_default($nl, 'do_clubb_mf_diag'); + add_default($nl, 'do_clubb_mf_rad'); + add_default($nl, 'do_clubb_mf_precip'); + add_default($nl, 'do_clubb_mf_addtke'); + add_default($nl, 'clubb_mf_L0'); + add_default($nl, 'clubb_mf_ent0'); + add_default($nl, 'clubb_mf_alphturb'); + add_default($nl, 'clubb_mf_Lopt'); + add_default($nl, 'clubb_mf_a0'); + add_default($nl, 'clubb_mf_b0'); + add_default($nl, 'clubb_mf_nup'); + add_default($nl, 'clubb_mf_max_L0'); + add_default($nl, 'clubb_mf_fdd'); + add_default($nl, 'do_clubb_mf_coldpool'); + add_default($nl, 'clubb_mf_ddalph'); + add_default($nl, 'clubb_mf_ddbeta'); + add_default($nl, 'clubb_mf_pwfac'); + add_default($nl, 'clubb_mf_ddexp'); + add_default($nl, 'clubb_mf_pwmin'); + add_default($nl, 'clubb_mf_pwmax'); + add_default($nl, 'clubb_mf_cldfrac_fac'); + add_default($nl, 'do_clubb_mf_ustar'); + add_default($nl, 'do_clubb_mf_mixd'); + add_default($nl, 'clubb_mf_up_ndt'); + add_default($nl, 'clubb_mf_cp_ndt'); + add_default($nl, 'do_clubb_mf_rhtke'); + add_default($nl, 'do_clubb_mf_cmt'); + add_default($nl, 'clubb_mf_kseed'); + add_default($nl, 'do_clubb_mf_lscale_perplume'); + add_default($nl, 'do_clubb_mf_coldpool_perplume'); + add_default($nl, 'do_clubb_mf_coldpool_init'); + add_default($nl, 'do_clubb_mf_aloft'); + } } # Tuning for wet scavenging of modal aerosols diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 92c8fc36e6..ce179cd73a 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4620,19 +4620,19 @@ Default: .false. If .true. turn on Suselj et al 2019 microphysics. -Default: .false. +Default: .true. If .true. couple MF plumes to radiation -Default: .false. +Default: .true. If .true. add MF contribution to TKE pbuf variable -Default: .false. +Default: .true. Integer: dynamic entrainment length scale option -Default: 0 +Default: 6 Real: linear coefficient relating ztop/cape to entrainment length scale -Default: 2.0 +Default: 0.15 Real: exponential coefficient relating ztop/cape to entrainment length scale -Default: 0.5 +Default: 1.0 Weighting factor for CLUBB TKE on plume entrainment -Default: 0.0 +Default: 3.0 Real: number of plumes in mass flux ensemble -Default: 10 +Default: 25 Fraction of autoconversion partitioned to downdrafts (zero means no downdrafts) -Default: 0.0 +Default: 0.5 If .true. turn on cold pool feedback parameterizations -Default: .false. +Default: .true. Linear enhancement factor to the downdrafts used for the cold pool calculations -Default: 200.0 +Default: 12.0 Factor to increase the ensemble MF plume cloud fractions -Default: 1.0 +Default: 10.0 If .true. use relative humidity thresholds to turn off TKE enhanced entrainment -Default: .false. +Default: .true. If .true. set unique entrainment length scale for each plume member -Default: .false. +Default: .true. If .true. set cold pool feedback to unique to each plume member -Default: .false. +Default: .true. If .true. turn on elevated convective initialization -Default: .false. +Default: .true. diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index fa23e0c87e..3c64638803 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -41,39 +41,39 @@ module clubb_mf ! 6 = ztopm1 ! 7 = rel.hum. at 500 hPa ! 8 = column int. rel.hum. - integer :: clubb_mf_Lopt = 0 - real(r8) :: clubb_mf_a0 = 0._r8 - real(r8) :: clubb_mf_b0 = 0._r8 - real(r8) :: clubb_mf_L0 = 0._r8 - real(r8) :: clubb_mf_ent0 = 0._r8 - real(r8) :: clubb_mf_alphturb= 0._r8 - real(r8) :: clubb_mf_max_L0 = 0._r8 - real(r8) :: clubb_mf_fdd = 0._r8 - real(r8) :: clubb_mf_ddalph = 0._r8 - real(r8) :: clubb_mf_ddbeta = 0._r8 - real(r8) :: clubb_mf_pwfac = 0._r8 - real(r8) :: clubb_mf_ddexp = 0._r8 + integer :: clubb_mf_Lopt = 6 + real(r8) :: clubb_mf_a0 = 0.15_r8 + real(r8) :: clubb_mf_b0 = 1.0_r8 + real(r8) :: clubb_mf_L0 = 50._r8 + real(r8) :: clubb_mf_ent0 = 0.2_r8 + real(r8) :: clubb_mf_alphturb= 3.0_r8 + real(r8) :: clubb_mf_max_L0 = 1.e3_r8 + real(r8) :: clubb_mf_fdd = 0.5_r8 + real(r8) :: clubb_mf_ddalph = 12.0_r8 + real(r8) :: clubb_mf_ddbeta = 1.0_r8 + real(r8) :: clubb_mf_pwfac = 1.0_r8 + real(r8) :: clubb_mf_ddexp = 3.0_r8 real(r8) :: clubb_mf_pwmin = 1.5_r8 real(r8) :: clubb_mf_pwmax = 3.0_r8 - real(r8) :: clubb_mf_cldfrac_fac = 1._r8 + real(r8) :: clubb_mf_cldfrac_fac = 10._r8 integer :: clubb_mf_up_ndt = 1 integer :: clubb_mf_cp_ndt = 1 integer :: clubb_mf_kseed = 1 integer, protected :: clubb_mf_nup = 0 logical, protected :: do_clubb_mf = .false. logical, protected :: do_clubb_mf_diag = .false. - logical, protected :: do_clubb_mf_rad = .false. - logical, protected :: do_clubb_mf_addtke = .false. - logical, protected :: do_clubb_mf_coldpool = .false. + logical, protected :: do_clubb_mf_rad = .true. + logical, protected :: do_clubb_mf_addtke = .true. + logical, protected :: do_clubb_mf_coldpool = .true. logical, protected :: do_clubb_mf_ustar = .false. logical, protected :: do_clubb_mf_mixd = .false. - logical, protected :: do_clubb_mf_precip = .false. - logical, protected :: do_clubb_mf_rhtke = .false. + logical, protected :: do_clubb_mf_precip = .true. + logical, protected :: do_clubb_mf_rhtke = .true. logical, protected :: do_clubb_mf_cmt = .false. - logical, protected :: do_clubb_mf_aloft = .false. + logical, protected :: do_clubb_mf_aloft = .true. logical, protected :: do_clubb_mf_coldpool_init = .false. - logical, protected :: do_clubb_mf_coldpool_perplume = .false. - logical, protected :: do_clubb_mf_lscale_perplume = .false. + logical, protected :: do_clubb_mf_coldpool_perplume = .true. + logical, protected :: do_clubb_mf_lscale_perplume = .true. logical :: tht_tweaks = .true. integer :: mf_num_cin = 5 From 2b132afc7ff1fbb682bf399064f63a5f468c2843 Mon Sep 17 00:00:00 2001 From: adamrher Date: Fri, 28 Aug 2026 15:00:15 -0600 Subject: [PATCH 32/63] quick fix to last push --- bld/build-namelist | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index ffb50fe9bb..f33b68b828 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3303,7 +3303,7 @@ if (($chem ne 'none') and ($chem ne 'terminator') and !($chem =~ /geoschem/)) { add_default($nl, 'chem_use_chemtrop'); } -# clubb-mf unified convection scheme +# CLUBB-MF unified convection scheme add_default($nl, 'do_clubb_mf'); my $clubb_mf = $nl->get_value('do_clubb_mf'); @@ -3701,13 +3701,6 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'do_clubb_mf'); my $clubb_mf = $nl->get_value('do_clubb_mf'); if ($clubb_sgs =~ /$TRUE/io) { - - #CLUBB+MF tunings - add_default($nl, 'clubb_l_do_expldiff_rtm_thlm', 'val'=>'.false.'); - add_default($nl, 'microp_aero_wsub_scale', 'val'=>'0.5'); - add_default($nl, 'microp_aero_wsubi_scale', 'val'=>'0.5'); - add_default($nl, 'clubb_l_predict_upwp_vpwp', 'val'=>'.false.'); - add_default($nl, 'do_clubb_mf_diag'); add_default($nl, 'do_clubb_mf_rad'); add_default($nl, 'do_clubb_mf_precip'); From b731848606041a5b2ef1a5e39983b0507a7aa5a7 Mon Sep 17 00:00:00 2001 From: adamrher Date: Fri, 28 Aug 2026 19:27:34 -0600 Subject: [PATCH 33/63] setup clubb-mf namelists (part 2 of 2) --- bld/build-namelist | 30 +++++++++++----- bld/namelist_files/namelist_defaults_cam.xml | 36 ++++++++++---------- bld/namelist_files/namelist_definition.xml | 2 +- src/physics/cam/clubb_mf.F90 | 2 +- 4 files changed, 41 insertions(+), 29 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index f33b68b828..5cceb1b566 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3307,7 +3307,7 @@ if (($chem ne 'none') and ($chem ne 'terminator') and !($chem =~ /geoschem/)) { add_default($nl, 'do_clubb_mf'); my $clubb_mf = $nl->get_value('do_clubb_mf'); -if ($clubb_mf eq '.true.') { +if ($clubb_mf =~ "true") { add_default($nl, 'deep_scheme', 'val'=>'off'); } else { add_default($nl, 'deep_scheme'); @@ -3429,12 +3429,19 @@ if ($cfg->get('microphys') =~ /^mg/) { # Aerosol Namelist options add_default($nl, 'microp_aero_bulk_scale'); add_default($nl, 'microp_aero_npccn_scale'); -add_default($nl, 'microp_aero_wsub_scale'); -add_default($nl, 'microp_aero_wsubi_scale'); add_default($nl, 'microp_aero_wsub_min'); add_default($nl, 'microp_aero_wsub_min_asf'); add_default($nl, 'microp_aero_wsubi_min'); +# CLUBB-MF cloud droplet activation tuning +if ($clubb_mf =~ "true") { + add_default($nl, 'microp_aero_wsub_scale', 'val'=>'0.5'); + add_default($nl, 'microp_aero_wsubi_scale', 'val'=>'0.5'); +} else { + add_default($nl, 'microp_aero_wsub_scale'); + add_default($nl, 'microp_aero_wsubi_scale'); +} + # Ice nucleation options if (!$simple_phys) { if ($chem =~ /_mam/ or $carma =~ /trop_strat/) { @@ -3647,7 +3654,6 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_l_call_pdf_closure_twice'); add_default($nl, 'clubb_l_damp_wp2_using_em'); add_default($nl, 'clubb_l_damp_wp3_Skw_squared'); - add_default($nl, 'clubb_l_do_expldiff_rtm_thlm'); add_default($nl, 'clubb_l_e3sm_config'); add_default($nl, 'clubb_l_enable_relaxed_clipping'); add_default($nl, 'clubb_l_godunov_upwind_wpxp_ta'); @@ -3663,7 +3669,6 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_l_mono_flux_lim_um'); add_default($nl, 'clubb_l_mono_flux_lim_vm'); add_default($nl, 'clubb_l_partial_upwind_wp3'); - add_default($nl, 'clubb_l_predict_upwp_vpwp'); add_default($nl, 'clubb_l_ho_nontrad_coriolis'); add_default($nl, 'clubb_l_ho_trad_coriolis'); add_default($nl, 'clubb_l_rcm_supersat_adj'); @@ -3694,13 +3699,20 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_wpxp_Ri_exp'); add_default($nl, 'clubb_z_displace'); + # CLUBB-MF runs w/o expldiff & prognostic momentum fluxes + if ($clubb_mf =~ "true") { + add_default($nl, 'clubb_l_predict_upwp_vpwp', 'val'=>'.false.'); + add_default($nl, 'clubb_l_do_expldiff_rtm_thlm', 'val'=>'.false.'); + } else { + add_default($nl, 'clubb_l_predict_upwp_vpwp'); + add_default($nl, 'clubb_l_do_expldiff_rtm_thlm'); + } + #Turn on HB scheme where CLUBB not active add_default($nl, 'do_hb_above_clubb'); - #CLUBB+MF options - add_default($nl, 'do_clubb_mf'); - my $clubb_mf = $nl->get_value('do_clubb_mf'); - if ($clubb_sgs =~ /$TRUE/io) { + # CLUBB-MF options + if ($clubb_mf =~ "true") { add_default($nl, 'do_clubb_mf_diag'); add_default($nl, 'do_clubb_mf_rad'); add_default($nl, 'do_clubb_mf_precip'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 0390b6aa8e..0187344add 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2354,37 +2354,37 @@ .false. .false. - .false. - .false. - .false. - 50.0 + .true. + .true. + .true. + 200.0 0.2 - 0.0 - 0 - 2.0 - 0.5 - 10 - 1.e3 - 0.0 - .false. - 2.e2 + 3.0 + 6 + 0.15 + 1.0 + 25 + 1.e3 + 0.5 + .true. + 12.0 1.0 1.0 3.0 1.5 3.0 - 1.0 + 10.0 .false. .false. 1 1 - .false. + .true. .false. - .false. + .true. .false. - .false. + .true. 1 - .false. + .true. 10 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index ce179cd73a..67b45bfbdd 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4639,7 +4639,7 @@ Default: .true. group="clubb_mf_nl" valid_values="" > Entrainment length scale in meters for individual plumes. Not used if do_clubb_mf=FALSE. -Default: 50.0 +Default: 200.0 Date: Sun, 30 Aug 2026 08:59:24 -0600 Subject: [PATCH 34/63] update remaining turbulent fluxes from energy to kinematic units --- src/physics/cam/clubb_intr.F90 | 58 ++++++++++++++++------------------ 1 file changed, 28 insertions(+), 30 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 6962732e92..06ebaf63af 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1792,28 +1792,28 @@ subroutine clubb_ini_cam(pbuf_ini) ! These are default CLUBB output. Not the higher order history budgets call addfld ('RHO_CLUBB', (/ 'lev ' /), 'A', 'kg/m3', 'Air Density', sampled_on_subcycle = .true. ) - call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance', sampled_on_subcycle = .true. ) - call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance', sampled_on_subcycle = .true. ) - call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance', sampled_on_subcycle = .true. ) + call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance', sampled_on_subcycle = .true. ) + call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance', sampled_on_subcycle = .true. ) + call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance', sampled_on_subcycle = .true. ) call addfld ('WP2_ZT_CLUBB', (/ 'lev ' /), 'A', 'm2/s2', 'Vert Vel Variance on zt grid', sampled_on_subcycle = .true. ) - call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux', sampled_on_subcycle = .true. ) - call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux', sampled_on_subcycle = .true. ) + call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux', sampled_on_subcycle = .true. ) + call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux', sampled_on_subcycle = .true. ) call addfld ('WP3_CLUBB', (/ 'lev ' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity', sampled_on_subcycle = .true. ) - call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Heat Flux', sampled_on_subcycle = .true. ) - call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux', sampled_on_subcycle = .true. ) - call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2', 'Moisture Variance', sampled_on_subcycle = .true. ) + call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K m/s', 'Heat Flux', sampled_on_subcycle = .true. ) + call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'kg/kg m/s', 'Moisture Flux', sampled_on_subcycle = .true. ) + call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2', 'Moisture Variance', sampled_on_subcycle = .true. ) call addfld ('RTP2_ZT_CLUBB', (/ 'lev ' /), 'A', 'kg^2/kg^2', 'Moisture Variance on zt grid', sampled_on_subcycle = .true. ) - call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance', sampled_on_subcycle = .true. ) + call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance', sampled_on_subcycle = .true. ) call addfld ('THLP2_ZT_CLUBB', (/ 'lev ' /), 'A', 'K^2', 'Temperature Variance on zt grid', sampled_on_subcycle = .true. ) - call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K kg/kg', 'Temp. Moist. Covariance', sampled_on_subcycle = .true. ) + call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K kg/kg', 'Temp. Moist. Covariance', sampled_on_subcycle = .true. ) call addfld ('RCM_CLUBB', (/ 'lev ' /), 'A', 'kg/kg', 'Cloud Water Mixing Ratio', sampled_on_subcycle = .true. ) call addfld ('RTM_CLUBB', (/ 'lev ' /), 'A', 'kg/kg', 'Total Water Mixing Ratio', sampled_on_subcycle = .true. ) call addfld ('THLM_CLUBB', (/ 'lev ' /), 'A', 'K', 'Liquid Water Potential Temperature', sampled_on_subcycle = .true. ) - call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux', sampled_on_subcycle = .true. ) + call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'kg/kg m/s', 'Liquid Water Flux', sampled_on_subcycle = .true. ) call addfld ('CLOUDFRAC_CLUBB', (/ 'lev ' /), 'A', 'fraction', 'Cloud Fraction', sampled_on_subcycle = .true. ) call addfld ('RCMINLAYER_CLUBB', (/ 'lev ' /), 'A', 'kg/kg', 'Cloud Water in Layer', sampled_on_subcycle = .true. ) call addfld ('CLOUDCOVER_CLUBB', (/ 'lev ' /), 'A', 'fraction', 'Cloud Cover', sampled_on_subcycle = .true. ) - call addfld ('WPTHVP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Buoyancy Flux', sampled_on_subcycle = .true. ) + call addfld ('WPTHVP_CLUBB', (/ 'ilev' /), 'A', 'K m/s', 'Buoyancy Flux', sampled_on_subcycle = .true. ) call addfld ('RVMTEND_CLUBB', (/ 'lev ' /), 'A', 'kg/kg /s', 'Water vapor tendency', sampled_on_subcycle = .true. ) call addfld ('STEND_CLUBB', (/ 'lev ' /), 'A', 'J/(kg s)', 'Static energy tendency', sampled_on_subcycle = .true. ) call addfld ('RCMTEND_CLUBB', (/ 'lev ' /), 'A', 'kg/kg /s', 'Cloud Liquid Water Tendency', sampled_on_subcycle = .true. ) @@ -1821,7 +1821,7 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ('UTEND_CLUBB', (/ 'lev ' /), 'A', 'm/s /s', 'U-wind Tendency', sampled_on_subcycle = .true. ) call addfld ('VTEND_CLUBB', (/ 'lev ' /), 'A', 'm/s /s', 'V-wind Tendency', sampled_on_subcycle = .true. ) call addfld ('ZT_CLUBB', (/ 'lev ' /), 'A', 'm', 'Thermodynamic Heights', sampled_on_subcycle = .true. ) - call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights', sampled_on_subcycle = .true. ) + call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights', sampled_on_subcycle = .true. ) call addfld ('UM_CLUBB', (/ 'lev ' /), 'A', 'm/s', 'Zonal Wind', sampled_on_subcycle = .true. ) call addfld ('VM_CLUBB', (/ 'lev ' /), 'A', 'm/s', 'Meridional Wind', sampled_on_subcycle = .true. ) call addfld ('WM_ZT_CLUBB', (/ 'lev ' /), 'A', 'm/s', 'Vertical Velocity', sampled_on_subcycle = .true. ) @@ -1889,12 +1889,12 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_qtforcdn' , (/ 'lev ' /), 'A', 'kg/kg/s' , 'qt downdraft forcing (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_thlforc' , (/ 'lev ' /), 'A', 'K/s' , 'thl forcing (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_qtforc' , (/ 'lev ' /), 'A', 'kg/kg/s' , 'qt forcing (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_thlflxup' , (/ 'ilev' /), 'A', 'W/m2' , 'thl updraft flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtflxup' , (/ 'ilev' /), 'A', 'W/m2', 'qt updraft flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_thlflxdn' , (/ 'ilev' /), 'A', 'W/m2' , 'thl downdraft flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtflxdn' , (/ 'ilev' /), 'A', 'W/m2', 'qt downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflxup' , (/ 'ilev' /), 'A', 'K m/s' , 'thl updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflxup' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt updraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflxdn' , (/ 'ilev' /), 'A', 'K m/s' , 'thl downdraft flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflxdn' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt downdraft flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'W/m2' , 'thl flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'W/m2', 'qt flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_thvflx' , (/ 'ilev' /), 'A', 'K m/s' , 'thv flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_uflxup' , (/ 'ilev' /), 'A', 'm2/s2' , 'u updraft flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_vflxup' , (/ 'ilev' /), 'A', 'm2/s2' , 'v updraft flux (EDMF)', sampled_on_subcycle=.true. ) @@ -5606,15 +5606,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & upwp_output(i,k) = upwp_pbuf(i,k_clubb) vpwp_output(i,k) = vpwp_pbuf(i,k_clubb) rtp2_output(i,k) = rtp2_pbuf(i,k_clubb) - wprcp_output(i,k) = wprcp(i,k_clubb) * latvap - wpthvp_output(i,k) = wpthvp_pbuf(i,k_clubb) * cpair + wprcp_output(i,k) = wprcp(i,k_clubb) + wpthvp_output(i,k) = wpthvp_pbuf(i,k_clubb) thlp2_output(i,k) = thlp2_pbuf(i,k_clubb) - wpthlp_output(i,k) = ( wpthlp_pbuf(i,k_clubb) - (apply_const * wpthlp_const) ) & - * rho_zm(i,k_clubb) * cpair ! liquid water potential temperature flux + wpthlp_output(i,k) = ( wpthlp_pbuf(i,k_clubb) - (apply_const * wpthlp_const) ) ! liquid water potential temperature flux - wprtp_output(i,k) = ( wprtp_pbuf(i,k_clubb) - (apply_const * wprtp_const) ) & - * rho_zm(i,k_clubb) * latvap ! total water mixig ratio flux + wprtp_output(i,k) = ( wprtp_pbuf(i,k_clubb) - (apply_const * wprtp_const) ) ! total water mixig ratio flux rtpthlp_output(i,k) = rtpthlp_pbuf(i,k_clubb) - (apply_const * rtpthlp_const) @@ -5845,8 +5843,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_awqt_output(:ncol, top_lev:pverp) = s_awqt(:ncol, 1:k_clubb) s_awu_output(:ncol, top_lev:pverp) = s_awu(:ncol, 1:k_clubb) s_awv_output(:ncol, top_lev:pverp) = s_awv(:ncol, 1:k_clubb) - mf_thlflx_output(:ncol, top_lev:pverp) = mf_thlflx(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * cpair - mf_qtflx_output(:ncol, top_lev:pverp) = mf_qtflx(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * latvap + mf_thlflx_output(:ncol, top_lev:pverp) = mf_thlflx(:ncol, 1:k_clubb) + mf_qtflx_output(:ncol, top_lev:pverp) = mf_qtflx(:ncol, 1:k_clubb) s_awthlup_output(:ncol, top_lev:pverp) = s_awthlup(:ncol, 1:k_clubb) s_awqtup_output(:ncol, top_lev:pverp) = s_awqtup(:ncol, 1:k_clubb) s_awuup_output(:ncol, top_lev:pverp) = s_awuup(:ncol, 1:k_clubb) @@ -5856,12 +5854,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_awudn_output(:ncol, top_lev:pverp) = s_awudn(:ncol, 1:k_clubb) s_awvdn_output(:ncol, top_lev:pverp) = s_awvdn(:ncol, 1:k_clubb) s_aww_output(:ncol, top_lev:pverp) = s_aww(:ncol, 1:k_clubb) - mf_thlflxup_output(:ncol, top_lev:pverp) = mf_thlflxup(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * cpair - mf_qtflxup_output(:ncol, top_lev:pverp) = mf_qtflxup(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * latvap + mf_thlflxup_output(:ncol, top_lev:pverp) = mf_thlflxup(:ncol, 1:k_clubb) + mf_qtflxup_output(:ncol, top_lev:pverp) = mf_qtflxup(:ncol, 1:k_clubb) mf_uflxup_output(:ncol, top_lev:pverp) = mf_uflxup(:ncol, 1:k_clubb) mf_vflxup_output(:ncol, top_lev:pverp) = mf_vflxup(:ncol, 1:k_clubb) - mf_thlflxdn_output(:ncol, top_lev:pverp) = mf_thlflxdn(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * cpair - mf_qtflxdn_output(:ncol, top_lev:pverp) = mf_qtflxdn(:ncol, 1:k_clubb) * rho_zm(:ncol, 1:k_clubb) * latvap + mf_thlflxdn_output(:ncol, top_lev:pverp) = mf_thlflxdn(:ncol, 1:k_clubb) + mf_qtflxdn_output(:ncol, top_lev:pverp) = mf_qtflxdn(:ncol, 1:k_clubb) mf_uflxdn_output(:ncol, top_lev:pverp) = mf_uflxdn(:ncol, 1:k_clubb) mf_vflxdn_output(:ncol, top_lev:pverp) = mf_vflxdn(:ncol, 1:k_clubb) mf_uflx_output(:ncol, top_lev:pverp) = mf_uflx(:ncol, 1:k_clubb) From 38aa38a55e6105cc740dacea73da8a304dcf5e03 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Sun, 30 Aug 2026 10:52:18 -0600 Subject: [PATCH 35/63] fixed incorrect units on edmf_thlflx --- src/physics/cam/clubb_intr.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 06ebaf63af..fbdead30a8 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1893,7 +1893,7 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ( 'edmf_qtflxup' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt updraft flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_thlflxdn' , (/ 'ilev' /), 'A', 'K m/s' , 'thl downdraft flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_qtflxdn' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt downdraft flux (EDMF)', sampled_on_subcycle=.true. ) - call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'W/m2' , 'thl flux (EDMF)', sampled_on_subcycle=.true. ) + call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'K m/s' , 'thl flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'kg/kg m/s', 'qt flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_thvflx' , (/ 'ilev' /), 'A', 'K m/s' , 'thv flux (EDMF)', sampled_on_subcycle=.true. ) call addfld ( 'edmf_uflxup' , (/ 'ilev' /), 'A', 'm2/s2' , 'u updraft flux (EDMF)', sampled_on_subcycle=.true. ) From 7efb25c13eae908a1010fc31b3445021918ac7a1 Mon Sep 17 00:00:00 2001 From: adamrher Date: Sun, 30 Aug 2026 18:33:38 -0600 Subject: [PATCH 36/63] addressed some of co-pilot review --- bld/build-namelist | 34 ++++++++++++++++++++-------------- src/physics/cam/clubb_intr.F90 | 2 +- 2 files changed, 21 insertions(+), 15 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 5cceb1b566..560e695ac9 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3303,17 +3303,30 @@ if (($chem ne 'none') and ($chem ne 'terminator') and !($chem =~ /geoschem/)) { add_default($nl, 'chem_use_chemtrop'); } -# CLUBB-MF unified convection scheme +# CLUBB_SGS +my $do_clubb_sgs = $nl->get_value('do_clubb_sgs'); +if (defined $do_clubb_sgs) { + die "CAM Namelist ERROR: User may not specify the value of do_clubb_sgs.\n". + "This variable is set by build-namelist based on information\n". + "from the configure cache file.\n"; +} +add_default($nl, 'do_clubb_sgs'); +my $clubb_sgs = $nl->get_value('do_clubb_sgs'); + +# Evaluate do_clubb_mf early to handle overrides add_default($nl, 'do_clubb_mf'); my $clubb_mf = $nl->get_value('do_clubb_mf'); -if ($clubb_mf =~ "true") { - add_default($nl, 'deep_scheme', 'val'=>'off'); -} else { +# Deep convection scheme and CLUBB+MF dependency check +if (defined $do_clubb_mf and $do_clubb_mf =~ /$TRUE/io) { + if ($clubb_sgs !~ /$TRUE/io) { + die "CAM Namelist ERROR: do_clubb_mf is set to .true. but do_clubb_sgs is not active.\n" . + "CLUBB+MF requires the CLUBB_SGS package to be enabled.\n"; + } + add_default($nl, 'deep_scheme', 'val'=>"'off'"); +} else { add_default($nl, 'deep_scheme'); -} - -# Deep convection scheme +} my $deep_scheme = $nl->get_value('deep_scheme'); # Aerosol convective processes @@ -3531,13 +3544,6 @@ if ($use_subcol_microp =~ /$TRUE/io) { } # CLUBB_SGS -my $do_clubb_sgs = $nl->get_value('do_clubb_sgs'); -if (defined $do_clubb_sgs) { - die "CAM Namelist ERROR: User may not specify the value of do_clubb_sgs.\n". - "This variable is set by build-namelist based on information\n". - "from the configure cache file.\n"; -} -add_default($nl, 'do_clubb_sgs'); my $clubb_sgs = $nl->get_value('do_clubb_sgs'); if ($clubb_sgs =~ /$TRUE/io) { my $clubb_do_adv = $cfg->get('clubb_do_adv'); diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 1a16db5b3d..af0dce7eaf 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -4700,7 +4700,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k - wp2_pbuf(i,k_cam) = wp2_pbuf(i,k_cam) + s_aww(i,k) + wp2_pbuf(i,k) = wp2_pbuf(i,k) + s_aww(i,k) khzm_pbuf(i,k_cam) = khzm(i,k) + & clubb_params(i,ic_K) * Lscale_zm(i,k) * sqrt(0.5_r8 * s_aww(i,k)) end do From 8b8466f828ec9675afba5d96f707152585950c7e Mon Sep 17 00:00:00 2001 From: adamrher Date: Sun, 30 Aug 2026 20:10:37 -0600 Subject: [PATCH 37/63] clean up add_hist_coord --- src/physics/cam/clubb_intr.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index af0dce7eaf..be950a195a 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -656,11 +656,10 @@ subroutine clubb_register_cam( ) ! Only in clubb_intr.F90 or SILHS call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), ice_supersat_idx) - ! these extra coord vars don't seem to work for interpolate_output=.true. - call add_hist_coord('ncyc', cld_macmic_num_steps, 'macro/micro cycle index') - call add_hist_coord('nens', clubb_mf_nup, 'clubb+mf ensemble size') - if (do_clubb_mf) then + ! note that the extra coord dim doesn't seem to work for interpolate_output=.true. + call add_hist_coord('nens', clubb_mf_nup, 'clubb+mf ensemble size') + call pbuf_add_field('ZTOPMN' ,'global' , dtype_r8, (/clubb_mf_up_ndt,pcols,clubb_mf_nup/), ztopmn_idx) call pbuf_add_field('ZTOPMA' ,'global' , dtype_r8, (/pcols,clubb_mf_nup/), ztopma_idx) call pbuf_add_field('ZTOP_MACMIC' ,'physpkg', dtype_r8, (/pcols,clubb_mf_nup/), ztopm1_macmic_idx) From d16d4c3d172327a6891262b4984574a792419268 Mon Sep 17 00:00:00 2001 From: adamrher Date: Mon, 7 Sep 2026 14:56:52 -0600 Subject: [PATCH 38/63] couple clubbmf to wetdep/convtran using deep hoks, pblcull added, bugfixes --- bld/build-namelist | 9 +- bld/namelist_files/namelist_defaults_cam.xml | 2 + bld/namelist_files/namelist_definition.xml | 16 + src/physics/cam/clubb_intr.F90 | 432 ++++++++++++++++++- src/physics/cam/clubb_mf.F90 | 250 ++++++++++- src/physics/cam/convect_deep.F90 | 148 ++++++- src/physics/cam/physpkg.F90 | 32 +- src/physics/cam7/physpkg.F90 | 51 ++- 8 files changed, 844 insertions(+), 96 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 560e695ac9..0d2f632124 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3318,11 +3318,16 @@ add_default($nl, 'do_clubb_mf'); my $clubb_mf = $nl->get_value('do_clubb_mf'); # Deep convection scheme and CLUBB+MF dependency check -if (defined $do_clubb_mf and $do_clubb_mf =~ /$TRUE/io) { +if (defined $clubb_mf and $clubb_mf =~ /$TRUE/io) { if ($clubb_sgs !~ /$TRUE/io) { die "CAM Namelist ERROR: do_clubb_mf is set to .true. but do_clubb_sgs is not active.\n" . "CLUBB+MF requires the CLUBB_SGS package to be enabled.\n"; } + #+++arh CLUBB+MF is only implemented in the cam7 physics driver + if ($phys !~ /cam7/) { + die "CAM Namelist ERROR: do_clubb_mf is set to .true. but the physics package is '$phys'.\n" . + "CLUBB+MF is only supported with cam7 physics (configure with -phys cam7).\n"; + } add_default($nl, 'deep_scheme', 'val'=>"'off'"); } else { add_default($nl, 'deep_scheme'); @@ -3751,6 +3756,8 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'do_clubb_mf_coldpool_perplume'); add_default($nl, 'do_clubb_mf_coldpool_init'); add_default($nl, 'do_clubb_mf_aloft'); + add_default($nl, 'do_clubb_mf_aspd'); + add_default($nl, 'do_clubb_mf_pblcull'); } } diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 0187344add..2c6e5b8dcd 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2385,6 +2385,8 @@ .true. 1 .true. + .true. + .true. 10 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 67b45bfbdd..4abddcc9a7 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4805,6 +4805,22 @@ If .true. turn on elevated convective initialization Default: .true. + +If .true. turn on the Arakawa-Schubert positive-definite detrainment limiter, +which eliminates negative diagnosed detrainment by growing the plume mass flux +by pure (capped) entrainment and absorbing the change into the plume area. +Default: .true. + + + +If .true. cull plumes entirely contained within the PBL: any plume whose ascent +terminates at or below the PBL top is removed from the ensemble (surface +closure and PBL-penetrating plumes untouched). +Default: .true. + + 1) at any point in the sub-cycles. + call pbuf_add_field('MFUP_MACMIC' ,'physpkg', dtype_r8, (/pcols,nzm_clubb/), mfup_macmic_idx) + call pbuf_add_field('ENTUP_MACMIC','physpkg', dtype_r8, (/pcols,nzm_clubb/), entup_macmic_idx) + call pbuf_add_field('DETUP_MACMIC','physpkg', dtype_r8, (/pcols,nzm_clubb/), detup_macmic_idx) + call pbuf_add_field('MFDN_MACMIC' ,'physpkg', dtype_r8, (/pcols,nzm_clubb/), mfdn_macmic_idx) + call pbuf_add_field('ENTDN_MACMIC','physpkg', dtype_r8, (/pcols,nzm_clubb/), entdn_macmic_idx) + call pbuf_add_field('DETDN_MACMIC','physpkg', dtype_r8, (/pcols,nzm_clubb/), detdn_macmic_idx) + call pbuf_add_field('SQTAC_MACMIC','physpkg', dtype_r8, (/pcols,nzt_clubb/), sqtac_macmic_idx) + call pbuf_add_field('SQTEV_MACMIC','physpkg', dtype_r8, (/pcols,nzt_clubb/), sqtev_macmic_idx) + call pbuf_add_field('KCTOP_MACMIC','physpkg', dtype_r8, (/pcols/), kctop_macmic_idx) end if #endif @@ -1664,8 +1734,28 @@ subroutine clubb_ini_cam(pbuf_ini) npccn_idx = pbuf_get_index('NPCCN') ! CLUBB+MF - prec_sh_idx = pbuf_get_index('PREC_SH') - snow_sh_idx = pbuf_get_index('SNOW_SH') + !+++arh PREC_SH/SNOW_SH index fetches removed: MF precip is now written to + ! the DEEP precip pbuf fields (PREC_DP/SNOW_DP, fetched below) + + !+++arh deep-convection pbuf indices for the MF-plume deep hookup + if (do_clubb_mf) then + prec_dp_idx = pbuf_get_index('PREC_DP') + snow_dp_idx = pbuf_get_index('SNOW_DP') + rprddp_idx = pbuf_get_index('RPRDDP') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + zm_mu_idx = pbuf_get_index('ZM_MU') + zm_eu_idx = pbuf_get_index('ZM_EU') + zm_du_idx = pbuf_get_index('ZM_DU') + zm_md_idx = pbuf_get_index('ZM_MD') + zm_ed_idx = pbuf_get_index('ZM_ED') + zm_dp_idx = pbuf_get_index('ZM_DP') + zm_dsubcld_idx = pbuf_get_index('ZM_DSUBCLD') + zm_jt_idx = pbuf_get_index('ZM_JT') + zm_maxg_idx = pbuf_get_index('ZM_MAXG') + zm_ideep_idx = pbuf_get_index('ZM_IDEEP') + end if + rprdsh_idx = pbuf_get_index('RPRDSH') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') ! Scalars aren't in use, set all indices to -1 sclr_idx%iisclr_rt = -1 @@ -2376,8 +2466,37 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc_pbuf ! CLUBB-MF pointers - real(r8),pointer :: prec_sh_pbuf(:) ! total precipitation from MF - real(r8),pointer :: snow_sh_pbuf(:) ! snow from MF + !+++arh MF precip goes to the deep-convection precip pbuf fields + real(r8),pointer :: prec_dp_pbuf(:) ! total precipitation from MF + real(r8),pointer :: snow_dp_pbuf(:) ! snow from MF + + !+++arh deep-hookup pbuf pointers + real(r8), pointer :: rprddp(:,:) ! Deep conv precip production (kg/kg/s - grid avg) + real(r8), pointer :: evapcdp(:,:) ! Deep conv precip evaporation (kg/kg/s - grid avg) + real(r8), pointer :: mu(:,:) ! Updraft mass flux (positive) (pcols,pver) + real(r8), pointer :: md(:,:) ! Downdraft mass flux (negative) (pcols,pver) + real(r8), pointer :: du(:,:) ! Mass detrain rate from updraft (pcols,pver) + real(r8), pointer :: eu(:,:) ! Mass entrain rate into updraft (pcols,pver) + real(r8), pointer :: ed(:,:) ! Mass entrain rate into downdraft (pcols,pver) + real(r8), pointer :: dpg(:,:) ! Delta pressure between interfaces, mb (pcols,pver) + real(r8), pointer :: dsubcld(:) ! Delta pressure from cloud base to sfc (pcols) + integer, pointer :: jt(:) ! Index of cloud top for each column (pcols) + integer, pointer :: maxg(:) ! Index of cloud base for each column (pcols) + integer, pointer :: ideep(:) ! Gathering array (pcols) + real(r8), pointer :: rprdsh(:,:) ! Shallow conv precip production (zeroed for deep hookup) + real(r8), pointer :: evapcsh(:,:) ! Shallow conv precip evaporation (zeroed for deep hookup) + + !+++arh macmic accumulators for the deep-hookup variables + real(r8), pointer :: s_mfup_macmic(:,:) + real(r8), pointer :: s_entup_macmic(:,:) + real(r8), pointer :: s_detup_macmic(:,:) + real(r8), pointer :: s_mfdn_macmic(:,:) + real(r8), pointer :: s_entdn_macmic(:,:) + real(r8), pointer :: s_detdn_macmic(:,:) + real(r8), pointer :: mf_sqtac_macmic(:,:) + real(r8), pointer :: mf_sqtev_macmic(:,:) + real(r8), pointer :: mf_kctop_macmic(:) ! highest plume top over the sub-cycles; also + ! the gathering (activity) criterion real(r8), pointer :: ztopmn(:,:,:) real(r8), pointer :: ztopma(:,:) @@ -2499,7 +2618,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_sqtup, mf_sthlup, & mf_sqtdn, mf_sthldn, & mf_sqt, mf_sthl, & - mf_qc_zt, mf_cloudfrac_zt + mf_qc_zt, mf_cloudfrac_zt, & + !+++arh deep-hookup: ensemble plume autoconversion / rain evaporation + mf_sqtac, mf_sqtev, & + !+++arh deep-hookup nadv-subcycle accumulators + mf_sqtac_nadv, mf_sqtev_nadv real(r8), dimension(state%ncol,nzm_clubb) :: & thlp2_rad, & @@ -2545,6 +2668,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_awthldn, s_awqtdn, s_awudn, s_awvdn, & s_awthl, s_awqt, & s_awu, s_awv, & + !+++arh deep-hookup: ensemble plume mass flux / entrainment / detrainment + s_mfup, s_entup, s_detup, & + s_mfdn, s_entdn, s_detdn, & + !+++arh deep-hookup nadv-subcycle accumulators + s_mfup_nadv, s_entup_nadv, s_detup_nadv, & + s_mfdn_nadv, s_entdn_nadv, s_detdn_nadv, & mf_precc, & ! MF work arrays (of size NCOL) @@ -2792,6 +2921,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_cbm1, mf_cbm1_nadv, & mf_freq_nadv + !+++arh deep-hookup: ensemble plume-top index per column, and gathering / + ! mass-flux consistency work variables. mf_kctop_nadv holds the highest + ! kctop over the nadv subcycles (also the gathering/activity criterion). + real(r8), dimension(state%ncol) :: mf_kctop, mf_kctop_nadv + integer :: lengath, tmptop, kcam, icol + real(r8) :: tmpcfl, tmpnet + real(r8), dimension(state%ncol,pver) :: esat, rh real(r8), dimension(state%ncol,pver) :: mq, mqsat real(r8), dimension(state%ncol) :: rhlev, rhinv @@ -2899,8 +3035,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, icwmrsh_idx, sh_icwmr_pbuf) call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh_pbuf) - call pbuf_get_field(pbuf, prec_sh_idx, prec_sh_pbuf ) - call pbuf_get_field(pbuf, snow_sh_idx, snow_sh_pbuf ) + !+++arh MF precip is written to the DEEP precip pbuf fields (indices are + ! only fetched when do_clubb_mf is active, so guard the get_field) + if (do_clubb_mf) then + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp_pbuf ) + call pbuf_get_field(pbuf, snow_dp_idx, snow_dp_pbuf ) + end if if (do_clubb_mf) then call pbuf_get_field(pbuf, tpert_idx, tpert) @@ -2916,6 +3056,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, cbm1_idx, cbm1) call pbuf_get_field(pbuf, cbm1_macmic_idx, cbm1_macmic) + !+++arh macmic accumulators for the deep-hookup variables + call pbuf_get_field(pbuf, mfup_macmic_idx, s_mfup_macmic) + call pbuf_get_field(pbuf, entup_macmic_idx, s_entup_macmic) + call pbuf_get_field(pbuf, detup_macmic_idx, s_detup_macmic) + call pbuf_get_field(pbuf, mfdn_macmic_idx, s_mfdn_macmic) + call pbuf_get_field(pbuf, entdn_macmic_idx, s_entdn_macmic) + call pbuf_get_field(pbuf, detdn_macmic_idx, s_detdn_macmic) + call pbuf_get_field(pbuf, sqtac_macmic_idx, mf_sqtac_macmic) + call pbuf_get_field(pbuf, sqtev_macmic_idx, mf_sqtev_macmic) + call pbuf_get_field(pbuf, kctop_macmic_idx, mf_kctop_macmic) + end if ! SILHS covariance contributions @@ -3333,6 +3484,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ddcp_macmic(:ncol,:) = 0._r8 cbm1_macmic(:ncol) = 0._r8 + !+++arh macmic accumulators for the deep-hookup variables + s_mfup_macmic(:ncol,:) = 0._r8 + s_entup_macmic(:ncol,:) = 0._r8 + s_detup_macmic(:ncol,:) = 0._r8 + s_mfdn_macmic(:ncol,:) = 0._r8 + s_entdn_macmic(:ncol,:) = 0._r8 + s_detdn_macmic(:ncol,:) = 0._r8 + mf_sqtac_macmic(:ncol,:) = 0._r8 + mf_sqtev_macmic(:ncol,:) = 0._r8 + mf_kctop_macmic(:ncol) = 0._r8 + end if !+++ARH - Temporary hack - pbuf_set_field is apparently not taking? @@ -3358,6 +3520,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thlforc_nadv(:ncol,:nzt_clubb) = 0._r8 mf_qtforc_nadv(:ncol,:nzt_clubb) = 0._r8 + !+++arh deep-hookup nadv-subcycle accumulators + s_mfup_nadv(:ncol,:nzm_clubb) = 0._r8 + s_entup_nadv(:ncol,:nzm_clubb) = 0._r8 + s_detup_nadv(:ncol,:nzm_clubb) = 0._r8 + s_mfdn_nadv(:ncol,:nzm_clubb) = 0._r8 + s_entdn_nadv(:ncol,:nzm_clubb) = 0._r8 + s_detdn_nadv(:ncol,:nzm_clubb) = 0._r8 + mf_sqtac_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_sqtev_nadv(:ncol,:nzt_clubb) = 0._r8 + mf_kctop_nadv(:ncol) = 0._r8 + max_cfl_nadv(:ncol) = 0._r8 end if @@ -4111,8 +4284,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_sqtup(i,:), mf_sthlup(i,:), & ! output mf_sqtdn(i,:), mf_sthldn(i,:), & ! output mf_sqt(i,:), mf_sthl(i,:), & ! output +!+++arh + mf_sqtac(i,:), mf_sqtev(i,:), & ! output mf_precc(i,:), & ! output - mf_ztop(i,:), mf_L0(i,:) ) + mf_ztop(i,:), mf_L0(i,:), & + !+++arh ensemble mf/ent/det profiles + plume top for the deep-convection hookup + s_mfup(i,:), s_entup(i,:), s_detup(i,:), & + s_mfdn(i,:), s_entdn(i,:), s_detdn(i,:), & + mf_kctop(i) ) end do @@ -4207,6 +4386,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_precc_nadv(i) = mf_precc_nadv(i) + mf_precc(i,gr%k_lb_zm)/1000._r8 mf_snow_nadv(i) = 0._r8 + !+++arh accumulate the deep-hookup variables over the nadv subcycles. + s_mfup_nadv(i,:nzm_clubb) = s_mfup_nadv(i,:nzm_clubb) + s_mfup(i,:nzm_clubb) + s_entup_nadv(i,:nzm_clubb) = s_entup_nadv(i,:nzm_clubb) + s_entup(i,:nzm_clubb) + s_detup_nadv(i,:nzm_clubb) = s_detup_nadv(i,:nzm_clubb) + s_detup(i,:nzm_clubb) + s_mfdn_nadv(i,:nzm_clubb) = s_mfdn_nadv(i,:nzm_clubb) + s_mfdn(i,:nzm_clubb) + s_entdn_nadv(i,:nzm_clubb) = s_entdn_nadv(i,:nzm_clubb) + s_entdn(i,:nzm_clubb) + s_detdn_nadv(i,:nzm_clubb) = s_detdn_nadv(i,:nzm_clubb) + s_detdn(i,:nzm_clubb) + mf_sqtac_nadv(i,:nzt_clubb) = mf_sqtac_nadv(i,:nzt_clubb) + mf_sqtac(i,:nzt_clubb) + mf_sqtev_nadv(i,:nzt_clubb) = mf_sqtev_nadv(i,:nzt_clubb) + mf_sqtev(i,:nzt_clubb) + ! kctop is not averaged: keep the HIGHEST plume top over the + ! subcycles (it doubles as the gathering/activity criterion: + ! int(kctop) > 1 means the column was active at some sub-cycle) + mf_kctop_nadv(i) = max(mf_kctop_nadv(i), mf_kctop(i)) + ! accumulate over nadv subcycles mf_L0_nadv(i,:) = mf_L0_nadv(i,:) + mf_L0(i,:) mf_ztop_nadv(i,:) = mf_ztop_nadv(i,:) + mf_ztop(i,:) @@ -4633,6 +4826,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_awvup = s_awvup(:,nzm_clubb:1:-1) s_awvdn = s_awvdn(:,nzm_clubb:1:-1) + !+++arh Deep-hookup ensemble mf/ent/det profiles on momentum levels: the + ! nadv accumulators are flipped (the raw per-subcycle arrays hold only + ! the last subcycle and are not used downstream). mf_kctop_nadv needs + ! no flip -- kctop is an orientation-independent offset from the surface. + s_mfup_nadv = s_mfup_nadv(:,nzm_clubb:1:-1) + s_entup_nadv = s_entup_nadv(:,nzm_clubb:1:-1) + s_detup_nadv = s_detup_nadv(:,nzm_clubb:1:-1) + s_mfdn_nadv = s_mfdn_nadv(:,nzm_clubb:1:-1) + s_entdn_nadv = s_entdn_nadv(:,nzm_clubb:1:-1) + s_detdn_nadv = s_detdn_nadv(:,nzm_clubb:1:-1) + ! MF fluxes on momentum levels mf_thlflx = mf_thlflx(:,nzm_clubb:1:-1) mf_thlflxup = mf_thlflxup(:,nzm_clubb:1:-1) @@ -4655,6 +4859,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_sqtup = mf_sqtup(:,nzt_clubb:1:-1) mf_sqtdn = mf_sqtdn(:,nzt_clubb:1:-1) + !+++arh Deep-hookup plume autoconversion / rain evaporation on thermo + ! levels (nadv accumulators, as above) + mf_sqtac_nadv = mf_sqtac_nadv(:,nzt_clubb:1:-1) + mf_sqtev_nadv = mf_sqtev_nadv(:,nzt_clubb:1:-1) + ! NOTE: mf_rcm needs no flip here -- it is overwritten from mf_rcm_nadv ! below, and that accumulator is flipped at the end of this block. @@ -4769,8 +4978,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv) mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv) mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv) - prec_sh_pbuf(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) - snow_sh_pbuf(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) +!+++arh MF precip attributed to the deep fields (PREC_DP/SNOW_DP) + prec_dp_pbuf(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) + snow_dp_pbuf(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) @@ -4780,11 +4990,35 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) mf_ent_nadv(:ncol,:nzm_clubb) = mf_ent_nadv(:ncol,:nzm_clubb)/REAL(nadv) + !+++arh average the deep-hookup variables over the nadv subcycles + ! (mf_kctop_nadv is the subcycle max, so it is not averaged) + s_mfup_nadv(:ncol,:nzm_clubb) = s_mfup_nadv(:ncol,:nzm_clubb)/REAL(nadv) + s_entup_nadv(:ncol,:nzm_clubb) = s_entup_nadv(:ncol,:nzm_clubb)/REAL(nadv) + s_detup_nadv(:ncol,:nzm_clubb) = s_detup_nadv(:ncol,:nzm_clubb)/REAL(nadv) + s_mfdn_nadv(:ncol,:nzm_clubb) = s_mfdn_nadv(:ncol,:nzm_clubb)/REAL(nadv) + s_entdn_nadv(:ncol,:nzm_clubb) = s_entdn_nadv(:ncol,:nzm_clubb)/REAL(nadv) + s_detdn_nadv(:ncol,:nzm_clubb) = s_detdn_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_sqtac_nadv(:ncol,:nzt_clubb) = mf_sqtac_nadv(:ncol,:nzt_clubb)/REAL(nadv) + mf_sqtev_nadv(:ncol,:nzt_clubb) = mf_sqtev_nadv(:ncol,:nzt_clubb)/REAL(nadv) + ! accumulate in buffer ztopm1_macmic(:ncol,:) = ztopm1_macmic(:ncol,:) + mf_ztopm1_nadv(:ncol,:) ddcp_macmic(:ncol,:) = ddcp_macmic(:ncol,:) + mf_ddcp_nadv(:ncol,:) cbm1_macmic(:ncol) = cbm1_macmic(:ncol) + mf_cbm1_nadv(:ncol) + !+++arh accumulate the nadv-averaged deep-hookup variables across the + ! macmic iterations; the plume-top index takes the max (highest + ! top over all sub-cycles), not the sum + s_mfup_macmic(:ncol,:) = s_mfup_macmic(:ncol,:) + s_mfup_nadv(:ncol,:nzm_clubb) + s_entup_macmic(:ncol,:) = s_entup_macmic(:ncol,:) + s_entup_nadv(:ncol,:nzm_clubb) + s_detup_macmic(:ncol,:) = s_detup_macmic(:ncol,:) + s_detup_nadv(:ncol,:nzm_clubb) + s_mfdn_macmic(:ncol,:) = s_mfdn_macmic(:ncol,:) + s_mfdn_nadv(:ncol,:nzm_clubb) + s_entdn_macmic(:ncol,:) = s_entdn_macmic(:ncol,:) + s_entdn_nadv(:ncol,:nzm_clubb) + s_detdn_macmic(:ncol,:) = s_detdn_macmic(:ncol,:) + s_detdn_nadv(:ncol,:nzm_clubb) + mf_sqtac_macmic(:ncol,:) = mf_sqtac_macmic(:ncol,:) + mf_sqtac_nadv(:ncol,:nzt_clubb) + mf_sqtev_macmic(:ncol,:) = mf_sqtev_macmic(:ncol,:) + mf_sqtev_nadv(:ncol,:nzt_clubb) + mf_kctop_macmic(:ncol) = max(mf_kctop_macmic(:ncol), mf_kctop_nadv(:ncol)) + if (macmic_it == cld_macmic_num_steps) then cbm1(:ncol) = cbm1_macmic(:ncol)/REAL(cld_macmic_num_steps) @@ -4846,6 +5080,161 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_cfl_output(:ncol) = max_cfl_nadv(:ncol) mf_freq_output(:ncol) = mf_freq_nadv(:ncol) +!+++arh entire section below (through the rprdsh/evapcsh zeroing) added for the deep hookup + ! ------------------------------------------------------------------- ! + ! Deep-convection hookup: ! + ! populate the deep-convection pbuf arrays from the MF plume ensemble ! + ! so that aero_convproc (aerosol transport/activation/scavenging, ! + ! convproc_do_aer=.true.) and zm_conv_convtran_run via ! + ! convect_deep_tend_2 (tracer transport) operate on the plumes. Both ! + ! consumers run later in tphysac this same timestep. The plume ! + ! precip production/evaporation are attributed to the DEEP fields ! + ! (RPRDDP/NEVAPR_DPCU) instead of the shallow ones to avoid double ! + ! counting in wetdep's cmfdqr = rprddp + rprdsh. ! + ! ! + ! The pbuf arrays are only populated on the LAST macmic iteration, ! + ! from the deep-hookup variables averaged over all nadv subcycles and ! + ! macmic iterations. A column is gathered (ideep) if it had an ! + ! active plume ensemble at ANY point in the sub-cycles, i.e. if the ! + ! highest plume top (kctop, a max over the sub-cycles) cleared the ! + ! first momentum interface. ! + ! ------------------------------------------------------------------- ! + if (macmic_it == cld_macmic_num_steps) then + + ! average the macmic accumulators over the macmic iterations, back + ! into the working arrays the population code below reads + s_mfup(:ncol,:) = s_mfup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_entup(:ncol,:) = s_entup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_detup(:ncol,:) = s_detup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_mfdn(:ncol,:) = s_mfdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_entdn(:ncol,:) = s_entdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_detdn(:ncol,:) = s_detdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + mf_sqtac(:ncol,:) = mf_sqtac_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + mf_sqtev(:ncol,:) = mf_sqtev_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ! plume top: highest kctop over all nadv/macmic sub-cycles (max, no averaging) + mf_kctop(:ncol) = mf_kctop_macmic(:ncol) + + call pbuf_get_field(pbuf, rprddp_idx, rprddp) ! precip formation, grid avg (kg/kg/s) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp) ! precip evaporation rate (kg/kg/s) + call pbuf_get_field(pbuf, zm_mu_idx, mu) + call pbuf_get_field(pbuf, zm_eu_idx, eu) + call pbuf_get_field(pbuf, zm_du_idx, du) + call pbuf_get_field(pbuf, zm_md_idx, md) + call pbuf_get_field(pbuf, zm_ed_idx, ed) + call pbuf_get_field(pbuf, zm_dp_idx, dpg) ! layer thickness (mb) + call pbuf_get_field(pbuf, zm_jt_idx, jt) ! top level index of convection + call pbuf_get_field(pbuf, zm_maxg_idx, maxg) ! launch (cloud-base) level index + call pbuf_get_field(pbuf, zm_ideep_idx, ideep) + ! dsubcld is only used by zm and momtran, not by convtran or aero_convproc, + ! but zm_conv_tend_2-style consumers read the field, so keep it zeroed + call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld) + + mu(:pcols,:pver) = 0._r8 + eu(:pcols,:pver) = 0._r8 + du(:pcols,:pver) = 0._r8 + md(:pcols,:pver) = 0._r8 + ed(:pcols,:pver) = 0._r8 + dpg(:pcols,:pver) = 0._r8 + dsubcld(:pcols) = 0._r8 + jt(:pcols) = pver + maxg(:pcols) = pver + ideep(:pcols) = 0 + + lengath = 0 + do i=1, ncol + ! mf_kctop counts momentum interfaces from the surface, so the CAM + ! interface index of the ensemble plume top is pverp-mf_kctop+1; the + ! deep-convection cloud-top LEVEL is one above the interface. + ! mf_kctop here is the HIGHEST plume top over the nadv/macmic sub-cycles. + tmptop = min(max(pverp - int(mf_kctop(i)), top_lev), pver) + !+++arh gather every column that was active at ANY point in the + ! nadv/macmic sub-cycles (kctop is the max over the sub-cycles, + ! so int(kctop) > 1 means the plume top cleared the first + ! momentum interface at some sub-cycle) + if (int(mf_kctop(i)) > 1) then + lengath = lengath + 1 + ideep(lengath) = i + jt(lengath) = tmptop + maxg(lengath) = pver ! surface-launched plumes + dpg(lengath,:pver) = state_loc%pdel(i,:pver)/100._r8 + end if + end do + + rprddp(:pcols,:pver) = 0._r8 + evapcdp(:pcols,:pver) = 0._r8 + do kcam = top_lev, pver + ! CLUBB index of both the CAM layer kcam (thermo grid) and the + ! interface at its top (momentum grid) + k_clubb = kcam + 1 - top_lev + do i=1, lengath + icol = ideep(i) + ! plume MFs are in kg/m2/s; ZM wants hPa/s. mu/md at CAM level kcam + ! hold the ensemble mass flux at the interface at the layer's top. + mu(i,kcam) = s_mfup(icol,k_clubb)*gravit/100._r8 + md(i,kcam) = s_mfdn(icol,k_clubb)*gravit/100._r8 + ! plume fractional entrainment [1/m] -> ZM d(massflux)/dp form [1/s] + ! (du/ed are rebuilt from exact discrete continuity below) + eu(i,kcam) = s_entup(icol,k_clubb)*mu(i,kcam)*dz_g(icol,k_clubb)/dpg(i,kcam) + end do + do i=1, ncol + rprddp(i,kcam) = -1._r8*mf_sqtac(i,k_clubb) + evapcdp(i,kcam) = -1._r8*mf_sqtev(i,k_clubb) + end do + end do + + ! convtran/convproc REQUIRE (a) a Courant limit mu*dt/dp <= 1 (ZM enforces + ! this on its cloud-base closure; violating it lets the flux-form limiters + ! remove more tracer than a layer holds -> negative gas concentrations -> + ! rrtmgp set_vmr abort) and (b) EXACT discrete continuity + ! mu(k) - mu(k+1) = (eu(k)-du(k))*dp(k) with mu(pver+1)=0 (and the + ! analogous downdraft relation), which the recursion for the in-updraft + ! concentration assumes. Scale the plume mass fluxes to the Courant + ! target, then rebuild du/ed from continuity (keeping the plume-derived + ! eu wherever a non-negative du can absorb it). + do i=1, lengath + ! Courant check against DRY pressure thickness: convtran scales eu/du/ed + ! by dp/dpdry and integrates dry-mixing-ratio constituents (the GHGs) + ! against dpdry, so the effective Courant number is mu*dt/dpdry. Target + ! 0.5 (rather than the ZM-style 1.0) to suppress the residual flux-form + ! limiter overshoots that drive convtran2 QNEG3 negatives. + tmpcfl = 0._r8 + do kcam=1, pver + tmpcfl = max(tmpcfl, max(mu(i,kcam), abs(md(i,kcam)))*hdtime & + /(state_loc%pdeldry(ideep(i),kcam)/100._r8)) + end do + if (tmpcfl > 0.5_r8) then + mu(i,:pver) = mu(i,:pver)*0.5_r8/tmpcfl + md(i,:pver) = md(i,:pver)*0.5_r8/tmpcfl + eu(i,:pver) = eu(i,:pver)*0.5_r8/tmpcfl + end if + do kcam=pver, 1, -1 + ! updraft: net = d(mu)/dp across layer kcam (mu below surface = 0) + if (kcam == pver) then + tmpnet = mu(i,kcam)/dpg(i,kcam) + else + tmpnet = (mu(i,kcam) - mu(i,kcam+1))/dpg(i,kcam) + end if + eu(i,kcam) = max(eu(i,kcam), tmpnet, 0._r8) + du(i,kcam) = eu(i,kcam) - tmpnet + ! downdraft: md(k+1) = md(k) - ed(k)*dp(k); ed >= 0 + if (kcam < pver) then + ed(i,kcam) = max((md(i,kcam) - md(i,kcam+1))/dpg(i,kcam), 0._r8) + else + ed(i,kcam) = 0._r8 + end if + end do + end do + + ! plume precip production/evaporation moved to the deep fields above; + ! zero the shallow ones so cmfdqr/evapc are not double counted + call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) + call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) + + rprdsh(:pcols,:pver) = 0._r8 + evapcsh(:pcols,:pver) = 0._r8 + + end if ! macmic_it == cld_macmic_num_steps (deep hookup) + end if !clubbmf !$acc parallel loop gang vector default(present) @@ -4891,7 +5280,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then ! subtract enthalpy of falling precip from tb - te_b = te_b - prec_sh_pbuf(i)*1000._r8*latice*hdtime +!+++arh + te_b = te_b - prec_dp_pbuf(i)*1000._r8*latice*hdtime end if ! Compute the disbalance of total energy, over depth where CLUBB is active @@ -5388,13 +5778,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then do k = 1, pver-1 do i = 1, ncol - ! While shallow convection is never called, CLUBB+MF uses the shallow cloud fraction and - ! shallow in-cloud mixing ratio pbuf variables to couple with radiation. + !+++arh For the deep hookup the MF plume cloud is attributed to the DEEP fields + ! (DP_FRAC/ICWMRDP feed aero_convproc and wetdep's conicw/cldcu the same + ! way ZM's do); shalcu/sh_icwmr stay zero so nothing is double counted. + ! concld below is unchanged since it uses deepcu+shalcu. if (do_clubb_mf_rad) then - shalcu_pbuf(i,k) = clubb_mf_cldfrac_fac*mf_cloudfrac_output(i,k) - sh_icwmr_pbuf(i,k) = mf_qc_output(i,k) + deepcu_pbuf(i,k) = clubb_mf_cldfrac_fac*mf_cloudfrac_output(i,k) + dp_icwmr_pbuf(i,k) = mf_qc_output(i,k) end if + if (deepcu_pbuf(i,k) <= frac_limit .or. dp_icwmr_pbuf(i,k) < ic_limit) then + deepcu_pbuf(i,k) = 0._r8 + endif + if (shalcu_pbuf(i,k) <= frac_limit .or. sh_icwmr_pbuf(i,k) < ic_limit) then shalcu_pbuf(i,k) = 0._r8 endif diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 0be0514212..de7def2a32 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -74,6 +74,12 @@ module clubb_mf logical, protected :: do_clubb_mf_coldpool_init = .false. logical, protected :: do_clubb_mf_coldpool_perplume = .true. logical, protected :: do_clubb_mf_lscale_perplume = .true. + !+++arh Arakawa-Schubert positive-definite detrainment limiter + logical, protected :: do_clubb_mf_aspd = .true. + !+++arh cull plumes entirely contained within the PBL: any plume whose ascent + ! terminates at or below the PBL top is removed from the ensemble (surface + ! closure and PBL-penetrating plumes untouched) + logical, protected :: do_clubb_mf_pblcull = .true. logical :: tht_tweaks = .true. integer :: mf_num_cin = 5 @@ -100,7 +106,9 @@ subroutine clubb_mf_readnl(nlfile) clubb_mf_fdd, do_clubb_mf_coldpool, clubb_mf_ddalph, clubb_mf_ddbeta, clubb_mf_pwfac, do_clubb_mf_ustar, & clubb_mf_ddexp, do_clubb_mf_mixd, clubb_mf_up_ndt, clubb_mf_cp_ndt, do_clubb_mf_rhtke, do_clubb_mf_cmt, & do_clubb_mf_coldpool_init, do_clubb_mf_coldpool_perplume, do_clubb_mf_lscale_perplume, clubb_mf_kseed, & - do_clubb_mf_addtke, do_clubb_mf_aloft, clubb_mf_pwmin, clubb_mf_pwmax, clubb_mf_cldfrac_fac + do_clubb_mf_addtke, do_clubb_mf_aloft, clubb_mf_pwmin, clubb_mf_pwmax, clubb_mf_cldfrac_fac, & +!+++arh + do_clubb_mf_aspd, do_clubb_mf_pblcull if (masterproc) then open( newunit=iunit, file=trim(nlfile), status='old' ) @@ -174,6 +182,12 @@ subroutine clubb_mf_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_addtke") call mpi_bcast(do_clubb_mf_aloft, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_aloft") +!+++arh + call mpi_bcast(do_clubb_mf_aspd, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_aspd") +!+++arh + call mpi_bcast(do_clubb_mf_pblcull, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_pblcull") call mpi_bcast(clubb_mf_pwmin, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_pwmin") call mpi_bcast(clubb_mf_pwmax, 1, mpi_real8, mstrid, mpicom, ierr) @@ -233,8 +247,15 @@ subroutine integrate_mf( nzm, nzt, dtime, sqtup, sthlup, & ! output sqtdn, sthldn, & ! output sqt, sthl, & ! output - variables needed for solver +!+++arh + sac, sev, & ! output - plume autoconversion / evaporation precc, & ! output - ztop, dynamic_L0 ) + ztop, dynamic_L0, & + !+++arh ensemble mass-flux, entrainment and detrainment profiles (and plume-top + ! index) for the deep-convection pbuf hookup (convtran/convproc) + mfup, entup, detup, & ! output + mfdn, entdn, detdn, & ! output + kctop ) ! output ! ================================================================================= ! ! Mass-flux algorithm ! @@ -333,7 +354,16 @@ subroutine integrate_mf( nzm, nzt, dtime, real(r8),dimension(nzt), intent(out) :: sqtup, sthlup, & ! thermodynamic grid sqtdn, sthldn, & ! thermodynamic grid - sqt, sthl ! thermodynamic grid + sqt, sthl, & ! thermodynamic grid +!+++arh + sac, sev ! thermodynamic grid + + !+++arh ensemble plume mass flux [kg/m2/s], fractional entrainment/detrainment [1/m] + ! for updrafts/downdrafts (momentum grid), and ensemble plume-top index + ! (counted in momentum interfaces from the surface, orientation independent) + real(r8),dimension(nzm), intent(out) :: mfup, entup, detup, & + mfdn, entdn, detdn + real(r8), intent(out) :: kctop real(r8),dimension(clubb_mf_nup), intent(out) :: ztop, dynamic_L0, mcape @@ -391,7 +421,10 @@ subroutine integrate_mf( nzm, nzt, dtime, ! microphyiscs terms real(r8), dimension(nzt,clubb_mf_nup) :: supqt, supthl, & ! thermodynamic grid sdnqt, sdnthl, & ! thermodynamic grid - upauto ! thermodynamic grid +!+++arh added upevap + upauto, upevap ! thermodynamic grid + !+++arh ensemble updraft rain evaporation (area-weighted sum over plumes) + real(r8), dimension(nzt) :: sevup ! thermodynamic grid ! precipitation rates real(r8), dimension(nzm,clubb_mf_nup) :: uprr, dnrr ! momentum grid ! @@ -487,14 +520,14 @@ subroutine integrate_mf( nzm, nzt, dtime, ! fixed entrainment rate real(r8),parameter :: fixent_ent = 2.e-4_r8 ! - ! Arakawa and Schubert detrainment limiter - logical :: do_aspd = .false. + !+++arh Arakawa and Schubert detrainment limiter is controlled by the + ! module-level do_clubb_mf_aspd namelist flag ! ! Lower limit on entrainment length scale real(r8),parameter :: min_L0 = 0.5_r8 ! ! limiter for tke enahnced fractional entrainment - ! (only used when do_aspd = .true.) + !+++arh (used by the downdraft eturb and the do_clubb_mf_aspd limiter) real(r8),parameter :: max_eturb = 10._r8 ! ! to condensate or not to condensate @@ -603,6 +636,21 @@ subroutine integrate_mf( nzm, nzt, dtime, sthl = 0._r8 precc = 0._r8 +!+++arh + sac = 0._r8 + sev = 0._r8 + sevup = 0._r8 + + !+++arh initialize deep-hookup outputs (must be set on every path, including + ! the no-convection early returns) + mfup = 0._r8 + entup = 0._r8 + detup = 0._r8 + mfdn = 0._r8 + entdn = 0._r8 + detdn = 0._r8 + kctop = 1._r8 + mix = 0._r8 entf = 0._r8 enti = 0 @@ -633,6 +681,8 @@ subroutine integrate_mf( nzm, nzt, dtime, upent = 0._r8 updet = 0._r8 upauto= 0._r8 +!+++arh + upevap= 0._r8 dnw = 0._r8 dna = 0._r8 @@ -662,6 +712,11 @@ subroutine integrate_mf( nzm, nzt, dtime, limarea = .true. end if + !+++arh with the ASPD limiter, area growth is only bounded per layer, so the + ! accumulated column area must be capped by the existing limarea + ! machinery (total convective area rescaled to amax) + if (do_clubb_mf_aspd) limarea = .true. + ! unique identifier zcb_unset = 9999999._r8 zcb = zcb_unset @@ -670,12 +725,16 @@ subroutine integrate_mf( nzm, nzt, dtime, !wthv = wthl+zvir*ths*wqt wthv_sfc = wthl_sfc+zvir*ths*wqt_sfc + !+++arh PBL-top index, used by the PBL-confined plume cull and the aloft + ! launch (hoisted out of the aloft branch below) + kpbl = ksfcm + do while (zm(kpbl) < pblh .and. kpbl /= ktopm) + kpbl = kpbl + kdir + end do + if (do_clubb_mf_aloft .and. wthv_sfc < 0.01_r8) then aloft = .true. - kpbl = ksfcm - do while (zm(kpbl) < pblh) - kpbl = kpbl + kdir - end do +!+++arh kpbl computation removed here (hoisted above the aloft branch) kmid = ksfcm ! Use a pressure-based criterion to locate the mid-level within the @@ -1135,8 +1194,11 @@ subroutine integrate_mf( nzm, nzt, dtime, updet(kn,i) = detn else - ! zero out plumes that terminate at k<3 - if (abs(k-kstart+kdir)<4) then + !+++arh cull plumes terminating at/below the PBL top (do_clubb_mf_pblcull), + ! in addition to the original 3-levels-above-launch minimum (which also + ! covers aloft launches where kstart is above kpbl) + if ( abs(k-kstart+kdir)<4 .or. & + (do_clubb_mf_pblcull .and. (k - kpbl)*kdir <= 0) ) then supqt(:,i) = 0._r8 upauto(:,i)= 0._r8 supthl(:,i)= 0._r8 @@ -1244,6 +1306,8 @@ subroutine integrate_mf( nzm, nzt, dtime, lmixt = 0.5_r8*(uplmix(k,i)+uplmix(kn,i)) supqt(kt,i) = supqt(kt,i) + sevap supthl(kt,i) = supthl(kt,i) - lmixt*sevap*iexner_zt(kt)/cpair +!+++arh + upevap(kt,i) = sevap end do end do end if @@ -1342,7 +1406,24 @@ subroutine integrate_mf( nzm, nzt, dtime, dnrr(kn,i) = max( dnrr(k,i) & - rho_zt(kt)*dzt(kt)*(sdnqt(kt,i) + upauto(kt,i)*clubb_mf_fdd) , 0._r8 ) - ! include eturb? + !+++arh compute the TKE entrainment enhancement locally for the downdraft. + ! Previously the scalar eturb here held a STALE value: whatever the last + ! iteration of the updraft ascent loops left in it (often the near-top + ! level of the last plume, where small upw makes eturb large), so the + ! downdraft dilution and w equation used an essentially arbitrary + ! enhancement. Mirror the ascent formulation with the downdraft's own + ! velocity and the same rhtke/max_L0 switches, and cap at max_eturb + ! (|dnw| is only bounded below by mindnw=1e-2 m/s, which would otherwise + ! allow enhancements of O(100)). + eturb = 1._r8 + clubb_mf_alphturb*sqrt(tke(k))/abs(dnw(k,i)) + if (do_clubb_mf_rhtke) then + rh_L0 = 50._r8*(rhinv**3._r8) + if (rh_L0 >= 733.34_r8) eturb = 1._r8 + else + if (dynamic_L0(i) >= clubb_mf_max_L0) eturb = 1._r8 + end if + eturb = min(eturb, max_eturb) + entexp = exp(-1._r8*entn*eturb*dzt(kt)) entexpu = exp(-1._r8*entn*dzt(kt)/3._r8) @@ -1454,24 +1535,92 @@ subroutine integrate_mf( nzm, nzt, dtime, ! --------------------------------------------------------- ! ! AS.pd limiter ! ! --------------------------------------------------------- ! - if (do_aspd) then - do k = ksfcm, ktopm-kdir, kdir + !+++arh Arakawa-Schubert positive-definite detrainment limiter, repaired: + ! - the scheme's mass-continuity convention is the detn diagnosis in the + ! ascent loop: 1/M dM/dz = upent - updet, where upent ALREADY contains + ! the TKE eturb enhancement. The old code multiplied by the scalar + ! eturb again, which both double counted the enhancement and used a + ! stale value (whatever the last ascent/downdraft iteration left in + ! it) rather than the (k,i) being limited. + ! - the entrainment used for the pure-entrainment regrowth is capped at + ! mix*max_eturb, restoring the documented purpose of max_eturb + ! (eturb = 1 + alphturb*sqrt(tke)/w diverges as w -> 0 and an uncapped + ! exp(upent*dz) can produce runaway plume areas). + ! - guard against M(k)=0 (plume base and aloft-launch levels) and start + ! at kstart so the aloft downward extension is untouched. + ! - upmf/updet are kept consistent with the adjusted areas (downstream + ! ensemble sums and the deep-hookup mass fluxes use upa/upw directly + ! and are computed after this block). + if (do_clubb_mf_aspd) then + do k = kstart, ktopm-kdir, kdir kt = k - (1-kdir)/2 kn = k + kdir do i=1,clubb_mf_nup - if (upw(kn,i)>0._r8) then + if (upw(kn,i)>0._r8 .and. upa(k,i)*upw(k,i)>0._r8) then + ! capped effective entrainment for mass continuity + entn = min(upent(kn,i), mix(kt,i)*max_eturb) ! diagnose detrainment Mn = rho_zm(k)*upa(k,i)*upw(k,i) - det = upent(kn,i)*eturb - (rho_zm(kn)*upa(kn,i)*upw(kn,i) - Mn) & + det = entn - (rho_zm(kn)*upa(kn,i)*upw(kn,i) - Mn) & /(Mn*dzt(kt)) if (det < 0._r8) then - ! diagnose area to eliminate detrainment and conserve mass - Mn = rho_zm(k)*upa(k,i)*upw(k,i)*exp(upent(kn,i)*eturb*dzt(kt)) - upa(kn,i) = Mn/(rho_zm(kn)*upw(kn,i)) + ! eliminate negative detrainment: grow M by pure entrainment + ! and absorb the change into the plume area. + ! cap the per-layer growth exponent: where dynamic_L0 is small the capped + ! entrainment mix*max_eturb can still reach O(1) m^-1 and exp(entn*dz) + ! overflows, producing runaway plume areas (found as area >> 1 in the + ! edmf_S_AE diagnostics of the first ASPD test runs) + Mn = Mn*exp(min(entn*dzt(kt), 0.5_r8)) + upa(kn,i) = Mn/(rho_zm(kn)*upw(kn,i)) + upmf(kn,i) = Mn + updet(kn,i) = 0._r8 end if end if end do end do + !+++arh downdraft counterpart: enforce non-negative detrainment along the + ! descent. The downdraft mass entrainment rate mirrors its construction + ! (per-plume constant entn; fixed dna with dnw from the w equation), so + ! where |Md| grows downward faster than entrainment allows, cap the + ! growth and absorb it into dna. + ! Interaction with the sub-cloud exponential dnw boundary condition + ! (which keeps flux gradients across the lowest levels gentle and + ! dz-insensitive): the decaying |Md| tail is positive detrainment, so + ! the limiter never modifies it; sweeping downward with the current + ! (already-limited) upper-level dna means any in-cloud dna reduction + ! cascades smoothly across cloud base (bounded by exp(entn*dz) per + ! layer) instead of leaving a discontinuity there; and since the cap + ! only ever REDUCES dna, near-surface flux gradients can only become + ! gentler. Do NOT restrict this loop to the in-cloud region: that + ! would strand reduced in-cloud dna against the unmodified sub-cloud + ! constant and reintroduce a cloud-base flux-gradient discontinuity. + if (do_clubb_mf_precip .and. clubb_mf_fdd > 0._r8) then + do i=1,clubb_mf_nup + if (fixent) then + entn = fixent_ent + else if (dynamic_L0(i) > 0._r8) then + entn = clubb_mf_ent0/dynamic_L0(i) + else + cycle + end if + do k = ktopm, ksfcm+kdir, -kdir + kt = k - (1+kdir)/2 + kn = k - kdir + if (dna(kn,i)*abs(dnw(kn,i))>0._r8 .and. & + dna(k,i)*abs(dnw(k,i))>0._r8) then + ! mass flux magnitude above (k) and below (kn) + Mn = rho_zm(k)*dna(k,i)*abs(dnw(k,i)) + det = entn - (rho_zm(kn)*dna(kn,i)*abs(dnw(kn,i)) - Mn) & + /(Mn*dzt(kt)) + if (det < 0._r8) then + ! same per-layer growth cap as the updraft limiter + Mn = Mn*exp(min(entn*dzt(kt), 0.5_r8)) + dna(kn,i) = Mn/(rho_zm(kn)*abs(dnw(kn,i))) + end if + end if + end do + end do + end if end if ! --------------------------------------------------------- ! @@ -1596,10 +1745,69 @@ subroutine integrate_mf( nzm, nzt, dtime, sqtdn(kt_dn) = sqtdn(kt_dn) + dna(k,i)*sdnqt(kt_dn,i) sthldn(kt_dn) = sthldn(kt_dn) + dna(k,i)*sdnthl(kt_dn,i) + + !+++arh area-weighted plume autoconversion and updraft rain evaporation + ! for the deep hookup (RPRDDP/NEVAPR_DPCU) + sac(kt_dn) = sac(kt_dn) + upa(kn,i)*upauto(kt_dn,i) + sevup(kt_dn) = sevup(kt_dn) + upa(kn,i)*upevap(kt_dn,i) end do sqt(kt_dn) = sqtup(kt_dn) + sqtdn(kt_dn) sthl(kt_dn) = sthlup(kt_dn) + sthldn(kt_dn) + + !+++arh total (updraft + downdraft) rain evaporation + sev(kt_dn) = sevup(kt_dn) + sqtdn(kt_dn) + enddo + +!+++arh entire section below (through the kctop loop) added for the deep hookup + ! --------------------------------------------------------- ! + ! ensemble mass flux, entrainment and detrainment for the ! + ! deep-convection hookup. ! + ! Total updraft (downdraft) mass flux = ! + ! rho * sum_i a_i*w_i = rho*awup (awdn). ! + ! Fractional entrainment is the mass-flux-weighted plume ! + ! entrainment; detrainment is then derived from discrete ! + ! mass continuity so that (ent-det) is consistent with ! + ! d(mf)/dz, which keeps the downstream ZM_MU/EU/DU arrays ! + ! internally consistent. ! + ! --------------------------------------------------------- ! + do k = ksfcm, ktopm, kdir + mfup(k) = rho_zm(k)*awup(k) + mfdn(k) = rho_zm(k)*awdn(k) + do i=1,clubb_mf_nup + entup(k) = entup(k) + rho_zm(k)*upa(k,i)*upw(k,i)*upent(k,i) + enddo + if (mfup(k) > 0._r8) then + entup(k) = entup(k)/mfup(k) + else + entup(k) = 0._r8 + end if + enddo + do k = ksfcm+kdir, ktopm, kdir + kn = k - kdir + kt_dn = k - (1+kdir)/2 + ! updraft: det = ent - d(ln mf)/dz, clipped >= 0 + if (mfup(kn) > 0._r8 .and. mfup(k) > 0._r8) then + detup(k) = entup(k) - (mfup(k) - mfup(kn))/(mfup(kn)*dzt(kt_dn)) + if (detup(k) < 0._r8) detup(k) = 0._r8 + end if + enddo + do k = ktopm, ksfcm+kdir, -kdir + kt = k - (1+kdir)/2 + kn = k - kdir + ! downdraft grows downward: ent from d(|mf|)/dz descending, det clipped + if (abs(mfdn(k)) > 0._r8 .and. abs(mfdn(kn)) > 0._r8) then + entdn(kn) = (abs(mfdn(kn)) - abs(mfdn(k)))/(abs(mfdn(k))*dzt(kt)) + if (entdn(kn) < 0._r8) then + detdn(kn) = -entdn(kn) + entdn(kn) = 0._r8 + end if + end if + enddo + ! ensemble plume-top index, counted in momentum interfaces from the + ! surface (1 = surface interface); orientation independent + do k = ksfcm, ktopm-kdir, kdir + if (ac(k) > 0._r8) kctop = real(abs(k-ksfcm)+1, r8) enddo ! --------------------------------------------------------- ! ! ztopm1 calculation ! diff --git a/src/physics/cam/convect_deep.F90 b/src/physics/cam/convect_deep.F90 index 166d5e5693..3f0fccf300 100644 --- a/src/physics/cam/convect_deep.F90 +++ b/src/physics/cam/convect_deep.F90 @@ -14,6 +14,9 @@ module convect_deep use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pver, pcols, pverp use cam_logfile, only: iulog + !+++arh flag for the CLUBB-MF deep-convection hookup (plume ensemble drives + ! convtran/convproc through the ZM pbuf arrays with deep_scheme='off') + use clubb_mf, only: do_clubb_mf implicit none @@ -47,6 +50,20 @@ module convect_deep integer :: ttend_dp_idx = 0 + !+++arh pbuf indices of the ZM gathered arrays (registered by clubb_intr when + ! the CLUBB-MF deep hookup is active with deep_scheme='off'); used by + ! clubb_mf_convtran2 below + integer :: zm_mu_idx = 0 + integer :: zm_eu_idx = 0 + integer :: zm_du_idx = 0 + integer :: zm_md_idx = 0 + integer :: zm_ed_idx = 0 + integer :: zm_dp_idx = 0 + integer :: zm_dsubcld_idx = 0 + integer :: zm_jt_idx = 0 + integer :: zm_maxg_idx = 0 + integer :: zm_ideep_idx = 0 + !========================================================================================= contains @@ -156,6 +173,24 @@ subroutine convect_deep_init(pref_edge) pblh_idx = pbuf_get_index('pblh') tpert_idx = pbuf_get_index('tpert') + !+++arh fetch the ZM gathered-array indices registered by clubb_intr for the + ! CLUBB-MF deep hookup (deep_scheme='off' only) + if (trim(deep_scheme) == 'off' .and. do_clubb_mf) then + if (masterproc) write(iulog,*) & + 'convect_deep: CLUBB-MF deep hookup active: convtran2 will transport '// & + 'constituents using the MF plume ensemble mass fluxes' + zm_mu_idx = pbuf_get_index('ZM_MU') + zm_eu_idx = pbuf_get_index('ZM_EU') + zm_du_idx = pbuf_get_index('ZM_DU') + zm_md_idx = pbuf_get_index('ZM_MD') + zm_ed_idx = pbuf_get_index('ZM_ED') + zm_dp_idx = pbuf_get_index('ZM_DP') + zm_dsubcld_idx = pbuf_get_index('ZM_DSUBCLD') + zm_jt_idx = pbuf_get_index('ZM_JT') + zm_maxg_idx = pbuf_get_index('ZM_MAXG') + zm_ideep_idx = pbuf_get_index('ZM_IDEEP') + end if + call addfld ('ICWMRDP', (/ 'lev' /), 'A', 'kg/kg', 'Deep Convection in-cloud water mixing ratio ' ) end subroutine convect_deep_init @@ -250,7 +285,13 @@ subroutine convect_deep_tend( & cld = 0 ql = 0 rprd = 0 - fracis = 0 + !+++arh with the CLUBB-MF deep hookup, fracis must keep the value 1.0 set by + ! tphysbc so that gases are transported by convtran2 in tphysac (wetdep + ! later overwrites the aerosol entries); ql/rprd/evapcdp zeroed here are + ! repopulated by clubb_tend_cam (tphysac) before any consumer reads them + if (.not. do_clubb_mf) then + fracis = 0 + end if evapcdp = 0 case('ZM') ! 1 ==> Zhang-McFarlane (default) @@ -298,6 +339,9 @@ subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf) if ( deep_scheme .eq. 'ZM' ) then ! Zhang-McFarlane call zm_conv_tend_2( state, ptend, ztodt, pbuf) + !+++arh CLUBB-MF deep hookup: transport constituents with the MF plume ensemble. + else if ( deep_scheme .eq. 'off' .and. do_clubb_mf ) then + call clubb_mf_convtran2( state, ptend, ztodt, pbuf ) else call physics_ptend_init(ptend, state%psetcols, 'convect_deep') end if @@ -305,5 +349,107 @@ subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf) end subroutine convect_deep_tend_2 +!========================================================================================= + +!+++arh new subroutine: convective tracer transport driven by the CLUBB-MF plume +! ensemble. Mirrors zm_conv_tend_2 (fully pbuf-driven), reading the ZM_* +! gathered arrays that clubb_tend_cam populated from the plume ensemble. +subroutine clubb_mf_convtran2( state, ptend, ztodt, pbuf) + + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use time_manager, only: get_nstep + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use constituents, only: pcnst, cnst_is_convtran2 + use ccpp_constituent_prop_mod, only: ccpp_const_props + use zm_conv_convtran, only: zm_conv_convtran_run + use cam_abortutils, only: endrun + +! Arguments + type(physics_state), intent(in ) :: state + type(physics_ptend), intent(out) :: ptend + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: ztodt + +! Local variables + integer :: i + integer :: lengath ! number of columns with active plumes + integer :: nstep + integer :: ncol + + logical :: lq(pcnst) + real(r8), dimension(pcols,pver) :: dpdry + + ! physics buffer fields + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble + real(r8), pointer :: mu(:,:) + real(r8), pointer :: eu(:,:) + real(r8), pointer :: du(:,:) + real(r8), pointer :: md(:,:) + real(r8), pointer :: ed(:,:) + real(r8), pointer :: dp(:,:) + real(r8), pointer :: dsubcld(:) + integer, pointer :: jt(:) + integer, pointer :: maxg(:) + integer, pointer :: ideep(:) + + character(len=40) :: scheme_name + character(len=512) :: errmsg + integer :: errflg + + !----------------------------------------------------------------------------------- + + ! transport ONLY the convtran2 constituents (trace gases; aerosols are + ! excluded via convproc_do_aer). The convtran1 species are the PUMAS + ! condensate/precip constituents (CLDLIQ/CLDICE/RAINQM/... registered with + ! is_convtran1=.true.): transporting those with the plume mass fluxes + ! double counts water already carried by the CLUBB-MF qt/thl fluxes and, + ! without ZM's compensating heating/detrainment, destabilizes the dycore + ! (NaN in w after ~2 weeks in testing). + lq(1) = .false. + lq(2:) = cnst_is_convtran2(2:) + call physics_ptend_init(ptend, state%psetcols, 'convtran2', lq=lq ) + + call pbuf_get_field(pbuf, fracis_idx, fracis) + call pbuf_get_field(pbuf, zm_mu_idx, mu) + call pbuf_get_field(pbuf, zm_eu_idx, eu) + call pbuf_get_field(pbuf, zm_du_idx, du) + call pbuf_get_field(pbuf, zm_md_idx, md) + call pbuf_get_field(pbuf, zm_ed_idx, ed) + call pbuf_get_field(pbuf, zm_dp_idx, dp) + call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld) + call pbuf_get_field(pbuf, zm_jt_idx, jt) + call pbuf_get_field(pbuf, zm_maxg_idx, maxg) + call pbuf_get_field(pbuf, zm_ideep_idx, ideep) + + ncol = state%ncol + nstep = get_nstep() + + lengath = count(ideep > 0) + if (lengath > ncol) lengath = ncol + + if (any(ptend%lq(:)) .and. lengath > 0) then + ! initialize dpdry for call to convtran + ! it is used for tracers of dry mixing ratio type + dpdry = 0._r8 + do i = 1, lengath + dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 + end do + + ptend%q(:,:,:) = 0._r8 + + call zm_conv_convtran_run (ncol, pver, & + ptend%lq,state%q(:ncol,:,:), pcnst, mu(:ncol,:), md(:ncol,:), & + du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & + jt(:ncol), maxg(:ncol), ideep(:ncol), 1, lengath, & + nstep, fracis(:ncol,:,:), ptend%q(:ncol,:,:), dpdry(:ncol,:), ccpp_const_props, & + scheme_name, errmsg, errflg) + + if (errflg /= 0) then + call endrun('clubb_mf_convtran2: From zm_conv_convtran_run: ' // errmsg) + end if + end if + +end subroutine clubb_mf_convtran2 + end module convect_deep diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 7530c954cf..127b295544 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -42,7 +42,8 @@ module physpkg use offline_driver, only: offline_driver_dorun - use clubb_mf, only: do_clubb_mf +!+++arh clubb_mf dependency removed: CLUBB-MF is only supported with cam7 +! physics (enforced in bld/build-namelist) implicit none private @@ -2291,10 +2292,6 @@ subroutine tphysbc (ztodt, state, & real(r8) :: prec_sed_macmic(pcols) real(r8) :: snow_sed_macmic(pcols) - ! CLUBB+MF - real(r8) :: prec_sh_macmic(pcols) - real(r8) :: snow_sh_macmic(pcols) - ! energy checking variables real(r8) :: zero(pcols) ! array of zeros real(r8) :: zero_sc(pcols*psubcols) ! array of zeros @@ -2676,12 +2673,6 @@ subroutine tphysbc (ztodt, state, & prec_pcw_macmic = 0._r8 snow_pcw_macmic = 0._r8 - if (do_clubb_mf) then - ! CLUBB+MF - prec_sh_macmic = 0._r8 - snow_sh_macmic = 0._r8 - end if - ! contrail parameterization ! see Chen et al., 2012: Global contrail coverage simulated ! by CAM5 with the inventory of 2006 global aircraft emissions, JAMES @@ -2762,12 +2753,7 @@ subroutine tphysbc (ztodt, state, & ! Since we "added" the reserved liquid back in this routine, we need ! to account for it in the energy checker - if (do_clubb_mf) then - ! CLUBB+MF: add MF precip to flx_cnd [m/s] - flx_cnd(:ncol) = -1._r8*rliq(:ncol) + prec_sh(:ncol) - else - flx_cnd(:ncol) = -1._r8*rliq(:ncol) - end if + flx_cnd(:ncol) = -1._r8*rliq(:ncol) flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol) ! Unfortunately, physics_update does not know what time period @@ -2802,12 +2788,6 @@ subroutine tphysbc (ztodt, state, & call t_stopf('macrop_tend') - if (do_clubb_mf) then - ! CLUBB+MF - prec_sh_macmic(:ncol) = prec_sh_macmic(:ncol) + prec_sh(:ncol) - snow_sh_macmic(:ncol) = snow_sh_macmic(:ncol) + snow_sh(:ncol) - end if - !=================================================== ! Calculate cloud microphysics !=================================================== @@ -2961,12 +2941,6 @@ subroutine tphysbc (ztodt, state, & prec_str(:ncol) = prec_pcw(:ncol) + prec_sed(:ncol) snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol) - if (do_clubb_mf) then - ! CLUBB+MF - prec_sh(:ncol) = prec_sh_macmic(:ncol)/cld_macmic_num_steps - snow_sh(:ncol) = snow_sh_macmic(:ncol)/cld_macmic_num_steps - end if - endif ! Add the precipitation from CARMA to the precipitation from stratiform. diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index b9b18b9a5d..825c08e5b0 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -88,8 +88,8 @@ module physpkg integer :: snow_pcw_idx = 0 integer :: prec_dp_idx = 0 integer :: snow_dp_idx = 0 - integer :: prec_sh_idx = 0 - integer :: snow_sh_idx = 0 +!+++arh prec_sh_idx/snow_sh_idx removed: CLUBB-MF precip is carried in the +! deep-convection precip pbuf fields (PREC_DP/SNOW_DP) integer :: dlfzm_idx = 0 ! detrained convective cloud water mixing ratio. integer :: ducore_idx = 0 ! ducore index in physics buffer integer :: dvcore_idx = 0 ! dvcore index in physics buffer @@ -949,8 +949,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) prec_dp_idx = pbuf_get_index('PREC_DP') snow_dp_idx = pbuf_get_index('SNOW_DP') - prec_sh_idx = pbuf_get_index('PREC_SH') - snow_sh_idx = pbuf_get_index('SNOW_SH') +!+++arh PREC_SH/SNOW_SH index fetches removed (CLUBB-MF precip now in PREC_DP/SNOW_DP) dlfzm_idx = pbuf_get_index('DLFZM', ierr) cmfmczm_idx = pbuf_get_index('CMFMC_DP', ierr) @@ -1519,9 +1518,9 @@ subroutine tphysac (ztodt, cam_in, & real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation - ! CLUBB+MF - real(r8),pointer :: prec_sh(:) ! total precipitation from Hack convection - real(r8),pointer :: snow_sh(:) ! snow from Hack convection + !+++arh CLUBB+MF precip is carried in the deep-convection pbuf fields + real(r8),pointer :: prec_dp(:) ! total precipitation from CLUBB-MF (deep) + real(r8),pointer :: snow_dp(:) ! snow from CLUBB-MF (deep) ! Local copies for substepping real(r8) :: prec_pcw_macmic(pcols) @@ -1533,9 +1532,9 @@ subroutine tphysac (ztodt, cam_in, & real(r8) :: prec_sed_carma(pcols) ! total precip from cloud sedimentation (CARMA) real(r8) :: snow_sed_carma(pcols) ! snow from cloud ice sedimentation (CARMA) - ! CLUBB+MF - real(r8) :: prec_sh_macmic(pcols) - real(r8) :: snow_sh_macmic(pcols) + !+++arh CLUBB+MF + real(r8) :: prec_dp_macmic(pcols) + real(r8) :: snow_dp_macmic(pcols) logical :: labort ! abort flag @@ -1635,8 +1634,9 @@ subroutine tphysac (ztodt, cam_in, & end if if (do_clubb_mf) then - call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) - call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) +!+++arh CLUBB-MF precip now carried in the deep fields + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp ) + call pbuf_get_field(pbuf, snow_dp_idx, snow_dp ) end if if (dlfzm_idx > 0) then @@ -1765,9 +1765,9 @@ subroutine tphysac (ztodt, cam_in, & snow_pcw_macmic = 0._r8 if (do_clubb_mf) then - ! CLUBB+MF - prec_sh_macmic = 0._r8 - snow_sh_macmic = 0._r8 + !+++arh CLUBB+MF + prec_dp_macmic = 0._r8 + snow_dp_macmic = 0._r8 end if ! contrail parameterization @@ -1805,7 +1805,8 @@ subroutine tphysac (ztodt, cam_in, & ! Since we "added" the reserved liquid back in this routine, we need ! to account for it in the energy checker if (do_clubb_mf) then - flx_cnd(:ncol) = -1._r8*rliq(:ncol) + prec_sh(:ncol) +!+++arh + flx_cnd(:ncol) = -1._r8*rliq(:ncol) + prec_dp(:ncol) else flx_cnd(:ncol) = -1._r8*rliq(:ncol) end if @@ -1842,9 +1843,9 @@ subroutine tphysac (ztodt, cam_in, & call t_stopf('macrop_tend') if (do_clubb_mf) then - ! CLUBB+MF - prec_sh_macmic(:ncol) = prec_sh_macmic(:ncol) + prec_sh(:ncol) - snow_sh_macmic(:ncol) = snow_sh_macmic(:ncol) + snow_sh(:ncol) + !+++arh CLUBB+MF + prec_dp_macmic(:ncol) = prec_dp_macmic(:ncol) + prec_dp(:ncol) + snow_dp_macmic(:ncol) = snow_dp_macmic(:ncol) + snow_dp(:ncol) end if !=================================================== @@ -1995,9 +1996,9 @@ subroutine tphysac (ztodt, cam_in, & snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol) if (do_clubb_mf) then - ! CLUBB+MF - prec_sh(:ncol) = prec_sh_macmic(:ncol)/cld_macmic_num_steps - snow_sh(:ncol) = snow_sh_macmic(:ncol)/cld_macmic_num_steps + !+++arh CLUBB+MF + prec_dp(:ncol) = prec_dp_macmic(:ncol)/cld_macmic_num_steps + snow_dp(:ncol) = snow_dp_macmic(:ncol)/cld_macmic_num_steps end if endif @@ -2774,8 +2775,7 @@ subroutine tphysbc (ztodt, state, & ! convective precipitation variables real(r8),pointer :: prec_dp(:) ! total precipitation from ZM convection real(r8),pointer :: snow_dp(:) ! snow from ZM convection - real(r8),pointer :: prec_sh(:) ! total precipitation from Hack convection - real(r8),pointer :: snow_sh(:) ! snow from Hack convection +!+++arh unused prec_sh/snow_sh pointers removed ! stratiform precipitation variables real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s) @@ -3013,8 +3013,7 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, prec_dp_idx, prec_dp ) call pbuf_get_field(pbuf, snow_dp_idx, snow_dp ) - call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) - call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) +!+++arh unused PREC_SH/SNOW_SH fetches removed call pbuf_get_field(pbuf, prec_str_idx, prec_str ) call pbuf_get_field(pbuf, snow_str_idx, snow_str ) From 4dbd937810ec3c8a2d0e53019cdafeacd2f81f52 Mon Sep 17 00:00:00 2001 From: adamrher Date: Mon, 7 Sep 2026 18:20:18 -0600 Subject: [PATCH 39/63] turn off pblcull and aspd options by default --- bld/namelist_files/namelist_defaults_cam.xml | 4 ++-- bld/namelist_files/namelist_definition.xml | 4 ++-- src/physics/cam/clubb_mf.F90 | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 2c6e5b8dcd..08be82db96 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2385,8 +2385,8 @@ .true. 1 .true. - .true. - .true. + .false. + .false. 10 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 4abddcc9a7..894cea37e0 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4810,7 +4810,7 @@ Default: .true. If .true. turn on the Arakawa-Schubert positive-definite detrainment limiter, which eliminates negative diagnosed detrainment by growing the plume mass flux by pure (capped) entrainment and absorbing the change into the plume area. -Default: .true. +Default: .false. diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index de7def2a32..c5c3daf459 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -75,11 +75,11 @@ module clubb_mf logical, protected :: do_clubb_mf_coldpool_perplume = .true. logical, protected :: do_clubb_mf_lscale_perplume = .true. !+++arh Arakawa-Schubert positive-definite detrainment limiter - logical, protected :: do_clubb_mf_aspd = .true. + logical, protected :: do_clubb_mf_aspd = .false. !+++arh cull plumes entirely contained within the PBL: any plume whose ascent ! terminates at or below the PBL top is removed from the ensemble (surface ! closure and PBL-penetrating plumes untouched) - logical, protected :: do_clubb_mf_pblcull = .true. + logical, protected :: do_clubb_mf_pblcull = .false. logical :: tht_tweaks = .true. integer :: mf_num_cin = 5 From 90a119fc933d499d08c0938d6ea2ffc5ae7f74c3 Mon Sep 17 00:00:00 2001 From: adamrher Date: Wed, 9 Sep 2026 10:49:58 -0600 Subject: [PATCH 40/63] code mods to pass science evaluating (i.e., turn on convproc_aer) --- bld/build-namelist | 6 +++- bld/namelist_files/namelist_defaults_cam.xml | 2 +- src/physics/cam/clubb_intr.F90 | 32 +++++++++++++++----- src/physics/cam/clubb_mf.F90 | 12 ++++++-- 4 files changed, 39 insertions(+), 13 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 0d2f632124..bc9dce570e 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3335,7 +3335,11 @@ if (defined $clubb_mf and $clubb_mf =~ /$TRUE/io) { my $deep_scheme = $nl->get_value('deep_scheme'); # Aerosol convective processes -if (($phys =~ /cam6/ or $phys =~ /cam7/) and $deep_scheme =~ /ZM/) { +#+++arh also activated when CLUBB-MF is on: the deep hookup populates the ZM_* +# pbuf arrays from the plume ensemble so aero_convproc operates on the +# plumes (deep_scheme='off'; CLUBB-MF is cam7-only) +if ((($phys =~ /cam6/ or $phys =~ /cam7/) and $deep_scheme =~ /ZM/) + or (defined $clubb_mf and $clubb_mf =~ /$TRUE/io)) { add_default($nl, 'convproc_do_aer', 'val'=>'.true.'); add_default($nl, 'convproc_do_evaprain_atonce', 'val'=>'.true.'); add_default($nl, 'convproc_pom_spechygro', 'val'=>'0.2D0'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 08be82db96..080065df40 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2356,7 +2356,7 @@ .false. .true. .true. - .true. + .false. 200.0 0.2 3.0 diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index b271b66f31..677688b508 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -4387,12 +4387,21 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_snow_nadv(i) = 0._r8 !+++arh accumulate the deep-hookup variables over the nadv subcycles. + ! The fractional entrainment/detrainment are RATIO diagnostics + ! (mass-flux-weighted per subcycle, denominator = mfup): near + ! plume tops the per-subcycle ratio can be immense while the + ! same subcycle's mass flux vanishes -- averaging the ratio + ! separately from the mass flux breaks that cancellation and + ! produced enormous ZM_EU values (aero_convproc courant + ! substep count exploded -> nstep-0 hang). Accumulate the + ! entrainment/detrainment MASS FLUX (rate x mf, bounded) + ! instead; the population block consumes it directly. s_mfup_nadv(i,:nzm_clubb) = s_mfup_nadv(i,:nzm_clubb) + s_mfup(i,:nzm_clubb) - s_entup_nadv(i,:nzm_clubb) = s_entup_nadv(i,:nzm_clubb) + s_entup(i,:nzm_clubb) - s_detup_nadv(i,:nzm_clubb) = s_detup_nadv(i,:nzm_clubb) + s_detup(i,:nzm_clubb) + s_entup_nadv(i,:nzm_clubb) = s_entup_nadv(i,:nzm_clubb) + s_entup(i,:nzm_clubb)*s_mfup(i,:nzm_clubb) + s_detup_nadv(i,:nzm_clubb) = s_detup_nadv(i,:nzm_clubb) + s_detup(i,:nzm_clubb)*s_mfup(i,:nzm_clubb) s_mfdn_nadv(i,:nzm_clubb) = s_mfdn_nadv(i,:nzm_clubb) + s_mfdn(i,:nzm_clubb) - s_entdn_nadv(i,:nzm_clubb) = s_entdn_nadv(i,:nzm_clubb) + s_entdn(i,:nzm_clubb) - s_detdn_nadv(i,:nzm_clubb) = s_detdn_nadv(i,:nzm_clubb) + s_detdn(i,:nzm_clubb) + s_entdn_nadv(i,:nzm_clubb) = s_entdn_nadv(i,:nzm_clubb) + s_entdn(i,:nzm_clubb)*abs(s_mfdn(i,:nzm_clubb)) + s_detdn_nadv(i,:nzm_clubb) = s_detdn_nadv(i,:nzm_clubb) + s_detdn(i,:nzm_clubb)*abs(s_mfdn(i,:nzm_clubb)) mf_sqtac_nadv(i,:nzt_clubb) = mf_sqtac_nadv(i,:nzt_clubb) + mf_sqtac(i,:nzt_clubb) mf_sqtev_nadv(i,:nzt_clubb) = mf_sqtev_nadv(i,:nzt_clubb) + mf_sqtev(i,:nzt_clubb) ! kctop is not averaged: keep the HIGHEST plume top over the @@ -5172,9 +5181,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! hold the ensemble mass flux at the interface at the layer's top. mu(i,kcam) = s_mfup(icol,k_clubb)*gravit/100._r8 md(i,kcam) = s_mfdn(icol,k_clubb)*gravit/100._r8 - ! plume fractional entrainment [1/m] -> ZM d(massflux)/dp form [1/s] - ! (du/ed are rebuilt from exact discrete continuity below) - eu(i,kcam) = s_entup(icol,k_clubb)*mu(i,kcam)*dz_g(icol,k_clubb)/dpg(i,kcam) + !+++arh s_entup now carries the sub-cycle-averaged entrainment MASS + ! FLUX (fractional entrainment x plume mass flux, kg/m3/s), so + ! eu comes from it directly -- no rate x averaged-mf product + ! (du/ed are rebuilt from exact discrete continuity below) + eu(i,kcam) = s_entup(icol,k_clubb)*(gravit/100._r8)*dz_g(icol,k_clubb)/dpg(i,kcam) end do do i=1, ncol rprddp(i,kcam) = -1._r8*mf_sqtac(i,k_clubb) @@ -5197,10 +5208,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! against dpdry, so the effective Courant number is mu*dt/dpdry. Target ! 0.5 (rather than the ZM-style 1.0) to suppress the residual flux-form ! limiter overshoots that drive convtran2 QNEG3 negatives. + !+++arh the aero_convproc courant number also carries the entrainment + ! flux term (eudp = eu*dpdry), so include eu*dt in the cap -- + ! otherwise its internal substep count ntsub = 1+int(courant) + ! is unbounded by the mass-flux cap alone tmpcfl = 0._r8 do kcam=1, pver tmpcfl = max(tmpcfl, max(mu(i,kcam), abs(md(i,kcam)))*hdtime & - /(state_loc%pdeldry(ideep(i),kcam)/100._r8)) + /(state_loc%pdeldry(ideep(i),kcam)/100._r8) & + + eu(i,kcam)*hdtime) end do if (tmpcfl > 0.5_r8) then mu(i,:pver) = mu(i,:pver)*0.5_r8/tmpcfl diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index c5c3daf459..89b3ad487f 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -530,6 +530,12 @@ subroutine integrate_mf( nzm, nzt, dtime, !+++arh (used by the downdraft eturb and the do_clubb_mf_aspd limiter) real(r8),parameter :: max_eturb = 10._r8 ! + !+++arh floor on the ensemble mass flux for the deep-hookup ratio + ! diagnostics (entup/detup/entdn/detdn): near plume tops the + ! mass-flux-weighted entrainment divides by a vanishing mfup while + ! upent ~ 1/upw diverges, producing immense (finite) ratios + real(r8),parameter :: mf_tiny = 1.e-12_r8 + ! ! to condensate or not to condensate logical :: do_condensation = .true. ! @@ -1777,7 +1783,7 @@ subroutine integrate_mf( nzm, nzt, dtime, do i=1,clubb_mf_nup entup(k) = entup(k) + rho_zm(k)*upa(k,i)*upw(k,i)*upent(k,i) enddo - if (mfup(k) > 0._r8) then + if (mfup(k) > mf_tiny) then entup(k) = entup(k)/mfup(k) else entup(k) = 0._r8 @@ -1787,7 +1793,7 @@ subroutine integrate_mf( nzm, nzt, dtime, kn = k - kdir kt_dn = k - (1+kdir)/2 ! updraft: det = ent - d(ln mf)/dz, clipped >= 0 - if (mfup(kn) > 0._r8 .and. mfup(k) > 0._r8) then + if (mfup(kn) > mf_tiny .and. mfup(k) > mf_tiny) then detup(k) = entup(k) - (mfup(k) - mfup(kn))/(mfup(kn)*dzt(kt_dn)) if (detup(k) < 0._r8) detup(k) = 0._r8 end if @@ -1796,7 +1802,7 @@ subroutine integrate_mf( nzm, nzt, dtime, kt = k - (1+kdir)/2 kn = k - kdir ! downdraft grows downward: ent from d(|mf|)/dz descending, det clipped - if (abs(mfdn(k)) > 0._r8 .and. abs(mfdn(kn)) > 0._r8) then + if (abs(mfdn(k)) > mf_tiny .and. abs(mfdn(kn)) > mf_tiny) then entdn(kn) = (abs(mfdn(kn)) - abs(mfdn(k)))/(abs(mfdn(k))*dzt(kt)) if (entdn(kn) < 0._r8) then detdn(kn) = -entdn(kn) From 07fbfab40cefbc03e31d0805ecbd0004fdd73782 Mon Sep 17 00:00:00 2001 From: adamrher Date: Fri, 11 Sep 2026 19:50:31 -0600 Subject: [PATCH 41/63] deep_scheme='CLUBB_MF' hookup, MF_WUP hook, macmic cloud field averaging --- bld/build-namelist | 43 +- bld/namelist_files/namelist_defaults_cam.xml | 1 - bld/namelist_files/namelist_definition.xml | 34 +- .../cam/nochem_clubbmf/user_nl_cam | 3 +- .../cam/outfrq9s_clubbmf/user_nl_cam | 3 +- src/chemistry/aerosol/aero_convproc.F90 | 65 +- src/physics/cam/clubb_intr.F90 | 558 ++++++++---------- src/physics/cam/clubb_mf.F90 | 100 ++-- src/physics/cam/convect_deep.F90 | 64 +- src/physics/cam7/physpkg.F90 | 47 +- 10 files changed, 451 insertions(+), 467 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index bc9dce570e..23abf565c3 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3313,33 +3313,26 @@ if (defined $do_clubb_sgs) { add_default($nl, 'do_clubb_sgs'); my $clubb_sgs = $nl->get_value('do_clubb_sgs'); -# Evaluate do_clubb_mf early to handle overrides -add_default($nl, 'do_clubb_mf'); -my $clubb_mf = $nl->get_value('do_clubb_mf'); +# Deep convection scheme +add_default($nl, 'deep_scheme'); +my $deep_scheme = $nl->get_value('deep_scheme'); -# Deep convection scheme and CLUBB+MF dependency check -if (defined $clubb_mf and $clubb_mf =~ /$TRUE/io) { +# CLUBB+MF dependency checks +if ($deep_scheme =~ /CLUBB_MF/) { if ($clubb_sgs !~ /$TRUE/io) { - die "CAM Namelist ERROR: do_clubb_mf is set to .true. but do_clubb_sgs is not active.\n" . + die "CAM Namelist ERROR: deep_scheme='CLUBB_MF' but do_clubb_sgs is not active.\n" . "CLUBB+MF requires the CLUBB_SGS package to be enabled.\n"; } - #+++arh CLUBB+MF is only implemented in the cam7 physics driver + # CLUBB+MF is only valid cam7 physics if ($phys !~ /cam7/) { - die "CAM Namelist ERROR: do_clubb_mf is set to .true. but the physics package is '$phys'.\n" . + die "CAM Namelist ERROR: deep_scheme='CLUBB_MF' but the physics package is '$phys'.\n" . "CLUBB+MF is only supported with cam7 physics (configure with -phys cam7).\n"; } - add_default($nl, 'deep_scheme', 'val'=>"'off'"); -} else { - add_default($nl, 'deep_scheme'); } -my $deep_scheme = $nl->get_value('deep_scheme'); # Aerosol convective processes -#+++arh also activated when CLUBB-MF is on: the deep hookup populates the ZM_* -# pbuf arrays from the plume ensemble so aero_convproc operates on the -# plumes (deep_scheme='off'; CLUBB-MF is cam7-only) if ((($phys =~ /cam6/ or $phys =~ /cam7/) and $deep_scheme =~ /ZM/) - or (defined $clubb_mf and $clubb_mf =~ /$TRUE/io)) { + or $deep_scheme =~ /CLUBB_MF/) { add_default($nl, 'convproc_do_aer', 'val'=>'.true.'); add_default($nl, 'convproc_do_evaprain_atonce', 'val'=>'.true.'); add_default($nl, 'convproc_pom_spechygro', 'val'=>'0.2D0'); @@ -3454,15 +3447,8 @@ add_default($nl, 'microp_aero_npccn_scale'); add_default($nl, 'microp_aero_wsub_min'); add_default($nl, 'microp_aero_wsub_min_asf'); add_default($nl, 'microp_aero_wsubi_min'); - -# CLUBB-MF cloud droplet activation tuning -if ($clubb_mf =~ "true") { - add_default($nl, 'microp_aero_wsub_scale', 'val'=>'0.5'); - add_default($nl, 'microp_aero_wsubi_scale', 'val'=>'0.5'); -} else { - add_default($nl, 'microp_aero_wsub_scale'); - add_default($nl, 'microp_aero_wsubi_scale'); -} +add_default($nl, 'microp_aero_wsub_scale'); +add_default($nl, 'microp_aero_wsubi_scale'); # Ice nucleation options if (!$simple_phys) { @@ -3715,7 +3701,7 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_z_displace'); # CLUBB-MF runs w/o expldiff & prognostic momentum fluxes - if ($clubb_mf =~ "true") { + if ($deep_scheme =~ /CLUBB_MF/) { add_default($nl, 'clubb_l_predict_upwp_vpwp', 'val'=>'.false.'); add_default($nl, 'clubb_l_do_expldiff_rtm_thlm', 'val'=>'.false.'); } else { @@ -3727,7 +3713,7 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'do_hb_above_clubb'); # CLUBB-MF options - if ($clubb_mf =~ "true") { + if ($deep_scheme =~ /CLUBB_MF/) { add_default($nl, 'do_clubb_mf_diag'); add_default($nl, 'do_clubb_mf_rad'); add_default($nl, 'do_clubb_mf_precip'); @@ -4043,7 +4029,8 @@ if ($waccm_phys or add_default($nl, 'use_gw_front' , 'val'=>'.false.'); } # Check if deep convection scheme used. If not set use_gw_convect_dp=.false. -if ($deep_scheme =~ /off/) { +# CLUBB_MF does not (yet) provide TTEND_DP, so treat it like 'off' here +if ($deep_scheme =~ /off/ or $deep_scheme =~ /CLUBB_MF/) { $use_gw_convect_dp = '.false.'; } add_default($nl, 'use_gw_convect_dp', 'val'=>$use_gw_convect_dp); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 080065df40..42401d00bf 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2352,7 +2352,6 @@ - .false. .false. .true. .true. diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 894cea37e0..0b93398bbf 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3684,9 +3684,12 @@ Default: 10 + group="phys_ctl_nl" valid_values="ZM,off,CLUBB_SGS,CLUBB_MF" > Type of deep convection scheme employed. 'ZM' for Zhang-McFarlane; -'off' for none. +'off' for none; 'CLUBB_MF' for the CLUBB-MF EDMF plume ensemble (adds +ensemble mass fluxes to CLUBB's higher-order equation set and drives +aerosol convective transport/scavenging and tracer transport through the +deep-convection pbuf interface; requires cam7 physics and CLUBB_SGS). Default: 'ZM' unless using 'pbl=none' @@ -4603,17 +4606,10 @@ Exponent for Richardson number in calculation of invrs_tau_wpxp term Displacement of log law profile above ground (units: m) - - -If .true. add ensemble mass fluxes to CLUBB's higher-order equation set. -Together with CLUBB, this constitutes an eddy-diffusivity mass-flux approach. -Default: .false. - - + -If .true. add detailed budget terms to output by default. Note that do_clubb_mf must also be set to .true. +If .true. add detailed budget terms to output by default. Note that deep_scheme='CLUBB_MF' must also be set. Default: .false. @@ -4637,8 +4633,8 @@ Default: .true. -Entrainment length scale in meters for individual plumes. Not used if -do_clubb_mf=FALSE. +Entrainment length scale in meters for individual plumes. Not used unless +deep_scheme='CLUBB_MF'. Default: 200.0 @@ -4662,8 +4658,8 @@ Default: 1.0 -Entrainment efficiency for individual plumes. Not used if -do_clubb_mf=FALSE. +Entrainment efficiency for individual plumes. Not used unless +deep_scheme='CLUBB_MF'. Default: 0.20 @@ -4807,17 +4803,13 @@ Default: .true. -If .true. turn on the Arakawa-Schubert positive-definite detrainment limiter, -which eliminates negative diagnosed detrainment by growing the plume mass flux -by pure (capped) entrainment and absorbing the change into the plume area. +If .true. turn on the Arakawa-Schubert positive detrainment limiter Default: .false. -If .true. cull plumes entirely contained within the PBL: any plume whose ascent -terminates at or below the PBL top is removed from the ensemble (surface -closure and PBL-penetrating plumes untouched). +If .true. cull plumes entirely contained within the PBL Default: .false. diff --git a/cime_config/testdefs/testmods_dirs/cam/nochem_clubbmf/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/nochem_clubbmf/user_nl_cam index 8d611ff48f..ae9fe45d78 100644 --- a/cime_config/testdefs/testmods_dirs/cam/nochem_clubbmf/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/nochem_clubbmf/user_nl_cam @@ -3,6 +3,5 @@ ndens=1,1,1,1,1,1 nhtfrq=9,9,9,9,9,9 inithist='ENDOFRUN' -do_clubb_mf=.true. do_clubb_mf_diag=.true. -deep_scheme='off' +deep_scheme='CLUBB_MF' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clubbmf/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clubbmf/user_nl_cam index 9b1e051a77..457b51b070 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clubbmf/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clubbmf/user_nl_cam @@ -2,6 +2,5 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=9,9,9,9,9,9 inithist='ENDOFRUN' -do_clubb_mf=.true. do_clubb_mf_diag=.true. -deep_scheme='off' +deep_scheme='CLUBB_MF' diff --git a/src/chemistry/aerosol/aero_convproc.F90 b/src/chemistry/aerosol/aero_convproc.F90 index 6fbbcd2dfb..c3d50d723f 100644 --- a/src/chemistry/aerosol/aero_convproc.F90 +++ b/src/chemistry/aerosol/aero_convproc.F90 @@ -98,6 +98,9 @@ module aero_convproc integer :: zm_maxg_idx = 0 integer :: zm_ideep_idx = 0 +logical :: use_plume_wup = .false. +integer :: mf_wup_idx = 0 + integer :: cmfmc_sh_idx = 0 integer :: sh_e_ed_ratio_idx = 0 @@ -167,6 +170,7 @@ subroutine aero_convproc_init(aero_props) integer :: npass_calc_updraft logical :: history_aerosol character(len=32) :: name_a, name_c + character(len=16) :: deep_scheme character(len=*), parameter :: prefix = 'aero_convproc_init: ' @@ -269,6 +273,18 @@ subroutine aero_convproc_init(aero_props) zm_maxg_idx = pbuf_get_index('ZM_MAXG') zm_ideep_idx = pbuf_get_index('ZM_IDEEP') + ! CLUBB_MF provides the plume-ensemble updraft speed (MF_WUP, + ! registered by convect_deep, populated by clubb_tend_cam); ZM keeps the + ! original mu/(rhoair*zm_areafrac) estimate + call phys_getopts(deep_scheme_out = deep_scheme) + if (trim(deep_scheme) == 'CLUBB_MF') then + use_plume_wup = .true. + mf_wup_idx = pbuf_get_index('MF_WUP') + if (masterproc) write(iulog,*) prefix// & + 'deep_scheme=CLUBB_MF: activation updraft speed taken from the '// & + 'plume ensemble (MF_WUP) instead of mu/(rhoair*zm_areafrac)' + end if + cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') sh_e_ed_ratio_idx = pbuf_get_index('SH_E_ED_RATIO', istat) @@ -534,6 +550,7 @@ subroutine aero_convproc_dp_intr( aero_props, & integer, pointer :: maxg(:) ! Index of cloud bottom for each column (pcols) integer, pointer :: ideep(:) ! Gathering array (pcols) integer :: lengath ! Gathered min lon indices over which to operate + real(r8), pointer :: wup_dp(:,:) ! Gathered plume-ensemble updraft speed (m/s; pcols,pver) ! Initialize @@ -564,14 +581,28 @@ subroutine aero_convproc_dp_intr( aero_props, & dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 end do - call aero_convproc_tend( aero_props, 'deep', lchnk, dt, & - state%t, state%pmid, q, du, eu, & - ed, dp, dpdry, jt, & - maxg, ideep, 1, lengath, & - dp_frac, icwmrdp, rprddp, evapcdp, & - fracice, dqdt, nsrflx, qsrflx, & - xx_mfup_max, xx_wcldbase, xx_kcldbase, & - dcondt_resusp3d ) + ! pass the plume-ensemble updraft speed when CLUBB_MF drives + ! the deep interface; otherwise the original call (ZM) is unchanged + if (use_plume_wup) then + call pbuf_get_field(pbuf, mf_wup_idx, wup_dp) + call aero_convproc_tend( aero_props, 'deep', lchnk, dt, & + state%t, state%pmid, q, du, eu, & + ed, dp, dpdry, jt, & + maxg, ideep, 1, lengath, & + dp_frac, icwmrdp, rprddp, evapcdp, & + fracice, dqdt, nsrflx, qsrflx, & + xx_mfup_max, xx_wcldbase, xx_kcldbase, & + dcondt_resusp3d, wup_in=wup_dp ) + else + call aero_convproc_tend( aero_props, 'deep', lchnk, dt, & + state%t, state%pmid, q, du, eu, & + ed, dp, dpdry, jt, & + maxg, ideep, 1, lengath, & + dp_frac, icwmrdp, rprddp, evapcdp, & + fracice, dqdt, nsrflx, qsrflx, & + xx_mfup_max, xx_wcldbase, xx_kcldbase, & + dcondt_resusp3d ) + end if call outfld( 'DP_MFUP_MAX', xx_mfup_max, pcols, lchnk ) call outfld( 'DP_WCLDBASE', xx_wcldbase, pcols, lchnk ) @@ -588,7 +619,7 @@ subroutine aero_convproc_tend( aero_props, convtype, lchnk, dt, & cldfrac, icwmr, rprd, evapc, & fracice, dqdt, nsrflx, qsrflx, & xx_mfup_max, xx_wcldbase, xx_kcldbase, & - dcondt_resusp3d ) + dcondt_resusp3d, wup_in ) !----------------------------------------------------------------------- ! @@ -668,6 +699,7 @@ subroutine aero_convproc_tend( aero_props, convtype, lchnk, dt, & real(r8), intent(out) :: xx_wcldbase(pcols) real(r8), intent(out) :: xx_kcldbase(pcols) real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver) + real(r8), intent(in), optional :: wup_in(pcols,pver) ! Gathered plume-ensemble updraft speed (m/s) !--------------------------Local Variables------------------------------ @@ -776,6 +808,8 @@ subroutine aero_convproc_tend( aero_props, convtype, lchnk, dt, & real(r8) tmpf ! work variables real(r8) xinv_ntsub ! 1.0/ntsub real(r8) wup(pver) ! working updraft velocity (m/s) + logical do_wup_in ! use the plume-ensemble updraft speed + real(r8) tmpwup ! layer-mean plume updraft speed (m/s) real(r8) conu2(pcols,pver,2,ncnstaer) real(r8) dcondt2(pcols,pver,2,ncnstaer) @@ -798,6 +832,9 @@ subroutine aero_convproc_tend( aero_props, convtype, lchnk, dt, & call endrun( '*** aero_convproc_tend -- convtype is not |deep| or |uwsh|' ) end if + ! use the plume-ensemble updraft speed if supplied (deep only) + do_wup_in = present(wup_in) .and. (iconvtype == 1) + nerr = 0 nerrmax = 99 @@ -1078,6 +1115,16 @@ subroutine aero_convproc_tend( aero_props, convtype, lchnk, dt, & ! shallow - wup = (mup in kg/m2/s) / [rhoair * (updraft area)] wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + else if (do_wup_in) then +! CLUBB_MF: layer-mean of the plume-ensemble mass-flux-weighted updraft speed + tmpwup = wup_in(i,k) + if (k < pver) tmpwup = 0.5_r8*(wup_in(i,k) + wup_in(i,k+1)) + if (tmpwup > 0.01_r8) then + wup(k) = tmpwup + else + wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * zm_areafrac) + end if else ! deep - as in shallow, but assumed constant updraft_area with height zm_areafrac wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 677688b508..ede2839108 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -452,7 +452,6 @@ module clubb_intr pblh_idx, & ! PBL pbuf icwmrdp_idx, & ! In cloud mixing ratio for deep convection tke_idx, & ! turbulent kinetic energy - icwmrsh_idx, & ! In cloud mixing ratio for shallow convection (MF) tpert_idx, & ! temperature perturbation from PBL fice_idx, & ! fice_idx index in physics buffer cmeliq_idx, & ! cmeliq_idx index in physics buffer @@ -497,13 +496,9 @@ module clubb_intr integer :: & cmfmc_sh_idx = 0 - !+++arh prec_sh_idx/snow_sh_idx removed: MF precip is now written to the - ! DEEP precip pbuf fields (PREC_DP/SNOW_DP, indices below) - - !+++arh deep-convection pbuf indices for the MF-plume deep hookup - ! (RPRDDP/NEVAPR_DPCU/PREC_DP/SNOW_DP are registered by convect_deep_register - ! when deep_scheme='off'; the ZM_* gathered arrays are registered below in - ! clubb_register_cam since zm_conv_register does not run) + ! deep-convection pbuf indices for the MF-plume deep hookup (all of + ! these fields, including the ZM_* gathered arrays, are registered by + ! convect_deep_register when deep_scheme='CLUBB_MF'; clubb populates them) integer :: prec_dp_idx = 0 integer :: snow_dp_idx = 0 integer :: rprddp_idx = 0 @@ -518,8 +513,6 @@ module clubb_intr integer :: zm_jt_idx = 0 integer :: zm_maxg_idx = 0 integer :: zm_ideep_idx = 0 - integer :: rprdsh_idx = 0 - integer :: nevapr_shcu_idx = 0 integer :: & ztopmn_idx, & @@ -531,8 +524,7 @@ module clubb_intr cbm1_idx, & cbm1_macmic_idx - !+++arh macmic accumulators for the deep-hookup variables (physpkg pbuf so - ! they persist across the macmic iterations within a physics timestep) + ! CLUBB_MF macmic accumulators for the deep-hookup variables integer :: & mfup_macmic_idx = 0, & entup_macmic_idx = 0, & @@ -544,6 +536,12 @@ module clubb_intr sqtev_macmic_idx = 0, & kctop_macmic_idx = 0 + ! CLUBB_MF accumulators for the plume-ensemble updraft speed passed to aero_convproc + integer :: & + sawwup_macmic_idx = 0, & + sawup_macmic_idx = 0, & + mf_wup_idx = 0 + contains ! =============================================================================== ! @@ -567,8 +565,6 @@ subroutine clubb_register_cam( ) ! Add CLUBB fields to pbuf use physics_buffer, only: pbuf_add_field, dtype_r8, dtype_i4, dyn_time_lvls use subcol_utils, only: subcol_get_scheme -!+++arh - use cam_abortutils, only: endrun integer :: cld_macmic_num_steps @@ -704,31 +700,10 @@ subroutine clubb_register_cam( ) call pbuf_add_field('CBM1' ,'global' , dtype_r8, (/pcols/), cbm1_idx) call pbuf_add_field('CBM1_MACMIC' ,'physpkg', dtype_r8, (/pcols/), cbm1_macmic_idx) - !+++arh register the ZM gathered-array pbuf fields normally registered by - ! zm_conv_register, so that zm_conv_convtran_run (tracer transport) and - ! aero_convproc (aerosol transport/activation/scavenging) can operate on - ! the CLUBB-MF plume ensemble when deep_scheme='off'. Registering these - ! with deep_scheme='ZM' would duplicate zm_conv_register, so guard it. - if (trim(deep_scheme) /= 'off') then - call endrun('clubb_register_cam: CLUBB-MF deep hookup requires deep_scheme=off '// & - '(ZM_* pbuf fields would be registered twice)') - end if - call pbuf_add_field('ZM_MU', 'physpkg', dtype_r8, (/pcols,pver/), zm_mu_idx) - call pbuf_add_field('ZM_EU', 'physpkg', dtype_r8, (/pcols,pver/), zm_eu_idx) - call pbuf_add_field('ZM_DU', 'physpkg', dtype_r8, (/pcols,pver/), zm_du_idx) - call pbuf_add_field('ZM_MD', 'physpkg', dtype_r8, (/pcols,pver/), zm_md_idx) - call pbuf_add_field('ZM_ED', 'physpkg', dtype_r8, (/pcols,pver/), zm_ed_idx) - call pbuf_add_field('ZM_DP', 'physpkg', dtype_r8, (/pcols,pver/), zm_dp_idx) - call pbuf_add_field('ZM_DSUBCLD', 'physpkg', dtype_r8, (/pcols/), zm_dsubcld_idx) - call pbuf_add_field('ZM_JT', 'physpkg', dtype_i4, (/pcols/), zm_jt_idx) - call pbuf_add_field('ZM_MAXG', 'physpkg', dtype_i4, (/pcols/), zm_maxg_idx) - call pbuf_add_field('ZM_IDEEP', 'physpkg', dtype_i4, (/pcols/), zm_ideep_idx) - - !+++arh macmic accumulators for the deep-hookup variables. KCTOP holds - ! the HIGHEST ensemble plume top over the nadv/macmic sub-cycles; - ! the final gathering (ZM_IDEEP) keys off it: a column is active - ! if its plume top cleared the first momentum interface - ! (int(kctop) > 1) at any point in the sub-cycles. + ! ZM gathered-array pbuf fields (ZM_MU/.../ZM_IDEEP) are + ! registered by convect_deep_register (deep_scheme='CLUBB_MF'), which + ! owns the deep-convection interface; clubb_tend_cam populates them from + ! the plume ensemble (indices fetched in clubb_ini_cam). call pbuf_add_field('MFUP_MACMIC' ,'physpkg', dtype_r8, (/pcols,nzm_clubb/), mfup_macmic_idx) call pbuf_add_field('ENTUP_MACMIC','physpkg', dtype_r8, (/pcols,nzm_clubb/), entup_macmic_idx) call pbuf_add_field('DETUP_MACMIC','physpkg', dtype_r8, (/pcols,nzm_clubb/), detup_macmic_idx) @@ -738,6 +713,9 @@ subroutine clubb_register_cam( ) call pbuf_add_field('SQTAC_MACMIC','physpkg', dtype_r8, (/pcols,nzt_clubb/), sqtac_macmic_idx) call pbuf_add_field('SQTEV_MACMIC','physpkg', dtype_r8, (/pcols,nzt_clubb/), sqtev_macmic_idx) call pbuf_add_field('KCTOP_MACMIC','physpkg', dtype_r8, (/pcols/), kctop_macmic_idx) + ! plume updraft-speed accumulators for convproc_aer + call pbuf_add_field('SAWWUP_MACMIC','physpkg', dtype_r8, (/pcols,nzm_clubb/), sawwup_macmic_idx) + call pbuf_add_field('SAWUP_MACMIC' ,'physpkg', dtype_r8, (/pcols,nzm_clubb/), sawup_macmic_idx) end if #endif @@ -1724,7 +1702,6 @@ subroutine clubb_ini_cam(pbuf_ini) qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio - icwmrsh_idx = pbuf_get_index('ICWMRSH') ! In-cloud shallow convective mixing ratio (EDMF) sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance prer_evap_idx = pbuf_get_index('PRER_EVAP') @@ -1733,11 +1710,6 @@ subroutine clubb_ini_cam(pbuf_ini) naai_idx = pbuf_get_index('NAAI') npccn_idx = pbuf_get_index('NPCCN') - ! CLUBB+MF - !+++arh PREC_SH/SNOW_SH index fetches removed: MF precip is now written to - ! the DEEP precip pbuf fields (PREC_DP/SNOW_DP, fetched below) - - !+++arh deep-convection pbuf indices for the MF-plume deep hookup if (do_clubb_mf) then prec_dp_idx = pbuf_get_index('PREC_DP') snow_dp_idx = pbuf_get_index('SNOW_DP') @@ -1753,9 +1725,8 @@ subroutine clubb_ini_cam(pbuf_ini) zm_jt_idx = pbuf_get_index('ZM_JT') zm_maxg_idx = pbuf_get_index('ZM_MAXG') zm_ideep_idx = pbuf_get_index('ZM_IDEEP') + mf_wup_idx = pbuf_get_index('MF_WUP') end if - rprdsh_idx = pbuf_get_index('RPRDSH') - nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') ! Scalars aren't in use, set all indices to -1 sclr_idx%iisclr_rt = -1 @@ -2433,7 +2404,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:) :: pblh_pbuf ! planetary boundary layer height [m] real(r8), pointer, dimension(:,:) :: tke_pbuf ! turbulent kinetic energy [m^2/s^2] real(r8), pointer, dimension(:,:) :: dp_icwmr_pbuf ! deep convection in cloud mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: sh_icwmr_pbuf ! shallow convection (EDMF) in cloud mixing ratio [kg/kg] real(r8), pointer, dimension(:,:) :: ice_supersat_frac_pbuf ! Cloud fraction of ice clouds (pver)[fraction] real(r8), pointer, dimension(:,:) :: relvar_pbuf ! relative cloud water variance [-] real(r8), pointer, dimension(:,:) :: naai_pbuf @@ -2466,11 +2436,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc_pbuf ! CLUBB-MF pointers - !+++arh MF precip goes to the deep-convection precip pbuf fields real(r8),pointer :: prec_dp_pbuf(:) ! total precipitation from MF real(r8),pointer :: snow_dp_pbuf(:) ! snow from MF - !+++arh deep-hookup pbuf pointers + ! deep-hookup pbuf pointers real(r8), pointer :: rprddp(:,:) ! Deep conv precip production (kg/kg/s - grid avg) real(r8), pointer :: evapcdp(:,:) ! Deep conv precip evaporation (kg/kg/s - grid avg) real(r8), pointer :: mu(:,:) ! Updraft mass flux (positive) (pcols,pver) @@ -2483,10 +2452,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & integer, pointer :: jt(:) ! Index of cloud top for each column (pcols) integer, pointer :: maxg(:) ! Index of cloud base for each column (pcols) integer, pointer :: ideep(:) ! Gathering array (pcols) - real(r8), pointer :: rprdsh(:,:) ! Shallow conv precip production (zeroed for deep hookup) - real(r8), pointer :: evapcsh(:,:) ! Shallow conv precip evaporation (zeroed for deep hookup) - !+++arh macmic accumulators for the deep-hookup variables + ! macmic accumulators for the deep-hookup variables real(r8), pointer :: s_mfup_macmic(:,:) real(r8), pointer :: s_entup_macmic(:,:) real(r8), pointer :: s_detup_macmic(:,:) @@ -2496,8 +2463,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer :: mf_sqtac_macmic(:,:) real(r8), pointer :: mf_sqtev_macmic(:,:) real(r8), pointer :: mf_kctop_macmic(:) ! highest plume top over the sub-cycles; also - ! the gathering (activity) criterion + ! the gathering (activity) criterion (ideep) + real(r8), pointer :: s_awwup_macmic(:,:) + real(r8), pointer :: s_awup_macmic(:,:) + real(r8), pointer :: wup_gath(:,:) + ! covnetive memory varaibles for CLUBB_MF real(r8), pointer :: ztopmn(:,:,:) real(r8), pointer :: ztopma(:,:) real(r8), pointer :: ztopm1_macmic(:,:) @@ -2615,13 +2586,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thlforcup_nadv,mf_qtforcup_nadv, & !fundamentally represents the volumetric change inside a cell. mf_thlforcdn_nadv,mf_qtforcdn_nadv, & !All forcing variables belong strictly on the mf_thlforc_nadv, mf_qtforc_nadv, & !thermodynamic grid (nzt_clubb). - mf_sqtup, mf_sthlup, & - mf_sqtdn, mf_sthldn, & - mf_sqt, mf_sthl, & - mf_qc_zt, mf_cloudfrac_zt, & - !+++arh deep-hookup: ensemble plume autoconversion / rain evaporation - mf_sqtac, mf_sqtev, & - !+++arh deep-hookup nadv-subcycle accumulators + mf_sqtup, mf_sthlup, & + mf_sqtdn, mf_sthldn, & + mf_sqt, mf_sthl, & + mf_qc_zt, mf_cloudfrac_zt, & + mf_sqtac, mf_sqtev, & mf_sqtac_nadv, mf_sqtev_nadv real(r8), dimension(state%ncol,nzm_clubb) :: & @@ -2668,15 +2637,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_awthldn, s_awqtdn, s_awudn, s_awvdn, & s_awthl, s_awqt, & s_awu, s_awv, & - !+++arh deep-hookup: ensemble plume mass flux / entrainment / detrainment s_mfup, s_entup, s_detup, & s_mfdn, s_entdn, s_detdn, & - !+++arh deep-hookup nadv-subcycle accumulators s_mfup_nadv, s_entup_nadv, s_detup_nadv, & s_mfdn_nadv, s_entdn_nadv, s_detdn_nadv, & + s_awwup_nadv, s_awup_nadv, & mf_precc, & - ! MF work arrays (of size NCOL) + ! MF work arrays mf_thlflxup, mf_qtflxup, mf_uflxup, mf_vflxup, & mf_thlflxdn, mf_qtflxdn, mf_uflxdn, mf_vflxdn, & mf_thlflx, mf_qtflx, mf_uflx, mf_vflx, & @@ -2687,12 +2655,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_ent, mf_ent_nadv, & ! MF local momentum vars - rtm_zm, thlm_zm, & ! momentum grid - th_zm, qv_zm, & ! momentum grid - qc_zm, & ! momentum grid - kappa_zm, p_in_Pa_zm, & ! momentum grid - tke_zm, & ! momentum grid - invrs_exner_zm ! momentum grid + rtm_zm, thlm_zm, & + th_zm, qv_zm, & + qc_zm, & + kappa_zm, p_in_Pa_zm, & + tke_zm, & + invrs_exner_zm real(r8), dimension(state%ncol,nzm_clubb,clubb_mf_nup) :: & mf_upa, mf_dna, & @@ -2902,13 +2870,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] real(r8), dimension(state%ncol,clubb_mf_nup) :: mf_ztop, mf_ztop_nadv, & - mf_ztopm1, mf_ztopm1_nadv, & - mf_L0, mf_L0_nadv, & - mf_ddcp, mf_ddcp_nadv, & - mf_cape, mf_cape_nadv + mf_ztopm1, mf_ztopm1_nadv, & + mf_L0, mf_L0_nadv, & + mf_ddcp, mf_ddcp_nadv, & + mf_cape, mf_cape_nadv #endif - ! CFL limiter vars + ! CLUBB_MF real(r8), parameter :: cflval = 1._r8 real(r8) :: lambda character(len=256) :: lambda_errmsg @@ -2917,13 +2885,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & logical :: cfllim - real(r8), dimension(state%ncol) :: mf_precc_nadv, mf_snow_nadv,& + real(r8), dimension(state%ncol) :: mf_precc_nadv, mf_snow_nadv,& mf_cbm1, mf_cbm1_nadv, & mf_freq_nadv - !+++arh deep-hookup: ensemble plume-top index per column, and gathering / - ! mass-flux consistency work variables. mf_kctop_nadv holds the highest - ! kctop over the nadv subcycles (also the gathering/activity criterion). real(r8), dimension(state%ncol) :: mf_kctop, mf_kctop_nadv integer :: lengath, tmptop, kcam, icol real(r8) :: tmpcfl, tmpnet @@ -3032,17 +2997,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, kvh_idx, khzm_pbuf) call pbuf_get_field(pbuf, pblh_idx, pblh_pbuf) call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr_pbuf) - call pbuf_get_field(pbuf, icwmrsh_idx, sh_icwmr_pbuf) call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh_pbuf) - !+++arh MF precip is written to the DEEP precip pbuf fields (indices are - ! only fetched when do_clubb_mf is active, so guard the get_field) if (do_clubb_mf) then call pbuf_get_field(pbuf, prec_dp_idx, prec_dp_pbuf ) call pbuf_get_field(pbuf, snow_dp_idx, snow_dp_pbuf ) - end if - if (do_clubb_mf) then call pbuf_get_field(pbuf, tpert_idx, tpert) call pbuf_get_field(pbuf, ztopmn_idx, ztopmn) @@ -3056,7 +3016,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, cbm1_idx, cbm1) call pbuf_get_field(pbuf, cbm1_macmic_idx, cbm1_macmic) - !+++arh macmic accumulators for the deep-hookup variables + ! macmic accumulators for the deep-hookup variables call pbuf_get_field(pbuf, mfup_macmic_idx, s_mfup_macmic) call pbuf_get_field(pbuf, entup_macmic_idx, s_entup_macmic) call pbuf_get_field(pbuf, detup_macmic_idx, s_detup_macmic) @@ -3066,6 +3026,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, sqtac_macmic_idx, mf_sqtac_macmic) call pbuf_get_field(pbuf, sqtev_macmic_idx, mf_sqtev_macmic) call pbuf_get_field(pbuf, kctop_macmic_idx, mf_kctop_macmic) + call pbuf_get_field(pbuf, sawwup_macmic_idx, s_awwup_macmic) + call pbuf_get_field(pbuf, sawup_macmic_idx, s_awup_macmic) end if @@ -3480,11 +3442,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_freq_nadv = 0._r8 if (macmic_it==1) then - ztopm1_macmic(:ncol,:) = 0._r8 - ddcp_macmic(:ncol,:) = 0._r8 - cbm1_macmic(:ncol) = 0._r8 - - !+++arh macmic accumulators for the deep-hookup variables + ztopm1_macmic(:ncol,:) = 0._r8 + ddcp_macmic(:ncol,:) = 0._r8 + cbm1_macmic(:ncol) = 0._r8 s_mfup_macmic(:ncol,:) = 0._r8 s_entup_macmic(:ncol,:) = 0._r8 s_detup_macmic(:ncol,:) = 0._r8 @@ -3494,6 +3454,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_sqtac_macmic(:ncol,:) = 0._r8 mf_sqtev_macmic(:ncol,:) = 0._r8 mf_kctop_macmic(:ncol) = 0._r8 + s_awwup_macmic(:ncol,:) = 0._r8 + s_awup_macmic(:ncol,:) = 0._r8 end if @@ -3520,13 +3482,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thlforc_nadv(:ncol,:nzt_clubb) = 0._r8 mf_qtforc_nadv(:ncol,:nzt_clubb) = 0._r8 - !+++arh deep-hookup nadv-subcycle accumulators s_mfup_nadv(:ncol,:nzm_clubb) = 0._r8 s_entup_nadv(:ncol,:nzm_clubb) = 0._r8 s_detup_nadv(:ncol,:nzm_clubb) = 0._r8 s_mfdn_nadv(:ncol,:nzm_clubb) = 0._r8 s_entdn_nadv(:ncol,:nzm_clubb) = 0._r8 s_detdn_nadv(:ncol,:nzm_clubb) = 0._r8 + s_awwup_nadv(:ncol,:nzm_clubb) = 0._r8 + s_awup_nadv(:ncol,:nzm_clubb) = 0._r8 mf_sqtac_nadv(:ncol,:nzt_clubb) = 0._r8 mf_sqtev_nadv(:ncol,:nzt_clubb) = 0._r8 mf_kctop_nadv(:ncol) = 0._r8 @@ -4284,14 +4247,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_sqtup(i,:), mf_sthlup(i,:), & ! output mf_sqtdn(i,:), mf_sthldn(i,:), & ! output mf_sqt(i,:), mf_sthl(i,:), & ! output -!+++arh mf_sqtac(i,:), mf_sqtev(i,:), & ! output mf_precc(i,:), & ! output - mf_ztop(i,:), mf_L0(i,:), & - !+++arh ensemble mf/ent/det profiles + plume top for the deep-convection hookup - s_mfup(i,:), s_entup(i,:), s_detup(i,:), & - s_mfdn(i,:), s_entdn(i,:), s_detdn(i,:), & - mf_kctop(i) ) + mf_ztop(i,:), mf_L0(i,:), & ! output + s_mfup(i,:), s_entup(i,:), s_detup(i,:), & ! output + s_mfdn(i,:), s_entdn(i,:), s_detdn(i,:), & ! output + mf_kctop(i) ) ! output end do @@ -4386,22 +4347,26 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_precc_nadv(i) = mf_precc_nadv(i) + mf_precc(i,gr%k_lb_zm)/1000._r8 mf_snow_nadv(i) = 0._r8 - !+++arh accumulate the deep-hookup variables over the nadv subcycles. - ! The fractional entrainment/detrainment are RATIO diagnostics - ! (mass-flux-weighted per subcycle, denominator = mfup): near - ! plume tops the per-subcycle ratio can be immense while the - ! same subcycle's mass flux vanishes -- averaging the ratio - ! separately from the mass flux breaks that cancellation and - ! produced enormous ZM_EU values (aero_convproc courant - ! substep count exploded -> nstep-0 hang). Accumulate the - ! entrainment/detrainment MASS FLUX (rate x mf, bounded) - ! instead; the population block consumes it directly. + ! accumulate the deep-hookup variables over the nadv subcycles. + ! the fractional entrainment/detrainment are RATIO diagnostics + ! (mass-flux-weighted per subcycle, denominator = mfup): near + ! plume tops the per-subcycle ratio can be immense while the + ! same subcycle's mass flux vanishes -- averaging the ratio + ! separately from the mass flux breaks that cancellation and + ! produced enormous ZM_EU values (aero_convproc courant + ! substep count exploded -> nstep-0 hang). accumulate the + ! entrainment/detrainment MASS FLUX (rate x mf, bounded) + ! instead; the population block consumes it directly. s_mfup_nadv(i,:nzm_clubb) = s_mfup_nadv(i,:nzm_clubb) + s_mfup(i,:nzm_clubb) s_entup_nadv(i,:nzm_clubb) = s_entup_nadv(i,:nzm_clubb) + s_entup(i,:nzm_clubb)*s_mfup(i,:nzm_clubb) s_detup_nadv(i,:nzm_clubb) = s_detup_nadv(i,:nzm_clubb) + s_detup(i,:nzm_clubb)*s_mfup(i,:nzm_clubb) s_mfdn_nadv(i,:nzm_clubb) = s_mfdn_nadv(i,:nzm_clubb) + s_mfdn(i,:nzm_clubb) s_entdn_nadv(i,:nzm_clubb) = s_entdn_nadv(i,:nzm_clubb) + s_entdn(i,:nzm_clubb)*abs(s_mfdn(i,:nzm_clubb)) s_detdn_nadv(i,:nzm_clubb) = s_detdn_nadv(i,:nzm_clubb) + s_detdn(i,:nzm_clubb)*abs(s_mfdn(i,:nzm_clubb)) + ! accumulate sum(a*w^2) and sum(a*w) of the updraft + ! ensemble so the ratio gives the mass-flux-weighted plume w + s_awwup_nadv(i,:nzm_clubb) = s_awwup_nadv(i,:nzm_clubb) + s_awwup(i,:nzm_clubb) + s_awup_nadv(i,:nzm_clubb) = s_awup_nadv(i,:nzm_clubb) + s_awup(i,:nzm_clubb) mf_sqtac_nadv(i,:nzt_clubb) = mf_sqtac_nadv(i,:nzt_clubb) + mf_sqtac(i,:nzt_clubb) mf_sqtev_nadv(i,:nzt_clubb) = mf_sqtev_nadv(i,:nzt_clubb) + mf_sqtev(i,:nzt_clubb) ! kctop is not averaged: keep the HIGHEST plume top over the @@ -4409,7 +4374,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! int(kctop) > 1 means the column was active at some sub-cycle) mf_kctop_nadv(i) = max(mf_kctop_nadv(i), mf_kctop(i)) - ! accumulate over nadv subcycles mf_L0_nadv(i,:) = mf_L0_nadv(i,:) + mf_L0(i,:) mf_ztop_nadv(i,:) = mf_ztop_nadv(i,:) + mf_ztop(i,:) mf_ztopm1_nadv(i,:) = mf_ztopm1_nadv(i,:) + mf_ztopm1(i,:) @@ -4518,11 +4482,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & um_forcing = um_forcing(:,nzt_clubb:1:-1) vm_forcing = vm_forcing(:,nzt_clubb:1:-1) -!+++ arh -- I think we should do the array flipping for all clubb-mf variables here, around a do_clubb_mf if statement - mf_qtforcup = mf_qtforcup(:,nzt_clubb:1:-1) - mf_thlforcup = mf_thlforcup(:,nzt_clubb:1:-1) - mf_qtforcdn = mf_qtforcdn(:,nzt_clubb:1:-1) - mf_thlforcdn = mf_thlforcdn(:,nzt_clubb:1:-1) + if (do_clubb_mf) then + mf_qtforcup = mf_qtforcup(:,nzt_clubb:1:-1) + mf_thlforcup = mf_thlforcup(:,nzt_clubb:1:-1) + mf_qtforcdn = mf_qtforcdn(:,nzt_clubb:1:-1) + mf_thlforcdn = mf_thlforcdn(:,nzt_clubb:1:-1) + end if wm_zt = wm_zt(:,nzt_clubb:1:-1) rho_zt = rho_zt(:,nzt_clubb:1:-1) @@ -4835,7 +4800,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_awvup = s_awvup(:,nzm_clubb:1:-1) s_awvdn = s_awvdn(:,nzm_clubb:1:-1) - !+++arh Deep-hookup ensemble mf/ent/det profiles on momentum levels: the + ! deep-hookup ensemble mf/ent/det profiles on momentum levels: the ! nadv accumulators are flipped (the raw per-subcycle arrays hold only ! the last subcycle and are not used downstream). mf_kctop_nadv needs ! no flip -- kctop is an orientation-independent offset from the surface. @@ -4845,6 +4810,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_mfdn_nadv = s_mfdn_nadv(:,nzm_clubb:1:-1) s_entdn_nadv = s_entdn_nadv(:,nzm_clubb:1:-1) s_detdn_nadv = s_detdn_nadv(:,nzm_clubb:1:-1) + s_awwup_nadv = s_awwup_nadv(:,nzm_clubb:1:-1) + s_awup_nadv = s_awup_nadv(:,nzm_clubb:1:-1) ! MF fluxes on momentum levels mf_thlflx = mf_thlflx(:,nzm_clubb:1:-1) @@ -4863,12 +4830,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_precc = mf_precc(:,nzm_clubb:1:-1) - ! Plume microphysics source terms on thermodynamic levels, needed for + ! plume microphysics source terms on thermodynamic levels, needed for ! edmf_sqtup / edmf_sqtdn. mf_sqtup = mf_sqtup(:,nzt_clubb:1:-1) mf_sqtdn = mf_sqtdn(:,nzt_clubb:1:-1) - !+++arh Deep-hookup plume autoconversion / rain evaporation on thermo + ! deep-hookup plume autoconversion / rain evaporation on thermo ! levels (nadv accumulators, as above) mf_sqtac_nadv = mf_sqtac_nadv(:,nzt_clubb:1:-1) mf_sqtev_nadv = mf_sqtev_nadv(:,nzt_clubb:1:-1) @@ -4876,7 +4843,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! NOTE: mf_rcm needs no flip here -- it is overwritten from mf_rcm_nadv ! below, and that accumulator is flipped at the end of this block. - ! Per-plume profiles on momentum levels + ! per-plume profiles on momentum levels mf_upa = mf_upa(:,nzm_clubb:1:-1,:) mf_upw = mf_upw(:,nzm_clubb:1:-1,:) mf_upmf = mf_upmf(:,nzm_clubb:1:-1,:) @@ -4987,7 +4954,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv) mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv) mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv) -!+++arh MF precip attributed to the deep fields (PREC_DP/SNOW_DP) prec_dp_pbuf(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) snow_dp_pbuf(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) @@ -4999,14 +4965,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) mf_ent_nadv(:ncol,:nzm_clubb) = mf_ent_nadv(:ncol,:nzm_clubb)/REAL(nadv) - !+++arh average the deep-hookup variables over the nadv subcycles - ! (mf_kctop_nadv is the subcycle max, so it is not averaged) s_mfup_nadv(:ncol,:nzm_clubb) = s_mfup_nadv(:ncol,:nzm_clubb)/REAL(nadv) s_entup_nadv(:ncol,:nzm_clubb) = s_entup_nadv(:ncol,:nzm_clubb)/REAL(nadv) s_detup_nadv(:ncol,:nzm_clubb) = s_detup_nadv(:ncol,:nzm_clubb)/REAL(nadv) s_mfdn_nadv(:ncol,:nzm_clubb) = s_mfdn_nadv(:ncol,:nzm_clubb)/REAL(nadv) s_entdn_nadv(:ncol,:nzm_clubb) = s_entdn_nadv(:ncol,:nzm_clubb)/REAL(nadv) s_detdn_nadv(:ncol,:nzm_clubb) = s_detdn_nadv(:ncol,:nzm_clubb)/REAL(nadv) + s_awwup_nadv(:ncol,:nzm_clubb) = s_awwup_nadv(:ncol,:nzm_clubb)/REAL(nadv) + s_awup_nadv(:ncol,:nzm_clubb) = s_awup_nadv(:ncol,:nzm_clubb)/REAL(nadv) mf_sqtac_nadv(:ncol,:nzt_clubb) = mf_sqtac_nadv(:ncol,:nzt_clubb)/REAL(nadv) mf_sqtev_nadv(:ncol,:nzt_clubb) = mf_sqtev_nadv(:ncol,:nzt_clubb)/REAL(nadv) @@ -5015,15 +4981,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ddcp_macmic(:ncol,:) = ddcp_macmic(:ncol,:) + mf_ddcp_nadv(:ncol,:) cbm1_macmic(:ncol) = cbm1_macmic(:ncol) + mf_cbm1_nadv(:ncol) - !+++arh accumulate the nadv-averaged deep-hookup variables across the - ! macmic iterations; the plume-top index takes the max (highest - ! top over all sub-cycles), not the sum + ! accumulate the nadv-averaged deep-hookup variables in buffer s_mfup_macmic(:ncol,:) = s_mfup_macmic(:ncol,:) + s_mfup_nadv(:ncol,:nzm_clubb) s_entup_macmic(:ncol,:) = s_entup_macmic(:ncol,:) + s_entup_nadv(:ncol,:nzm_clubb) s_detup_macmic(:ncol,:) = s_detup_macmic(:ncol,:) + s_detup_nadv(:ncol,:nzm_clubb) s_mfdn_macmic(:ncol,:) = s_mfdn_macmic(:ncol,:) + s_mfdn_nadv(:ncol,:nzm_clubb) s_entdn_macmic(:ncol,:) = s_entdn_macmic(:ncol,:) + s_entdn_nadv(:ncol,:nzm_clubb) s_detdn_macmic(:ncol,:) = s_detdn_macmic(:ncol,:) + s_detdn_nadv(:ncol,:nzm_clubb) + s_awwup_macmic(:ncol,:) = s_awwup_macmic(:ncol,:) + s_awwup_nadv(:ncol,:nzm_clubb) + s_awup_macmic(:ncol,:) = s_awup_macmic(:ncol,:) + s_awup_nadv(:ncol,:nzm_clubb) mf_sqtac_macmic(:ncol,:) = mf_sqtac_macmic(:ncol,:) + mf_sqtac_nadv(:ncol,:nzt_clubb) mf_sqtev_macmic(:ncol,:) = mf_sqtev_macmic(:ncol,:) + mf_sqtev_nadv(:ncol,:nzt_clubb) mf_kctop_macmic(:ncol) = max(mf_kctop_macmic(:ncol), mf_kctop_nadv(:ncol)) @@ -5089,165 +5055,161 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_cfl_output(:ncol) = max_cfl_nadv(:ncol) mf_freq_output(:ncol) = mf_freq_nadv(:ncol) -!+++arh entire section below (through the rprdsh/evapcsh zeroing) added for the deep hookup ! ------------------------------------------------------------------- ! ! Deep-convection hookup: ! ! populate the deep-convection pbuf arrays from the MF plume ensemble ! ! so that aero_convproc (aerosol transport/activation/scavenging, ! ! convproc_do_aer=.true.) and zm_conv_convtran_run via ! - ! convect_deep_tend_2 (tracer transport) operate on the plumes. Both ! - ! consumers run later in tphysac this same timestep. The plume ! - ! precip production/evaporation are attributed to the DEEP fields ! - ! (RPRDDP/NEVAPR_DPCU) instead of the shallow ones to avoid double ! - ! counting in wetdep's cmfdqr = rprddp + rprdsh. ! + ! convect_deep_tend_2 (tracer transport) operate on the plumes. ! + ! both consumers run later in tphysac this same timestep. ! ! ! - ! The pbuf arrays are only populated on the LAST macmic iteration, ! + ! the pbuf arrays are only populated on the LAST macmic iteration, ! ! from the deep-hookup variables averaged over all nadv subcycles and ! - ! macmic iterations. A column is gathered (ideep) if it had an ! + ! macmic iterations. a column is gathered (ideep) if it had an ! ! active plume ensemble at ANY point in the sub-cycles, i.e. if the ! ! highest plume top (kctop, a max over the sub-cycles) cleared the ! ! first momentum interface. ! ! ------------------------------------------------------------------- ! if (macmic_it == cld_macmic_num_steps) then - ! average the macmic accumulators over the macmic iterations, back - ! into the working arrays the population code below reads - s_mfup(:ncol,:) = s_mfup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_entup(:ncol,:) = s_entup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_detup(:ncol,:) = s_detup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_mfdn(:ncol,:) = s_mfdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_entdn(:ncol,:) = s_entdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_detdn(:ncol,:) = s_detdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - mf_sqtac(:ncol,:) = mf_sqtac_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - mf_sqtev(:ncol,:) = mf_sqtev_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - ! plume top: highest kctop over all nadv/macmic sub-cycles (max, no averaging) - mf_kctop(:ncol) = mf_kctop_macmic(:ncol) - - call pbuf_get_field(pbuf, rprddp_idx, rprddp) ! precip formation, grid avg (kg/kg/s) - call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp) ! precip evaporation rate (kg/kg/s) - call pbuf_get_field(pbuf, zm_mu_idx, mu) - call pbuf_get_field(pbuf, zm_eu_idx, eu) - call pbuf_get_field(pbuf, zm_du_idx, du) - call pbuf_get_field(pbuf, zm_md_idx, md) - call pbuf_get_field(pbuf, zm_ed_idx, ed) - call pbuf_get_field(pbuf, zm_dp_idx, dpg) ! layer thickness (mb) - call pbuf_get_field(pbuf, zm_jt_idx, jt) ! top level index of convection - call pbuf_get_field(pbuf, zm_maxg_idx, maxg) ! launch (cloud-base) level index - call pbuf_get_field(pbuf, zm_ideep_idx, ideep) - ! dsubcld is only used by zm and momtran, not by convtran or aero_convproc, - ! but zm_conv_tend_2-style consumers read the field, so keep it zeroed - call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld) - - mu(:pcols,:pver) = 0._r8 - eu(:pcols,:pver) = 0._r8 - du(:pcols,:pver) = 0._r8 - md(:pcols,:pver) = 0._r8 - ed(:pcols,:pver) = 0._r8 - dpg(:pcols,:pver) = 0._r8 - dsubcld(:pcols) = 0._r8 - jt(:pcols) = pver - maxg(:pcols) = pver - ideep(:pcols) = 0 - - lengath = 0 - do i=1, ncol - ! mf_kctop counts momentum interfaces from the surface, so the CAM - ! interface index of the ensemble plume top is pverp-mf_kctop+1; the - ! deep-convection cloud-top LEVEL is one above the interface. - ! mf_kctop here is the HIGHEST plume top over the nadv/macmic sub-cycles. - tmptop = min(max(pverp - int(mf_kctop(i)), top_lev), pver) - !+++arh gather every column that was active at ANY point in the - ! nadv/macmic sub-cycles (kctop is the max over the sub-cycles, - ! so int(kctop) > 1 means the plume top cleared the first - ! momentum interface at some sub-cycle) - if (int(mf_kctop(i)) > 1) then - lengath = lengath + 1 - ideep(lengath) = i - jt(lengath) = tmptop - maxg(lengath) = pver ! surface-launched plumes - dpg(lengath,:pver) = state_loc%pdel(i,:pver)/100._r8 - end if - end do - - rprddp(:pcols,:pver) = 0._r8 - evapcdp(:pcols,:pver) = 0._r8 - do kcam = top_lev, pver - ! CLUBB index of both the CAM layer kcam (thermo grid) and the - ! interface at its top (momentum grid) - k_clubb = kcam + 1 - top_lev - do i=1, lengath - icol = ideep(i) - ! plume MFs are in kg/m2/s; ZM wants hPa/s. mu/md at CAM level kcam - ! hold the ensemble mass flux at the interface at the layer's top. - mu(i,kcam) = s_mfup(icol,k_clubb)*gravit/100._r8 - md(i,kcam) = s_mfdn(icol,k_clubb)*gravit/100._r8 - !+++arh s_entup now carries the sub-cycle-averaged entrainment MASS - ! FLUX (fractional entrainment x plume mass flux, kg/m3/s), so - ! eu comes from it directly -- no rate x averaged-mf product - ! (du/ed are rebuilt from exact discrete continuity below) - eu(i,kcam) = s_entup(icol,k_clubb)*(gravit/100._r8)*dz_g(icol,k_clubb)/dpg(i,kcam) - end do + ! average the macmic accumulators over the macmic iterations, back + ! into the working arrays the population code below reads + s_mfup(:ncol,:) = s_mfup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_entup(:ncol,:) = s_entup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_detup(:ncol,:) = s_detup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_mfdn(:ncol,:) = s_mfdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_entdn(:ncol,:) = s_entdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_detdn(:ncol,:) = s_detdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + mf_sqtac(:ncol,:) = mf_sqtac_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + mf_sqtev(:ncol,:) = mf_sqtev_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ! plume top: highest kctop over all nadv/macmic sub-cycles (max, no averaging) + mf_kctop(:ncol) = mf_kctop_macmic(:ncol) + + call pbuf_get_field(pbuf, rprddp_idx, rprddp) ! precip formation, grid avg (kg/kg/s) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp) ! precip evaporation rate (kg/kg/s) + call pbuf_get_field(pbuf, zm_mu_idx, mu) + call pbuf_get_field(pbuf, zm_eu_idx, eu) + call pbuf_get_field(pbuf, zm_du_idx, du) + call pbuf_get_field(pbuf, zm_md_idx, md) + call pbuf_get_field(pbuf, zm_ed_idx, ed) + call pbuf_get_field(pbuf, zm_dp_idx, dpg) ! layer thickness (mb) + call pbuf_get_field(pbuf, zm_jt_idx, jt) ! top level index of convection + call pbuf_get_field(pbuf, zm_maxg_idx, maxg) ! launch (cloud-base) level index + call pbuf_get_field(pbuf, zm_ideep_idx, ideep) + ! dsubcld is only used by zm and momtran, not by convtran or aero_convproc, + ! but zm_conv_tend_2-style consumers read the field, so keep it zeroed + call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld) + call pbuf_get_field(pbuf, mf_wup_idx, wup_gath) + + mu(:pcols,:pver) = 0._r8 + eu(:pcols,:pver) = 0._r8 + du(:pcols,:pver) = 0._r8 + md(:pcols,:pver) = 0._r8 + ed(:pcols,:pver) = 0._r8 + dpg(:pcols,:pver) = 0._r8 + dsubcld(:pcols) = 0._r8 + wup_gath(:pcols,:pver) = 0._r8 + jt(:pcols) = pver + maxg(:pcols) = pver + ideep(:pcols) = 0 + + lengath = 0 do i=1, ncol - rprddp(i,kcam) = -1._r8*mf_sqtac(i,k_clubb) - evapcdp(i,kcam) = -1._r8*mf_sqtev(i,k_clubb) + ! mf_kctop counts momentum interfaces from the surface, so the CAM + ! interface index of the ensemble plume top is pverp-mf_kctop+1; the + ! deep-convection cloud-top LEVEL is one above the interface. + ! mf_kctop here is the HIGHEST plume top over the nadv/macmic sub-cycles. + tmptop = min(max(pverp - int(mf_kctop(i)), top_lev), pver) + ! gather every column that was active at ANY point in the + ! nadv/macmic sub-cycles (kctop is the max over the sub-cycles, + ! so int(kctop) > 1 means the plume top cleared the first + ! momentum interface at some sub-cycle) + if (int(mf_kctop(i)) > 1) then + lengath = lengath + 1 + ideep(lengath) = i + jt(lengath) = tmptop + maxg(lengath) = pver ! surface-launched plumes + dpg(lengath,:pver) = state_loc%pdel(i,:pver)/100._r8 + end if end do - end do - ! convtran/convproc REQUIRE (a) a Courant limit mu*dt/dp <= 1 (ZM enforces - ! this on its cloud-base closure; violating it lets the flux-form limiters - ! remove more tracer than a layer holds -> negative gas concentrations -> - ! rrtmgp set_vmr abort) and (b) EXACT discrete continuity - ! mu(k) - mu(k+1) = (eu(k)-du(k))*dp(k) with mu(pver+1)=0 (and the - ! analogous downdraft relation), which the recursion for the in-updraft - ! concentration assumes. Scale the plume mass fluxes to the Courant - ! target, then rebuild du/ed from continuity (keeping the plume-derived - ! eu wherever a non-negative du can absorb it). - do i=1, lengath - ! Courant check against DRY pressure thickness: convtran scales eu/du/ed - ! by dp/dpdry and integrates dry-mixing-ratio constituents (the GHGs) - ! against dpdry, so the effective Courant number is mu*dt/dpdry. Target - ! 0.5 (rather than the ZM-style 1.0) to suppress the residual flux-form - ! limiter overshoots that drive convtran2 QNEG3 negatives. - !+++arh the aero_convproc courant number also carries the entrainment - ! flux term (eudp = eu*dpdry), so include eu*dt in the cap -- - ! otherwise its internal substep count ntsub = 1+int(courant) - ! is unbounded by the mass-flux cap alone - tmpcfl = 0._r8 - do kcam=1, pver - tmpcfl = max(tmpcfl, max(mu(i,kcam), abs(md(i,kcam)))*hdtime & - /(state_loc%pdeldry(ideep(i),kcam)/100._r8) & - + eu(i,kcam)*hdtime) + rprddp(:pcols,:pver) = 0._r8 + evapcdp(:pcols,:pver) = 0._r8 + do kcam = top_lev, pver + + k_clubb = kcam + 1 - top_lev + + do i=1, lengath + icol = ideep(i) + ! plume MFs are in kg/m2/s; ZM wants hPa/s. mu/md at CAM level kcam + ! hold the ensemble mass flux at the interface at the layer's top. + mu(i,kcam) = s_mfup(icol,k_clubb)*gravit/100._r8 + ! mass-flux-weighted ensemble updraft speed at the same + ! interface as mu (sum a*w^2 / sum a*w over all nadv and + ! macmic sub-cycles. deliberately NOT Courant-scaled: aero_convproc's + ! activation should see the physical plume w, not the + ! transport-limited effective velocity. bounded for safety. + wup_gath(i,kcam) = min(50._r8, max(0._r8, & + s_awwup_macmic(icol,k_clubb) & + /max(s_awup_macmic(icol,k_clubb), 1.e-10_r8))) + md(i,kcam) = s_mfdn(icol,k_clubb)*gravit/100._r8 + ! s_entup carries the sub-cycle-averaged entrainment MASS + ! FLUX (fractional entrainment x plume mass flux, kg/m3/s) + eu(i,kcam) = s_entup(icol,k_clubb)*(gravit/100._r8)*dz_g(icol,k_clubb)/dpg(i,kcam) + end do + do i=1, ncol + rprddp(i,kcam) = -1._r8*mf_sqtac(i,k_clubb) + evapcdp(i,kcam) = -1._r8*mf_sqtev(i,k_clubb) + end do end do - if (tmpcfl > 0.5_r8) then - mu(i,:pver) = mu(i,:pver)*0.5_r8/tmpcfl - md(i,:pver) = md(i,:pver)*0.5_r8/tmpcfl - eu(i,:pver) = eu(i,:pver)*0.5_r8/tmpcfl - end if - do kcam=pver, 1, -1 - ! updraft: net = d(mu)/dp across layer kcam (mu below surface = 0) - if (kcam == pver) then - tmpnet = mu(i,kcam)/dpg(i,kcam) - else - tmpnet = (mu(i,kcam) - mu(i,kcam+1))/dpg(i,kcam) - end if - eu(i,kcam) = max(eu(i,kcam), tmpnet, 0._r8) - du(i,kcam) = eu(i,kcam) - tmpnet - ! downdraft: md(k+1) = md(k) - ed(k)*dp(k); ed >= 0 - if (kcam < pver) then - ed(i,kcam) = max((md(i,kcam) - md(i,kcam+1))/dpg(i,kcam), 0._r8) - else - ed(i,kcam) = 0._r8 + + ! convtran/convproc REQUIRE (a) a Courant limit mu*dt/dp <= 1 (ZM enforces + ! this on its cloud-base closure; violating it lets the flux-form limiters + ! remove more tracer than a layer holds -> negative gas concentrations -> + ! rrtmgp set_vmr abort) and (b) EXACT discrete continuity + ! mu(k) - mu(k+1) = (eu(k)-du(k))*dp(k) with mu(pver+1)=0 (and the + ! analogous downdraft relation), which the recursion for the in-updraft + ! concentration assumes. scale the plume mass fluxes to the Courant + ! target, then rebuild du/ed from continuity (keeping the plume-derived + ! eu wherever a non-negative du can absorb it). + do i=1, lengath + ! Courant check against DRY pressure thickness: convtran scales eu/du/ed + ! by dp/dpdry and integrates dry-mixing-ratio constituents (the GHGs) + ! against dpdry, so the effective Courant number is mu*dt/dpdry. Target + ! 0.5 (rather than the ZM-style 1.0) to suppress the residual flux-form + ! limiter overshoots that drive convtran2 QNEG3 negatives. + ! the aero_convproc courant number also carries the entrainment + ! flux term (eudp = eu*dpdry), so include eu*dt in the cap -- + ! otherwise its internal substep count ntsub = 1+int(courant) + ! is unbounded by the mass-flux cap alone + tmpcfl = 0._r8 + do kcam=1, pver + tmpcfl = max(tmpcfl, max(mu(i,kcam), abs(md(i,kcam)))*hdtime & + /(state_loc%pdeldry(ideep(i),kcam)/100._r8) & + + eu(i,kcam)*hdtime) + end do + if (tmpcfl > 0.5_r8) then + mu(i,:pver) = mu(i,:pver)*0.5_r8/tmpcfl + md(i,:pver) = md(i,:pver)*0.5_r8/tmpcfl + eu(i,:pver) = eu(i,:pver)*0.5_r8/tmpcfl end if + do kcam=pver, 1, -1 + ! updraft: net = d(mu)/dp across layer kcam (mu below surface = 0) + if (kcam == pver) then + tmpnet = mu(i,kcam)/dpg(i,kcam) + else + tmpnet = (mu(i,kcam) - mu(i,kcam+1))/dpg(i,kcam) + end if + eu(i,kcam) = max(eu(i,kcam), tmpnet, 0._r8) + du(i,kcam) = eu(i,kcam) - tmpnet + ! downdraft: md(k+1) = md(k) - ed(k)*dp(k); ed >= 0 + if (kcam < pver) then + ed(i,kcam) = max((md(i,kcam) - md(i,kcam+1))/dpg(i,kcam), 0._r8) + else + ed(i,kcam) = 0._r8 + end if + end do end do - end do - - ! plume precip production/evaporation moved to the deep fields above; - ! zero the shallow ones so cmfdqr/evapc are not double counted - call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) - call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) - - rprdsh(:pcols,:pver) = 0._r8 - evapcsh(:pcols,:pver) = 0._r8 end if ! macmic_it == cld_macmic_num_steps (deep hookup) @@ -5296,7 +5258,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then ! subtract enthalpy of falling precip from tb -!+++arh te_b = te_b - prec_dp_pbuf(i)*1000._r8*latice*hdtime end if @@ -5760,28 +5721,34 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! ! --------------------------------------------------------------------------------- ! - sh_icwmr_pbuf(:,:) = 0.0_r8 frac_limit = 0.01_r8 ic_limit = 1.e-12_r8 deepcu_pbuf(:,:) = 0.0_r8 + ! SH_FRAC has no other setter with shallow_scheme='CLUBB_SGS' (cam7 + ! convect_diagnostics zeroes ICWMRSH etc., but not SH_FRAC), and it is + ! read downstream (e.g. conv_water), so it must be zeroed here. shalcu_pbuf(:,:) = 0.0_r8 do k = 1, pver-1 do i = 1, ncol - ! diagnose the deep convective cloud fraction, as done in macrophysics based on the - ! deep convective mass flux, read in from pbuf. Since shallow convection is never - ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud - ! fraction is purely from deep convection scheme. - deepcu_pbuf(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh_pbuf(i,k+1))),0.6_r8)) + if (do_clubb_mf .and. do_clubb_mf_rad) then + ! for the deep hookup the MF plume cloud is attributed to the DEEP fields + ! (DP_FRAC/ICWMRDP feed aero_convproc and wetdep's conicw/cldcu the same + ! way ZM's do); shalcu/sh_icwmr stay zero so nothing is double counted. + deepcu_pbuf(i,k) = clubb_mf_cldfrac_fac*mf_cloudfrac_output(i,k) + dp_icwmr_pbuf(i,k) = mf_qc_output(i,k) + else + ! diagnose the deep convective cloud fraction, as done in macrophysics based on the + ! deep convective mass flux, read in from pbuf. Since shallow convection is never + ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud + ! fraction is purely from deep convection scheme. + deepcu_pbuf(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh_pbuf(i,k+1))),0.6_r8)) + end if if (deepcu_pbuf(i,k) <= frac_limit .or. dp_icwmr_pbuf(i,k) < ic_limit) then deepcu_pbuf(i,k) = 0._r8 endif - ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable - ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation - ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud - ! from CLUBB plus the deep convective cloud fraction ! NOTE: concld_pbuf used to be calculated in the commented-out version below, but since we ! set alst_pbuf=cloud_frac_pbuf, this simplifies to only using deepcu_pbuf. ! This is potentially a bug, but there's not really a "right" way to combine the different @@ -5791,40 +5758,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo - if (do_clubb_mf) then - do k = 1, pver-1 - do i = 1, ncol - !+++arh For the deep hookup the MF plume cloud is attributed to the DEEP fields - ! (DP_FRAC/ICWMRDP feed aero_convproc and wetdep's conicw/cldcu the same - ! way ZM's do); shalcu/sh_icwmr stay zero so nothing is double counted. - ! concld below is unchanged since it uses deepcu+shalcu. - if (do_clubb_mf_rad) then - deepcu_pbuf(i,k) = clubb_mf_cldfrac_fac*mf_cloudfrac_output(i,k) - dp_icwmr_pbuf(i,k) = mf_qc_output(i,k) - end if - - if (deepcu_pbuf(i,k) <= frac_limit .or. dp_icwmr_pbuf(i,k) < ic_limit) then - deepcu_pbuf(i,k) = 0._r8 - endif - - if (shalcu_pbuf(i,k) <= frac_limit .or. sh_icwmr_pbuf(i,k) < ic_limit) then - shalcu_pbuf(i,k) = 0._r8 - endif - - ! using the deep convective cloud fraction, CLUBB cloud fraction (variable - ! "cloud_frac") and CLUBB+MF cloud fraction ("shalcu") compute the convective cloud - ! fraction. This follows the formulation found in macrophysics code. Assumes that convective - ! cloud is all nonstratiform cloud from CLUBB or CLUBB+MF plus the deep convective cloud fraction - ! NOTE: concld_pbuf used to be calculated in the commented-out version below, but since we - ! set alst_pbuf=cloud_frac_pbuf, this simplifies to only using deepcu_pbuf and shalcu_pbuf. - ! This is potentially a bug, but there's not really a "right" way to combine the different - ! cloud fractions, so it has been left to only use deepcu_pbuf and shalcu_pbuf for now - !concld_pbuf(i,k) = min(cloud_frac(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k)+shalcu_pbuf(i,k),0.80_r8) - concld_pbuf(i,k) = min(deepcu_pbuf(i,k)+shalcu_pbuf(i,k),0.80_r8) - enddo - enddo - end if - if (single_column .and. .not. scm_cambfb_mode) then if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. & trim(scm_clubb_iop_name) == 'BOMEX_5day' .or. & @@ -5839,6 +5772,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif endif + ! NOTE on macmic sub-cycling: with CLUBB_MF the fields DP_FRAC, + ! ICWMRDP, CONCLD (and the deep part of CLD) computed above evolve + ! every macmic iteration so in-loop consumers (PUMAS reads + ! CLD/CONCLD) stay tightly coupled to the current sub-step. Their + ! post-loop consumers (aero_convproc/wetdep, conv_water, radiation) + ! must instead see the sub-cycle MEAN; that averaging is done in the + ! cam7 physpkg driver after the macmic loop, alongside + ! prec_dp/snow_dp. + ! --------------------------------------------------------------------------------- ! ! COMPUTE THE ICE CLOUD FRACTION PORTION ! ! use the aist_vector function to compute the ice cloud fraction ! diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 89b3ad487f..106bb43568 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -60,7 +60,11 @@ module clubb_mf integer :: clubb_mf_cp_ndt = 1 integer :: clubb_mf_kseed = 1 integer, protected :: clubb_mf_nup = 0 + ! do_clubb_mf is NOT a namelist variable: it is derived in + ! clubb_mf_readnl from deep_scheme='CLUBB_MF' (phys_ctl_nl), + ! making the deep-scheme choice and the MF plume ensemble a single switch logical, protected :: do_clubb_mf = .false. + ! logical, protected :: do_clubb_mf_diag = .false. logical, protected :: do_clubb_mf_rad = .true. logical, protected :: do_clubb_mf_addtke = .true. @@ -74,11 +78,7 @@ module clubb_mf logical, protected :: do_clubb_mf_coldpool_init = .false. logical, protected :: do_clubb_mf_coldpool_perplume = .true. logical, protected :: do_clubb_mf_lscale_perplume = .true. - !+++arh Arakawa-Schubert positive-definite detrainment limiter logical, protected :: do_clubb_mf_aspd = .false. - !+++arh cull plumes entirely contained within the PBL: any plume whose ascent - ! terminates at or below the PBL top is removed from the ensemble (surface - ! closure and PBL-penetrating plumes untouched) logical, protected :: do_clubb_mf_pblcull = .false. logical :: tht_tweaks = .true. integer :: mf_num_cin = 5 @@ -93,21 +93,22 @@ subroutine clubb_mf_readnl(nlfile) use namelist_utils, only: find_group_name use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_integer, mpi_logical + use phys_control, only: phys_getopts character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input character(len=*), parameter :: sub = 'clubb_mf_readnl' integer :: iunit, read_status, ierr + character(len=16) :: deep_scheme namelist /clubb_mf_nl/ clubb_mf_Lopt, clubb_mf_a0, clubb_mf_b0, clubb_mf_L0, clubb_mf_ent0, clubb_mf_alphturb, & - clubb_mf_nup, clubb_mf_max_L0, do_clubb_mf, do_clubb_mf_diag, do_clubb_mf_precip, do_clubb_mf_rad, & + clubb_mf_nup, clubb_mf_max_L0, do_clubb_mf_diag, do_clubb_mf_precip, do_clubb_mf_rad, & clubb_mf_fdd, do_clubb_mf_coldpool, clubb_mf_ddalph, clubb_mf_ddbeta, clubb_mf_pwfac, do_clubb_mf_ustar, & clubb_mf_ddexp, do_clubb_mf_mixd, clubb_mf_up_ndt, clubb_mf_cp_ndt, do_clubb_mf_rhtke, do_clubb_mf_cmt, & do_clubb_mf_coldpool_init, do_clubb_mf_coldpool_perplume, do_clubb_mf_lscale_perplume, clubb_mf_kseed, & do_clubb_mf_addtke, do_clubb_mf_aloft, clubb_mf_pwmin, clubb_mf_pwmax, clubb_mf_cldfrac_fac, & -!+++arh do_clubb_mf_aspd, do_clubb_mf_pblcull if (masterproc) then @@ -138,8 +139,6 @@ subroutine clubb_mf_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_nup") call mpi_bcast(clubb_mf_max_L0, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_max_L0") - call mpi_bcast(do_clubb_mf, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf") call mpi_bcast(do_clubb_mf_diag, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_diag") call mpi_bcast(do_clubb_mf_precip, 1, mpi_logical, mstrid, mpicom, ierr) @@ -182,10 +181,8 @@ subroutine clubb_mf_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_addtke") call mpi_bcast(do_clubb_mf_aloft, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_aloft") -!+++arh call mpi_bcast(do_clubb_mf_aspd, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_aspd") -!+++arh call mpi_bcast(do_clubb_mf_pblcull, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_pblcull") call mpi_bcast(clubb_mf_pwmin, 1, mpi_real8, mstrid, mpicom, ierr) @@ -195,6 +192,12 @@ subroutine clubb_mf_readnl(nlfile) call mpi_bcast(clubb_mf_cldfrac_fac, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_cldfrac_fac") + ! CLUBB-MF is selected with deep_scheme='CLUBB_MF'; deriving the + ! switch here (on all ranks) removes any possibility of an + ! inconsistent do_clubb_mf / deep_scheme combination + call phys_getopts(deep_scheme_out = deep_scheme) + do_clubb_mf = (trim(deep_scheme) == 'CLUBB_MF') + if ((.not. do_clubb_mf) .and. do_clubb_mf_diag ) then call endrun('clubb_mf_readnl: Error - cannot turn on do_clubb_mf_diag without also turning on do_clubb_mf') end if @@ -232,10 +235,10 @@ subroutine integrate_mf( nzm, nzt, dtime, dry_u, moist_u, & ! output dry_v, moist_v, & ! output moist_qc, & ! output - ae, & - ac, aup, adn, & - aw, awup, awdn, & - aww, awwup, awwdn, & + ae, & ! output + ac, aup, adn, & ! output + aw, awup, awdn, & ! output + aww, awwup, awwdn, & ! output awthlup, awqtup, awuup, awvup, & ! output awthldn, awqtdn, awudn, awvdn, & ! output awthl, awqt, & ! output @@ -247,12 +250,9 @@ subroutine integrate_mf( nzm, nzt, dtime, sqtup, sthlup, & ! output sqtdn, sthldn, & ! output sqt, sthl, & ! output - variables needed for solver -!+++arh sac, sev, & ! output - plume autoconversion / evaporation precc, & ! output - ztop, dynamic_L0, & - !+++arh ensemble mass-flux, entrainment and detrainment profiles (and plume-top - ! index) for the deep-convection pbuf hookup (convtran/convproc) + ztop, dynamic_L0, & ! output mfup, entup, detup, & ! output mfdn, entdn, detdn, & ! output kctop ) ! output @@ -355,12 +355,12 @@ subroutine integrate_mf( nzm, nzt, dtime, real(r8),dimension(nzt), intent(out) :: sqtup, sthlup, & ! thermodynamic grid sqtdn, sthldn, & ! thermodynamic grid sqt, sthl, & ! thermodynamic grid -!+++arh sac, sev ! thermodynamic grid - !+++arh ensemble plume mass flux [kg/m2/s], fractional entrainment/detrainment [1/m] + ! ensemble plume mass flux [kg/m2/s], fractional entrainment/detrainment [1/m] ! for updrafts/downdrafts (momentum grid), and ensemble plume-top index ! (counted in momentum interfaces from the surface, orientation independent) + ! needed to populate deep pbuf variables for use by convtran2 and convproc_aer real(r8),dimension(nzm), intent(out) :: mfup, entup, detup, & mfdn, entdn, detdn real(r8), intent(out) :: kctop @@ -421,9 +421,8 @@ subroutine integrate_mf( nzm, nzt, dtime, ! microphyiscs terms real(r8), dimension(nzt,clubb_mf_nup) :: supqt, supthl, & ! thermodynamic grid sdnqt, sdnthl, & ! thermodynamic grid -!+++arh added upevap upauto, upevap ! thermodynamic grid - !+++arh ensemble updraft rain evaporation (area-weighted sum over plumes) + ! ensemble updraft rain evaporation (area-weighted sum over plumes) real(r8), dimension(nzt) :: sevup ! thermodynamic grid ! precipitation rates real(r8), dimension(nzm,clubb_mf_nup) :: uprr, dnrr ! momentum grid @@ -520,20 +519,16 @@ subroutine integrate_mf( nzm, nzt, dtime, ! fixed entrainment rate real(r8),parameter :: fixent_ent = 2.e-4_r8 ! - !+++arh Arakawa and Schubert detrainment limiter is controlled by the - ! module-level do_clubb_mf_aspd namelist flag - ! ! Lower limit on entrainment length scale real(r8),parameter :: min_L0 = 0.5_r8 ! ! limiter for tke enahnced fractional entrainment - !+++arh (used by the downdraft eturb and the do_clubb_mf_aspd limiter) real(r8),parameter :: max_eturb = 10._r8 ! - !+++arh floor on the ensemble mass flux for the deep-hookup ratio - ! diagnostics (entup/detup/entdn/detdn): near plume tops the - ! mass-flux-weighted entrainment divides by a vanishing mfup while - ! upent ~ 1/upw diverges, producing immense (finite) ratios + ! floor on the ensemble mass flux for the deep-hookup ratio + ! diagnostics (entup/detup/entdn/detdn): near plume tops the + ! mass-flux-weighted entrainment divides by a vanishing mfup while + ! upent ~ 1/upw diverges, producing immense (finite) ratios real(r8),parameter :: mf_tiny = 1.e-12_r8 ! ! to condensate or not to condensate @@ -553,6 +548,9 @@ subroutine integrate_mf( nzm, nzt, dtime, ! ! max limiter on cold pool init effects real(r8),parameter :: max_cpinit = 0.5_r8 + ! + ! minimum depth of plume expressed as number of levels + integer,parameter :: kspan_min = 4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! @@ -642,13 +640,10 @@ subroutine integrate_mf( nzm, nzt, dtime, sthl = 0._r8 precc = 0._r8 -!+++arh sac = 0._r8 sev = 0._r8 sevup = 0._r8 - !+++arh initialize deep-hookup outputs (must be set on every path, including - ! the no-convection early returns) mfup = 0._r8 entup = 0._r8 detup = 0._r8 @@ -687,7 +682,6 @@ subroutine integrate_mf( nzm, nzt, dtime, upent = 0._r8 updet = 0._r8 upauto= 0._r8 -!+++arh upevap= 0._r8 dnw = 0._r8 @@ -718,7 +712,7 @@ subroutine integrate_mf( nzm, nzt, dtime, limarea = .true. end if - !+++arh with the ASPD limiter, area growth is only bounded per layer, so the + ! with the ASPD limiter, area growth is only bounded per layer, so the ! accumulated column area must be capped by the existing limarea ! machinery (total convective area rescaled to amax) if (do_clubb_mf_aspd) limarea = .true. @@ -731,8 +725,7 @@ subroutine integrate_mf( nzm, nzt, dtime, !wthv = wthl+zvir*ths*wqt wthv_sfc = wthl_sfc+zvir*ths*wqt_sfc - !+++arh PBL-top index, used by the PBL-confined plume cull and the aloft - ! launch (hoisted out of the aloft branch below) + ! PBL-top index kpbl = ksfcm do while (zm(kpbl) < pblh .and. kpbl /= ktopm) kpbl = kpbl + kdir @@ -740,13 +733,9 @@ subroutine integrate_mf( nzm, nzt, dtime, if (do_clubb_mf_aloft .and. wthv_sfc < 0.01_r8) then aloft = .true. -!+++arh kpbl computation removed here (hoisted above the aloft branch) kmid = ksfcm - ! Use a pressure-based criterion to locate the mid-level within the - ! troposphere. A threshold of ~500 hPa is preferred over the previous - ! fixed height (9 km) because it better represents the tropopause - ! location across different atmospheric conditions. + ! Use a pressure-based criterion to locate the mid-level within the troposphere do while (p_zm(kmid) > 500.E2_r8) kmid = kmid + kdir end do @@ -1200,10 +1189,8 @@ subroutine integrate_mf( nzm, nzt, dtime, updet(kn,i) = detn else - !+++arh cull plumes terminating at/below the PBL top (do_clubb_mf_pblcull), - ! in addition to the original 3-levels-above-launch minimum (which also - ! covers aloft launches where kstart is above kpbl) - if ( abs(k-kstart+kdir)<4 .or. & + ! cull plumes terminating at/below the PBL top (do_clubb_mf_pblcull), + if ( abs(k-kstart+kdir)shr_kind_r8 use ppgrid, only: pver, pcols, pverp use cam_logfile, only: iulog - !+++arh flag for the CLUBB-MF deep-convection hookup (plume ensemble drives - ! convtran/convproc through the ZM pbuf arrays with deep_scheme='off') - use clubb_mf, only: do_clubb_mf implicit none @@ -50,9 +47,9 @@ module convect_deep integer :: ttend_dp_idx = 0 - !+++arh pbuf indices of the ZM gathered arrays (registered by clubb_intr when - ! the CLUBB-MF deep hookup is active with deep_scheme='off'); used by - ! clubb_mf_convtran2 below + ! pbuf indices of the ZM gathered arrays, registered below when + ! deep_scheme='CLUBB_MF' (the CLUBB-MF plume ensemble provides the deep + ! transport); populated by clubb_tend_cam, used by clubb_mf_convtran2 below integer :: zm_mu_idx = 0 integer :: zm_eu_idx = 0 integer :: zm_du_idx = 0 @@ -63,6 +60,9 @@ module convect_deep integer :: zm_jt_idx = 0 integer :: zm_maxg_idx = 0 integer :: zm_ideep_idx = 0 + ! plume-ensemble mean updraft speed (m/s, gathered like ZM_MU; + ! populated by clubb_tend_cam, consumed by aero_convproc activation) + integer :: mf_wup_idx = 0 !========================================================================================= contains @@ -94,7 +94,7 @@ subroutine convect_deep_register !---------------------------------------- - use physics_buffer, only : pbuf_add_field, dtype_r8 + use physics_buffer, only : pbuf_add_field, dtype_r8, dtype_i4 use zm_conv_intr, only: zm_conv_register use phys_control, only: phys_getopts, use_gw_convect_dp @@ -116,6 +116,25 @@ subroutine convect_deep_register call pbuf_add_field('PREC_DP', 'physpkg',dtype_r8,(/pcols/), prec_dp_idx) call pbuf_add_field('SNOW_DP', 'physpkg',dtype_r8,(/pcols/), snow_dp_idx) + case('CLUBB_MF') ! The standard deep fields and the ZM gathered arrays are registered here + call pbuf_add_field('ICWMRDP', 'physpkg',dtype_r8,(/pcols,pver/),icwmrdp_idx) + call pbuf_add_field('RPRDDP', 'physpkg',dtype_r8,(/pcols,pver/),rprddp_idx) + call pbuf_add_field('NEVAPR_DPCU','physpkg',dtype_r8,(/pcols,pver/),nevapr_dpcu_idx) + call pbuf_add_field('PREC_DP', 'physpkg',dtype_r8,(/pcols/), prec_dp_idx) + call pbuf_add_field('SNOW_DP', 'physpkg',dtype_r8,(/pcols/), snow_dp_idx) + + call pbuf_add_field('ZM_MU', 'physpkg', dtype_r8, (/pcols,pver/), zm_mu_idx) + call pbuf_add_field('ZM_EU', 'physpkg', dtype_r8, (/pcols,pver/), zm_eu_idx) + call pbuf_add_field('ZM_DU', 'physpkg', dtype_r8, (/pcols,pver/), zm_du_idx) + call pbuf_add_field('ZM_MD', 'physpkg', dtype_r8, (/pcols,pver/), zm_md_idx) + call pbuf_add_field('ZM_ED', 'physpkg', dtype_r8, (/pcols,pver/), zm_ed_idx) + call pbuf_add_field('ZM_DP', 'physpkg', dtype_r8, (/pcols,pver/), zm_dp_idx) + call pbuf_add_field('ZM_DSUBCLD', 'physpkg', dtype_r8, (/pcols/), zm_dsubcld_idx) + call pbuf_add_field('ZM_JT', 'physpkg', dtype_i4, (/pcols/), zm_jt_idx) + call pbuf_add_field('ZM_MAXG', 'physpkg', dtype_i4, (/pcols/), zm_maxg_idx) + call pbuf_add_field('ZM_IDEEP', 'physpkg', dtype_i4, (/pcols/), zm_ideep_idx) + call pbuf_add_field('MF_WUP', 'physpkg', dtype_r8, (/pcols,pver/), mf_wup_idx) + end select ! If gravity waves from deep convection are on, output this field. @@ -152,6 +171,10 @@ subroutine convect_deep_init(pref_edge) if (masterproc) write(iulog,*)'convect_deep: no deep convection selected' case('CLUBB_SGS') if (masterproc) write(iulog,*)'convect_deep: CLUBB_SGS selected' + case('CLUBB_MF') + if (masterproc) write(iulog,*) & + 'convect_deep: CLUBB-MF selected: the EDMF plume ensemble drives '// & + 'aero_convproc and convtran2 through the ZM pbuf arrays' case('ZM') if (masterproc) write(iulog,*)'convect_deep initializing Zhang-McFarlane convection' call zm_conv_init(pref_edge) @@ -173,11 +196,9 @@ subroutine convect_deep_init(pref_edge) pblh_idx = pbuf_get_index('pblh') tpert_idx = pbuf_get_index('tpert') - !+++arh fetch the ZM gathered-array indices registered by clubb_intr for the - ! CLUBB-MF deep hookup (deep_scheme='off' only) - if (trim(deep_scheme) == 'off' .and. do_clubb_mf) then + if (trim(deep_scheme) == 'CLUBB_MF') then if (masterproc) write(iulog,*) & - 'convect_deep: CLUBB-MF deep hookup active: convtran2 will transport '// & + 'convect_deep: CLUBB-MF active: convtran2 will transport '// & 'constituents using the MF plume ensemble mass fluxes' zm_mu_idx = pbuf_get_index('ZM_MU') zm_eu_idx = pbuf_get_index('ZM_EU') @@ -257,7 +278,7 @@ subroutine convect_deep_tend( & call pbuf_get_field(pbuf, icwmrdp_idx, ql ) select case ( deep_scheme ) - case('off', 'CLUBB_SGS') + case('off', 'CLUBB_SGS', 'CLUBB_MF') zero = 0 mcon = 0 cme = 0 @@ -285,11 +306,13 @@ subroutine convect_deep_tend( & cld = 0 ql = 0 rprd = 0 - !+++arh with the CLUBB-MF deep hookup, fracis must keep the value 1.0 set by - ! tphysbc so that gases are transported by convtran2 in tphysac (wetdep - ! later overwrites the aerosol entries); ql/rprd/evapcdp zeroed here are - ! repopulated by clubb_tend_cam (tphysac) before any consumer reads them - if (.not. do_clubb_mf) then + ! with CLUBB-MF, fracis (insoluble fraction) must be 1.0 so that + ! gases are transported by convtran2 in tphysac (wetdep later overwrites + ! the aerosol entries); ql/rprd/evapcdp zeroed here are repopulated by + ! clubb_tend_cam before any consumer reads them + if (deep_scheme == 'CLUBB_MF') then + fracis = 1._r8 + else fracis = 0 end if evapcdp = 0 @@ -339,8 +362,7 @@ subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf) if ( deep_scheme .eq. 'ZM' ) then ! Zhang-McFarlane call zm_conv_tend_2( state, ptend, ztodt, pbuf) - !+++arh CLUBB-MF deep hookup: transport constituents with the MF plume ensemble. - else if ( deep_scheme .eq. 'off' .and. do_clubb_mf ) then + else if ( deep_scheme .eq. 'CLUBB_MF' ) then call clubb_mf_convtran2( state, ptend, ztodt, pbuf ) else call physics_ptend_init(ptend, state%psetcols, 'convect_deep') @@ -351,10 +373,10 @@ end subroutine convect_deep_tend_2 !========================================================================================= -!+++arh new subroutine: convective tracer transport driven by the CLUBB-MF plume +subroutine clubb_mf_convtran2( state, ptend, ztodt, pbuf) +! convective tracer transport driven by the CLUBB-MF plume ! ensemble. Mirrors zm_conv_tend_2 (fully pbuf-driven), reading the ZM_* ! gathered arrays that clubb_tend_cam populated from the plume ensemble. -subroutine clubb_mf_convtran2( state, ptend, ztodt, pbuf) use physics_types, only: physics_state, physics_ptend, physics_ptend_init use time_manager, only: get_nstep diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index 825c08e5b0..37e780a576 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -88,8 +88,6 @@ module physpkg integer :: snow_pcw_idx = 0 integer :: prec_dp_idx = 0 integer :: snow_dp_idx = 0 -!+++arh prec_sh_idx/snow_sh_idx removed: CLUBB-MF precip is carried in the -! deep-convection precip pbuf fields (PREC_DP/SNOW_DP) integer :: dlfzm_idx = 0 ! detrained convective cloud water mixing ratio. integer :: ducore_idx = 0 ! ducore index in physics buffer integer :: dvcore_idx = 0 ! dvcore index in physics buffer @@ -949,7 +947,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) prec_dp_idx = pbuf_get_index('PREC_DP') snow_dp_idx = pbuf_get_index('SNOW_DP') -!+++arh PREC_SH/SNOW_SH index fetches removed (CLUBB-MF precip now in PREC_DP/SNOW_DP) dlfzm_idx = pbuf_get_index('DLFZM', ierr) cmfmczm_idx = pbuf_get_index('CMFMC_DP', ierr) @@ -1518,10 +1515,17 @@ subroutine tphysac (ztodt, cam_in, & real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation - !+++arh CLUBB+MF precip is carried in the deep-convection pbuf fields + ! CLUBB+MF precip is carried in the deep-convection pbuf fields real(r8),pointer :: prec_dp(:) ! total precipitation from CLUBB-MF (deep) real(r8),pointer :: snow_dp(:) ! snow from CLUBB-MF (deep) + ! CLUBB+MF deep-convection cloud fields (evolve every macmic + ! iteration inside clubb_tend_cam; averaged over the sub-cycle + ! below, like prec_dp/snow_dp) + real(r8),pointer :: dp_frac(:,:) ! deep convective cloud fraction + real(r8),pointer :: dp_icwmr(:,:) ! deep convection in-cloud water mixing ratio + real(r8),pointer :: concld(:,:) ! convective cloud fraction + ! Local copies for substepping real(r8) :: prec_pcw_macmic(pcols) real(r8) :: snow_pcw_macmic(pcols) @@ -1532,9 +1536,12 @@ subroutine tphysac (ztodt, cam_in, & real(r8) :: prec_sed_carma(pcols) ! total precip from cloud sedimentation (CARMA) real(r8) :: snow_sed_carma(pcols) ! snow from cloud ice sedimentation (CARMA) - !+++arh CLUBB+MF + ! CLUBB+MF real(r8) :: prec_dp_macmic(pcols) real(r8) :: snow_dp_macmic(pcols) + real(r8) :: dp_frac_macmic(pcols,pver) + real(r8) :: dp_icwmr_macmic(pcols,pver) + real(r8) :: concld_macmic(pcols,pver) logical :: labort ! abort flag @@ -1634,9 +1641,14 @@ subroutine tphysac (ztodt, cam_in, & end if if (do_clubb_mf) then -!+++arh CLUBB-MF precip now carried in the deep fields call pbuf_get_field(pbuf, prec_dp_idx, prec_dp ) call pbuf_get_field(pbuf, snow_dp_idx, snow_dp ) + ifld = pbuf_get_index('DP_FRAC') + call pbuf_get_field(pbuf, ifld, dp_frac) + ifld = pbuf_get_index('ICWMRDP') + call pbuf_get_field(pbuf, ifld, dp_icwmr) + ifld = pbuf_get_index('CONCLD') + call pbuf_get_field(pbuf, ifld, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) end if if (dlfzm_idx > 0) then @@ -1765,9 +1777,11 @@ subroutine tphysac (ztodt, cam_in, & snow_pcw_macmic = 0._r8 if (do_clubb_mf) then - !+++arh CLUBB+MF prec_dp_macmic = 0._r8 snow_dp_macmic = 0._r8 + dp_frac_macmic = 0._r8 + dp_icwmr_macmic = 0._r8 + concld_macmic = 0._r8 end if ! contrail parameterization @@ -1805,7 +1819,6 @@ subroutine tphysac (ztodt, cam_in, & ! Since we "added" the reserved liquid back in this routine, we need ! to account for it in the energy checker if (do_clubb_mf) then -!+++arh flx_cnd(:ncol) = -1._r8*rliq(:ncol) + prec_dp(:ncol) else flx_cnd(:ncol) = -1._r8*rliq(:ncol) @@ -1843,9 +1856,11 @@ subroutine tphysac (ztodt, cam_in, & call t_stopf('macrop_tend') if (do_clubb_mf) then - !+++arh CLUBB+MF prec_dp_macmic(:ncol) = prec_dp_macmic(:ncol) + prec_dp(:ncol) snow_dp_macmic(:ncol) = snow_dp_macmic(:ncol) + snow_dp(:ncol) + dp_frac_macmic(:ncol,:) = dp_frac_macmic(:ncol,:) + dp_frac(:ncol,:) + dp_icwmr_macmic(:ncol,:) = dp_icwmr_macmic(:ncol,:) + dp_icwmr(:ncol,:) + concld_macmic(:ncol,:) = concld_macmic(:ncol,:) + concld(:ncol,:) end if !=================================================== @@ -1996,9 +2011,19 @@ subroutine tphysac (ztodt, cam_in, & snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol) if (do_clubb_mf) then - !+++arh CLUBB+MF prec_dp(:ncol) = prec_dp_macmic(:ncol)/cld_macmic_num_steps snow_dp(:ncol) = snow_dp_macmic(:ncol)/cld_macmic_num_steps + ! The deep-convection cloud fields evolve every macmic iteration + ! inside clubb_tend_cam so that in-loop consumers (PUMAS reads + ! CLD/CONCLD) stay coupled to the current sub-step; the post-loop + ! consumers (aero_model_wetdep, convect_deep_tend_2/aero_convproc, + ! conv_water, radiation) get the sub-cycle mean here. + dp_frac(:ncol,:) = dp_frac_macmic(:ncol,:)/cld_macmic_num_steps + dp_icwmr(:ncol,:) = dp_icwmr_macmic(:ncol,:)/cld_macmic_num_steps + concld(:ncol,:) = concld_macmic(:ncol,:)/cld_macmic_num_steps + ! rebuild total cloud from the averaged deep fraction, matching + ! clubb_intr's cld = min(ast + deepcu, 1) + cld(:ncol,:) = min(ast(:ncol,:) + dp_frac(:ncol,:), 1._r8) end if endif @@ -2775,7 +2800,6 @@ subroutine tphysbc (ztodt, state, & ! convective precipitation variables real(r8),pointer :: prec_dp(:) ! total precipitation from ZM convection real(r8),pointer :: snow_dp(:) ! snow from ZM convection -!+++arh unused prec_sh/snow_sh pointers removed ! stratiform precipitation variables real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s) @@ -3013,7 +3037,6 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, prec_dp_idx, prec_dp ) call pbuf_get_field(pbuf, snow_dp_idx, snow_dp ) -!+++arh unused PREC_SH/SNOW_SH fetches removed call pbuf_get_field(pbuf, prec_str_idx, prec_str ) call pbuf_get_field(pbuf, snow_str_idx, snow_str ) From 57eca12bdab9e22c2c60aa436d7028869a04ae90 Mon Sep 17 00:00:00 2001 From: adamrher Date: Fri, 11 Sep 2026 20:12:20 -0600 Subject: [PATCH 42/63] lower-tropospheric stability trigger mods added --- bld/build-namelist | 1 + bld/namelist_files/namelist_defaults_cam.xml | 3 +- bld/namelist_files/namelist_definition.xml | 10 +- src/physics/cam/clubb_intr.F90 | 93 +++++++++------ src/physics/cam/clubb_mf.F90 | 117 ++++++++++++++++++- 5 files changed, 184 insertions(+), 40 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 23abf565c3..4c168d789d 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3748,6 +3748,7 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'do_clubb_mf_aloft'); add_default($nl, 'do_clubb_mf_aspd'); add_default($nl, 'do_clubb_mf_pblcull'); + add_default($nl, 'do_clubb_mf_invswitch'); } } diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 42401d00bf..89b793e922 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2377,7 +2377,7 @@ .false. 1 1 - .true. + .false. .false. .true. .false. @@ -2386,6 +2386,7 @@ .true. .false. .false. + .true. 10 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 0b93398bbf..15898ca7b6 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4762,7 +4762,7 @@ Default: 1 If .true. use relative humidity thresholds to turn off TKE enhanced entrainment -Default: .true. +Default: .false. + +If .true. shut off the MF plume ensemble where the lower-tropospheric stability +(thl700 - thl1000) is at least 20 K (the marine stratocumulus regime), mirroring +the CLUBB-core expldiff criterion. +Default: .true. + + = 1._r8) rhlev(i) = 0.990_r8 - if (rhlev(i) > 0._r8) rhinv(i) = 1._r8 / ( (1._r8/rhlev(i)) - 1._r8 ) - end do - !--------------------------------------- integrate_mf call --------------------------------------- ! integrate_mf expects arguments of individual columns. ! If the column loop gets pushed into it, we can also avoid the array slicing. @@ -4210,7 +4203,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlm_zm(i,:), rtm_zm(i,:), thv_ds_zm(i,:), & ! input th_zm(i,:), qv_zm(i,:), qc_zm(i,:), & ! input ustar2(i), th_sfc(i), wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input - tke_zm(i,:), tpert(i), rhinv(i), & ! input + tke_zm(i,:), tpert(i), mf_lts(i), & ! input wpthlp_pbuf(i,:), wpthvp_pbuf(i,:), wprtp_pbuf(i,:), & ! input mf_ztopm1(i,:), mf_ddcp(i,:), mf_cbm1(i), & ! in-out mf_cape(i,:), & ! output @@ -6340,6 +6333,40 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end subroutine clubb_tend_cam + ! clamped linear-in-pressure interpolation of a midpoint + ! field to a target pressure level, mirroring the CLUBB-core pvertinterp + ! (advance_helper_module): below the lowest midpoint or above the highest + ! midpoint the boundary value is used. Kept verbatim from the first + ! implementation for bit-for-bit reproducibility of the LTS trigger. + subroutine mf_pinterp(ncol, pmid, pout, fld, outv) + integer, intent(in) :: ncol + real(r8), intent(in) :: pmid(:,:) ! (ncol,pver) midpoint pressure (Pa), increasing downward + real(r8), intent(in) :: pout ! target pressure (Pa) + real(r8), intent(in) :: fld(:,:) ! (ncol,pver) field on midpoints + real(r8), intent(out) :: outv(ncol) + + integer :: i, k + real(r8) :: dpu, dpl + + do i = 1, ncol + if (pout >= pmid(i,pver)) then + outv(i) = fld(i,pver) + else if (pout <= pmid(i,1)) then + outv(i) = fld(i,1) + else + do k = 1, pver-1 + if (pout > pmid(i,k) .and. pout <= pmid(i,k+1)) then + dpu = pout - pmid(i,k) + dpl = pmid(i,k+1) - pout + outv(i) = (fld(i,k)*dpl + fld(i,k+1)*dpu) / (dpl + dpu) + exit + end if + end do + end if + end do + + end subroutine mf_pinterp + subroutine clubb_emissions_cam (state, cam_in, ptend) !------------------------------------------------------------------------------- diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 106bb43568..adcecaaed7 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -72,7 +72,7 @@ module clubb_mf logical, protected :: do_clubb_mf_ustar = .false. logical, protected :: do_clubb_mf_mixd = .false. logical, protected :: do_clubb_mf_precip = .true. - logical, protected :: do_clubb_mf_rhtke = .true. + logical, protected :: do_clubb_mf_rhtke = .false. logical, protected :: do_clubb_mf_cmt = .false. logical, protected :: do_clubb_mf_aloft = .true. logical, protected :: do_clubb_mf_coldpool_init = .false. @@ -80,6 +80,13 @@ module clubb_mf logical, protected :: do_clubb_mf_lscale_perplume = .true. logical, protected :: do_clubb_mf_aspd = .false. logical, protected :: do_clubb_mf_pblcull = .false. + ! shut off the MF plume ensemble where the lower-tropospheric + ! inversion is strong (thl700 - thl1000 >= 20 K), mirroring the CLUBB-core + ! expldiff criterion (advance_clubb_core_module). Strong-inversion + ! columns are the marine-Sc regime, where CLUBB should own the boundary + ! layer; unlike do_clubb_mf_rhtke this is a direct on/off trigger rather + ! than an indirect entrainment enhancement. + logical, protected :: do_clubb_mf_invswitch = .true. logical :: tht_tweaks = .true. integer :: mf_num_cin = 5 @@ -109,7 +116,7 @@ subroutine clubb_mf_readnl(nlfile) clubb_mf_ddexp, do_clubb_mf_mixd, clubb_mf_up_ndt, clubb_mf_cp_ndt, do_clubb_mf_rhtke, do_clubb_mf_cmt, & do_clubb_mf_coldpool_init, do_clubb_mf_coldpool_perplume, do_clubb_mf_lscale_perplume, clubb_mf_kseed, & do_clubb_mf_addtke, do_clubb_mf_aloft, clubb_mf_pwmin, clubb_mf_pwmax, clubb_mf_cldfrac_fac, & - do_clubb_mf_aspd, do_clubb_mf_pblcull + do_clubb_mf_aspd, do_clubb_mf_pblcull, do_clubb_mf_invswitch if (masterproc) then open( newunit=iunit, file=trim(nlfile), status='old' ) @@ -185,6 +192,8 @@ subroutine clubb_mf_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_aspd") call mpi_bcast(do_clubb_mf_pblcull, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_pblcull") + call mpi_bcast(do_clubb_mf_invswitch, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_invswitch") call mpi_bcast(clubb_mf_pwmin, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_pwmin") call mpi_bcast(clubb_mf_pwmax, 1, mpi_real8, mstrid, mpicom, ierr) @@ -213,7 +222,7 @@ subroutine integrate_mf( nzm, nzt, dtime, thl_zm, qt_zm, thv_zm, & ! input th_zm, qv_zm, qc_zm, & ! input ustar, ths, wthl_sfc,wqt_sfc, pblh, & ! input - tke, tpert, rhinv, & ! input + tke, tpert, lts, & ! input wpthlp_env, wpthvp_env, wpqtp_env, & ! input ztopm1, ddcp, cbm1, & ! inout mcape, & ! output @@ -305,7 +314,16 @@ subroutine integrate_mf( nzm, nzt, dtime, real(r8), intent(in) :: wthl_sfc,wqt_sfc real(r8), intent(in) :: pblh,tpert - real(r8), intent(in) :: rhinv + ! lower-tropospheric stability thl(700 hPa) - thl(1000 hPa) (K), + ! computed in clubb_intr (kept there verbatim for bit-for-bit + ! reproducibility of the trigger; see the note at the computation site) + real(r8), intent(in) :: lts + ! the rhinv predictor is computed locally from the column inputs + ! (previously preprocessed in clubb_intr) + real(r8) :: rhinv, rhlev + real(r8), dimension(nzt) :: rhprof + real(r8) :: tmpt_rh, es_rh, qs_rh, tmpmq, tmpmqs + integer :: k_rh real(r8), intent(in) :: ths,ustar real(r8), intent(inout) :: cbm1 @@ -491,6 +509,9 @@ subroutine integrate_mf( nzm, nzt, dtime, ee2, ud2 ! aloft trigger flag logical :: aloft = .false. + + ! strong-inversion (marine-Sc) plume inhibition (do_clubb_mf_invswitch) + logical :: mf_inhibit ! rng seed real(r8), dimension(4) :: u_seed @@ -759,9 +780,59 @@ subroutine integrate_mf( nzm, nzt, dtime, wqt = wqt_sfc end if + ! ------------------------------------------------------------------- ! + ! local predictors, computed from the column inputs (previously ! + ! preprocessed in clubb_intr): ! + ! ! + ! (1) rhinv, consumed by the do_clubb_mf_rhtke entrainment factor and ! + ! by get_Lscale under clubb_mf_Lopt 7/8 -- computed only when one ! + ! of those consumers is active. Lopt 7 (and the rhtke factor) ! + ! use RH interpolated to 500 hPa; Lopt 8 uses the column- ! + ! integrated RH (rho_zt*dzt = dp/g, so the mass weighting matches ! + ! the previous state%pdel/g integral exactly). ! + ! (2) the lower-tropospheric stability thl(700 hPa) - thl(1000 hPa) ! + ! for the marine-Sc inhibition is computed in clubb_intr and ! + ! passed in as lts -- exactly the CLUBB-core expldiff criterion ! + ! (advance_clubb_core_module). ! + ! ------------------------------------------------------------------- ! + rhinv = 0._r8 + if (do_clubb_mf_rhtke .or. clubb_mf_Lopt==7 .or. clubb_mf_Lopt==8) then + if (clubb_mf_Lopt == 8) then + tmpmq = 0._r8 + tmpmqs = 0._r8 + do k_rh = 1, nzt + ! T from the full potential temperature (matches the state%t the + ! previous clubb_intr preprocessing used) + tmpt_rh = th(k_rh)/iexner_zt(k_rh) + call qsat(tmpt_rh, p_zt(k_rh), es_rh, qs_rh) + tmpmq = tmpmq + rho_zt(k_rh)*dzt(k_rh)*qv(k_rh) + tmpmqs = tmpmqs + rho_zt(k_rh)*dzt(k_rh)*qs_rh + end do + rhlev = tmpmq/max(tmpmqs, 1.e-30_r8) + else + do k_rh = 1, nzt + tmpt_rh = th(k_rh)/iexner_zt(k_rh) + call qsat(tmpt_rh, p_zt(k_rh), es_rh, qs_rh) + rhprof(k_rh) = qv(k_rh)/max(qs_rh, 1.e-30_r8) + end do + rhlev = mf_pinterp(nzt, p_zt, rhprof, 50000._r8) + end if + if (rhlev >= 1._r8) rhlev = 0.990_r8 + if (rhlev > 0._r8) rhinv = 1._r8/((1._r8/rhlev) - 1._r8) + end if + + ! marine-Sc inhibition: mirror the CLUBB-core expldiff + ! criterion (advance_clubb_core_module: expldiff is applied only where + ! thlm700 - thlm1000 < 20 K). Where the lower-tropospheric inversion is + ! at least that strong -- the marine stratocumulus regime -- the MF plume + ! ensemble is shut off entirely and CLUBB owns the boundary layer. All + ! plume outputs were zeroed above, so the inhibited column follows the + ! same code path as a negatively buoyant (no-convection) one. + mf_inhibit = do_clubb_mf_invswitch .and. (lts >= 20._r8) + ! if surface buoyancy is positive then do mass-flux !if ( wthv > 0._r8 ) then - if ( wthv > 0._r8 .and. wqt > 0._r8) then + if ( wthv > 0._r8 .and. wqt > 0._r8 .and. (.not. mf_inhibit) ) then if (do_clubb_mf_mixd) then convh = max(cbm1,pblhmin) @@ -1953,6 +2024,42 @@ subroutine integrate_mf( nzm, nzt, dtime, end subroutine integrate_mf + ! clamped linear-in-pressure interpolation of a column field + ! to a target pressure level, mirroring the CLUBB-core pvertinterp + ! (advance_helper_module): outside the sounding the boundary value is used, + ! so the criterion degrades gracefully over high terrain exactly as the + ! CLUBB-core expldiff switch does. Orientation-agnostic (brackets on the + ! pressure array itself), so it works for either vertical index convention. + function mf_pinterp(nz, p, fld, pout) result(val) + integer, intent(in) :: nz + real(r8), intent(in) :: p(nz) ! level pressures (Pa) + real(r8), intent(in) :: fld(nz) ! field on the same levels + real(r8), intent(in) :: pout ! target pressure (Pa) + real(r8) :: val + + integer :: k, kbot(1), ktop(1) + real(r8) :: wgt + + kbot = maxloc(p) + ktop = minloc(p) + if (pout >= p(kbot(1))) then + val = fld(kbot(1)) + else if (pout <= p(ktop(1))) then + val = fld(ktop(1)) + else + val = fld(kbot(1)) + do k = 1, nz-1 + if ((pout - p(k))*(pout - p(k+1)) <= 0._r8 .and. p(k) /= p(k+1)) then + wgt = (pout - p(k+1))/(p(k) - p(k+1)) + val = wgt*fld(k) + (1._r8 - wgt)*fld(k+1) + exit + end if + end do + end if + + end function mf_pinterp + + subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, th, & wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, wa, wb, & do_condensation, qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1, dynamic_L0, ztop, mcape) From 8cbac7422d26bbcf0c8f5493bc8951ada4ed7bc0 Mon Sep 17 00:00:00 2001 From: adamrher Date: Sun, 13 Sep 2026 14:42:14 -0600 Subject: [PATCH 43/63] address git copilot review --- bld/namelist_files/namelist_definition.xml | 2 +- src/physics/cam/clubb_intr.F90 | 11 ++++++++++- src/physics/cam/convect_deep.F90 | 19 +++++++++++++++---- src/physics/cam7/physpkg.F90 | 14 ++++++++++++-- 4 files changed, 38 insertions(+), 8 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 15898ca7b6..701e49ab72 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4628,7 +4628,7 @@ Default: .true. If .true. add MF contribution to TKE pbuf variable -Default: .true. +Default: .false. Date: Tue, 15 Sep 2026 18:32:33 -0600 Subject: [PATCH 44/63] First batch of PR updates from Cheryl's comments. --- bld/build-namelist | 19 ++--- bld/namelist_files/namelist_definition.xml | 25 +++++-- src/physics/cam/clubb_intr.F90 | 86 +++++++++++----------- src/physics/cam/clubb_mf.F90 | 8 +- 4 files changed, 67 insertions(+), 71 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 560e695ac9..c500f1d15b 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3313,12 +3313,10 @@ if (defined $do_clubb_sgs) { add_default($nl, 'do_clubb_sgs'); my $clubb_sgs = $nl->get_value('do_clubb_sgs'); -# Evaluate do_clubb_mf early to handle overrides -add_default($nl, 'do_clubb_mf'); -my $clubb_mf = $nl->get_value('do_clubb_mf'); - +# Evaluate clubb_mf early to handle overrides # Deep convection scheme and CLUBB+MF dependency check -if (defined $do_clubb_mf and $do_clubb_mf =~ /$TRUE/io) { +my $clubb_mf = $nl->get_value('do_clubb_mf'); +if ($clubb_mf =~ /$TRUE/io) { if ($clubb_sgs !~ /$TRUE/io) { die "CAM Namelist ERROR: do_clubb_mf is set to .true. but do_clubb_sgs is not active.\n" . "CLUBB+MF requires the CLUBB_SGS package to be enabled.\n"; @@ -3327,6 +3325,7 @@ if (defined $do_clubb_mf and $do_clubb_mf =~ /$TRUE/io) { } else { add_default($nl, 'deep_scheme'); } +add_default($nl, 'do_clubb_mf'); my $deep_scheme = $nl->get_value('deep_scheme'); # Aerosol convective processes @@ -3446,14 +3445,8 @@ add_default($nl, 'microp_aero_wsub_min'); add_default($nl, 'microp_aero_wsub_min_asf'); add_default($nl, 'microp_aero_wsubi_min'); -# CLUBB-MF cloud droplet activation tuning -if ($clubb_mf =~ "true") { - add_default($nl, 'microp_aero_wsub_scale', 'val'=>'0.5'); - add_default($nl, 'microp_aero_wsubi_scale', 'val'=>'0.5'); -} else { - add_default($nl, 'microp_aero_wsub_scale'); - add_default($nl, 'microp_aero_wsubi_scale'); -} +add_default($nl, 'microp_aero_wsub_scale'); +add_default($nl, 'microp_aero_wsubi_scale'); # Ice nucleation options if (!$simple_phys) { diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 67b45bfbdd..708131813d 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -2530,7 +2530,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP ISCCP data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell's longitude (t_local = t_UTC - longitude * 24/360). +gridcell's longitude (t_local = t_UTC + longitude * 24/360). Default: none @@ -2538,7 +2538,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP MISR data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell's longitude (t_local = t_UTC - longitude * 24/360). +gridcell's longitude (t_local = t_UTC + longitude * 24/360). Default: none @@ -2546,7 +2546,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP MODIS data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell's longitude (t_local = t_UTC - longitude * 24/360). +gridcell's longitude (t_local = t_UTC + longitude * 24/360). Default: none @@ -2554,7 +2554,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP CloudSat-CALIPSO data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell's longitude (t_local = t_UTC - longitude * 24/360). +gridcell's longitude (t_local = t_UTC + longitude * 24/360). Default: none @@ -2562,7 +2562,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP PARASOL data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell's longitude (t_local = t_UTC - longitude * 24/360). +gridcell's longitude (t_local = t_UTC + longitude * 24/360). Default: none @@ -2570,7 +2570,7 @@ Default: none group="cospsimulator_nl" valid_values="" > Swath localtimes (hours) for masking COSP ATLID data. The sampling "local time" refers to a linear shift from UTC as a function of a -gridcell's longitude (t_local = t_UTC - longitude * 24/360). +gridcell's longitude (t_local = t_UTC + longitude * 24/360). Default: none @@ -4619,7 +4619,7 @@ Default: .false. -If .true. turn on Suselj et al 2019 microphysics. +If .true. turn on Suselj et al 2019 microphysics DOI: 10.1175/JAS-D-18-0239.1 Default: .true. @@ -4644,7 +4644,16 @@ Default: 200.0 -Integer: dynamic entrainment length scale option +Dynamic entrainment length scale option: +0: fixed L0 +1: tke_clubb L0 +2: wpthlp_clubb L0 +3: test plume L0 +4: lel +5: cape +6: ztopm1 +7: rel.hum. at 500 hPa +8: column int. rel.hum. Default: 6 diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 07c1f59b98..f549fea5ad 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2779,8 +2779,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_cape, mf_cape_nadv #endif - ! CFL limiter vars - real(r8), parameter :: cflval = 1._r8 + ! Courant number limiter vars + real(r8), parameter :: cflval = 1._r8 ! Upper limit on Courant number for stability real(r8) :: lambda character(len=256) :: lambda_errmsg real(r8), dimension(state%ncol) :: cflfac, max_cfl, & @@ -2993,7 +2993,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then - ! SVP + ! Saturation Vapor Pressure calculation do k = 1, pver call qsat(state_loc%t(1:ncol,k), state_loc%pmid(1:ncol,k), esat(1:ncol,k), rh(1:ncol,k), ncol) end do @@ -3335,9 +3335,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - !+++ARH - Temporary hack - pbuf_set_field is apparently not taking? + ! check on pbuf_set_field if (is_first_step() .and. macmic_it==1) then - ddcp(:ncol,:) = 0._r8 + if (any(ddcp(:ncol,:) /= 0._r8)) then + call endrun(subr//': ddcp not set to 0 on first step and macmic iteration') + end if end if mf_precc_nadv(:ncol) = 0._r8 @@ -3875,7 +3877,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtm = rtm(:,nzt_clubb:1:-1) thlm = thlm(:,nzt_clubb:1:-1) - ! flipping grid defintion + ! flipping grid definition zt_g = zt_g(:,nzt_clubb:1:-1) if (do_clubb_mf) then @@ -3920,7 +3922,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & upwp_pert = upwp_pert(:,nzm_clubb:1:-1) vpwp_pert = vpwp_pert(:,nzm_clubb:1:-1) - ! flipping grid defintion + ! flipping grid definition zi_g = zi_g(:,nzm_clubb:1:-1) if (do_clubb_mf) then @@ -4227,7 +4229,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & max_cfl_nadv(i) = MAX(max_cfl(i),max_cfl_nadv(i)) end do call t_stopf('clubb_tend_cam:do_clubb_mf') - end if + end if ! if (do_clubb_mf) ! Advance CLUBB CORE one timestep in the future call t_startf('clubb_tend_cam:advance_clubb_core_api') @@ -4316,7 +4318,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & um_forcing = um_forcing(:,nzt_clubb:1:-1) vm_forcing = vm_forcing(:,nzt_clubb:1:-1) -!+++ arh -- I think we should do the array flipping for all clubb-mf variables here, around a do_clubb_mf if statement mf_qtforcup = mf_qtforcup(:,nzt_clubb:1:-1) mf_thlforcup = mf_thlforcup(:,nzt_clubb:1:-1) mf_qtforcdn = mf_qtforcdn(:,nzt_clubb:1:-1) @@ -4758,27 +4759,27 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! process clubb-mf accumulated arrays if (do_clubb_mf) then ! average over nadv - mf_L0_nadv = mf_L0_nadv/REAL(nadv) - mf_ztop_nadv = mf_ztop_nadv/REAL(nadv) - mf_ztopm1_nadv = mf_ztopm1_nadv/REAL(nadv) - mf_cape_nadv = mf_cape_nadv/REAL(nadv) - mf_ddcp_nadv = mf_ddcp_nadv/REAL(nadv) - mf_cbm1_nadv = mf_cbm1_nadv/REAL(nadv) - mf_freq_nadv = mf_freq_nadv/REAL(nadv) - - mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv) - mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv) - mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv) - prec_sh_pbuf(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv) - snow_sh_pbuf(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv) - - mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_thlforcdn_nadv(:ncol,:nzt_clubb) = mf_thlforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_qtforcdn_nadv(:ncol,:nzt_clubb) = mf_qtforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_thlforc_nadv(:ncol,:nzt_clubb) = mf_thlforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_ent_nadv(:ncol,:nzm_clubb) = mf_ent_nadv(:ncol,:nzm_clubb)/REAL(nadv) + mf_L0_nadv = mf_L0_nadv/REAL(nadv,r8) + mf_ztop_nadv = mf_ztop_nadv/REAL(nadv,r8) + mf_ztopm1_nadv = mf_ztopm1_nadv/REAL(nadv,r8) + mf_cape_nadv = mf_cape_nadv/REAL(nadv,r8) + mf_ddcp_nadv = mf_ddcp_nadv/REAL(nadv,r8) + mf_cbm1_nadv = mf_cbm1_nadv/REAL(nadv,r8) + mf_freq_nadv = mf_freq_nadv/REAL(nadv,r8) + + mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + prec_sh_pbuf(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv,r8) + snow_sh_pbuf(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv,r8) + + mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) + mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) + mf_thlforcdn_nadv(:ncol,:nzt_clubb) = mf_thlforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) + mf_qtforcdn_nadv(:ncol,:nzt_clubb) = mf_qtforcdn_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) + mf_thlforc_nadv(:ncol,:nzt_clubb) = mf_thlforc_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) + mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) + mf_ent_nadv(:ncol,:nzm_clubb) = mf_ent_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) ! accumulate in buffer ztopm1_macmic(:ncol,:) = ztopm1_macmic(:ncol,:) + mf_ztopm1_nadv(:ncol,:) @@ -4787,35 +4788,35 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (macmic_it == cld_macmic_num_steps) then - cbm1(:ncol) = cbm1_macmic(:ncol)/REAL(cld_macmic_num_steps) + cbm1(:ncol) = cbm1_macmic(:ncol)/REAL(cld_macmic_num_steps,r8) if (clubb_mf_up_ndt == 1) then - ztopma(:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ztopma(:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) else ztopmn(2:clubb_mf_up_ndt,:ncol,:) = ztopmn(1:clubb_mf_up_ndt-1,:ncol,:) - ztopmn(1,:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ztopmn(1,:ncol,:) = ztopm1_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) ztopma(:ncol,:) = 0._r8 do t=1,clubb_mf_up_ndt ztopma(:ncol,:) = ztopma(:ncol,:) + ztopmn(t,:ncol,:) end do - ztopma(:ncol,:) = ztopma(:ncol,:)/REAL(clubb_mf_up_ndt) + ztopma(:ncol,:) = ztopma(:ncol,:)/REAL(clubb_mf_up_ndt,r8) end if if (clubb_mf_cp_ndt == 1) then - ddcp(:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ddcp(:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) else ddcpmn(2:clubb_mf_cp_ndt,:ncol,:) = ddcpmn(1:clubb_mf_cp_ndt-1,:ncol,:) - ddcpmn(1,:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + ddcpmn(1,:ncol,:) = ddcp_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) ddcp(:ncol,:) = 0._r8 do t=1,clubb_mf_cp_ndt ddcp(:ncol,:) = ddcp(:ncol,:) + ddcpmn(t,:ncol,:) end do - ddcp(:ncol,:) = ddcp(:ncol,:)/REAL(clubb_mf_cp_ndt) - end if + ddcp(:ncol,:) = ddcp(:ncol,:)/REAL(clubb_mf_cp_ndt,r8) + end if ! if (clubb_mf_cp_ndt == 1) then ddcp(:ncol,:) = clubb_mf_ddalph*ddcp(:ncol,:) - end if + end if ! if (macmic_it == cld_macmic_num_steps) ! Need moist_qc and cloudfrac on thermo grid for output mf_qc_zt(:,:) = 0._r8 @@ -5378,9 +5379,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! from CLUBB plus the deep convective cloud fraction ! NOTE: concld_pbuf used to be calculated in the commented-out version below, but since we ! set alst_pbuf=cloud_frac_pbuf, this simplifies to only using deepcu_pbuf. - ! This is potentially a bug, but there's not really a "right" way to combine the different - ! cloud fractions, so it has been left to only use deepcu_pbuf for now - !concld_pbuf(i,k) = min(cloud_frac_pbuf(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k),0.80_r8) concld_pbuf(i,k) = min(deepcu_pbuf(i,k),0.80_r8) enddo enddo @@ -5936,7 +5934,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'edmf_freq' , mf_freq_output, pcols, lchnk ) call outfld( 'edmf_cape' , mf_cape_output, pcols, lchnk ) call outfld( 'edmf_cfl' , mf_cfl_output, pcols, lchnk ) - end if + end if ! if (do_clubb_mf) ! Output CLUBB history here if (stats_metadata%l_stats) then @@ -6840,7 +6838,7 @@ subroutine stats_avg( kk, num_output_fields, x, n ) do k = 1, kk if ( n(1,1,k,m) > 0 ) then - x(1,1,k,m) = x(1,1,k,m) / real( n(1,1,k,m) ) + x(1,1,k,m) = x(1,1,k,m) / real( n(1,1,k,m),r8 ) end if end do diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 0be0514212..3bfd004bd6 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -936,7 +936,7 @@ subroutine integrate_mf( nzm, nzt, dtime, mix(kt,i) = fixent_ent else ! get entrainment, ent=ent0/dz*P(dz/L0) - mix(kt,i) = real( enti(kt,i))*clubb_mf_ent0/dzt(kt) + mix(kt,i) = real( enti(kt,i),r8)*clubb_mf_ent0/dzt(kt) end if do iter_xc = 1, niter_xc @@ -1657,7 +1657,7 @@ subroutine integrate_mf( nzm, nzt, dtime, cbm1 = cbm1 + zm(kcbarr(i)) end do - cbm1 = cbm1/REAL(clubb_mf_nup) + cbm1 = cbm1/REAL(clubb_mf_nup,r8) ! --------------------------------------------------------- ! ! bulk downdraft velocity for coldpool parameterization ! @@ -1913,10 +1913,6 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, kpbl-kdir ,lcl ,lel ,lon ,mx , & msg-kdir ,tpert ,landfrac ) - !do i=1,clubb_mf_nup - ! mcape = mcape + cape(i) - !end do - !mcape = mcape/REAL(clubb_mf_nup) mcape = max(cape(1),25._r8) if (clubb_mf_Lopt==4) then From d69b19e086f42a80342cb9fd4600da3dd2a91b1b Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 18 Sep 2026 17:32:19 -0600 Subject: [PATCH 45/63] clubb_intr PR updates from review --- bld/build-namelist | 11 +- bld/namelist_files/namelist_defaults_cam.xml | 8 +- src/physics/cam/clubb_intr.F90 | 691 +++++++++---------- 3 files changed, 341 insertions(+), 369 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 038061f52b..c5f8a2e308 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3317,6 +3317,7 @@ my $clubb_sgs = $nl->get_value('do_clubb_sgs'); add_default($nl, 'deep_scheme'); my $deep_scheme = $nl->get_value('deep_scheme'); +$deep_scheme =~ s/['"]//g; # Strip quotes for exact XML attribute matching # CLUBB+MF dependency checks if ($deep_scheme =~ /CLUBB_MF/) { @@ -3701,14 +3702,8 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_wpxp_Ri_exp'); add_default($nl, 'clubb_z_displace'); - # CLUBB-MF runs w/o expldiff & prognostic momentum fluxes - if ($deep_scheme =~ /CLUBB_MF/) { - add_default($nl, 'clubb_l_predict_upwp_vpwp', 'val'=>'.false.'); - add_default($nl, 'clubb_l_do_expldiff_rtm_thlm', 'val'=>'.false.'); - } else { - add_default($nl, 'clubb_l_predict_upwp_vpwp'); - add_default($nl, 'clubb_l_do_expldiff_rtm_thlm'); - } + add_default($nl, 'clubb_l_predict_upwp_vpwp', 'deep_scheme'=>$deep_scheme); + add_default($nl, 'clubb_l_do_expldiff_rtm_thlm', 'deep_scheme'=>$deep_scheme); #Turn on HB scheme where CLUBB not active add_default($nl, 'do_hb_above_clubb'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 89b793e922..ec217437f4 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2242,9 +2242,10 @@ .false. .false. .false. - .false. - .true. - .false. + .false. + .true. + .false. + .false. .false. .false. .true. @@ -2264,6 +2265,7 @@ .false. .false. .true. + .false. .false. .false. .false. diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index f75db67759..339af00dcc 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2868,7 +2868,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & integer :: & errflg, & j, k, t, ixind, nadv, n, & ! Loop variables - k_cam, k_clubb, k_clubb_pver, sclr, iedsclr, & ! Loop variables + k_cam, k_clubb, sclr, iedsclr, & ! Loop variables ixcldice, ixcldliq, ixnumliq, & ixnumice, ixq, & itim_old, & @@ -2884,13 +2884,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #endif ! Courant number limiter vars - real(r8), parameter :: cflval = 1._r8 ! Upper limit on Courant number for stability - real(r8) :: lambda - character(len=256) :: lambda_errmsg - real(r8), dimension(state%ncol) :: cflfac, max_cfl, & - th_sfc, max_cfl_nadv - logical :: cfllim - + real(r8), dimension(state%ncol) :: max_cfl_nadv real(r8), dimension(state%ncol) :: mf_precc_nadv, mf_snow_nadv,& mf_cbm1, mf_cbm1_nadv, & @@ -3469,13 +3463,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - ! check on pbuf_set_field - if (is_first_step() .and. macmic_it==1) then - if (any(ddcp(:ncol,:) /= 0._r8)) then - call endrun(subr//': ddcp not set to 0 on first step and macmic iteration') - end if - end if - mf_precc_nadv(:ncol) = 0._r8 mf_snow_nadv(:ncol) = 0._r8 @@ -4157,248 +4144,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - !####################################################################### - !###################### CALL MF DIAGNOSTIC PLUMES ###################### - !####################################################################### + ! CALL MF DIAGNOSTIC PLUMES if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') - ! fields on momentum grid needed for mass flux calc. - rtm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm(:ncol,:) ) - thlm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm(:ncol,:) ) - th_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, th_zt(:ncol,:) ) - qv_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qv_zt(:ncol,:) ) - qc_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qc_zt(:ncol,:) ) - kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt(:ncol,:) ) - - do k = 1, nzm_clubb - do i = 1, ncol - invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k) * inv_p0_clubb)**kappa_zm(i,k) ) - end do - end do - - ! theta at surface needed for plume initialization. - ! gr%k_lb_zm is the surface (lower boundary) momentum index: 1 for an - ! ascending grid, nzm_clubb for a descending grid. - th_sfc(1:ncol) = cam_in%ts(1:ncol)*invrs_exner_zm(1:ncol,gr%k_lb_zm) - - ! friction velocity needed for clubb-mf - ustar2(1:ncol) = calc_friction_velocity(cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), rrho(1:ncol)) - - ! update thv if clubb is subcycled - if (t>1) then - do i = 1, ncol - thv_ds_zt(i,:) = thlm(i,:) & - + latvap*rcm(i,:)*invrs_exner_zt(i,:)/cpair - thv_ds_zt(i,:) = thv_ds_zt(i,:) & - * (1._r8+zvir*(rtm(i,:)-rcm(i,:)) - rcm(i,:)) - end do - thv_ds_zm(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thv_ds_zt(1:ncol,:) ) - end if - - ! set memory terms - mf_ztopm1(1:ncol,:) = ztopma(1:ncol,:) - mf_ddcp(1:ncol,:) = ddcp(1:ncol,:) - mf_cbm1(1:ncol) = cbm1(1:ncol) - - !--------------------------------------- integrate_mf call --------------------------------------- - ! integrate_mf expects arguments of individual columns. - ! If the column loop gets pushed into it, we can also avoid the array slicing. - - do i = 1, ncol - - call integrate_mf( nzm_clubb, nzt_clubb, dtime, & ! input - rho_zm(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - rho_zt(i,:), dz_g(i,:), zt_g(i,:), p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input - um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input - wm_zm(i,:), th_zt(i,:), qv_zt(i,:), qc_zt(i,:), & ! input - thlm_zm(i,:), rtm_zm(i,:), thv_ds_zm(i,:), & ! input - th_zm(i,:), qv_zm(i,:), qc_zm(i,:), & ! input - ustar2(i), th_sfc(i), wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input - tke_zm(i,:), tpert(i), mf_lts(i), & ! input - wpthlp_pbuf(i,:), wpthvp_pbuf(i,:), wprtp_pbuf(i,:), & ! input - mf_ztopm1(i,:), mf_ddcp(i,:), mf_cbm1(i), & ! in-out - mf_cape(i,:), & ! output - mf_upa(i,:,:), mf_dna(i,:,:), & ! output - mf_upw(i,:,:), mf_dnw(i,:,:), & ! output - mf_upmf(i,:,:), & ! output - mf_upqt(i,:,:), mf_dnqt(i,:,:), & ! output - mf_upthl(i,:,:), mf_dnthl(i,:,:), & ! output - mf_upthv(i,:,:), mf_dnthv(i,:,:), & ! output - mf_upth(i,:,:), mf_dnth(i,:,:), & ! output - mf_upqc(i,:,:), mf_dnqc(i,:,:), & ! output - mf_upbuoy(i,:,:), & ! output - mf_upent(i,:,:), & ! output - mf_updet(i,:,:), & ! output - mf_dry_a(i,:), mf_moist_a(i,:), & ! output - mf_dry_w(i,:), mf_moist_w(i,:), & ! output - mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - mf_dry_thl(i,:), mf_moist_thl(i,:), & ! output - mf_dry_u(i,:), mf_moist_u(i,:), & ! output - mf_dry_v(i,:), mf_moist_v(i,:), & ! output - mf_moist_qc(i,:), & ! output - s_ae(i,:), & ! output - s_ac(i,:), s_aup(i,:), s_adn(i,:), & ! output - s_aw(i,:), s_awup(i,:), s_awdn(i,:), & ! output - s_aww(i,:), s_awwup(i,:), s_awwdn(i,:), & ! output - s_awthlup(i,:), s_awqtup(i,:), s_awuup(i,:), s_awvup(i,:), & ! output - s_awthldn(i,:), s_awqtdn(i,:), s_awudn(i,:), s_awvdn(i,:), & ! output - s_awthl(i,:), s_awqt(i,:), & ! output - s_awu(i,:), s_awv(i,:), & ! output - mf_thlflxup(i,:), mf_qtflxup(i,:), mf_uflxup(i,:), mf_vflxup(i,:), & ! output - mf_thlflxdn(i,:), mf_qtflxdn(i,:), mf_uflxdn(i,:), mf_vflxdn(i,:), & ! output - mf_thlflx(i,:), mf_qtflx(i,:), mf_uflx(i,:), mf_vflx(i,:), & ! output - mf_thvflx(i,:), & ! output - mf_sqtup(i,:), mf_sthlup(i,:), & ! output - mf_sqtdn(i,:), mf_sthldn(i,:), & ! output - mf_sqt(i,:), mf_sthl(i,:), & ! output - mf_sqtac(i,:), mf_sqtev(i,:), & ! output - mf_precc(i,:), & ! output - mf_ztop(i,:), mf_L0(i,:), & ! output - s_mfup(i,:), s_entup(i,:), s_detup(i,:), & ! output - s_mfdn(i,:), s_entdn(i,:), s_detdn(i,:), & ! output - mf_kctop(i) ) ! output - - end do - - !--------------------------------------- END integrate_mf call --------------------------------------- - - ! CFL limiter - cfllim = .true. - cflfac(:ncol) = 1._r8 - ! no mass flux through the ground; gr%k_lb_zm is the surface momentum - ! index (1 ascending, nzm_clubb descending) - s_aw(:ncol,gr%k_lb_zm) = 0._r8 - max_cfl(:ncol)= 0._r8 - do i=1,ncol - do k=1,nzt_clubb - max_cfl(i) = max(max_cfl(i),dtime*invrs_dz_g(i,k)*max(abs(s_aw(i,k)),abs(s_aw(i,k+1)))) - end do - if (max_cfl(i).gt.cflval.and.cfllim) cflfac(i) = cflval/max_cfl(i) - end do - - ! check for mass conservation - do k=1,nzt_clubb - do i=1,ncol - if ((-1._r8*mf_sqt(i,k)*dtime) > rtm(i,k)) then - lambda = -1._r8*rtm(i,k)/(mf_sqt(i,k)*dtime) - write(lambda_errmsg,'(a,3i6,4es16.8)') & - 'MF drying exceeds rtm. lchnk,i,k,lambda,mf_sqt,rtm,dtime = ', & - lchnk, i, k, lambda, mf_sqt(i,k), rtm(i,k), dtime - call endrun('clubb_tend_cam: '//trim(lambda_errmsg)) - end if - end do - end do - - ! pass MF turbulent advection term as CLUBB explicit forcing term - rtm_forcing(:ncol,:) = 0._r8 - thlm_forcing(:ncol,:) = 0._r8 - mf_qtforcup(:ncol,:) = 0._r8 - mf_thlforcup(:ncol,:) = 0._r8 - mf_qtforcdn(:ncol,:) = 0._r8 - mf_thlforcdn(:ncol,:) = 0._r8 - - ! pass MF turbulent advection term as CLUBB explicit forcing term - do k = 1, nzt_clubb - do i = 1, ncol - rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k+1) * mf_qtflx(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflx(i,k))) & - + mf_sqt(i,k) - - thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k+1) * mf_thlflx(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflx(i,k))) & - + mf_sthl(i,k) - - mf_qtforcup(i,k) = mf_qtforcup(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k+1) * mf_qtflxup(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflxup(i,k))) & - + mf_sqtup(i,k) - - mf_thlforcup(i,k) = mf_thlforcup(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k+1) * mf_thlflxup(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflxup(i,k))) & - + mf_sthlup(i,k) + call compute_mf_plumes() - mf_qtforcdn(i,k) = mf_qtforcdn(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k+1) * mf_qtflxdn(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflxdn(i,k))) & - + mf_sqtdn(i,k) - - mf_thlforcdn(i,k) = mf_thlforcdn(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k+1) * mf_thlflxdn(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflxdn(i,k))) & - + mf_sthldn(i,k) - end do - end do - - ! convective momentum transport - if (do_clubb_mf_cmt) then - um_forcing(:ncol,:) = 0._r8 - vm_forcing(:ncol,:) = 0._r8 - do k = 1, nzt_clubb - do i = 1, ncol - um_forcing(i,k) = um_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k+1) * mf_uflx(i,k+1)) - (rho_ds_zm(i,k) * mf_uflx(i,k))) - - vm_forcing(i,k) = vm_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & - ((rho_ds_zm(i,k+1) * mf_vflx(i,k+1)) - (rho_ds_zm(i,k) * mf_vflx(i,k))) - end do - end do - end if - - do i=1,ncol - ! compute ensemble cloud properties - mf_qc_nadv(i,:nzm_clubb) = mf_qc_nadv(i,:nzm_clubb) + mf_moist_qc(i,:nzm_clubb) - mf_rcm_nadv(i,:nzm_clubb) = mf_rcm_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb)*mf_moist_qc(i,:nzm_clubb) - mf_cloudfrac_nadv(i,:nzm_clubb) = mf_cloudfrac_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb) - - ! surface precip, [kg/m2/s]->[m/s] - mf_precc_nadv(i) = mf_precc_nadv(i) + mf_precc(i,gr%k_lb_zm)/1000._r8 - mf_snow_nadv(i) = 0._r8 - - ! accumulate the deep-hookup variables over the nadv subcycles. - ! the fractional entrainment/detrainment are RATIO diagnostics - ! (mass-flux-weighted per subcycle, denominator = mfup): near - ! plume tops the per-subcycle ratio can be immense while the - ! same subcycle's mass flux vanishes -- averaging the ratio - ! separately from the mass flux breaks that cancellation and - ! produced enormous ZM_EU values (aero_convproc courant - ! substep count exploded -> nstep-0 hang). accumulate the - ! entrainment/detrainment MASS FLUX (rate x mf, bounded) - ! instead; the population block consumes it directly. - s_mfup_nadv(i,:nzm_clubb) = s_mfup_nadv(i,:nzm_clubb) + s_mfup(i,:nzm_clubb) - s_entup_nadv(i,:nzm_clubb) = s_entup_nadv(i,:nzm_clubb) + s_entup(i,:nzm_clubb)*s_mfup(i,:nzm_clubb) - s_detup_nadv(i,:nzm_clubb) = s_detup_nadv(i,:nzm_clubb) + s_detup(i,:nzm_clubb)*s_mfup(i,:nzm_clubb) - s_mfdn_nadv(i,:nzm_clubb) = s_mfdn_nadv(i,:nzm_clubb) + s_mfdn(i,:nzm_clubb) - s_entdn_nadv(i,:nzm_clubb) = s_entdn_nadv(i,:nzm_clubb) + s_entdn(i,:nzm_clubb)*abs(s_mfdn(i,:nzm_clubb)) - s_detdn_nadv(i,:nzm_clubb) = s_detdn_nadv(i,:nzm_clubb) + s_detdn(i,:nzm_clubb)*abs(s_mfdn(i,:nzm_clubb)) - ! accumulate sum(a*w^2) and sum(a*w) of the updraft - ! ensemble so the ratio gives the mass-flux-weighted plume w - s_awwup_nadv(i,:nzm_clubb) = s_awwup_nadv(i,:nzm_clubb) + s_awwup(i,:nzm_clubb) - s_awup_nadv(i,:nzm_clubb) = s_awup_nadv(i,:nzm_clubb) + s_awup(i,:nzm_clubb) - mf_sqtac_nadv(i,:nzt_clubb) = mf_sqtac_nadv(i,:nzt_clubb) + mf_sqtac(i,:nzt_clubb) - mf_sqtev_nadv(i,:nzt_clubb) = mf_sqtev_nadv(i,:nzt_clubb) + mf_sqtev(i,:nzt_clubb) - ! kctop is not averaged: keep the HIGHEST plume top over the - ! subcycles (it doubles as the gathering/activity criterion: - ! int(kctop) > 1 means the column was active at some sub-cycle) - mf_kctop_nadv(i) = max(mf_kctop_nadv(i), mf_kctop(i)) - - mf_L0_nadv(i,:) = mf_L0_nadv(i,:) + mf_L0(i,:) - mf_ztop_nadv(i,:) = mf_ztop_nadv(i,:) + mf_ztop(i,:) - mf_ztopm1_nadv(i,:) = mf_ztopm1_nadv(i,:) + mf_ztopm1(i,:) - mf_cape_nadv(i,:) = mf_cape_nadv(i,:) + mf_cape(i,:) - mf_ddcp_nadv(i,:) = mf_ddcp_nadv(i,:) + mf_ddcp(i,:) - mf_cbm1_nadv(i) = mf_cbm1_nadv(i) + mf_cbm1(i) - - if (ANY(mf_ztop(i,:) > 0._r8)) mf_freq_nadv(i) = mf_freq_nadv(i) + 1._r8 - - mf_thlforcup_nadv(i,:nzt_clubb) = mf_thlforcup_nadv(i,:nzt_clubb) + mf_thlforcup(i,:nzt_clubb) - mf_qtforcup_nadv(i,:nzt_clubb) = mf_qtforcup_nadv(i,:nzt_clubb) + mf_qtforcup(i,:nzt_clubb) - mf_thlforcdn_nadv(i,:nzt_clubb) = mf_thlforcdn_nadv(i,:nzt_clubb) + mf_thlforcdn(i,:nzt_clubb) - mf_qtforcdn_nadv(i,:nzt_clubb) = mf_qtforcdn_nadv(i,:nzt_clubb) + mf_qtforcdn(i,:nzt_clubb) - mf_thlforc_nadv(i,:nzt_clubb) = mf_thlforc_nadv(i,:nzt_clubb) + thlm_forcing(i,:nzt_clubb) - mf_qtforc_nadv(i,:nzt_clubb) = mf_qtforc_nadv(i,:nzt_clubb) + rtm_forcing(i,:nzt_clubb) - mf_ent_nadv(i,:nzm_clubb) = mf_ent_nadv(i,:nzm_clubb) + s_awu(i,:nzm_clubb) - max_cfl_nadv(i) = MAX(max_cfl(i),max_cfl_nadv(i)) - end do call t_stopf('clubb_tend_cam:do_clubb_mf') - end if ! if (do_clubb_mf) + end if ! Advance CLUBB CORE one timestep in the future call t_startf('clubb_tend_cam:advance_clubb_core_api') @@ -4959,8 +4712,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qc(:ncol,:nzm_clubb) = mf_qc_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) mf_rcm(:ncol,:nzm_clubb) = mf_rcm_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) mf_cloudfrac(:ncol,:nzm_clubb) = mf_cloudfrac_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) - prec_sh_pbuf(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv,r8) - snow_sh_pbuf(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv,r8) + prec_dp_pbuf(:ncol) = mf_precc_nadv(:ncol)/REAL(nadv,r8) + snow_dp_pbuf(:ncol) = mf_snow_nadv(:ncol)/REAL(nadv,r8) mf_thlforcup_nadv(:ncol,:nzt_clubb) = mf_thlforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) mf_qtforcup_nadv(:ncol,:nzt_clubb) = mf_qtforcup_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) @@ -4970,16 +4723,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qtforc_nadv(:ncol,:nzt_clubb) = mf_qtforc_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) mf_ent_nadv(:ncol,:nzm_clubb) = mf_ent_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) - s_mfup_nadv(:ncol,:nzm_clubb) = s_mfup_nadv(:ncol,:nzm_clubb)/REAL(nadv) - s_entup_nadv(:ncol,:nzm_clubb) = s_entup_nadv(:ncol,:nzm_clubb)/REAL(nadv) - s_detup_nadv(:ncol,:nzm_clubb) = s_detup_nadv(:ncol,:nzm_clubb)/REAL(nadv) - s_mfdn_nadv(:ncol,:nzm_clubb) = s_mfdn_nadv(:ncol,:nzm_clubb)/REAL(nadv) - s_entdn_nadv(:ncol,:nzm_clubb) = s_entdn_nadv(:ncol,:nzm_clubb)/REAL(nadv) - s_detdn_nadv(:ncol,:nzm_clubb) = s_detdn_nadv(:ncol,:nzm_clubb)/REAL(nadv) - s_awwup_nadv(:ncol,:nzm_clubb) = s_awwup_nadv(:ncol,:nzm_clubb)/REAL(nadv) - s_awup_nadv(:ncol,:nzm_clubb) = s_awup_nadv(:ncol,:nzm_clubb)/REAL(nadv) - mf_sqtac_nadv(:ncol,:nzt_clubb) = mf_sqtac_nadv(:ncol,:nzt_clubb)/REAL(nadv) - mf_sqtev_nadv(:ncol,:nzt_clubb) = mf_sqtev_nadv(:ncol,:nzt_clubb)/REAL(nadv) + s_mfup_nadv(:ncol,:nzm_clubb) = s_mfup_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + s_entup_nadv(:ncol,:nzm_clubb) = s_entup_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + s_detup_nadv(:ncol,:nzm_clubb) = s_detup_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + s_mfdn_nadv(:ncol,:nzm_clubb) = s_mfdn_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + s_entdn_nadv(:ncol,:nzm_clubb) = s_entdn_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + s_detdn_nadv(:ncol,:nzm_clubb) = s_detdn_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + s_awwup_nadv(:ncol,:nzm_clubb) = s_awwup_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + s_awup_nadv(:ncol,:nzm_clubb) = s_awup_nadv(:ncol,:nzm_clubb)/REAL(nadv,r8) + mf_sqtac_nadv(:ncol,:nzt_clubb) = mf_sqtac_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) + mf_sqtev_nadv(:ncol,:nzt_clubb) = mf_sqtev_nadv(:ncol,:nzt_clubb)/REAL(nadv,r8) ! accumulate in buffer ztopm1_macmic(:ncol,:) = ztopm1_macmic(:ncol,:) + mf_ztopm1_nadv(:ncol,:) @@ -5029,7 +4782,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ddcp(:ncol,:) = clubb_mf_ddalph*ddcp(:ncol,:) - end if ! if (macmic_it == cld_macmic_num_steps) + end if ! if (macmic_it == cld_macmic_num_steps) ! Need moist_qc and cloudfrac on thermo grid for output mf_qc_zt(:,:) = 0._r8 @@ -5079,14 +4832,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! average the macmic accumulators over the macmic iterations, back ! into the working arrays the population code below reads - s_mfup(:ncol,:) = s_mfup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_entup(:ncol,:) = s_entup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_detup(:ncol,:) = s_detup_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_mfdn(:ncol,:) = s_mfdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_entdn(:ncol,:) = s_entdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - s_detdn(:ncol,:) = s_detdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - mf_sqtac(:ncol,:) = mf_sqtac_macmic(:ncol,:)/REAL(cld_macmic_num_steps) - mf_sqtev(:ncol,:) = mf_sqtev_macmic(:ncol,:)/REAL(cld_macmic_num_steps) + s_mfup(:ncol,:) = s_mfup_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) + s_entup(:ncol,:) = s_entup_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) + s_detup(:ncol,:) = s_detup_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) + s_mfdn(:ncol,:) = s_mfdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) + s_entdn(:ncol,:) = s_entdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) + s_detdn(:ncol,:) = s_detdn_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) + mf_sqtac(:ncol,:) = mf_sqtac_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) + mf_sqtev(:ncol,:) = mf_sqtev_macmic(:ncol,:)/REAL(cld_macmic_num_steps,r8) ! plume top: highest kctop over all nadv/macmic sub-cycles (max, no averaging) mf_kctop(:ncol) = mf_kctop_macmic(:ncol) @@ -5572,46 +5325,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_cam_tend:do_liqsupersat') end if - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzt_clubb - 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) - - k_cam = top_lev - 1 + k - - pdfp_rtp2_output(i,k_cam) = 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 - - ! 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. - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, top_lev-1 - do i=1, ncol - upwp_pbuf(i,k) = 0._r8 - vpwp_pbuf(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_output(i,k) = 0._r8 - zi_output(i,k) = 0._r8 - khzm_pbuf(i,k) = 0._r8 - qclvar(i,k) = 2._r8 - end do - end do - - ! ------------------------------------------------------------ ! ! The rest of the code deals with diagnosing variables ! ! for microphysics/radiation computation and macrophysics ! @@ -6078,6 +5791,312 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Writing state variables after EDMF scheme for detailed analysis ! ! --------------------------------------------------------------- ! if (do_clubb_mf) then + call output_mf_diagnostics() + end if + + ! Output CLUBB history here + if (stats_metadata%l_stats) then + + do j = 1, stats_zt(1)%num_output_fields + + temp1 = trim(stats_zt(1)%file%grid_avg_var(j)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + + call outfld(trim(sub), out_zt(:,:,j), pcols, lchnk ) + enddo + + do j = 1, stats_zm(1)%num_output_fields + + temp1 = trim(stats_zm(1)%file%grid_avg_var(j)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + + call outfld(trim(sub),out_zm(:,:,j), pcols, lchnk) + enddo + + if (stats_metadata%l_output_rad_files) then + 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 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 + + 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 + call t_stopf('clubb_tend_cam:non_acc_region') + + ! Cleanup err_info + call cleanup_err_info_api(err_info) +#endif + + call t_stopf('clubb_tend_cam') + + return + + contains + +#ifdef CLUBB_SGS + + subroutine compute_mf_plumes() + implicit none + + ! Local variables restricted to the MF diagnostic plumes block + real(r8), parameter :: cflval = 1._r8 ! Upper limit on Courant number for stability + real(r8) :: lambda + character(len=256) :: lambda_errmsg + real(r8), dimension(state%ncol) :: cflfac, max_cfl, th_sfc + logical :: cfllim + integer :: i, k + + ! fields on momentum grid needed for mass flux calc. + rtm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm(:ncol,:) ) + thlm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm(:ncol,:) ) + th_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, th_zt(:ncol,:) ) + qv_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qv_zt(:ncol,:) ) + qc_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qc_zt(:ncol,:) ) + kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt(:ncol,:) ) + + do k = 1, nzm_clubb + do i = 1, ncol + invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k) * inv_p0_clubb)**kappa_zm(i,k) ) + end do + end do + + ! theta at surface needed for plume initialization. + ! gr%k_lb_zm is the surface (lower boundary) momentum index: 1 for an + ! ascending grid, nzm_clubb for a descending grid. + th_sfc(1:ncol) = cam_in%ts(1:ncol)*invrs_exner_zm(1:ncol,gr%k_lb_zm) + + ! friction velocity needed for clubb-mf + ustar2(1:ncol) = calc_friction_velocity(cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), rrho(1:ncol)) + + ! update thv if clubb is subcycled + if (t>1) then + do i = 1, ncol + thv_ds_zt(i,:) = thlm(i,:) & + + latvap*rcm(i,:)*invrs_exner_zt(i,:)/cpair + thv_ds_zt(i,:) = thv_ds_zt(i,:) & + * (1._r8+zvir*(rtm(i,:)-rcm(i,:)) - rcm(i,:)) + end do + thv_ds_zm(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thv_ds_zt(1:ncol,:) ) + end if + + ! set memory terms + mf_ztopm1(1:ncol,:) = ztopma(1:ncol,:) + mf_ddcp(1:ncol,:) = ddcp(1:ncol,:) + mf_cbm1(1:ncol) = cbm1(1:ncol) + + !--------------------------------------- integrate_mf call --------------------------------------- + ! integrate_mf expects arguments of individual columns. + ! If the column loop gets pushed into it, we can also avoid the array slicing. + + do i = 1, ncol + + call integrate_mf( nzm_clubb, nzt_clubb, dtime, & ! input + rho_zm(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + rho_zt(i,:), dz_g(i,:), zt_g(i,:), p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input + wm_zm(i,:), th_zt(i,:), qv_zt(i,:), qc_zt(i,:), & ! input + thlm_zm(i,:), rtm_zm(i,:), thv_ds_zm(i,:), & ! input + th_zm(i,:), qv_zm(i,:), qc_zm(i,:), & ! input + ustar2(i), th_sfc(i), wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input + tke_zm(i,:), tpert(i), mf_lts(i), & ! input + wpthlp_pbuf(i,:), wpthvp_pbuf(i,:), wprtp_pbuf(i,:), & ! input + mf_ztopm1(i,:), mf_ddcp(i,:), mf_cbm1(i), & ! in-out + mf_cape(i,:), & ! output + mf_upa(i,:,:), mf_dna(i,:,:), & ! output + mf_upw(i,:,:), mf_dnw(i,:,:), & ! output + mf_upmf(i,:,:), & ! output + mf_upqt(i,:,:), mf_dnqt(i,:,:), & ! output + mf_upthl(i,:,:), mf_dnthl(i,:,:), & ! output + mf_upthv(i,:,:), mf_dnthv(i,:,:), & ! output + mf_upth(i,:,:), mf_dnth(i,:,:), & ! output + mf_upqc(i,:,:), mf_dnqc(i,:,:), & ! output + mf_upbuoy(i,:,:), & ! output + mf_upent(i,:,:), & ! output + mf_updet(i,:,:), & ! output + mf_dry_a(i,:), mf_moist_a(i,:), & ! output + mf_dry_w(i,:), mf_moist_w(i,:), & ! output + mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output + mf_dry_thl(i,:), mf_moist_thl(i,:), & ! output + mf_dry_u(i,:), mf_moist_u(i,:), & ! output + mf_dry_v(i,:), mf_moist_v(i,:), & ! output + mf_moist_qc(i,:), & ! output + s_ae(i,:), & ! output + s_ac(i,:), s_aup(i,:), s_adn(i,:), & ! output + s_aw(i,:), s_awup(i,:), s_awdn(i,:), & ! output + s_aww(i,:), s_awwup(i,:), s_awwdn(i,:), & ! output + s_awthlup(i,:), s_awqtup(i,:), s_awuup(i,:), s_awvup(i,:), & ! output + s_awthldn(i,:), s_awqtdn(i,:), s_awudn(i,:), s_awvdn(i,:), & ! output + s_awthl(i,:), s_awqt(i,:), & ! output + s_awu(i,:), s_awv(i,:), & ! output + mf_thlflxup(i,:), mf_qtflxup(i,:), mf_uflxup(i,:), mf_vflxup(i,:), & ! output + mf_thlflxdn(i,:), mf_qtflxdn(i,:), mf_uflxdn(i,:), mf_vflxdn(i,:), & ! output + mf_thlflx(i,:), mf_qtflx(i,:), mf_uflx(i,:), mf_vflx(i,:), & ! output + mf_thvflx(i,:), & ! output + mf_sqtup(i,:), mf_sthlup(i,:), & ! output + mf_sqtdn(i,:), mf_sthldn(i,:), & ! output + mf_sqt(i,:), mf_sthl(i,:), & ! output + mf_sqtac(i,:), mf_sqtev(i,:), & ! output + mf_precc(i,:), & ! output + mf_ztop(i,:), mf_L0(i,:), & ! output + s_mfup(i,:), s_entup(i,:), s_detup(i,:), & ! output + s_mfdn(i,:), s_entdn(i,:), s_detdn(i,:), & ! output + mf_kctop(i) ) ! output + + end do + + !--------------------------------------- END integrate_mf call --------------------------------------- + + ! CFL limiter + cfllim = .true. + cflfac(:ncol) = 1._r8 + ! no mass flux through the ground; gr%k_lb_zm is the surface momentum + ! index (1 ascending, nzm_clubb descending) + s_aw(:ncol,gr%k_lb_zm) = 0._r8 + max_cfl(:ncol)= 0._r8 + do i=1,ncol + do k=1,nzt_clubb + max_cfl(i) = max(max_cfl(i),dtime*invrs_dz_g(i,k)*max(abs(s_aw(i,k)),abs(s_aw(i,k+1)))) + end do + if (max_cfl(i).gt.cflval.and.cfllim) cflfac(i) = cflval/max_cfl(i) + end do + + ! check for mass conservation + do k=1,nzt_clubb + do i=1,ncol + if ((-1._r8*mf_sqt(i,k)*dtime) > rtm(i,k)) then + lambda = -1._r8*rtm(i,k)/(mf_sqt(i,k)*dtime) + write(lambda_errmsg,'(a,3i6,4es16.8)') & + 'MF drying exceeds rtm. lchnk,i,k,lambda,mf_sqt,rtm,dtime = ', & + lchnk, i, k, lambda, mf_sqt(i,k), rtm(i,k), dtime + call endrun('clubb_tend_cam: '//trim(lambda_errmsg)) + end if + end do + end do + + ! pass MF turbulent advection term as CLUBB explicit forcing term + rtm_forcing(:ncol,:) = 0._r8 + thlm_forcing(:ncol,:) = 0._r8 + mf_qtforcup(:ncol,:) = 0._r8 + mf_thlforcup(:ncol,:) = 0._r8 + mf_qtforcdn(:ncol,:) = 0._r8 + mf_thlforcdn(:ncol,:) = 0._r8 + + ! pass MF turbulent advection term as CLUBB explicit forcing term + do k = 1, nzt_clubb + do i = 1, ncol + rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_qtflx(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflx(i,k))) & + + mf_sqt(i,k) + + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_thlflx(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflx(i,k))) & + + mf_sthl(i,k) + + mf_qtforcup(i,k) = mf_qtforcup(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_qtflxup(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflxup(i,k))) & + + mf_sqtup(i,k) + + mf_thlforcup(i,k) = mf_thlforcup(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_thlflxup(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflxup(i,k))) & + + mf_sthlup(i,k) + + mf_qtforcdn(i,k) = mf_qtforcdn(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_qtflxdn(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflxdn(i,k))) & + + mf_sqtdn(i,k) + + mf_thlforcdn(i,k) = mf_thlforcdn(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_thlflxdn(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflxdn(i,k))) & + + mf_sthldn(i,k) + end do + end do + + ! convective momentum transport + if (do_clubb_mf_cmt) then + um_forcing(:ncol,:) = 0._r8 + vm_forcing(:ncol,:) = 0._r8 + do k = 1, nzt_clubb + do i = 1, ncol + um_forcing(i,k) = um_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_uflx(i,k+1)) - (rho_ds_zm(i,k) * mf_uflx(i,k))) + + vm_forcing(i,k) = vm_forcing(i,k) - invrs_rho_ds_zt(i,k) * gr%grid_dir * invrs_dz_g(i,k) * cflfac(i) * & + ((rho_ds_zm(i,k+1) * mf_vflx(i,k+1)) - (rho_ds_zm(i,k) * mf_vflx(i,k))) + end do + end do + end if + + do i=1,ncol + ! compute ensemble cloud properties + mf_qc_nadv(i,:nzm_clubb) = mf_qc_nadv(i,:nzm_clubb) + mf_moist_qc(i,:nzm_clubb) + mf_rcm_nadv(i,:nzm_clubb) = mf_rcm_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb)*mf_moist_qc(i,:nzm_clubb) + mf_cloudfrac_nadv(i,:nzm_clubb) = mf_cloudfrac_nadv(i,:nzm_clubb) + mf_moist_a(i,:nzm_clubb) + + ! surface precip, [kg/m2/s]->[m/s] + mf_precc_nadv(i) = mf_precc_nadv(i) + mf_precc(i,gr%k_lb_zm)/1000._r8 + mf_snow_nadv(i) = 0._r8 + + ! accumulate the deep-hookup variables over the nadv subcycles. + ! the fractional entrainment/detrainment are RATIO diagnostics + ! (mass-flux-weighted per subcycle, denominator = mfup): near + ! plume tops the per-subcycle ratio can be immense while the + ! same subcycle's mass flux vanishes -- averaging the ratio + ! separately from the mass flux breaks that cancellation and + ! produced enormous ZM_EU values (aero_convproc courant + ! substep count exploded -> nstep-0 hang). accumulate the + ! entrainment/detrainment MASS FLUX (rate x mf, bounded) + ! instead; the population block consumes it directly. + s_mfup_nadv(i,:nzm_clubb) = s_mfup_nadv(i,:nzm_clubb) + s_mfup(i,:nzm_clubb) + s_entup_nadv(i,:nzm_clubb) = s_entup_nadv(i,:nzm_clubb) + s_entup(i,:nzm_clubb)*s_mfup(i,:nzm_clubb) + s_detup_nadv(i,:nzm_clubb) = s_detup_nadv(i,:nzm_clubb) + s_detup(i,:nzm_clubb)*s_mfup(i,:nzm_clubb) + s_mfdn_nadv(i,:nzm_clubb) = s_mfdn_nadv(i,:nzm_clubb) + s_mfdn(i,:nzm_clubb) + s_entdn_nadv(i,:nzm_clubb) = s_entdn_nadv(i,:nzm_clubb) + s_entdn(i,:nzm_clubb)*abs(s_mfdn(i,:nzm_clubb)) + s_detdn_nadv(i,:nzm_clubb) = s_detdn_nadv(i,:nzm_clubb) + s_detdn(i,:nzm_clubb)*abs(s_mfdn(i,:nzm_clubb)) + ! accumulate sum(a*w^2) and sum(a*w) of the updraft + ! ensemble so the ratio gives the mass-flux-weighted plume w + s_awwup_nadv(i,:nzm_clubb) = s_awwup_nadv(i,:nzm_clubb) + s_awwup(i,:nzm_clubb) + s_awup_nadv(i,:nzm_clubb) = s_awup_nadv(i,:nzm_clubb) + s_awup(i,:nzm_clubb) + mf_sqtac_nadv(i,:nzt_clubb) = mf_sqtac_nadv(i,:nzt_clubb) + mf_sqtac(i,:nzt_clubb) + mf_sqtev_nadv(i,:nzt_clubb) = mf_sqtev_nadv(i,:nzt_clubb) + mf_sqtev(i,:nzt_clubb) + ! kctop is not averaged: keep the HIGHEST plume top over the + ! subcycles (it doubles as the gathering/activity criterion: + ! int(kctop) > 1 means the column was active at some sub-cycle) + mf_kctop_nadv(i) = max(mf_kctop_nadv(i), mf_kctop(i)) + + mf_L0_nadv(i,:) = mf_L0_nadv(i,:) + mf_L0(i,:) + mf_ztop_nadv(i,:) = mf_ztop_nadv(i,:) + mf_ztop(i,:) + mf_ztopm1_nadv(i,:) = mf_ztopm1_nadv(i,:) + mf_ztopm1(i,:) + mf_cape_nadv(i,:) = mf_cape_nadv(i,:) + mf_cape(i,:) + mf_ddcp_nadv(i,:) = mf_ddcp_nadv(i,:) + mf_ddcp(i,:) + mf_cbm1_nadv(i) = mf_cbm1_nadv(i) + mf_cbm1(i) + + if (ANY(mf_ztop(i,:) > 0._r8)) mf_freq_nadv(i) = mf_freq_nadv(i) + 1._r8 + + mf_thlforcup_nadv(i,:nzt_clubb) = mf_thlforcup_nadv(i,:nzt_clubb) + mf_thlforcup(i,:nzt_clubb) + mf_qtforcup_nadv(i,:nzt_clubb) = mf_qtforcup_nadv(i,:nzt_clubb) + mf_qtforcup(i,:nzt_clubb) + mf_thlforcdn_nadv(i,:nzt_clubb) = mf_thlforcdn_nadv(i,:nzt_clubb) + mf_thlforcdn(i,:nzt_clubb) + mf_qtforcdn_nadv(i,:nzt_clubb) = mf_qtforcdn_nadv(i,:nzt_clubb) + mf_qtforcdn(i,:nzt_clubb) + mf_thlforc_nadv(i,:nzt_clubb) = mf_thlforc_nadv(i,:nzt_clubb) + thlm_forcing(i,:nzt_clubb) + mf_qtforc_nadv(i,:nzt_clubb) = mf_qtforc_nadv(i,:nzt_clubb) + rtm_forcing(i,:nzt_clubb) + mf_ent_nadv(i,:nzm_clubb) = mf_ent_nadv(i,:nzm_clubb) + s_awu(i,:nzm_clubb) + max_cfl_nadv(i) = MAX(max_cfl(i),max_cfl_nadv(i)) + end do + + end subroutine compute_mf_plumes + + subroutine output_mf_diagnostics() + implicit none + + integer :: k, k_clubb, k_clubb_pver + ! Initialize Output arrays mf_dry_a_output(:ncol,:) = 0._r8 mf_moist_a_output(:ncol,:) = 0._r8 @@ -6292,54 +6311,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'edmf_freq' , mf_freq_output, pcols, lchnk ) call outfld( 'edmf_cape' , mf_cape_output, pcols, lchnk ) call outfld( 'edmf_cfl' , mf_cfl_output, pcols, lchnk ) - end if ! if (do_clubb_mf) - ! Output CLUBB history here - if (stats_metadata%l_stats) then - - do j = 1, stats_zt(1)%num_output_fields - - temp1 = trim(stats_zt(1)%file%grid_avg_var(j)%name) - sub = temp1 - if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) - - call outfld(trim(sub), out_zt(:,:,j), pcols, lchnk ) - enddo - - do j = 1, stats_zm(1)%num_output_fields - - temp1 = trim(stats_zm(1)%file%grid_avg_var(j)%name) - sub = temp1 - if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) - - call outfld(trim(sub),out_zm(:,:,j), pcols, lchnk) - enddo - - if (stats_metadata%l_output_rad_files) then - 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 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 - - 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 - call t_stopf('clubb_tend_cam:non_acc_region') - - ! Cleanup err_info - call cleanup_err_info_api(err_info) + end subroutine output_mf_diagnostics #endif - call t_stopf('clubb_tend_cam') - - return - end subroutine clubb_tend_cam ! clamped linear-in-pressure interpolation of a midpoint From d636ae1137c75522e3445c6061fc45494da9b4f3 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 18 Sep 2026 23:05:10 -0600 Subject: [PATCH 46/63] fix for interpolated history tapes using extra coord dimension --- src/control/cam_history.F90 | 11 +++----- src/dynamics/se/interp_mod.F90 | 46 ++++++++++++++++++++++++++++------ 2 files changed, 42 insertions(+), 15 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 21080d3462..11c75e0798 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5414,6 +5414,7 @@ subroutine dump_field (fld, t, f, restart) pio_double, tape(t)%hlist(fld)%hbuf, varid) else ! We are doing output via the field's grid + if (interpolate) then !Determine what the output field kind should be: @@ -5423,10 +5424,6 @@ subroutine dump_field (fld, t, f, restart) ncreal = pio_real end if - mdimsize = tape(t)%hlist(fld)%field%enddim2 - tape(t)%hlist(fld)%field%begdim2 + 1 - if (mdimsize == 0) then - mdimsize = tape(t)%hlist(fld)%field%numlev - end if if (tape(t)%hlist(fld)%field%meridional_complement > 0) then compind = tape(t)%hlist(fld)%field%meridional_complement compid => tape(t)%hlist(compind)%varid(index) @@ -5434,12 +5431,12 @@ subroutine dump_field (fld, t, f, restart) call pio_setframe(tape(t)%Files(f), compid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) call write_interpolated(tape(t)%Files(f), varid, compid, & tape(t)%hlist(fld)%hbuf, tape(t)%hlist(compind)%hbuf, & - mdimsize, ncreal, fdecomp) + fdims(2:frank), ncreal, fdecomp) else if (tape(t)%hlist(fld)%field%zonal_complement <= 0) then ! Scalar field call write_interpolated(tape(t)%Files(f), varid, & - tape(t)%hlist(fld)%hbuf, mdimsize, ncreal, fdecomp) - end if + tape(t)%hlist(fld)%hbuf, fdims(2:frank), ncreal, fdecomp) + end if else if (nadims == 2) then ! Special case for 2D field (no levels) due to hbuf structure if ((tape(t)%hlist(fld)%hwrt_prec == 4) .and. (.not. restart)) then diff --git a/src/dynamics/se/interp_mod.F90 b/src/dynamics/se/interp_mod.F90 index 3092e08e03..1674c731e2 100644 --- a/src/dynamics/se/interp_mod.F90 +++ b/src/dynamics/se/interp_mod.F90 @@ -186,7 +186,7 @@ subroutine set_interp_hfile(hfilenum, interp_info) end if end subroutine set_interp_hfile - subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp_type) + subroutine write_interpolated_scalar(File, varid, fld, ext_dims, data_type, decomp_type) use pio, only: file_desc_t, var_desc_t use pio, only: iosystem_desc_t use pio, only: pio_initdecomp, pio_freedecomp @@ -213,7 +213,8 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp type(file_desc_t), intent(inout) :: File type(var_desc_t) , intent(inout) :: varid real(r8), intent(in) :: fld(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type + integer, intent(in) :: ext_dims(:) + integer, intent(in) :: data_type, decomp_type ! ! local variables ! @@ -237,6 +238,14 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp integer :: nlon, nlat, ncol, nsize, nhalo, nhcc logical :: usefillvalues character(len=*), parameter :: subname = 'write_interpolated_scalar' + integer :: numlev + + numlev = 1 + if (size(ext_dims) > 0) then + do k = 1, size(ext_dims) + numlev = numlev * ext_dims(k) + end do + end if usefillvalues=.false. @@ -384,10 +393,16 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp st = en+1 end do - if(numlev==1) then + if(size(ext_dims)==0) then call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat/), idof, iodesc) + else if(size(ext_dims)==1) then + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,ext_dims(1)/), idof, iodesc) + else if(size(ext_dims)==2) then + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,ext_dims(1),ext_dims(2)/), idof, iodesc) + else if(size(ext_dims)==3) then + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,ext_dims(1),ext_dims(2),ext_dims(3)/), idof, iodesc) else - call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,numlev/), idof, iodesc) + call endrun(subname//': too many extra dimensions') end if if(data_type == pio_real) then @@ -404,7 +419,7 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp end subroutine write_interpolated_scalar - subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, data_type, decomp_type) + subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, ext_dims, data_type, decomp_type) use pio, only: file_desc_t, var_desc_t use pio, only: iosystem_desc_t use pio, only: pio_initdecomp, pio_freedecomp @@ -432,7 +447,8 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d type(file_desc_t), intent(inout) :: File type(var_desc_t), intent(inout) :: varidu, varidv real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type + integer, intent(in) :: ext_dims(:) + integer, intent(in) :: data_type, decomp_type type(hybrid_t) :: hybrid type(io_desc_t) :: iodesc @@ -455,6 +471,14 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d real (r8) :: D(2,2) ! derivative of gnomonic mapping real (r8) :: v1,v2 character(len=*), parameter :: subname = 'write_interpolated_vector' + integer :: numlev + + numlev = 1 + if (size(ext_dims) > 0) then + do k = 1, size(ext_dims) + numlev = numlev * ext_dims(k) + end do + end if usefillvalues=.false. @@ -641,10 +665,16 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d st = en+1 end do - if(numlev==1) then + if(size(ext_dims)==0) then call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat/), idof, iodesc) + else if(size(ext_dims)==1) then + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,ext_dims(1)/), idof, iodesc) + else if(size(ext_dims)==2) then + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,ext_dims(1),ext_dims(2)/), idof, iodesc) + else if(size(ext_dims)==3) then + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,ext_dims(1),ext_dims(2),ext_dims(3)/), idof, iodesc) else - call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,numlev/), idof, iodesc) + call endrun(subname//': too many extra dimensions') end if if(data_type == pio_real) then From ba67880213091300b1fa6401d0e2d658e01f1875 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Sat, 19 Sep 2026 13:38:43 -0600 Subject: [PATCH 47/63] TR8 fix for izumi test --- src/physics/cam/clubb_mf.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 01849fe61d..33fe150587 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -454,7 +454,7 @@ subroutine integrate_mf( nzm, nzt, dtime, real(r8), dimension(nzm,clubb_mf_nup) :: uprg, dnrg ! momentum grid real(r8) :: drytot, lamk, sdnmax real(r8), parameter :: mf_dry_frac_max = 0.9_r8 ! max fractional total water removable per timestep - ! + ! ! entrainment profiles real(r8), dimension(nzt,clubb_mf_nup) :: entf, mix ! thermodynamic grid integer, dimension(nzt,clubb_mf_nup) :: enti ! thermodynamic grid @@ -514,7 +514,7 @@ subroutine integrate_mf( nzm, nzt, dtime, logical :: mf_inhibit ! rng seed real(r8), dimension(4) :: u_seed - + ! alpha relates star qunataties to stddev after Suselj etal 2019 real(r8),parameter :: alphw = 0.572_r8, & alphqt = 2.890_r8, & @@ -2153,7 +2153,7 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, else if (clubb_mf_Lopt==1) then !TKE do k = ktop-2*kdir, ksfc+kdir, -kdir - if (zm(k) < 20000 .and. tke(k) - tke(k+kdir) > 1e-5) then + if (zm(k) < 20000._r8 .and. tke(k) - tke(k+kdir) > 1e-5_r8) then ztop = zm(k) exit endif @@ -2163,7 +2163,7 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, else if (clubb_mf_Lopt==2) then !Heat flux do k = ktop-2*kdir, ksfc+kdir, -kdir - if (zm(k) < 20000 .and. abs(abs(wpthlp_env(k))-abs(wpthlp_env(k-kdir))) > 1e-4) then + if (zm(k) < 20000_r8 .and. abs(abs(wpthlp_env(k))-abs(wpthlp_env(k-kdir))) > 1e-4_r8) then ztop = zm(k) exit endif From 0cc307f8c59b1fac9e25f3ed893e77821eac97dc Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 22 Sep 2026 14:59:39 -0600 Subject: [PATCH 48/63] updates to fix interp interface calls for fv and fv3 dycores and gw_drag fix for clubb_mf deep. --- .gitmodules | 6 +++--- src/dynamics/fv/interp_mod.F90 | 7 ++++--- src/physics/cam/clubb_intr.F90 | 2 +- src/physics/cam/gw_drag_cam.F90 | 2 +- 4 files changed, 9 insertions(+), 8 deletions(-) diff --git a/.gitmodules b/.gitmodules index 6fe486cfba..4679077a5f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -43,10 +43,10 @@ [submodule "fv3"] path = src/dynamics/fv3 - url = https://github.com/ESCOMP/CAM_FV3_interface.git + url = https://github.com/jtruesdal/CAM_FV3_interface.git fxrequired = AlwaysRequired - fxtag = fv3int_061924 - fxDONOTUSEurl = https://github.com/ESCOMP/CAM_FV3_interface.git + fxtag = fv3int_092126 + fxDONOTUSEurl = https://github.com/jtruesdal/CAM_FV3_interface.git [submodule "geoschem"] path = src/chemistry/geoschem/geoschem_src diff --git a/src/dynamics/fv/interp_mod.F90 b/src/dynamics/fv/interp_mod.F90 index a36f01d731..6a038f181a 100644 --- a/src/dynamics/fv/interp_mod.F90 +++ b/src/dynamics/fv/interp_mod.F90 @@ -38,25 +38,26 @@ subroutine set_interp_hfile(hfilenum, interp_info) integer, intent(in) :: hfilenum type(interp_info_t), intent(inout) :: interp_info(:) end subroutine set_interp_hfile - - subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp_type) + subroutine write_interpolated_scalar(File, varid, fld, ext_dims, data_type, decomp_type) use pio, only : file_desc_t, var_desc_t use shr_kind_mod, only : r8=>shr_kind_r8 implicit none type(file_desc_t), intent(inout) :: File type(var_desc_t), intent(inout) :: varid real(r8), intent(in) :: fld(:,:,:) + integer, intent(in) :: ext_dims(:) integer, intent(in) :: numlev, data_type, decomp_type call endrun('This routine is a stub, you shouldnt get here') end subroutine write_interpolated_scalar - subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, data_type, decomp_type) + subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, ext_dims, data_type, decomp_type) use pio, only : file_desc_t, var_desc_t implicit none type(file_desc_t), intent(inout) :: File type(var_desc_t), intent(inout) :: varidu, varidv real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) + integer, intent(in) :: ext_dims(:) integer, intent(in) :: numlev, data_type, decomp_type call endrun('This routine is a stub, you shouldnt get here') diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 339af00dcc..e30fc70285 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -3216,7 +3216,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc err_info, err_info%err_header, & !$acc cpairv, rairv, se_dis, eleak, cld_pbuf, clubb_params_single_col, grid_dx, grid_dy ) & !$acc copyout( clubb_s, clubbtop_pbuf, & - !$acc qclvar, wprcp, rcm_in_layer, rcm, cloud_frac, thlm, rtm, & + !$acc qclvar, wprcp, rcm_in_layer, rcm, cloud_frac, thlm, rtm, qc_zt, qv_zt, th_zt, & !$acc um, vm, wm_zt, exner, zt_g, zi_g, invrs_cpairv, & !$acc rho_zm, rho_zt, & !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & diff --git a/src/physics/cam/gw_drag_cam.F90 b/src/physics/cam/gw_drag_cam.F90 index ae701f48f4..f66d04adca 100644 --- a/src/physics/cam/gw_drag_cam.F90 +++ b/src/physics/cam/gw_drag_cam.F90 @@ -558,7 +558,7 @@ subroutine gw_drag_cam_init() sgh_idx = pbuf_get_index('SGH') endif - if (use_gw_convect_dp .or. use_gw_movmtn_pbl) then + if (deep_scheme == 'ZM' .and. (use_gw_convect_dp .or. use_gw_movmtn_pbl)) then ttend_dp_idx = pbuf_get_index('TTEND_DP',errflg) end if From 0a054e19f0de3e4c340656e7c293225a200429de Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 22 Sep 2026 15:03:02 -0600 Subject: [PATCH 49/63] forgot to update src/dynamics/fv3 dir pointer for new branch --- src/dynamics/fv3 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/fv3 b/src/dynamics/fv3 index 66227690a9..46b7e3ba2a 160000 --- a/src/dynamics/fv3 +++ b/src/dynamics/fv3 @@ -1 +1 @@ -Subproject commit 66227690a9fb43a64492de32de14562a25ede717 +Subproject commit 46b7e3ba2af5f4ff92b4a437157838e70823e16c From 421bbdaf797a9d5c21e63b202d0923eb63060758 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 24 Sep 2026 20:30:41 -0600 Subject: [PATCH 50/63] PR comment mods --- src/physics/cam/clubb_mf.F90 | 229 ++++++++++++++++++++++------------- src/physics/cam/physpkg.F90 | 4 +- 2 files changed, 149 insertions(+), 84 deletions(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 33fe150587..7f80fd0bf7 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -130,6 +130,9 @@ subroutine clubb_mf_readnl(nlfile) close(iunit) end if + if (clubb_mf_Lopt < 0 .or. clubb_mf_Lopt > 8 ) & + call endrun('clubb_mf_readnl: clubb_mf_Lopt value must be between 0 and 8') + call mpi_bcast(clubb_mf_Lopt, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_Lopt") call mpi_bcast(clubb_mf_a0, 1, mpi_real8, mstrid, mpicom, ierr) @@ -515,23 +518,23 @@ subroutine integrate_mf( nzm, nzt, dtime, ! rng seed real(r8), dimension(4) :: u_seed - ! alpha relates star qunataties to stddev after Suselj etal 2019 + ! alpha relates star qunataties to stddev Suselj etal 2019 DOI: 10.1175/JAS-D-18-0239.1 real(r8),parameter :: alphw = 0.572_r8, & alphqt = 2.890_r8, & alphthv = 2.890_r8 - ! w' covariance after Suselj etal 2019 + ! w' covariance Suselj etal 2019 2019 DOI: 10.1175/JAS-D-18-0239.1 real(r8),parameter :: cwqt = 0.32_r8, & cwthv = 0.58_r8 - ! virtual mass coefficients for w-eqn after Suselj etal 2019 + ! virtual mass coefficients for w-eqn Suselj etal 2019 DOI: 10.1175/JAS-D-18-0239.1 real(r8),parameter :: wa = 1.0_r8, & wb = 1.5_r8 ! min values to avoid singularities real(r8),parameter :: wstarmin = 1.e-3_r8, & pblhmin = 100._r8 - ! evaporation efficiency after Suselj etal 2019 + ! evaporation efficiency Suselj etal 2019 DOI: 10.1175/JAS-D-18-0239.1 real(r8),parameter :: ke = 2.5e-4_r8 ! - ! height here downdrafts feel the surface + ! height where downdrafts feel the surface real(r8),parameter :: z00dn = 1.e3_r8, & tinynum = 1.e-7_r8 ! to fix entrainmnet rate @@ -572,6 +575,79 @@ subroutine integrate_mf( nzm, nzt, dtime, ! ! minimum depth of plume expressed as number of levels integer,parameter :: kspan_min = 4 + ! + ! threshold on surface buoyancy flux below which elevated ("aloft") + ! convection triggering is used instead of surface-based + real(r8), parameter :: aloft_wthv_thresh = 0.01_r8 + + ! reference pressure (Pa) used to locate the mid-troposphere level + ! for the aloft-triggering search, and as + ! the target level for RH interpolation in the rhinv predictor + real(r8), parameter :: p_midtrop = 50000._r8 + ! + ! floor on the RH-interpolation denominator (qsat) + real(r8), parameter :: qsat_floor = 1.e-30_r8 + ! + ! cap on interpolated relative humidity before inverting it into rhinv, + ! to avoid a singularity as RH -> 1 + real(r8), parameter :: rh_cap = 0.990_r8 + ! + ! lower-tropospheric-stability threshold (K) above which the marine-Sc + ! inversion is judged strong enough to inhibit the MF plume ensemble + ! entirely (mirrors the CLUBB-core expldiff criterion) + real(r8), parameter :: lts_inhibit_thresh = 20._r8 + ! + ! vertical extension depth (m) used to stretch an aloft-triggered plume + ! back down toward the surface when its launch level is within this + ! depth of the surface + real(r8), parameter :: aloft_ext_depth = 1000._r8 + ! + ! coefficient and exponent in the RH-based dynamic entrainment-length + ! diagnostic: rh_L0 = rh_L0_coef * rhinv**rh_L0_exp + real(r8), parameter :: rh_L0_coef = 50._r8 + real(r8), parameter :: rh_L0_exp = 3._r8 + ! + ! rh_L0 threshold above which do_clubb_mf_rhtke forces eturb to 1 + ! (TKE-entrainment enhancement switched off) + real(r8), parameter :: rh_L0_thresh = 733.34_r8 + ! + ! momentum entrains at a reduced rate relative to the thermodynamic + ! entrainment rate entn -- classic mass-flux assumption + real(r8), parameter :: ent_mom_reduction = 3._r8 + ! + ! sentinel "not yet reached" value for zcb (cloud-base height); + ! must be far above any physically possible height + real(r8), parameter :: zcb_unset_val = 9999999._r8 + ! + ! upper search bound (m) for locating the TKE-gradient or heat-flux- + ! gradient based L0 diagnostic (clubb_mf_Lopt 1/2) -- currently written + ! as 20000._r8 in one branch and 20000_r8 (no decimal) in the other + real(r8), parameter :: Lscale_search_top = 20000._r8 + ! + ! TKE vertical-gradient threshold (clubb_mf_Lopt==1) marking the + ! diagnosed top of the turbulent layer + real(r8), parameter :: tke_grad_thresh = 1.e-5_r8 + ! + ! heat-flux vertical-gradient threshold (clubb_mf_Lopt==2), same role + ! as tke_grad_thresh but for the heat-flux-based diagnostic + real(r8), parameter :: hflux_grad_thresh = 1.e-4_r8 + ! + ! minimum pressure (Pa) at which the dilute-CAPE calculation (Lopt 4/5) + ! is considered reliable; levels above this are excluded from the search + real(r8), parameter :: p_dilute_calc_top = 40.e2_r8 + ! + ! Pa -> hPa conversion, needed because buoyan_dilute expects hPa + real(r8), parameter :: pa_to_hpa = 0.01_r8 + ! + ! floor on the dilute-CAPE result (J/kg) used to derive ztop under + ! clubb_mf_Lopt==5 + real(r8), parameter :: cape_floor = 25._r8 + ! + ! max fixed-point iterations for the qc/T condensation solve + integer, parameter :: condensation_max_iter = 50 + ! + ! convergence tolerance on successive qc iterates + real(r8), parameter :: condensation_tol = 2.e-5_r8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! @@ -739,7 +815,7 @@ subroutine integrate_mf( nzm, nzt, dtime, if (do_clubb_mf_aspd) limarea = .true. ! unique identifier - zcb_unset = 9999999._r8 + zcb_unset = zcb_unset_val !zcb_unset_val = 9999999._r8 zcb = zcb_unset ! surface buoyancy flux @@ -752,12 +828,12 @@ subroutine integrate_mf( nzm, nzt, dtime, kpbl = kpbl + kdir end do - if (do_clubb_mf_aloft .and. wthv_sfc < 0.01_r8) then + if (do_clubb_mf_aloft .and. wthv_sfc < aloft_wthv_thresh) then ! aloft_wthv_thresh = 0.01_r8 aloft = .true. kmid = ksfcm ! Use a pressure-based criterion to locate the mid-level within the troposphere - do while (p_zm(kmid) > 500.E2_r8) + do while (p_zm(kmid) > p_midtrop) !p_midtrop = 50000._r8 kmid = kmid + kdir end do @@ -808,16 +884,16 @@ subroutine integrate_mf( nzm, nzt, dtime, tmpmq = tmpmq + rho_zt(k_rh)*dzt(k_rh)*qv(k_rh) tmpmqs = tmpmqs + rho_zt(k_rh)*dzt(k_rh)*qs_rh end do - rhlev = tmpmq/max(tmpmqs, 1.e-30_r8) + rhlev = tmpmq/max(tmpmqs, qsat_floor) !qsat_floor = 1.e-30_r8 else do k_rh = 1, nzt tmpt_rh = th(k_rh)/iexner_zt(k_rh) call qsat(tmpt_rh, p_zt(k_rh), es_rh, qs_rh) - rhprof(k_rh) = qv(k_rh)/max(qs_rh, 1.e-30_r8) + rhprof(k_rh) = qv(k_rh)/max(qs_rh, qsat_floor) !qsat_floor = 1.e-30_r8 end do - rhlev = mf_pinterp(nzt, p_zt, rhprof, 50000._r8) + rhlev = mf_pinterp(nzt, p_zt, rhprof, p_midtrop) !p_midtrop = 50000._r8 end if - if (rhlev >= 1._r8) rhlev = 0.990_r8 + if (rhlev >= 1._r8) rhlev = rh_cap ! rh_cap = 0.990_r8 if (rhlev > 0._r8) rhinv = 1._r8/((1._r8/rhlev) - 1._r8) end if @@ -828,11 +904,16 @@ subroutine integrate_mf( nzm, nzt, dtime, ! ensemble is shut off entirely and CLUBB owns the boundary layer. All ! plume outputs were zeroed above, so the inhibited column follows the ! same code path as a negatively buoyant (no-convection) one. - mf_inhibit = do_clubb_mf_invswitch .and. (lts >= 20._r8) + mf_inhibit = do_clubb_mf_invswitch .and. (lts >= lts_inhibit_thresh) ! lts_inhibit_thresh = 20._r8 - ! if surface buoyancy is positive then do mass-flux - !if ( wthv > 0._r8 ) then - if ( wthv > 0._r8 .and. wqt > 0._r8 .and. (.not. mf_inhibit) ) then + ! if no positive buoyancy and no moisture flux then return + if (.not. (wthv > 0._r8 .and. wqt > 0._r8 .and. (.not. mf_inhibit) ) ) then + + ddcp(:) = 0._r8 + ztopm1(:) = zm(ksfcm) + return + + else ! we have positive surface buoyancy and moisture flux lets do mass-flux if (do_clubb_mf_mixd) then convh = max(cbm1,pblhmin) @@ -924,10 +1005,6 @@ subroutine integrate_mf( nzm, nzt, dtime, betathl = (thv(kt+2*kdir)-thv(kt))/(0.5_r8*(dzt(kt+2*kdir)+2._r8*dzt(kt+kdir)+dzt(kt))) if (.not.aloft) then -!jt The following 2 lines I think are correct since the surface is .5 grid down from the surface dzt -!jt upqt(kstart,i)= qt(kt)-betaqt*0.5_r8*dzt(kt)+facqtu*upqt(kstart,i) -!jt upthv(kstart,i)= thv(kt)-betathl*0.5_r8*dzt(kt)+facthvu*upthv(kstart,i) -!jt The following 2 lines are to restore bfb accuracy upqt(kstart,i)= qt(kt)-betaqt*dzt(kt)+facqtu*upqt(kstart,i) upthv(kstart,i)= thv(kt)-betathl*dzt(kt)+facthvu*upthv(kstart,i) else @@ -960,7 +1037,7 @@ subroutine integrate_mf( nzm, nzt, dtime, ! if aloft extend the mass flux plume below kstart nbot levels if (aloft) then zsub = zm(kstart) - dzext = 1000._r8 + dzext = aloft_ext_depth ! aloft_ext_depth = 1000._r8 !if greater than dzext above the surface if (zsub > dzext) then ! find nbot levs below kstart @@ -1015,10 +1092,11 @@ subroutine integrate_mf( nzm, nzt, dtime, ! --------------------------------------------------------- ! ! Stochastic entrainmnet calculation ! - ! From Suselj et al 2019, after Romps and Kuang 2010 ! + ! From Suselj et al 2019 DOI: 10.1175/JAS-D-18-0239.1 ! + ! after Romps and Kuang 2010 ! ! (ideally we wouldn't fill the entire arrray w/ the RNG, ! ! but the RNG doesn't work properly when it operates on ! - ! the entire array. I'm not sure why this is happening.) ! + ! the entire array. ! ! --------------------------------------------------------- ! do k = ksfct, ktopt-kdir, kdir ! get entrainment coefficient, dz/L0 @@ -1035,7 +1113,6 @@ subroutine integrate_mf( nzm, nzt, dtime, ! get poisson, P(dz/L0) call poisson( nzt, clubb_mf_nup, ksfct, ktopt, kdir, entf, enti, u_seed ) - ! call poisson( nzt, clubb_mf_nup, entf, enti, u(clubb_mf_kseed+1:clubb_mf_kseed+4)) ! --------------------------------------------------------- ! ! Main upward sweep to compute updraft properties ! @@ -1108,9 +1185,6 @@ subroutine integrate_mf( nzm, nzt, dtime, ! ----------------------------------------------------------------- ! if (excessm*excessn > 0._r8) then xc = min(1._r8,max(0._r8,1._r8-2._r8*wa*gravit*cridis/wn**2._r8*(1._r8-thvn/thv_zm(kn)))) - aquad = 0._r8 - bquad = 0._r8 - cquad = 0._r8 else ! -------------------------------------------------- ! ! Case 2 : When either cumulus or env. is saturated. ! @@ -1124,7 +1198,7 @@ subroutine integrate_mf( nzm, nzt, dtime, ! kk=1 : Cumulus Segment, kk=2 : Environment Segment ! ! -------------------------------------------------- ! do kk = 1, 2 - if( kk .eq. 1 ) then + if( kk == 1 ) then thv_x0 = thvn thv_x1 = ( 1._r8 - 1._r8/xsat ) * thvn + ( 1._r8/xsat ) * thvxsat else @@ -1134,15 +1208,15 @@ subroutine integrate_mf( nzm, nzt, dtime, aquad = wn**2 bquad = 2._r8*wa*gravit*cridis*(thv_x1 - thv_x0)/thv_zm(kn) - 2._r8*wn**2 cquad = 2._r8*wa*gravit*cridis*(thv_x0 - thv_zm(kn))/thv_zm(kn) + wn**2 - if( kk .eq. 1 ) then - if( ( bquad**2-4._r8*aquad*cquad ) .ge. 0._r8 ) then + if( kk == 1 ) then + if( ( bquad**2-4._r8*aquad*cquad ) >= 0._r8 ) then call roots(aquad,bquad,cquad,xs1,xs2,status) x_cu = min(1._r8,max(0._r8,min(xsat,min(xs1,xs2)))) else x_cu = xsat endif else - if( ( bquad**2-4._r8*aquad*cquad) .ge. 0._r8 ) then + if( ( bquad**2-4._r8*aquad*cquad) >= 0._r8 ) then call roots(aquad,bquad,cquad,xs1,xs2,status) x_en = min(1._r8,max(0._r8,max(xsat,min(xs1,xs2)))) else @@ -1150,7 +1224,7 @@ subroutine integrate_mf( nzm, nzt, dtime, endif endif enddo - if( x_cu .eq. xsat ) then + if( x_cu == xsat ) then xc = max(x_cu, x_en) else xc = x_cu @@ -1177,8 +1251,8 @@ subroutine integrate_mf( nzm, nzt, dtime, ! --------------------------------------------------------- ! eturb = (1._r8 + clubb_mf_alphturb*sqrt(tke(k))/upw(k,i)) if (do_clubb_mf_rhtke) then - rh_L0 = 50._r8*(rhinv**3._r8) - if (rh_L0 >= 733.34_r8) eturb = 1._r8 + rh_L0 = rh_L0_coef * (rhinv**rh_L0_exp) ! rh_L0_coef = 50._r8, rh_L0_exp = 3._r8 + if (rh_L0 >= rh_L0_thresh) eturb = 1._r8 ! rh_L0_thresh = 733.34_r8 else if (dynamic_L0(i) >= clubb_mf_max_L0) eturb = 1._r8 end if @@ -1186,7 +1260,7 @@ subroutine integrate_mf( nzm, nzt, dtime, ! integrate updraft entexp = exp(-entn*eturb*dzt(kt)) - entexpu = exp(-entn*dzt(kt)/3._r8) + entexpu = exp(-entn*dzt(kt)/ent_mom_reduction) ! ent_mom_reduction = 3._r8 qtn = qt(kt) *(1._r8-entexp ) + upqt (k,i)*entexp + supqt(kt,i) thln = thl(kt)*(1._r8-entexp ) + upthl(k,i)*entexp + supthl(kt,i) @@ -1202,7 +1276,7 @@ subroutine integrate_mf( nzm, nzt, dtime, if (do_condensation) then call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & thvn, qcn, thn, qln, qin, qsn, lmixn) - if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(kn) + if (zcb(i)==zcb_unset .and. qcn > 0._r8) zcb(i) = zm(kn) else thvn = thln*(1._r8+zvir*qtn) end if @@ -1337,7 +1411,7 @@ subroutine integrate_mf( nzm, nzt, dtime, kn = k - kdir ! get rain evaporation - if ((upqs(k,i) + upqs(kn,i)).le.0._r8) then + if ((upqs(k,i) + upqs(kn,i)) <=0._r8) then qtovqs = 0._r8 else qtovqs = (upqt(k,i) + upqt(kn,i))/(upqs(k,i) + upqs(kn,i)) @@ -1472,15 +1546,15 @@ subroutine integrate_mf( nzm, nzt, dtime, ! compute the TKE entrainment enhancement locally for the downdraft. eturb = 1._r8 + clubb_mf_alphturb*sqrt(tke(k))/abs(dnw(k,i)) if (do_clubb_mf_rhtke) then - rh_L0 = 50._r8*(rhinv**3._r8) - if (rh_L0 >= 733.34_r8) eturb = 1._r8 + rh_L0 = rh_L0_coef*(rhinv**rh_L0_exp) ! rh_L0_coef = 50._r8, rh_L0_exp = 3._r8 + if (rh_L0 >= rh_L0_thresh) eturb = 1._r8 ! rh_L0_thresh = 733.34_r8 else if (dynamic_L0(i) >= clubb_mf_max_L0) eturb = 1._r8 end if eturb = min(eturb, max_eturb) entexp = exp(-1._r8*entn*eturb*dzt(kt)) - entexpu = exp(-1._r8*entn*dzt(kt)/3._r8) + entexpu = exp(-1._r8*entn*dzt(kt)/ent_mom_reduction) ! ent_mom_reduction = 3._r8 ! integrate downward dnu(kn,i) = u(kt) *(1._r8-entexpu) + dnu (k,i)*entexpu @@ -1572,8 +1646,7 @@ subroutine integrate_mf( nzm, nzt, dtime, end do!i -!+++ARH this should be changed to only zero out above the downdraft (dnw<-mindw) -!+++ARH also this should zero out dna as well + ! this should be changed to only zero out above the downdraft (dnw<-mindw) ! zero out downdraft fluxes for dnw == -mindnw do i=1,clubb_mf_nup do k=ksfcm, ktopm, kdir @@ -1755,7 +1828,7 @@ subroutine integrate_mf( nzm, nzt, dtime, ! --------------------------------------------------------- ! ! 1. Momentum Grid Accumulations (Interfaces) - ! Iterates over all interfaces (1 to 59) + ! Iterates over all interfaces do k=ksfcm, ktopm, kdir do i=1,clubb_mf_nup awup(k) = awup(k) + upa(k,i)*upw(k,i) @@ -1784,13 +1857,14 @@ subroutine integrate_mf( nzm, nzt, dtime, awv(k) = awvup(k)+ awvdn(k) enddo + ! 2. Thermodynamic Grid Accumulations (Cells) - ! Iterates over active atmospheric cells only - ! Top-Down: 58 down to 1. Bottom-Up: 2 up to nzm. + ! loop counter k used to derive + ! kt_dn (the cell) and + ! kn (the interface immediately below the cell, toward ksfcm) + ! Loop counter k range: Top-down: nzm-1 down to 1. Bottom-up: 2 up to nzm. + ! Actual cell range (kt_dn): Top-down: nzm-1 down to 1. Bottom-up: 1 up to nzm-1. do k = ksfcm+kdir, ktopm, kdir - ! The interface directly BELOW the current cell - ! In top-down (-1): cell 58 -> interface 59 - ! In bottom-up (1): cell 2 -> interface 1 kn = k - kdir kt_dn = k - (1+kdir)/2 @@ -2016,9 +2090,6 @@ subroutine integrate_mf( nzm, nzt, dtime, uflx(k) = uflxup(k) + uflxdn(k) vflx(k) = vflxup(k) + vflxdn(k) enddo - else - ddcp(:) = 0._r8 - ztopm1(:) = zm(ksfcm) end if end subroutine integrate_mf @@ -2146,44 +2217,38 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, kdir = -1 end if - if (clubb_mf_Lopt==0) then + if (clubb_mf_Lopt == 0) then !Constant L0 dynamic_L0 = clubb_mf_L0 ztop = clubb_mf_L0 - else if (clubb_mf_Lopt==1) then + else if (clubb_mf_Lopt == 1) then !TKE do k = ktop-2*kdir, ksfc+kdir, -kdir - if (zm(k) < 20000._r8 .and. tke(k) - tke(k+kdir) > 1e-5_r8) then + if (zm(k) < Lscale_search_top .and. tke(k) - tke(k+kdir) > tke_grad_thresh) then ! Lscale_search_top = 20000._r8,tke_grad_thresh = 1.e-5_r8 ztop = zm(k) exit endif enddo dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) - else if (clubb_mf_Lopt==2) then + else if (clubb_mf_Lopt == 2) then !Heat flux do k = ktop-2*kdir, ksfc+kdir, -kdir - if (zm(k) < 20000_r8 .and. abs(abs(wpthlp_env(k))-abs(wpthlp_env(k-kdir))) > 1e-4_r8) then + if (zm(k) < Lscale_search_top .and. abs(abs(wpthlp_env(k))-abs(wpthlp_env(k-kdir))) > hflux_grad_thresh) then !hflux_grad_thresh = 1.e-4_r8 ztop = zm(k) exit endif enddo dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) - else if (clubb_mf_Lopt==3) then + else if (clubb_mf_Lopt == 3) then !Test plume call oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, & wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, & wa, wb, tke, do_condensation, do_clubb_mf_precip, ztop ) dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) - !ztop = ztop - 1600._r8 - !if (ztop < 1._r8) then - ! dynamic_L0 = clubb_mf_a0 - !else - ! dynamic_L0 = min(35._r8,clubb_mf_a0*(ztop**clubb_mf_b0)) - !end if - else if (clubb_mf_Lopt==4 .or. clubb_mf_Lopt==5) then + else if (clubb_mf_Lopt == 4 .or. clubb_mf_Lopt == 5) then !dilute cape calculation !dmpdz = -1._r8*ent_zt(2:nz,:) dmpdz(:,:) = -1.E-3_r8 @@ -2197,31 +2262,31 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, end do do k = ksfc, ktop, kdir - if (p_zt(k) > 40.e2_r8) then + if (p_zt(k) > p_dilute_calc_top) then ! p_dilute_calc_top = 40.e2_r8 msg = k end if end do call buoyan_dilute(nzt, nzm, 1 ,dmpdz , & - qv ,t_zt ,p_zt*0.01_r8 ,zt ,p_zm*0.01_r8 , & + qv ,t_zt ,p_zt*pa_to_hpa ,zt ,p_zm*pa_to_hpa , & ! pa_to_hpa = 0.01_r8 tp ,qstp ,tl ,cape ,cin , & kpbl-kdir ,lcl ,lel ,lon ,mx , & msg-kdir ,tpert ,landfrac ) - mcape = max(cape(1),25._r8) + mcape = max(cape(1),cape_floor) ! cape_floor = 25._r8 - if (clubb_mf_Lopt==4) then + if (clubb_mf_Lopt == 4) then ztop = max(zt(lel(1)+kdir),convh) - else if (clubb_mf_Lopt==5) then + else if (clubb_mf_Lopt == 5) then ztop = mcape end if dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) - else if (clubb_mf_Lopt==6) then + else if (clubb_mf_Lopt == 6) then ! grab ztop from max height of ensemble in prior time-step(s) ztop = ztopm1 dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) - else if (clubb_mf_Lopt==7 .or. clubb_mf_Lopt==8) then + else if (clubb_mf_Lopt == 7 .or. clubb_mf_Lopt == 8) then ztop = rhinv dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) end if @@ -2243,9 +2308,9 @@ subroutine condensation_mf( qt, thl, p, iex, thv, qc, th, ql, qi, qs, lmix ) real(r8) :: diff,t,qstmp,qcold,es,wf logical :: noice = .true. ! max number of iterations - niter=50 + niter = condensation_max_iter ! condensation_max_iter = 50 ! minimum difference - diff=2.e-5_r8 + diff = condensation_tol ! condensation_tol = 2.e-5_r8 qc=0._r8 t=thl/iex @@ -2324,7 +2389,7 @@ end subroutine condensation_mf subroutine precip_mf(qs,qt,w,dz,dzcld,Supqt) !********************************************************************** ! Precipitation microphysics - ! By Adam Herrington, after Kay Suselj + ! By Adam Herrington, algorithm from Kay Suselj DOI: 10.1175/JAS-D-18-0239.1 !********************************************************************** real(r8),intent(in) :: qs,qt,w,dz,dzcld @@ -2356,7 +2421,7 @@ end subroutine precip_mf subroutine poisson(nz, nup, ksfc, ktop, kdir, lambda, poi, state) !********************************************************************** - ! Set a unique (but reproduceble) seed for the kiss RNG + ! Set a unique (but reproducible) seed for the kiss RNG ! Call Poisson deviate ! By Adam Herrington !********************************************************************** @@ -2507,23 +2572,23 @@ subroutine roots(a,b,c,r1,r2,status) status = 0 - if( a .eq. 0._r8 ) then ! Form b*x + c = 0 - if( b .eq. 0._r8 ) then ! Failure: c = 0 + if( a == 0._r8 ) then ! Form b*x + c = 0 + if( b == 0._r8 ) then ! Failure: c = 0 status = 1 else ! b*x + c = 0 r1 = -c/b endif r2 = r1 else - if( b .eq. 0._r8 ) then ! Form a*x**2 + c = 0 - if( a*c .gt. 0._r8 ) then ! Failure: x**2 = -c/a < 0 + if( b == 0._r8 ) then ! Form a*x**2 + c = 0 + if( a*c > 0._r8 ) then ! Failure: x**2 = -c/a < 0 status = 2 else ! x**2 = -c/a r1 = sqrt(-c/a) endif r2 = -r1 else ! Form a*x**2 + b*x + c = 0 - if( (b**2 - 4._r8*a*c) .lt. 0._r8 ) then ! Failure, no real roots + if( (b**2 - 4._r8*a*c) < 0._r8 ) then ! Failure, no real roots status = 3 else q = -0.5_r8*(b + sign(1.0_r8,b)*sqrt(b**2 - 4._r8*a*c)) @@ -2670,7 +2735,7 @@ subroutine oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl if (do_condensation) then call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & thvn, qcn, thn, qln, qin, qsn, lmixn) - if (zcb.eq.zcb_unset .and. qcn > 0._r8) zcb = zm(kn) + if (zcb == zcb_unset .and. qcn > 0._r8) zcb = zm(kn) else thvn = thln*(1._r8+zvir*qtn) end if @@ -2888,7 +2953,7 @@ subroutine buoyan_dilute( nzt, nzm, nup, dmpdz, q, t, p, z, pf, & ! skipped and cape retains initialized value of zero). ! do i = 1,nup - plge600(i) = pl(i).ge.600._r8 ! Just change to always allow buoy calculation. + plge600(i) = pl(i)>=600._r8 ! Just change to always allow buoy calculation. end do ! Main buoyancy calculation. diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 0ba3d2417b..2e329c9362 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -42,8 +42,8 @@ module physpkg use offline_driver, only: offline_driver_dorun -!+++arh clubb_mf dependency removed: CLUBB-MF is only supported with cam7 -! physics (enforced in bld/build-namelist) +! clubb_mf dependency removed: CLUBB-MF is only supported with cam7 +! physics (enforced in bld/build-namelist) implicit none private From b8d15412bcaaf2d730c0175fee2ee253b5d0c0b6 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 24 Sep 2026 20:39:43 -0600 Subject: [PATCH 51/63] add call to get_opt for deep_scheme. --- src/physics/cam/gw_drag_cam.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/physics/cam/gw_drag_cam.F90 b/src/physics/cam/gw_drag_cam.F90 index 08c0c3c1a4..4337e7d6e4 100644 --- a/src/physics/cam/gw_drag_cam.F90 +++ b/src/physics/cam/gw_drag_cam.F90 @@ -474,6 +474,7 @@ subroutine gw_drag_cam_init() character(len=cl) :: gw_drag_file_loc character(len=cl) :: gw_drag_file_mm_loc character(len=cl) :: gw_drag_file_sh_loc + character(len=16) :: deep_scheme !----------------------------------------------------------------------- @@ -551,6 +552,8 @@ subroutine gw_drag_cam_init() sgh_idx = pbuf_get_index('SGH') endif + call phys_getopts(deep_scheme_out = deep_scheme) + if (deep_scheme == 'ZM' .and. (use_gw_convect_dp .or. use_gw_movmtn_pbl)) then ttend_dp_idx = pbuf_get_index('TTEND_DP',errflg) end if From e96c82dc517d453d4bb5d901ed52d2cf00e9914e Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 24 Sep 2026 23:22:16 -0600 Subject: [PATCH 52/63] add new parameters for magic numbers --- src/physics/cam/clubb_mf.F90 | 62 +++++++++++++++++++----------------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 7f80fd0bf7..91e139eb14 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -618,36 +618,6 @@ subroutine integrate_mf( nzm, nzt, dtime, ! sentinel "not yet reached" value for zcb (cloud-base height); ! must be far above any physically possible height real(r8), parameter :: zcb_unset_val = 9999999._r8 - ! - ! upper search bound (m) for locating the TKE-gradient or heat-flux- - ! gradient based L0 diagnostic (clubb_mf_Lopt 1/2) -- currently written - ! as 20000._r8 in one branch and 20000_r8 (no decimal) in the other - real(r8), parameter :: Lscale_search_top = 20000._r8 - ! - ! TKE vertical-gradient threshold (clubb_mf_Lopt==1) marking the - ! diagnosed top of the turbulent layer - real(r8), parameter :: tke_grad_thresh = 1.e-5_r8 - ! - ! heat-flux vertical-gradient threshold (clubb_mf_Lopt==2), same role - ! as tke_grad_thresh but for the heat-flux-based diagnostic - real(r8), parameter :: hflux_grad_thresh = 1.e-4_r8 - ! - ! minimum pressure (Pa) at which the dilute-CAPE calculation (Lopt 4/5) - ! is considered reliable; levels above this are excluded from the search - real(r8), parameter :: p_dilute_calc_top = 40.e2_r8 - ! - ! Pa -> hPa conversion, needed because buoyan_dilute expects hPa - real(r8), parameter :: pa_to_hpa = 0.01_r8 - ! - ! floor on the dilute-CAPE result (J/kg) used to derive ztop under - ! clubb_mf_Lopt==5 - real(r8), parameter :: cape_floor = 25._r8 - ! - ! max fixed-point iterations for the qc/T condensation solve - integer, parameter :: condensation_max_iter = 50 - ! - ! convergence tolerance on successive qc iterates - real(r8), parameter :: condensation_tol = 2.e-5_r8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! @@ -2201,6 +2171,30 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, lon, mx, & k + ! upper search bound (m) for locating the TKE-gradient or heat-flux- + ! gradient based L0 diagnostic (clubb_mf_Lopt 1/2) -- currently written + ! as 20000._r8 in one branch and 20000_r8 (no decimal) in the other + real(r8), parameter :: Lscale_search_top = 20000._r8 + ! + ! TKE vertical-gradient threshold (clubb_mf_Lopt==1) marking the + ! diagnosed top of the turbulent layer + real(r8), parameter :: tke_grad_thresh = 1.e-5_r8 + ! + ! heat-flux vertical-gradient threshold (clubb_mf_Lopt==2), same role + ! as tke_grad_thresh but for the heat-flux-based diagnostic + real(r8), parameter :: hflux_grad_thresh = 1.e-4_r8 + ! + ! minimum pressure (Pa) at which the dilute-CAPE calculation (Lopt 4/5) + ! is considered reliable; levels above this are excluded from the search + real(r8), parameter :: p_dilute_calc_top = 40.e2_r8 + ! + ! Pa -> hPa conversion, needed because buoyan_dilute expects hPa + real(r8), parameter :: pa_to_hpa = 0.01_r8 + ! + ! floor on the dilute-CAPE result (J/kg) used to derive ztop under + ! clubb_mf_Lopt==5 + real(r8), parameter :: cape_floor = 25._r8 + ! intialize local variables cape = 0._r8 mcape = 0._r8 @@ -2307,6 +2301,14 @@ subroutine condensation_mf( qt, thl, p, iex, thv, qc, th, ql, qi, qs, lmix ) integer :: niter,i real(r8) :: diff,t,qstmp,qcold,es,wf logical :: noice = .true. + + ! + ! max fixed-point iterations for the qc/T condensation solve + integer, parameter :: condensation_max_iter = 50 + ! + ! convergence tolerance on successive qc iterates + real(r8), parameter :: condensation_tol = 2.e-5_r8 + ! max number of iterations niter = condensation_max_iter ! condensation_max_iter = 50 ! minimum difference From 13b70a52f11dda3ea32e3b2e772b85ba19c1a3d2 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 25 Sep 2026 12:36:27 -0600 Subject: [PATCH 53/63] next set of PR recommended mods, including comment and spelling cleanup, new parameters for magic numbers, fix for out of bounds array access. --- src/physics/cam/clubb_mf.F90 | 154 +++++++++++++---------------------- 1 file changed, 55 insertions(+), 99 deletions(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 91e139eb14..57aa0c484b 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -518,7 +518,7 @@ subroutine integrate_mf( nzm, nzt, dtime, ! rng seed real(r8), dimension(4) :: u_seed - ! alpha relates star qunataties to stddev Suselj etal 2019 DOI: 10.1175/JAS-D-18-0239.1 + ! alpha relates star quantities to stddev Suselj etal 2019 DOI: 10.1175/JAS-D-18-0239.1 real(r8),parameter :: alphw = 0.572_r8, & alphqt = 2.890_r8, & alphthv = 2.890_r8 @@ -555,14 +555,11 @@ subroutine integrate_mf( nzm, nzt, dtime, ! upent ~ 1/upw diverges, producing immense (finite) ratios real(r8),parameter :: mf_tiny = 1.e-12_r8 ! - ! to condensate or not to condensate - logical :: do_condensation = .true. - ! ! use implicit method for plume updraft velocity - logical :: do_implicit = .false. + logical, parameter :: do_implicit = .false. ! ! to scale surface fluxes - logical :: scalesrf = .false. + logical, parameter :: scalesrf = .false. ! ! minimum downdraft speed real(r8),parameter :: mindnw = 1.E-2_r8 @@ -876,14 +873,17 @@ subroutine integrate_mf( nzm, nzt, dtime, ! same code path as a negatively buoyant (no-convection) one. mf_inhibit = do_clubb_mf_invswitch .and. (lts >= lts_inhibit_thresh) ! lts_inhibit_thresh = 20._r8 - ! if no positive buoyancy and no moisture flux then return + ! Early return if no positive buoyancy and no moisture flux if (.not. (wthv > 0._r8 .and. wqt > 0._r8 .and. (.not. mf_inhibit) ) ) then ddcp(:) = 0._r8 ztopm1(:) = zm(ksfcm) + cbm1 = zm(ksfcm) return - else ! we have positive surface buoyancy and moisture flux lets do mass-flux + end if + + ! we have positive surface buoyancy and moisture flux lets do mass-flux if (do_clubb_mf_mixd) then convh = max(cbm1,pblhmin) @@ -988,20 +988,15 @@ subroutine integrate_mf( nzm, nzt, dtime, upmf(kstart,i) = rho_zm(kstart)*upa(kstart,i)*upw(kstart,i) ! get cloud, lowest momentum level - if (do_condensation) then - call condensation_mf(upqt(kstart,i), upthl(kstart,i), p_zm(kstart), iexner_zm(kstart), & - thvn, qcn, thn, qln, qin, qsn, lmixn) - upthv(kstart,i) = thvn - upqc(kstart,i) = qcn - upql(kstart,i) = qln - upqi(kstart,i) = qin - upqs(kstart,i) = qsn - upth(kstart,i) = thn - if (qcn > 0._r8) zcb(i) = zm(kstart) - else - ! assume no cldliq - upqc(kstart,i) = 0._r8 - end if + call condensation_mf(upqt(kstart,i), upthl(kstart,i), p_zm(kstart), iexner_zm(kstart), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + upthv(kstart,i) = thvn + upqc(kstart,i) = qcn + upql(kstart,i) = qln + upqi(kstart,i) = qin + upqs(kstart,i) = qsn + upth(kstart,i) = thn + if (qcn > 0._r8) zcb(i) = zm(kstart) end do ! if aloft extend the mass flux plume below kstart nbot levels @@ -1051,7 +1046,7 @@ subroutine integrate_mf( nzm, nzt, dtime, ! --------------------------------------------------------- ! call get_Lscale (nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, th, & wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, wa, wb, & - do_condensation, qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1(i), dynamic_L0(i), ztop(i), mcape(i)) + qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1(i), dynamic_L0(i), ztop(i), mcape(i)) ! cold pool feedback on the entrainmnet length scale dynamic_L0(i) = dynamic_L0(i) * cpfac(i) @@ -1063,10 +1058,7 @@ subroutine integrate_mf( nzm, nzt, dtime, ! --------------------------------------------------------- ! ! Stochastic entrainmnet calculation ! ! From Suselj et al 2019 DOI: 10.1175/JAS-D-18-0239.1 ! - ! after Romps and Kuang 2010 ! - ! (ideally we wouldn't fill the entire arrray w/ the RNG, ! - ! but the RNG doesn't work properly when it operates on ! - ! the entire array. ! + ! after Romps and Kuang 2010 DOI: 10.1175/2009JAS3307.1 ! ! --------------------------------------------------------- ! do k = ksfct, ktopt-kdir, kdir ! get entrainment coefficient, dz/L0 @@ -1082,6 +1074,8 @@ subroutine integrate_mf( nzm, nzt, dtime, u_seed(4) = u(ksfct + (clubb_mf_kseed + 2) * kdir) ! get poisson, P(dz/L0) + ! Ideally we would not fill the enti array above plume tops, + ! but plume tops have not yet been determined. call poisson( nzt, clubb_mf_nup, ksfct, ktopt, kdir, entf, enti, u_seed ) ! --------------------------------------------------------- ! @@ -1129,10 +1123,10 @@ subroutine integrate_mf( nzm, nzt, dtime, thln0 = thln wn0 = wn - ! --------------------------------------------------------- ! - ! Compute excess water to derive neutral mixing fraction ! - ! after Bretherton et al 2014 ! - ! --------------------------------------------------------- ! + ! --------------------------------------------------------------------------------- + ! Compute excess water to derive neutral mixing fraction ! + ! after Bretherton et al 2014 DOI 10.1175/1520-0493(2004)132<0864:ANPFSC>2.0.CO;2 ! + ! -------------------------------------------------------------------------------- ! ! qexcess of the envrionment tlm = thl_zm(kn)/iexner_zm(kn) @@ -1243,13 +1237,9 @@ subroutine integrate_mf( nzm, nzt, dtime, supthl(kt,i) = supthl(kt,i)*upw(k,i)/dzt(kt) ! get cloud, momentum levels - if (do_condensation) then - call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & - thvn, qcn, thn, qln, qin, qsn, lmixn) - if (zcb(i)==zcb_unset .and. qcn > 0._r8) zcb(i) = zm(kn) - else - thvn = thln*(1._r8+zvir*qtn) - end if + call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + if (zcb(i)==zcb_unset .and. qcn > 0._r8) zcb(i) = zm(kn) ! get buoyancy B=gravit*(0.5_r8*(thvn + upthv(k,i))/thv(kt)-1._r8) @@ -1915,6 +1905,7 @@ subroutine integrate_mf( nzm, nzt, dtime, sthl(k) = 0._r8 ztopm1(:) = zm(ksfcm) ddcp(:) = 0._r8 + cbm1 = zm(ksfcm) return end if ! height of the plume ensemble @@ -1957,6 +1948,11 @@ subroutine integrate_mf( nzm, nzt, dtime, end do end if + ! Edge case where kdbarr is still 0, plume persists through the entire column; + if (kcbarr(i) == 0) then + kcbarr(i) = ktopm ! use the model top as the cap + end if + cbm1 = cbm1 + zm(kcbarr(i)) end do @@ -1965,42 +1961,14 @@ subroutine integrate_mf( nzm, nzt, dtime, ! --------------------------------------------------------- ! ! bulk downdraft velocity for coldpool parameterization ! ! --------------------------------------------------------- ! -!+++ARH -! ! reset ddcp -! ddcp = 0._r8 -! do i=1,clubb_mf_nup -! ! find cloud base -! kcb = 0 -! do k=1,nz -! if (upqc(k,i) > 0._r8) then -! kcb = k -! exit -! end if -! end do -! -! ! reset iddcp -! iddcp = 0._r8 -! if (kcb == 0) then -! continue -! else if (kcb == 1) then -! iddcp = iddcp + dna(k,i)*dnw(k,i) -! continue -! else -! ddint = 0._r8 -! do k=1,kcb-1 -! ddint = ddint + dna(k,i)*dnw(k,i)*dzt(k+1) -! end do -! iddcp = iddcp + -1._r8*ddint/zm(kcb) -! end if -! ddcp = ddcp + iddcp -! ! -! end do -! + ! reset ddcp ddcp(:) = 0._r8 if (do_clubb_mf_coldpool .and. clubb_mf_fdd > 0._r8) then - ! use single level for cold pool param. - ! reset ddcp + ! use single level for cold pool param. note this differs from the sub-cloud mean + ! in the original implementation (Suselj et al. 2019; DOI: 10.1175/JAS-D-18-0239.1) + ! because we've implemented a different boundary condition for the downdrafts + ! to ensure they smoothly decay towards the surface using an analytical function. do i=1,clubb_mf_nup if (ddbotm(i) == 0) then continue @@ -2060,7 +2028,6 @@ subroutine integrate_mf( nzm, nzt, dtime, uflx(k) = uflxup(k) + uflxdn(k) vflx(k) = vflxup(k) + vflxdn(k) enddo - end if end subroutine integrate_mf @@ -2103,7 +2070,7 @@ end function mf_pinterp subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, th, & wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, wa, wb, & - do_condensation, qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1, dynamic_L0, ztop, mcape) + qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1, dynamic_L0, ztop, mcape) ! --------------------------------------------------------- ! ! Calculate ztop and dynamic_L based on value of namelist ! ! --------------------------------------------------------- ! @@ -2123,8 +2090,6 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, wa, wb, ztopm1, & pblh, convh, rhinv - logical, intent(in) :: do_condensation - real(r8), intent(out) :: dynamic_L0, ztop, mcape ! local variables @@ -2239,7 +2204,7 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, !Test plume call oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, & wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, & - wa, wb, tke, do_condensation, do_clubb_mf_precip, ztop ) + wa, wb, tke, do_clubb_mf_precip, ztop ) dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) else if (clubb_mf_Lopt == 4 .or. clubb_mf_Lopt == 5) then @@ -2607,7 +2572,7 @@ end subroutine roots subroutine oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, & wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, & - wa, wb, tke, do_condensation, do_precip, plumeheight ) + wa, wb, tke, do_precip, plumeheight ) !********************************************************************** ! Calculate a single plume with fixed entrainment ! to be used for a dynamic mixing length calculation @@ -2622,7 +2587,7 @@ subroutine oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl real(r8), intent(in) :: wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, & cwthv, zcb_unset, wa, wb - logical, intent(in) :: do_condensation, do_precip + logical, intent(in) :: do_precip real(r8), intent(inout) :: plumeheight @@ -2692,20 +2657,15 @@ subroutine oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl upth(ksfcm) = upthl(ksfcm) ! get cloud, lowest momentum level - if (do_condensation) then - call condensation_mf(upqt(ksfcm), upthl(ksfcm), p_zm(ksfcm), iexner_zm(ksfcm), & - thvn, qcn, thn, qln, qin, qsn, lmixn) - upthv(ksfcm) = thvn - upqc(ksfcm) = qcn - upql(ksfcm) = qln - upqi(ksfcm) = qin - upqs(ksfcm) = qsn - upth(ksfcm) = thn - if (qcn > 0._r8) zcb = zm(ksfcm) - else - ! assume no cldliq - upqc(ksfcm) = 0._r8 - end if + call condensation_mf(upqt(ksfcm), upthl(ksfcm), p_zm(ksfcm), iexner_zm(ksfcm), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + upthv(ksfcm) = thvn + upqc(ksfcm) = qcn + upql(ksfcm) = qln + upqi(ksfcm) = qin + upqs(ksfcm) = qsn + upth(ksfcm) = thn + if (qcn > 0._r8) zcb = zm(ksfcm) do k = ksfcm, ktopm-kdir, kdir kt = k - (1-kdir)/2 @@ -2734,13 +2694,9 @@ subroutine oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl supthl(kt) = supthl(kt)*upw(k)/dzt(kt) ! get cloud, momentum levels - if (do_condensation) then - call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & - thvn, qcn, thn, qln, qin, qsn, lmixn) - if (zcb == zcb_unset .and. qcn > 0._r8) zcb = zm(kn) - else - thvn = thln*(1._r8+zvir*qtn) - end if + call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + if (zcb == zcb_unset .and. qcn > 0._r8) zcb = zm(kn) ! get buoyancy B=gravit*(0.5_r8*(thvn + upthv(k))/thv(kt)-1._r8) From 9385e64f1cb17fd6a13891c757cfa6c5fadda19c Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 28 Sep 2026 22:58:03 -0600 Subject: [PATCH 54/63] PR mods, delete lopt4/5 routines, new buoyancy mixfrac routine. --- bld/namelist_files/namelist_definition.xml | 2 - src/physics/cam/clubb_intr.F90 | 2 +- src/physics/cam/clubb_mf.F90 | 1184 +++----------------- 3 files changed, 137 insertions(+), 1051 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index e4d5aae12d..b734251750 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4715,8 +4715,6 @@ Dynamic entrainment length scale option: 1: tke_clubb L0 2: wpthlp_clubb L0 3: test plume L0 -4: lel -5: cape 6: ztopm1 7: rel.hum. at 500 hPa 8: column int. rel.hum. diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 2c1792083a..690852d1c0 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1809,7 +1809,7 @@ subroutine clubb_ini_cam(pbuf_ini) if ( trim(subcol_scheme) == 'SILHS' ) then clubb_config_flags%saturation_formula = saturation_flatau else - clubb_config_flags%saturation_formula = saturation_gfdl ! Goff & Gratch (1946) approximation for SVP + clubb_config_flags%saturation_formula = saturation_gfdl ! Goff & Gratch (1946) approx for Sat Vap Pres end if ! Set up CLUBB core. Note that some of these inputs are overwritten diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 57aa0c484b..df9abb4397 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -36,8 +36,6 @@ module clubb_mf ! 1 = tke_clubb L0 ! 2 = wpthlp_clubb L0 ! 3 = test plume L0 - ! 4 = lel - ! 5 = cape ! 6 = ztopm1 ! 7 = rel.hum. at 500 hPa ! 8 = column int. rel.hum. @@ -130,8 +128,8 @@ subroutine clubb_mf_readnl(nlfile) close(iunit) end if - if (clubb_mf_Lopt < 0 .or. clubb_mf_Lopt > 8 ) & - call endrun('clubb_mf_readnl: clubb_mf_Lopt value must be between 0 and 8') + if (clubb_mf_Lopt < 0 .or. clubb_mf_Lopt == 4 .or. clubb_mf_Lopt ==5 .or. clubb_mf_Lopt > 8 ) & + call endrun('clubb_mf_readnl: clubb_mf_Lopt value must be one of 0,1,2,3,6,7,8') call mpi_bcast(clubb_mf_Lopt, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_Lopt") @@ -499,17 +497,11 @@ subroutine integrate_mf( nzm, nzt, dtime, logical :: bsort = .false. real(r8),parameter :: rle = 0.1_r8 integer :: niter_xc = 1 - integer :: kk, status, iter_xc - real(r8) :: tlm, excessm, qsm, & - tln, excessn, es, & - xc, xsat, x_en, & - x_cu, xs1, xs2, & - aquad, bquad, cquad, & - thlxsat, thvxsat, qtxsat, & - thv_x0, thv_x1, cridis, & - thln0, qtn0, wn0, & - entn, detn, mfn, & - ee2, ud2 + integer :: iter_xc + real(r8) :: es, entn, detn, mfn, ee2, ud2 + real(r8) :: thln0, qtn0, wn0 + + ! aloft trigger flag logical :: aloft = .false. @@ -1105,103 +1097,33 @@ subroutine integrate_mf( nzm, nzt, dtime, mix(kt,i) = real( enti(kt,i),r8)*clubb_mf_ent0/dzt(kt) end if + !ee2 and the plume's post-entrainment state are mutually dependent + !iterate for ee2 a few times using successive substitution do iter_xc = 1, niter_xc - if (bsort) then - if (iter_xc==1) then - qtn = upqt(k,i) - thln = upthl(k,i) - wn = upw(k,i) - else - qtn = 0.5_r8*(qtn + qtn0) - thln = 0.5_r8*(thln + thln0) - wn = 0.5_r8*(wn + wn0) - end if - - ! save this iteration - qtn0 = qtn - thln0 = thln - wn0 = wn - - ! --------------------------------------------------------------------------------- - ! Compute excess water to derive neutral mixing fraction ! - ! after Bretherton et al 2014 DOI 10.1175/1520-0493(2004)132<0864:ANPFSC>2.0.CO;2 ! - ! -------------------------------------------------------------------------------- ! - - ! qexcess of the envrionment - tlm = thl_zm(kn)/iexner_zm(kn) - call qsat(tlm,p_zm(kn),es,qsm) - excessm = qt_zm(kn) - qsm - - ! qexcess in plume - tln = thln/iexner_zm(kn) - call qsat(tln,p_zm(kn),es,qsn) - excessn = qtn - qsn - - call condensation_mf(qtn, thln, p_zm(kn), iexner_zm(kn), & - thvn, qcn, thn, qln, qin, qsn, lmixn) - - ! critical stopping distance - cridis = rle*ztopm1(i) - - ! ----------------------------------------------------------------- ! - ! Case 1 : When both cumulus and env. are unsaturated or saturated. ! - ! ----------------------------------------------------------------- ! - if (excessm*excessn > 0._r8) then - xc = min(1._r8,max(0._r8,1._r8-2._r8*wa*gravit*cridis/wn**2._r8*(1._r8-thvn/thv_zm(kn)))) - else - ! -------------------------------------------------- ! - ! Case 2 : When either cumulus or env. is saturated. ! - ! -------------------------------------------------- ! - xsat = excessn / ( excessn - excessm ); - thlxsat = thln + xsat * ( thl_zm(kn) - thln ); - qtxsat = qtn + xsat * ( qt_zm(kn) - qtn ); - call condensation_mf(qtxsat, thlxsat, p_zm(kn), iexner_zm(kn), & - thvxsat, qcn, thn, qln, qin, qsn, lmixn) - ! -------------------------------------------------- ! - ! kk=1 : Cumulus Segment, kk=2 : Environment Segment ! - ! -------------------------------------------------- ! - do kk = 1, 2 - if( kk == 1 ) then - thv_x0 = thvn - thv_x1 = ( 1._r8 - 1._r8/xsat ) * thvn + ( 1._r8/xsat ) * thvxsat - else - thv_x1 = thv_zm(kn) - thv_x0 = ( xsat / ( xsat - 1._r8 ) ) * thv_zm(kn) + ( 1._r8/( 1._r8 - xsat ) ) * thvxsat - endif - aquad = wn**2 - bquad = 2._r8*wa*gravit*cridis*(thv_x1 - thv_x0)/thv_zm(kn) - 2._r8*wn**2 - cquad = 2._r8*wa*gravit*cridis*(thv_x0 - thv_zm(kn))/thv_zm(kn) + wn**2 - if( kk == 1 ) then - if( ( bquad**2-4._r8*aquad*cquad ) >= 0._r8 ) then - call roots(aquad,bquad,cquad,xs1,xs2,status) - x_cu = min(1._r8,max(0._r8,min(xsat,min(xs1,xs2)))) - else - x_cu = xsat - endif - else - if( ( bquad**2-4._r8*aquad*cquad) >= 0._r8 ) then - call roots(aquad,bquad,cquad,xs1,xs2,status) - x_en = min(1._r8,max(0._r8,max(xsat,min(xs1,xs2)))) - else - x_en = 1._r8 - endif - endif - enddo - if( x_cu == xsat ) then - xc = max(x_cu, x_en) - else - xc = x_cu - endif - endif + if (iter_xc==1) then + qtn = upqt(k,i) + thln = upthl(k,i) + wn = upw(k,i) + else + qtn = 0.5_r8*(qtn + qtn0) + thln = 0.5_r8*(thln + thln0) + wn = 0.5_r8*(wn + wn0) + end if - ee2 = xc**2 - ud2 = 1._r8 - 2._r8*xc + xc**2 + qtn0 = qtn + thln0 = thln + wn0 = wn - ! detrainment rate + if (bsort) then + !calculate mixing fractions (ee2, ud2) given a plumes thermodynamic state + call buoyancy_sort_mixfrac( qtn, thln, wn, & + thl_zm(kn), qt_zm(kn), thv_zm(kn), & + iexner_zm(kn), p_zm(kn), ztopm1(i), & + rle, wa, & + ee2, ud2 ) detn = mix(kt,i) * ud2 - - else !no bsort + else !simple closure, mixing fractions are constants. ee2 = 1._r8 ud2 = 1._r8 end if @@ -2031,6 +1953,112 @@ subroutine integrate_mf( nzm, nzt, dtime, end subroutine integrate_mf + subroutine buoyancy_sort_mixfrac( qtn, thln, wn, & + thl_zm_kn, qt_zm_kn, thv_zm_kn, & + iexner_zm_kn, p_zm_kn, ztopm1_i, & + rle, wa, & + ee2, ud2 ) + ! =============================================================================== ! + ! Buoyancy-sorting neutral mixing fraction, after Bretherton et al 2014. ! + ! Iterates the trial (qtn,thln,wn) state internally and returns only the final ! + ! entrainment/detrainment area-fraction terms (ee2, ud2). ! + ! =============================================================================== ! + + use wv_saturation, only: qsat + + real(r8), intent(in) :: qtn, thln, wn ! this iteration's trial plume state -- caller's job to pick it + real(r8), intent(in) :: thl_zm_kn, qt_zm_kn, thv_zm_kn + real(r8), intent(in) :: iexner_zm_kn, p_zm_kn + real(r8), intent(in) :: ztopm1_i + real(r8), intent(in) :: rle, wa + + real(r8), intent(out) :: ee2, ud2 + + ! local variables + integer :: kk, status + real(r8) :: qtn0, thln0, wn0, xc + real(r8) :: tlm, es, qsm, excessm, tln, qsn, excessn + real(r8) :: thvn, qcn, thn, qln, qin, lmixn + real(r8) :: cridis, xsat, thlxsat, qtxsat, thvxsat + real(r8) :: thv_x0, thv_x1, aquad, bquad, cquad, xs1, xs2, x_cu, x_en + + + ! --------------------------------------------------------- ! + ! Compute excess water to derive neutral mixing fraction ! + ! after Bretherton et al 2014 ! + ! --------------------------------------------------------- ! + + ! qexcess of the envrionment + tlm = thl_zm_kn/iexner_zm_kn + call qsat(tlm,p_zm_kn,es,qsm) + excessm = qt_zm_kn - qsm + + ! qexcess in plume + tln = thln/iexner_zm_kn + call qsat(tln,p_zm_kn,es,qsn) + excessn = qtn - qsn + + call condensation_mf(qtn, thln, p_zm_kn, iexner_zm_kn, & + thvn, qcn, thn, qln, qin, qsn, lmixn) + + ! critical stopping distance + cridis = rle*ztopm1_i + + ! ----------------------------------------------------------------- ! + ! Case 1 : When both cumulus and env. are unsaturated or saturated. ! + ! ----------------------------------------------------------------- ! + if (excessm*excessn > 0._r8) then + xc = min(1._r8,max(0._r8,1._r8-2._r8*wa*gravit*cridis/wn**2._r8*(1._r8-thvn/thv_zm_kn))) + else + ! -------------------------------------------------- ! + ! Case 2 : When either cumulus or env. is saturated. ! + ! -------------------------------------------------- ! + xsat = excessn / ( excessn - excessm ); + thlxsat = thln + xsat * ( thl_zm_kn - thln ); + qtxsat = qtn + xsat * ( qt_zm_kn - qtn ); + call condensation_mf(qtxsat, thlxsat, p_zm_kn, iexner_zm_kn, & + thvxsat, qcn, thn, qln, qin, qsn, lmixn) + ! -------------------------------------------------- ! + ! kk=1 : Cumulus Segment, kk=2 : Environment Segment ! + ! -------------------------------------------------- ! + do kk = 1, 2 + if( kk == 1 ) then + thv_x0 = thvn + thv_x1 = ( 1._r8 - 1._r8/xsat ) * thvn + ( 1._r8/xsat ) * thvxsat + else + thv_x1 = thv_zm_kn + thv_x0 = ( xsat / ( xsat - 1._r8 ) ) * thv_zm_kn + ( 1._r8/( 1._r8 - xsat ) ) * thvxsat + endif + aquad = wn**2 + bquad = 2._r8*wa*gravit*cridis*(thv_x1 - thv_x0)/thv_zm_kn - 2._r8*wn**2 + cquad = 2._r8*wa*gravit*cridis*(thv_x0 - thv_zm_kn)/thv_zm_kn + wn**2 + if( kk == 1 ) then + if( ( bquad**2-4._r8*aquad*cquad ) >= 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_cu = min(1._r8,max(0._r8,min(xsat,min(xs1,xs2)))) + else + x_cu = xsat + endif + else + if( ( bquad**2-4._r8*aquad*cquad) >= 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_en = min(1._r8,max(0._r8,max(xsat,min(xs1,xs2)))) + else + x_en = 1._r8 + endif + endif + enddo + if( x_cu == xsat ) then + xc = max(x_cu, x_en) + else + xc = x_cu + endif + endif + + ee2 = xc**2 + ud2 = 1._r8 - 2._r8*xc + xc**2 + + end subroutine buoyancy_sort_mixfrac ! clamped linear-in-pressure interpolation of a column field ! to a target pressure level, mirroring the CLUBB-core pvertinterp @@ -2067,7 +2095,6 @@ function mf_pinterp(nz, p, fld, pout) result(val) end function mf_pinterp - subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl, th, & wmax, wmin, sigmaw, sigmaqt, sigmathv, cwqt, cwthv, zcb_unset, wa, wb, & qv, p_zt, zt, tpert, pblh, convh, rhinv, ztopm1, dynamic_L0, ztop, mcape) @@ -2149,17 +2176,9 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, ! as tke_grad_thresh but for the heat-flux-based diagnostic real(r8), parameter :: hflux_grad_thresh = 1.e-4_r8 ! - ! minimum pressure (Pa) at which the dilute-CAPE calculation (Lopt 4/5) - ! is considered reliable; levels above this are excluded from the search - real(r8), parameter :: p_dilute_calc_top = 40.e2_r8 - ! ! Pa -> hPa conversion, needed because buoyan_dilute expects hPa real(r8), parameter :: pa_to_hpa = 0.01_r8 ! - ! floor on the dilute-CAPE result (J/kg) used to derive ztop under - ! clubb_mf_Lopt==5 - real(r8), parameter :: cape_floor = 25._r8 - ! intialize local variables cape = 0._r8 mcape = 0._r8 @@ -2207,40 +2226,6 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, wa, wb, tke, do_clubb_mf_precip, ztop ) dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) - else if (clubb_mf_Lopt == 4 .or. clubb_mf_Lopt == 5) then - !dilute cape calculation - !dmpdz = -1._r8*ent_zt(2:nz,:) - dmpdz(:,:) = -1.E-3_r8 - t_zt = th/iexner_zt - landfrac = 1._r8 - - do k = ksfc+kdir, ktop, kdir - if (zt(k-kdir) <= pblh) then - kpbl = k - end if - end do - - do k = ksfc, ktop, kdir - if (p_zt(k) > p_dilute_calc_top) then ! p_dilute_calc_top = 40.e2_r8 - msg = k - end if - end do - - call buoyan_dilute(nzt, nzm, 1 ,dmpdz , & - qv ,t_zt ,p_zt*pa_to_hpa ,zt ,p_zm*pa_to_hpa , & ! pa_to_hpa = 0.01_r8 - tp ,qstp ,tl ,cape ,cin , & - kpbl-kdir ,lcl ,lel ,lon ,mx , & - msg-kdir ,tpert ,landfrac ) - - mcape = max(cape(1),cape_floor) ! cape_floor = 25._r8 - - if (clubb_mf_Lopt == 4) then - ztop = max(zt(lel(1)+kdir),convh) - else if (clubb_mf_Lopt == 5) then - ztop = mcape - end if - dynamic_L0 = clubb_mf_a0*(ztop**clubb_mf_b0) - else if (clubb_mf_Lopt == 6) then ! grab ztop from max height of ensemble in prior time-step(s) ztop = ztopm1 @@ -2298,7 +2283,7 @@ subroutine condensation_mf( qt, thl, p, iex, thv, qc, th, ql, qi, qs, lmix ) end if t = thl/iex+get_alhl(wf)/cpair*qc !as in (4) - ! qsat, p is in pascal (check!) + ! qsat, p is in pascal call qsat(t,p,es,qstmp) qcold = qc qc = max(0.5_r8*qc+0.5_r8*(qt-qstmp),0._r8) @@ -2728,901 +2713,4 @@ subroutine oneplume( nzm, nzt, zm, dzt, iexner_zm, iexner_zt, p_zm, qt, thv, thl end subroutine oneplume - -subroutine buoyan_dilute( nzt, nzm, nup, dmpdz, q, t, p, z, pf, & - tp, qstp, tl, cape, cin, pblt, lcl, lel, lon, mx, & - msg, tpert, landfrac ) -!----------------------------------------------------------------------- -! Calculates CAPE the lifting condensation level and the convective top -! where buoyancy is first -ve. -! Method: Calculates the parcel temperature based on a simple constant -! entraining plume model. CAPE is integrated from buoyancy. -! 09/09/04 - Simplest approach using an assumed entrainment rate for -! testing (dmpdp). -! 08/04/05 - Swap to convert dmpdz to dmpdp -! -! SCAM Logical Switches - DILUTE:RBN - Now Disabled -! --------------------- -! switch(1) = .T. - Uses the dilute parcel calculation to obtain tendencies. -! switch(2) = .T. - Includes entropy/q changes due to condensate loss and freezing. -! switch(3) = .T. - Adds the PBL Tpert for the parcel temperature at all levels. -! -! References: -! Raymond and Blythe (1992) JAS -! -! Author: -! Richard Neale - September 2004 -! -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! input arguments -! - integer, intent(in) :: nzt, nzm ! vertical grid sizes - integer, intent(in) :: nup ! number of plumes - - real(r8), intent(in) :: dmpdz(nzt,nup)! Parcel fractional mass entrainment rate (/m) 3D - - real(r8), intent(in) :: q(nzt) ! spec. humidity - real(r8), intent(in) :: t(nzt) ! temperature - real(r8), intent(in) :: p(nzt) ! pressure - real(r8), intent(in) :: z(nzt) ! height - real(r8), intent(in) :: pf(nzm) ! pressure at interfaces - integer, intent(in) :: pblt ! index of pbl depth - integer, intent(in) :: msg - real(r8), intent(in) :: tpert ! perturbation temperature by pbl processes - real(r8), intent(in) :: landfrac - -! output arguments - real(r8), intent(out) :: tp(nzt,nup) ! parcel temperature - real(r8), intent(out) :: qstp(nzt,nup) ! saturation mixing ratio of parcel (only above lcl, just q below). - real(r8), intent(out) :: tl(nup) ! parcel temperature at lcl - real(r8), intent(out) :: cape(nup) ! convective aval. pot. energy. - real(r8), intent(out) :: cin (nup) ! CIN - integer, intent(out) :: lcl(nup) ! - integer, intent(out) :: lel(nup) ! - integer, intent(out) :: lon ! level of onset of deep convection - integer, intent(out) :: mx ! level of max moist static energy - - !--------------------------Local Variables------------------------------ - - ! =============================================================================== ! - ! GRID ORIENTATION GENERALIZATION VARIABLES - ! ------------------------------------------------------------------------------- ! - ! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without - ! duplicating code, these variables abstract the vertical loop bounds and slices. - ! - ! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. - ! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. - ! kdir : Directional step (+1 for moving up, -1 for moving down). - ! - ! STAGGERED GRID INDEXING - ! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative - ! index of the cell center (zt) to the interface (zm) flips depending on whether - ! memory is loaded top-down or bottom-up. These variables dynamically map them: - ! - ! kt : The active thermodynamic cell center associated with the current step. - ! Upward Sweep: kt = k - (1-kdir)/2 - ! Downward Sweep: kt = k - (1+kdir)/2 - ! - ! kn : The NEXT momentum interface in the direction of the current sweep. - ! Upward Sweep: kn = k + kdir - ! Downward Sweep: kn = k - kdir - ! - ! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. - ! kt_up = k - (1-kdir)/2 - ! - ! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. - ! kt_dn = k - (1+kdir)/2 - ! =============================================================================== ! - integer :: ksfct, ktopt, kdir, kn - integer lelten(nup,mf_num_cin) - real(r8) capeten(nup,mf_num_cin) ! provisional value of cape - real(r8) cinten(nup,mf_num_cin) ! provisional value of CIN - real(r8) tv(nzt) - real(r8) tpv(nzt,nup) - real(r8) buoy(nzt,nup) - real(r8) pl(nup) - - real(r8) a1, a2, estp, plexp, hmax, hmn, y - logical plge600(nup) - integer knt(nup) - real(r8) e - integer i, k, n - - real(r8), parameter :: tiedke_add = 0.5_r8 -!----------------------------------------------------------------------- - if (z(1) < z(nzt)) then - ksfct = 1 - ktopt = nzt - kdir = 1 - else - ksfct = nzt - ktopt = 1 - kdir = -1 - end if - - do n = 1,mf_num_cin - do i = 1,nup - lelten(i,n) = ksfct - capeten(i,n) = 0._r8 - cinten (i,n) = 0._r8 - end do - end do - - lon = ksfct - mx = lon - hmax = 0._r8 - - do i = 1,nup - knt(i) = 0 - lel(i) = ksfct - cape(i) = 0._r8 - tp(:,i) = t(:) - qstp(:,i) = q(:) - end do - -!!! RBN - Initialize tv and buoy for output. -!!! tv=tv : tpv=tpv : qstp=q : buoy=0. - if (tht_tweaks) then - tv (:) = t(:) *(1._r8+q(:)/epsilo)/ (1._r8+q(:)) - else - tv (:) = t(:) *(1._r8+1.608_r8*q(:))/ (1._r8+q(:)) - endif -!-tht - do i = 1,nup - tpv (:,i) = tv(:) - end do - buoy(:,:) = 0._r8 - -! set "launching" level(mx) to be at maximum moist static energy. -! search for this level stops at planetary boundary layer top. - do k = ksfct, msg-kdir, kdir - hmn =(cpair+q(k)*cpliq)*t(k)/(1._r8+q(k)) + (1._r8+q(k)/epsilo)/(1._r8+q(k))*gravit*z(k) & - +(latvap-(cpliq-cpwv)*(t(k)-tmelt))*q(k) - if ((k - pblt)*kdir <= 0 .and. (k - lon)*kdir >= 0 .and. hmn > hmax) then - hmax = hmn - mx = k - end if - end do - -! LCL dilute calculation - initialize to mx(i) -! Determine lcl in parcel_dilute and get pl,tl after parcel_dilute -! Original code actually sets LCL as level above wher condensate forms. -! Therefore in parcel_dilute lcl(i) will be at first level where qsmix < qtmix. - - do i = 1,nup ! Initialise LCL variables. - lcl(i) = mx - tl(i) = t(mx) - pl(i) = p(mx) - end do - -! -! main buoyancy calculation. -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!! DILUTE PLUME CALCULATION USING ENTRAINING PLUME !!! - call parcel_dilute(nzt, nzm, nup, msg, mx, p, z, t, q, & - tpert, tp, tpv, qstp, pl, tl, lcl, & - landfrac, dmpdz) - -! If lcl is above the nominal level of non-divergence (600 mbs), -! no deep convection is permitted (ensuing calculations -! skipped and cape retains initialized value of zero). -! - do i = 1,nup - plge600(i) = pl(i)>=600._r8 ! Just change to always allow buoy calculation. - end do - -! Main buoyancy calculation. - do k = ksfct, msg-kdir, kdir - do i=1,nup - if ((k - mx)*kdir >= 0 .and. plge600(i)) then - if (tht_tweaks) then - tv(k) = t(k)* (1._r8+q(k)/epsilo)/ (1._r8+q(k)) !+tht - else - tv(k) = t(k)* (1._r8+1.608_r8*q(k))/ (1._r8+q(k)) !orig - endif -! +0.5K or not? (arbitrary at this point - introduce in parcel_dilute instead? tht) - buoy(k,i) = tpv(k,i) - tv(k) + tiedke_add ! +0.5K or not? - else - qstp(k,i) = q(k) - tp(k,i) = t(k) - tpv(k,i) = tv(k) - endif - end do - end do - -!------------------------------------------------------------------------------- -! beginning from one below top (first level p>40hPa, msg) check for at most -! num_cin levels of neutral buoyancy (LELten) and compute CAPEten between LCL - do k = msg-2*kdir, ksfct, -kdir - do i = 1,nup - if ((k - lcl(i))*kdir > 0 .and. plge600(i)) then - if (buoy(k-kdir,i) > 0._r8 .and. buoy(k,i) <= 0._r8) then - knt(i) = min(mf_num_cin,knt(i) + 1) - lelten(i,knt(i)) = k - end if - end if - end do - end do - -! calculate convective available potential energy (cape). - do n = 1,mf_num_cin - do k = msg-kdir, ksfct, -kdir - do i = 1,nup - if (plge600(i) .and. (k - mx)*kdir >= 0 .and. (k - lelten(i,n))*kdir < 0) then - ! Using pf(k) and pf(k+kdir). Since pf is on momentum grid (nzm=nzt+1), - ! if k ranges from 1 to nzt, k+1 ranges from 2 to nzm (valid). - ! For top-down (kdir=-1), k-1 ranges from nzt-1 to 0. - ! The interface pressure above thermo layer k is k - (1-kdir)/2 - kn = k - (1-kdir)/2 - capeten(i,n) = capeten(i,n) + rair*buoy(k,i)*abs(log(pf(kn)/pf(kn+kdir))) - cinten (i,n) = cinten (i,n) - rair*min(buoy(k,i),0._r8)*abs(log(pf(kn)/pf(kn+kdir))) - end if - end do - end do - end do - -! find maximum cape from all possible tentative capes from one sounding - do n = 1,mf_num_cin - do i = 1,nup - if (capeten(i,n) > cape(i)) then - cape(i) = capeten(i,n) - cin (i) = cinten (i,n) !+tht CIN - lel(i) = lelten(i,n) - end if - end do - end do - -! put lower bound on cape for diagnostic purposes. - do i = 1,nup - cape(i) = max(cape(i), 0._r8) - end do - -return -end subroutine buoyan_dilute - - - subroutine parcel_dilute (nzt, nzm, nup, msg, klaunch, p, z, t, q, & - tpert, tp, tpv, qstp, pl, tl, lcl, & - landfrac, dmpdz) -!-tht - -! Routine to determine -! 1. Tp - Parcel temperature -! 2. qstp - Saturated mixing ratio at the parcel temperature. - -!-------------------- -implicit none -!-------------------- - -integer, intent(in) :: nzt, nzm -integer, intent(in) :: nup -integer, intent(in) :: msg -integer, intent(in) :: klaunch - -real(r8), intent(in) :: tpert ! PBL temperature perturbation. -real(r8), intent(in) :: landfrac -real(r8), intent(in), dimension(nzt) :: p -real(r8), intent(in), dimension(nzt) :: z -real(r8), intent(in), dimension(nzt) :: t -real(r8), intent(in), dimension(nzt) :: q - -real(r8), intent(inout), dimension(nzt,nup) :: tp ! Parcel temp. -real(r8), intent(inout), dimension(nzt,nup) :: qstp ! Parcel water vapour (sat value above lcl). -real(r8), intent(inout), dimension(nup) :: tl ! Actual temp of LCL. -real(r8), intent(inout), dimension(nup) :: pl ! Actual pressure of LCL. -integer, intent(inout), dimension(nup) :: lcl ! Lifting condesation level (first model level with saturation). - -real(r8), intent(out), dimension(nzt,nup) :: tpv ! Define tpv within this routine. - -real(r8), dimension(nzt,nup) :: dmpdz ! Parcel fractional mass entrainment rate (/m) 3D - -! =============================================================================== ! -! GRID ORIENTATION GENERALIZATION VARIABLES -! ------------------------------------------------------------------------------- ! -! To support both top-down (CAM) and bottom-up (CLUBB) grid orientations without -! duplicating code, these variables abstract the vertical loop bounds and slices. -! -! ksfcm / ksfct : Index of the surface for momentum (m) and thermodynamic (t) grids. -! ktopm / ktopt : Index of the model top for momentum (m) and thermodynamic (t) grids. -! kdir : Directional step (+1 for moving up, -1 for moving down). -! -! STAGGERED GRID INDEXING -! Because momentum (zm) and thermodynamic (zt) grids are staggered, the relative -! index of the cell center (zt) to the interface (zm) flips depending on whether -! memory is loaded top-down or bottom-up. These variables dynamically map them: -! -! kt : The active thermodynamic cell center associated with the current step. -! Upward Sweep: kt = k - (1-kdir)/2 -! Downward Sweep: kt = k - (1+kdir)/2 -! -! kn : The NEXT momentum interface in the direction of the current sweep. -! Upward Sweep: kn = k + kdir -! Downward Sweep: kn = k - kdir -! -! kt_up : The thermodynamic cell center physically ABOVE momentum interface k. -! kt_up = k - (1-kdir)/2 -! -! kt_dn : The thermodynamic cell center physically BELOW momentum interface k. -! kt_dn = k - (1+kdir)/2 -! =============================================================================== ! -integer :: ksfct, ktopt, kdir - -real(r8) tmix(nzt,nup) ! Tempertaure of the entraining parcel. -real(r8) qtmix(nzt,nup) ! Total water of the entraining parcel. -real(r8) qsmix(nzt,nup) ! Saturated mixing ratio at the tmix. -real(r8) smix(nzt,nup) ! Entropy of the entraining parcel. -real(r8) xsh2o(nzt,nup) ! Precipitate lost from parcel. -real(r8) ds_xsh2o(nzt,nup) ! Entropy change due to loss of condensate. -real(r8) ds_freeze(nzt,nup) ! Entropy change sue to freezing of precip. -real(r8) dmpdz2d(nzt,nup) ! variable detrainment rate - -real(r8) zl(nup) ! lcl - -real(r8) mp(nup) ! Parcel mass flux. -real(r8) qtp(nup) ! Parcel total water. -real(r8) sp(nup) ! Parcel entropy. -real(r8) sp0(nup) ! Parcel launch entropy. -real(r8) qtp0(nup) ! Parcel launch total water. -real(r8) mp0(nup) ! Parcel launch relative mass flux. - -real(r8) lwmax ! Maximum condesate that can be held in cloud before rainout. -real(r8) dmpdp ! Parcel fractional mass entrainment rate (/mb). -real(r8) dpdz,dzdp ! Hydrstatic relation and inverse of. -real(r8) senv ! Environmental entropy at each grid point. -real(r8) qtenv ! Environmental total water " " ". -real(r8) penv ! Environmental total pressure " " ". -real(r8) zenv -real(r8) tenv ! Environmental total temperature " " ". -real(r8) new_s ! Hold value for entropy after condensation/freezing adjustments. -real(r8) new_q ! Hold value for total water after condensation/freezing adjustments. -real(r8) dp ! Layer thickness (center to center) -real(r8) tfguess ! First guess for entropy inversion - crucial for efficiency! -real(r8) tscool ! Super cooled temperature offset (in degC) (eg -35). - -real(r8) qxsk, qxskp1 ! LCL excess water (k, k+1) -real(r8) dsdp, dqtdp, dqxsdp ! LCL s, qt, p gradients (k, k+1) -real(r8) slcl,qtlcl,qslcl ! LCL s, qt, qs values. -real(r8) dmpdz_lnd, dmpdz_mask - -integer rcall ! Number of ientropy call for errors recording -integer nit_lheat ! Number of iterations for condensation/freezing loop. -integer i,k,ii ! Loop counters. - -real(r8) est - -if (z(1) < z(nzt)) then - ksfct = 1 - ktopt = nzt - kdir = 1 -else - ksfct = nzt - ktopt = 1 - kdir = -1 -end if - -nit_lheat = 2 ! iterations for ds,dq changes from condensation freezing. - -lwmax = 1.e10_r8 ! tht: don't precipitate -tscool =-10._r8 ! tht: allow even just mild supercooling?! - -qtmix=0._r8 -smix=0._r8 - -qtenv = 0._r8 -senv = 0._r8 -tenv = 0._r8 -penv = 0._r8 -zenv = 0._r8 - -qtp0 = 0._r8 -sp0 = 0._r8 -mp0 = 0._r8 - -qtp = 0._r8 -sp = 0._r8 -mp = 0._r8 - -new_q = 0._r8 -new_s = 0._r8 - -zl(:)=0._r8 - -! **** Begin loops **** - -do k = ksfct, msg-kdir, kdir - do i=1,nup - -! Initialize parcel values at launch level. - - if (k == klaunch) then - qtp0(i) = q(k) ! Parcel launch total water (assuming subsaturated) - OK????. - -!+tht: formulate dilution on enthalpy not on entropy - if (tht_tweaks) then - sp0(i) = enthalpy(t(k),p(k),qtp0(i),z(k)) ! Parcel launch enthalpy. - else - sp0(i) = entropy (t(k),p(k),qtp0(i)) ! Parcel launch entropy. - endif -!-tht - mp0(i) = 1._r8 ! Parcel launch relative mass (=1 for dmpdp=0 i.e. undilute). - smix(k,i) = sp0(i) - qtmix(k,i) = qtp0(i) -!+tht: since the function to invert for T is *identical* with sp0(i)=entropy(t), unless there is -! a coding error (likely, given the mess) the result must be t(i,k) (verified 21/2/2014) - if (tht_tweaks) then - tmix(k,i) = t(k) - call qsat_hPa(tmix(k,i),p(k), est, qsmix(k,i)) - else - tfguess = t(k) - rcall = 1 - call ientropy (rcall,smix(k,i),p(k),qtmix(k,i),tmix(k,i),qsmix(k,i),tfguess) - endif -!-tht - end if - - if ((k - klaunch)*kdir > 0) then - - dp = -abs(p(k)-p(k-kdir)) - qtenv = 0.5_r8*(q(k)+q(k-kdir)) - tenv = 0.5_r8*(t(k)+t(k-kdir)) - penv = 0.5_r8*(p(k)+p(k-kdir)) - zenv = 0.5_r8*(z(k)+z(k-kdir)) - - if (tht_tweaks) then - senv = enthalpy(tenv,penv,qtenv,zenv) ! Enthalpy of environment. - else - senv = entropy (tenv,penv,qtenv) ! Entropy of environment. - endif - -! Determine fractional entrainment rate /pa given value /m. - - dpdz = -(penv*gravit)/(rair*tenv) ! in mb/m since p in mb. - dzdp = 1._r8/dpdz ! in m/mb -!+tht -! NB: land fudge makes no sense to me - make dmpdz_lnd=dmpdz (as per default code, hard-wired to 1e-3) - !dmpdp = dmpdz*dzdp - !dmpdp = dmpdz(i)*dzdp ! /mb Fractional entrainment 2D - dmpdp = dmpdz(k,i)*dzdp ! /mb Fractional entrainment 3D -!-tht - -! Sum entrainment to current level -! entrains q,s out of intervening dp layers, in which linear variation is assumed -! so really it entrains the mean of the 2 stored values. - - sp(i) = sp(i) - dmpdp*dp*senv - qtp(i) = qtp(i) - dmpdp*dp*qtenv - mp(i) = mp(i) - dmpdp*dp - -! Entrain s and qt to next level. - - smix(k,i) = (sp0(i) + sp(i)) / (mp0(i) + mp(i)) - qtmix(k,i) = (qtp0(i) + qtp(i)) / (mp0(i) + mp(i)) - - tfguess = tmix(k-kdir,i) - rcall = 2 - - if (tht_tweaks) then - call ienthalpy(rcall,smix(k,i),p(k),z(k),qtmix(k,i),tmix(k,i),qsmix(k,i),tfguess) - else - call ientropy (rcall,smix(k,i),p(k),qtmix(k,i),tmix(k,i),qsmix(k,i),tfguess) - endif - - if (qsmix(k,i) <= qtmix(k,i) .and. qsmix(k-kdir,i) > qtmix(k-kdir,i)) then - lcl(i) = k - qxsk = qtmix(k,i) - qsmix(k,i) - qxskp1 = qtmix(k-kdir,i) - qsmix(k-kdir,i) - dqxsdp = (qxsk - qxskp1)/dp - pl(i) = p(k-kdir) - qxskp1/dqxsdp - zl(i) = z(k-kdir) - qxskp1/dqxsdp *dzdp - dsdp = (smix(k,i) - smix(k-kdir,i))/dp - dqtdp = (qtmix(k,i) - qtmix(k-kdir,i))/dp - slcl = smix(k-kdir,i) + dsdp* (pl(i)-p(k-kdir)) - qtlcl = qtmix(k-kdir,i) + dqtdp*(pl(i)-p(k-kdir)) - - tfguess = tmix(k,i) - rcall = 3 - - if (tht_tweaks) then - call ienthalpy(rcall,slcl,pl(i),zl(i),qtlcl,tl(i),qslcl,tfguess) - else - call ientropy (rcall,slcl,pl(i),qtlcl,tl(i),qslcl,tfguess) - endif - endif -! - end if ! k < klaunch - - - end do ! Levels loop -end do ! Columns loop - - -! if ( masterproc ) then -! do k = 1,msg-1 -! do i = 1,nup -! write(iulog,*) "after, k, nup, dmpdz ", k, i, dmpdz(k,i) -! end do -! end do -! end if - - -!!!!!!!!!!!!!!!!!!!!!!!!!!END ENTRAINMENT LOOP!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!! Could stop now and test with this as it will provide some estimate of buoyancy -!! without the effects of freezing/condensation taken into account for tmix. - -!! So we now have a profile of entropy and total water of the entraining parcel -!! Varying with height from the launch level klaunch parcel=environment. To the -!! top allowed level for the existence of convection. - -!! Now we have to adjust these values such that the water held in vaopor is < or -!! = to qsmix. Therefore, we assume that the cloud holds a certain amount of -!! condensate (lwmax) and the rest is rained out (xsh2o). This, obviously -!! provides latent heating to the mixed parcel and so this has to be added back -!! to it. But does this also increase qsmix as well? Also freezing processes - - -xsh2o = 0._r8 -ds_xsh2o = 0._r8 -ds_freeze = 0._r8 - -!!!!!!!!!!!!!!!!!!!!!!!!!PRECIPITATION/FREEZING LOOP!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Iterate solution twice for accuracy - - -do k = ksfct, msg-kdir, kdir - do i=1,nup - -! Initialize variables at k=klaunch - - if (k == klaunch) then - -! Set parcel values at launch level assume no liquid water. - - tp(k,i) = tmix(k,i) - qstp(k,i) = q(k) - if (tht_tweaks) then - tpv(k,i) = (tp(k,i) + tpert) * (1._r8+qstp(k,i)/epsilo) / (1._r8+qstp(k,i)) !+tht OK with mx ratio - else - tpv(k,i) = (tp(k,i) + tpert) * (1._r8+1.608_r8*qstp(k,i)) / (1._r8+qstp(k,i)) - endif - end if - - if ((k - klaunch)*kdir > 0) then - - if (tht_tweaks) then - smix(k,i)=entropy(tmix(k,i),p(k),qtmix(k,i)) !+tht make sure to use entropy here - endif - -!---- -! Initiate loop if switch(2) = .T. - RBN:DILUTE - TAKEN OUT BUT COULD BE RETURNED LATER. -! Iterate nit_lheat times for s,qt changes. - do ii=0,nit_lheat-1 - -! Rain (xsh2o) is excess condensate, bar LWMAX (Accumulated loss from qtmix). - xsh2o(k,i) = max (0._r8, qtmix(k,i) - qsmix(k,i) - lwmax) - ds_xsh2o(k,i) = ds_xsh2o(k-kdir,i) - cpliq * log (tmix(k,i)/tmelt) * max(0._r8,(xsh2o(k,i)-xsh2o(k-kdir,i))) - - if (tmix(k,i) <= tmelt+tscool .and. ds_freeze(k-kdir,i) == 0._r8) then - ds_freeze(k,i) = (latice/tmix(k,i)) * max(0._r8,qtmix(k,i)-qsmix(k,i)-xsh2o(k,i)) - end if - - if (tmix(k,i) <= tmelt+tscool .and. ds_freeze(k-kdir,i) /= 0._r8) then - ds_freeze(k,i) = ds_freeze(k-kdir,i)+(latice/tmix(k,i)) * max(0._r8,(qsmix(k-kdir,i)-qsmix(k,i))) - end if - -! Adjust entropy and accordingly to sum of ds (be careful of signs). - new_s = smix(k,i) + ds_xsh2o(k,i) + ds_freeze(k,i) - -! Adjust liquid water and accordingly to xsh2o. - new_q = qtmix(k,i) - xsh2o(k,i) - -! Invert entropy to get updated Tmix and qsmix of parcel. - - tfguess = tmix(k,i) - rcall =4 - call ientropy (rcall,new_s, p(k), new_q, tmix(k,i), qsmix(k,i), tfguess) - - end do ! Iteration loop for freezing processes. - -! tp - Parcel temp is temp of mixture. -! tpv - Parcel v. temp should be density temp with new_q total water. - - tp(k,i) = tmix(k,i) - -! tpv = tprho in the presence of condensate (i.e. when new_q > qsmix) - if (new_q > qsmix(k,i)) then ! Super-saturated so condensate present - reduces buoyancy. - qstp(k,i) = qsmix(k,i) - else ! Just saturated/sub-saturated - no condensate virtual effects. - qstp(k,i) = new_q - end if - - if (tht_tweaks) then - tpv(k,i) = (tp(k,i)+tpert)* (1._r8+qstp(k,i)/epsilo) / (1._r8+ new_q) !+tht - else - tpv(k,i) = (tp(k,i)+tpert)* (1._r8+1.608_r8*qstp(k,i)) / (1._r8+ new_q) - endif - - end if ! k > klaunch - - end do ! Loop for columns - -end do ! Loop for vertical levels. - - -return -end subroutine parcel_dilute - -!----------------------------------------------------------------------------------------- -real(r8) function entropy(TK,p,qtot) -!----------------------------------------------------------------------------------------- -! -! TK(K),p(mb),qtot(kg/kg) -! from Raymond and Blyth 1992 -! - real(r8), intent(in) :: p,qtot,TK - real(r8) :: qv,qst,e,est,L - real(r8), parameter :: pref = 1000._r8 - -L = latvap - (cpliq - cpwv)*(TK-tmelt) ! T IN CENTIGRADE - -call qsat_hPa(TK, p, est, qst) - -qv = min(qtot,qst) ! Partition qtot into vapor part only. -e = qv*p / (epsilo +qv) - -entropy = (cpair + qtot*cpliq)*log( TK/tmelt) - rair*log( (p-e)/pref ) + & - L*qv/TK - qv*rh2o*log(qv/qst) - -end FUNCTION entropy - -!----------------------------------------------------------------------------------------- -SUBROUTINE ientropy (rcall,s,p,qt,T,qst,Tfg) -!----------------------------------------------------------------------------------------- -! -! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). -! Inverts entropy, pressure and total water qt -! for T and saturated vapor mixing ratio -! - - integer, intent(in) :: rcall - real(r8), intent(in) :: s, p, Tfg, qt - real(r8), intent(out) :: qst, T - real(r8) :: est - real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol - integer :: i - - logical :: converged - - ! Max number of iteration loops. - integer, parameter :: LOOPMAX = 100 - real(r8), parameter :: EPS = 3.e-8_r8 - - converged = .false. - - ! Invert the entropy equation -- use Brent's method - ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. - - T = Tfg ! Better first guess based on Tprofile from conv. - - a = Tfg-10 !low bracket - b = Tfg+10 !high bracket - - fa = entropy(a, p, qt) - s - fb = entropy(b, p, qt) - s - - c=b - fc=fb - tol=0.001_r8 - - converge: do i=0, LOOPMAX - if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & - (fb < 0.0_r8 .and. fc < 0.0_r8)) then - c=a - fc=fa - d=b-a - ebr=d - end if - if (abs(fc) < abs(fb)) then - a=b - b=c - c=a - fa=fb - fb=fc - fc=fa - end if - - tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol - xm=0.5_r8*(c-b) - converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) - if (converged) exit converge - - if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then - sbr=fb/fa - if (a == c) then - pbr=2.0_r8*xm*sbr - qbr=1.0_r8-sbr - else - qbr=fa/fc - rbr=fb/fc - pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) - qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) - end if - if (pbr > 0.0_r8) qbr=-qbr - pbr=abs(pbr) - if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then - ebr=d - d=pbr/qbr - else - d=xm - ebr=d - end if - else - d=xm - ebr=d - end if - a=b - fa=fb - b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) - - fb = entropy(b, p, qt) - s - - end do converge - - T = b - call qsat_hPa(T, p, est, qst) - - if (.not. converged) then - call endrun('**** ZM_CONV IENTROPY: Tmix did not converge ****') - end if - -100 format (A,I1,I4,I4,7(A,F6.2)) - -end SUBROUTINE ientropy - -! Wrapper for qsat_water that does translation between Pa and hPa -! qsat_water uses Pa internally, so get it right, need to pass in Pa. -! Afterward, set es back to hPa. -subroutine qsat_hPa(t, p, es, qm) - use wv_saturation, only: qsat_water - - ! Inputs - real(r8), intent(in) :: t ! Temperature (K) - real(r8), intent(in) :: p ! Pressure (hPa) - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure (hPa) - real(r8), intent(out) :: qm ! Saturation mass mixing ratio - ! (vapor mass over dry mass, kg/kg) - - call qsat_water(t, p*100._r8, es, qm) - - es = es*0.01_r8 - -end subroutine qsat_hPa - -!----------------------------------------------------------------------------------------- -real(r8) function enthalpy(TK,p,qtot,z) -!----------------------------------------------------------------------------------------- -! -! TK(K),p(mb),qtot(kg/kg) -! - real(r8), intent(in) :: p,qtot,TK,z - real(r8) :: qv,qst,e,est,L - -L = latvap - (cpliq - cpwv)*(TK-tmelt) - -call qsat_hPa(TK, p, est, qst) -qv = min(qtot,qst) ! Partition qtot into vapor part only. - - enthalpy = (cpair + qtot*cpliq)* TK + L*qv + (1._r8+qtot)*gravit*z - -return -end FUNCTION enthalpy - -!----------------------------------------------------------------------------------------- - SUBROUTINE ienthalpy (rcall,s,p,z,qt,T,qst,Tfg) !identical with iENTROPY, only function calls swapped -!----------------------------------------------------------------------------------------- -! -! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). -! Inverts entropy, pressure and total water qt -! for T and saturated vapor mixing ratio -! - - integer, intent(in) :: rcall - real(r8), intent(in) :: s, p, z, Tfg, qt - real(r8), intent(out) :: qst, T - real(r8) :: est - real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol - integer :: i - - logical :: converged - - ! Max number of iteration loops. - integer, parameter :: LOOPMAX = 100 - real(r8), parameter :: EPS = 3.e-8_r8 - - converged = .false. - - ! Invert the entropy equation -- use Brent's method - ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. - - T = Tfg ! Better first guess based on Tprofile from conv. - - a = Tfg-10 !low bracket - b = Tfg+10 !high bracket - - fa = enthalpy(a, p, qt,z) - s - fb = enthalpy(b, p, qt,z) - s - - c=b - fc=fb - tol=0.001_r8 - - converge: do i=0, LOOPMAX - if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & - (fb < 0.0_r8 .and. fc < 0.0_r8)) then - c=a - fc=fa - d=b-a - ebr=d - end if - if (abs(fc) < abs(fb)) then - a=b - b=c - c=a - fa=fb - fb=fc - fc=fa - end if - - tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol - xm=0.5_r8*(c-b) - converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) - if (converged) exit converge - - if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then - sbr=fb/fa - if (a == c) then - pbr=2.0_r8*xm*sbr - qbr=1.0_r8-sbr - else - qbr=fa/fc - rbr=fb/fc - pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) - qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) - end if - if (pbr > 0.0_r8) qbr=-qbr - pbr=abs(pbr) - if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then - ebr=d - d=pbr/qbr - else - d=xm - ebr=d - end if - else - d=xm - ebr=d - end if - a=b - fa=fb - b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) - - fb = enthalpy(b, p, qt,z) - s - - end do converge - - T = b - call qsat_hPa(T, p, est, qst) - - if (.not. converged) then - call endrun('**** ZM_CONV IENTHALPY: Tmix did not converge ****') - end if - -100 format (A,I1,I4,I4,7(A,F6.2)) - - end SUBROUTINE ienthalpy - end module clubb_mf From 5f1e4744b5cfb4d6fdcc12f83b57c750185e1c9d Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 30 Sep 2026 10:21:54 -0600 Subject: [PATCH 55/63] PR updated comments and removed nlev from interp_mod fv3 interface --- .gitmodules | 2 +- src/dynamics/fv3 | 2 +- src/physics/cam/clubb_mf.F90 | 1 + 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index ec86480087..fe0d868fbd 100644 --- a/.gitmodules +++ b/.gitmodules @@ -45,7 +45,7 @@ path = src/dynamics/fv3 url = https://github.com/jtruesdal/CAM_FV3_interface.git fxrequired = AlwaysRequired - fxtag = fv3int_092126 + fxtag = fv3int_093026 fxDONOTUSEurl = https://github.com/jtruesdal/CAM_FV3_interface.git [submodule "geoschem"] diff --git a/src/dynamics/fv3 b/src/dynamics/fv3 index 46b7e3ba2a..b765d62a18 160000 --- a/src/dynamics/fv3 +++ b/src/dynamics/fv3 @@ -1 +1 @@ -Subproject commit 46b7e3ba2af5f4ff92b4a437157838e70823e16c +Subproject commit b765d62a1848ea15ca7c1ccfed602d8efbcb8273 diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index df9abb4397..a853e5a6d5 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1960,6 +1960,7 @@ subroutine buoyancy_sort_mixfrac( qtn, thln, wn, & ee2, ud2 ) ! =============================================================================== ! ! Buoyancy-sorting neutral mixing fraction, after Bretherton et al 2014. ! + ! DOI: 10.1175/1520-0493(2004)132<0864:ANPFSC>2.0.CO;2 ! ! Iterates the trial (qtn,thln,wn) state internally and returns only the final ! ! entrainment/detrainment area-fraction terms (ee2, ud2). ! ! =============================================================================== ! From 1a570f2c64e57d7ea0d4f47805e71da91215f100 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 30 Sep 2026 15:25:25 -0600 Subject: [PATCH 56/63] PR updates to remove a bad comment and unused parameter --- src/physics/cam/clubb_intr.F90 | 1 - src/physics/cam/clubb_mf.F90 | 3 --- 2 files changed, 4 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 690852d1c0..aa96593ce2 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -688,7 +688,6 @@ subroutine clubb_register_cam( ) call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), ice_supersat_idx) if (do_clubb_mf) then - ! note that the extra coord dim doesn't seem to work for interpolate_output=.true. call add_hist_coord('nens', clubb_mf_nup, 'clubb+mf ensemble size') call pbuf_add_field('ZTOPMN' ,'global' , dtype_r8, (/clubb_mf_up_ndt,pcols,clubb_mf_nup/), ztopmn_idx) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index a853e5a6d5..10ae537bb6 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -2177,9 +2177,6 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, ! as tke_grad_thresh but for the heat-flux-based diagnostic real(r8), parameter :: hflux_grad_thresh = 1.e-4_r8 ! - ! Pa -> hPa conversion, needed because buoyan_dilute expects hPa - real(r8), parameter :: pa_to_hpa = 0.01_r8 - ! ! intialize local variables cape = 0._r8 mcape = 0._r8 From d303296dfa0ef07a1b2412ba1d35f365f1977614 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 2 Oct 2026 00:29:30 -0600 Subject: [PATCH 57/63] PR comment update and bug fix for fv interp_mod --- src/dynamics/fv/interp_mod.F90 | 4 ++-- src/physics/cam/clubb_mf.F90 | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/dynamics/fv/interp_mod.F90 b/src/dynamics/fv/interp_mod.F90 index 6a038f181a..86f1eeacb9 100644 --- a/src/dynamics/fv/interp_mod.F90 +++ b/src/dynamics/fv/interp_mod.F90 @@ -46,7 +46,7 @@ subroutine write_interpolated_scalar(File, varid, fld, ext_dims, data_type, deco type(var_desc_t), intent(inout) :: varid real(r8), intent(in) :: fld(:,:,:) integer, intent(in) :: ext_dims(:) - integer, intent(in) :: numlev, data_type, decomp_type + integer, intent(in) :: data_type, decomp_type call endrun('This routine is a stub, you shouldnt get here') end subroutine write_interpolated_scalar @@ -58,7 +58,7 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, ext_dims, type(var_desc_t), intent(inout) :: varidu, varidv real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) integer, intent(in) :: ext_dims(:) - integer, intent(in) :: numlev, data_type, decomp_type + integer, intent(in) :: data_type, decomp_type call endrun('This routine is a stub, you shouldnt get here') end subroutine write_interpolated_vector diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 10ae537bb6..ed3dd20fb2 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1959,7 +1959,7 @@ subroutine buoyancy_sort_mixfrac( qtn, thln, wn, & rle, wa, & ee2, ud2 ) ! =============================================================================== ! - ! Buoyancy-sorting neutral mixing fraction, after Bretherton et al 2014. ! + ! Buoyancy-sorting neutral mixing fraction, after Bretherton et al 2004. ! ! DOI: 10.1175/1520-0493(2004)132<0864:ANPFSC>2.0.CO;2 ! ! Iterates the trial (qtn,thln,wn) state internally and returns only the final ! ! entrainment/detrainment area-fraction terms (ee2, ud2). ! @@ -1986,7 +1986,8 @@ subroutine buoyancy_sort_mixfrac( qtn, thln, wn, & ! --------------------------------------------------------- ! ! Compute excess water to derive neutral mixing fraction ! - ! after Bretherton et al 2014 ! + ! after Bretherton et al 2004 ! + ! DOI: 10.1175/1520-0493(2004)132<0864:ANPFSC>2.0.CO;2 ! ! --------------------------------------------------------- ! ! qexcess of the envrionment From ea791386236861b8d72d2fdddea56c60e70e5a8a Mon Sep 17 00:00:00 2001 From: adamrher Date: Tue, 6 Oct 2026 14:09:32 -0600 Subject: [PATCH 58/63] replace downdraft clamp --- src/physics/cam/clubb_mf.F90 | 22 +++++++++------------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index ed3dd20fb2..e32d5cb0eb 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1514,12 +1514,19 @@ subroutine integrate_mf( nzm, nzt, dtime, end if wn2 = max(wn2,mindnw**2._r8) dnw(kn,i) = -1._r8*sqrt(wn2) - else + ! analytical taper in sub-cloud layer to + ! avoid unphysical flux divergence near surface zsub = zm(ddbotm(i)+kdir) wcb = dnw(ddbotm(i)+kdir,i) dnw(kn,i) = wcb - (wcb/(zsub**clubb_mf_ddexp))*(zsub - zm(kn))**clubb_mf_ddexp - dnw(kn,i) = min(dnw(kn,i),-1._r8*mindnw) + if (dnw(kn,i) >= -1._r8*mindnw) then + ! sub-cloud profile has decayed to the velocity floor: the downdraft + ! ends here. Levels below keep their zero initialization. + dnw(kn,i) = 0._r8 + dna(kn,i) = 0._r8 + exit + end if end if end do!k @@ -1528,17 +1535,6 @@ subroutine integrate_mf( nzm, nzt, dtime, end do!i - ! this should be changed to only zero out above the downdraft (dnw<-mindw) - ! zero out downdraft fluxes for dnw == -mindnw - do i=1,clubb_mf_nup - do k=ksfcm, ktopm, kdir - if ( dnw(k,i) == -1._r8*mindnw ) then - dnw(k,i) = 0._r8 - dna(k,i) = 0._r8 - end if - end do - end do - end if ! end computing downdrafts From 6f8a35cf846f5fe3b9c8434bc8d4b7118e643c63 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 7 Oct 2026 12:55:55 -0600 Subject: [PATCH 59/63] updates for issue 1590 and needed to update one pbuf_get_field for cam6_4_204 leapfrog mods. --- src/physics/cam/clubb_intr.F90 | 6 +++--- src/physics/cam7/physpkg.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index d76e46ac3b..1f6e4bce96 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -167,8 +167,8 @@ module clubb_intr ! This is mainly for testing, it should not significantly change answers logical :: lq(pcnst) - logical :: do_rainturb - logical :: clubb_do_adv + logical :: do_rainturb = .false. + logical :: clubb_do_adv = .false. logical :: clubb_do_liqsupersat = .false. logical :: clubb_do_energyfix = .true. integer :: edsclr_dim ! Number of scalars to transport in CLUBB @@ -3579,7 +3579,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Note that some of the moments below can be positive or negative. ! Remove a constant that was added to prevent dynamics from clipping ! them to prevent dynamics from making them positive. - do k = 1, nzm_clubb + do k = 1, nzt_clubb do i = 1, ncol k_cam = top_lev - 1 + k rtpthlp_pbuf(i,k) = state_loc%q(i,k_cam,ixrtpthlp) - ( rtpthlp_const * apply_const ) diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index a63bd246f2..a30bd25857 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -1626,7 +1626,7 @@ subroutine tphysac (ztodt, cam_in, & ifld = pbuf_get_index('ICWMRDP') call pbuf_get_field(pbuf, ifld, dp_icwmr) ifld = pbuf_get_index('CONCLD') - call pbuf_get_field(pbuf, ifld, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, ifld, concld, start=(/1,1/), kount=(/pcols,pver/)) end if if (dlfzm_idx > 0) then From c18d090d97fc56470649d2938d6388a09f9f2200 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 7 Oct 2026 13:35:52 -0600 Subject: [PATCH 60/63] Removed a comment that tripped up the NAG r8-tagged-literal check --- src/physics/cam/clubb_mf.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index e32d5cb0eb..df3a55a337 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1516,7 +1516,7 @@ subroutine integrate_mf( nzm, nzt, dtime, dnw(kn,i) = -1._r8*sqrt(wn2) else ! analytical taper in sub-cloud layer to - ! avoid unphysical flux divergence near surface + ! avoid unphysical flux divergence near surface zsub = zm(ddbotm(i)+kdir) wcb = dnw(ddbotm(i)+kdir,i) dnw(kn,i) = wcb - (wcb/(zsub**clubb_mf_ddexp))*(zsub - zm(kn))**clubb_mf_ddexp @@ -2162,8 +2162,7 @@ subroutine get_Lscale(nzt, nzm, zm, tke, wpthlp_env, dzt, iexner_zm, iexner_zt, k ! upper search bound (m) for locating the TKE-gradient or heat-flux- - ! gradient based L0 diagnostic (clubb_mf_Lopt 1/2) -- currently written - ! as 20000._r8 in one branch and 20000_r8 (no decimal) in the other + ! gradient based L0 diagnostic real(r8), parameter :: Lscale_search_top = 20000._r8 ! ! TKE vertical-gradient threshold (clubb_mf_Lopt==1) marking the @@ -2457,6 +2456,7 @@ subroutine hormann(kiss_gen,lambda,kout) ! Implements Poisson Transformed Rejection with Squeeze (PTRS) ! from W. Hormann Insurance: Mathematics and Economics 12, 39-45 (1993) ! By Jake Reschke + ! DOI: 10.1016/0167-6687(93)90997-4 !********************************************************************** use shr_RandNum_mod, only: ShrKissRandGen From 0d62530cc72aae9e48864d5fe8188e2c84925c73 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 7 Oct 2026 21:51:09 -0600 Subject: [PATCH 61/63] testlist clubbmf test requires cam7 changed FHIST TO FHISTC_LTso, added mpass interp_mod.F90 api changes to match required mods for PR1576 --- cime_config/testdefs/testlist_cam.xml | 2 +- src/dynamics/mpas/interp_mod.F90 | 10 ++++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index f19dc37544..1fbd055167 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -168,7 +168,7 @@ - + diff --git a/src/dynamics/mpas/interp_mod.F90 b/src/dynamics/mpas/interp_mod.F90 index f22883ee4f..dc2c9665a2 100644 --- a/src/dynamics/mpas/interp_mod.F90 +++ b/src/dynamics/mpas/interp_mod.F90 @@ -58,12 +58,13 @@ end subroutine set_interp_hfile !========================================================================================= -subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp_type) +subroutine write_interpolated_scalar(File, varid, fld, ext_dims, data_type, decomp_type) type(file_desc_t), intent(inout) :: File type(var_desc_t), intent(inout) :: varid real(r8), intent(in) :: fld(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type + integer, intent(in) :: ext_dims(:) + integer, intent(in) :: data_type, decomp_type !---------------------------------------------------------------------------- @@ -74,12 +75,13 @@ end subroutine write_interpolated_scalar !========================================================================================= subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, & - numlev, data_type, decomp_type) + ext_dims, data_type, decomp_type) type(file_desc_t), intent(inout) :: File type(var_desc_t), intent(inout) :: varidu, varidv real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type + integer, intent(in) :: ext_dims(:) + integer, intent(in) :: data_type, decomp_type !---------------------------------------------------------------------------- call endrun('FATAL - write_interpolated_vector is a stub, you shouldnt get here') From 10a705b3c3336805196bea3f8b3879d5fcc25c4a Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 8 Oct 2026 14:14:26 -0600 Subject: [PATCH 62/63] bugfix evapcdp is supposed to be positive, and mf_sqtev is already using a positive convention, I removed the -1 multiplication factor --- src/physics/cam/clubb_intr.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 1f6e4bce96..9a5a0832b7 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -4926,7 +4926,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do do i=1, ncol rprddp(i,kcam) = -1._r8*mf_sqtac(i,k_clubb) - evapcdp(i,kcam) = -1._r8*mf_sqtev(i,k_clubb) + evapcdp(i,kcam) = mf_sqtev(i,k_clubb) end do end do From 2a5f8e6c2709ee39ede1a5f28f3ba3d7a4277510 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 9 Oct 2026 08:24:06 -0600 Subject: [PATCH 63/63] update ChangeLog with all test results - ready to tag --- doc/ChangeLog | 320 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 320 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index b90bb9ebd7..6eeff15fb1 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,3 +1,323 @@ +Tag name: cam6_4_207 +Originator(s): jtruesdal, adamrher +Date: Oct 9, 2026 +One-line Summary: Update CLUBB+MF (EDMF) to the latest version; CLUBB+MF is + now selected with deep_scheme='CLUBB_MF' +Github PR URL: https://github.com/ESCOMP/CAM/pull/1576 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +- Update CLUBB+MF to latest version (#1370) + Brings the updated CLUBB+MF (clubb_mf) code into CAM. The CLUBB interface + (clubb_inter.F90) is extended to support the enhanced integrate_mf call, new + EDMF diagnostics/outputs, and additional namelist controls for CLUBB+MF + behavior (radiation coupling, microphysics, TKE contribution, cold pool, + etc.). The majority of the code updates reside in clubb_mf.F90. + + - clubb_mf is now agnostic to the direction of the vertical levels: loops + and indices are adjusted as needed depending on whether the input arrays + are top-down or bottom-up. + - The number of vertical levels for the new MF arrays is now consistent + with the associated thermodynamic or momentum grid. + - CLUBB+MF is now selected with deep_scheme='CLUBB_MF'. The MF plume + ensemble provides the deep-convection fields (PREC_DP, SNOW_DP, ICWMRDP, + DP_FRAC, RPRDDP, NEVAPR_DPCU) and populates the ZM-style gathered pbuf + arrays (ZM_MU, ZM_EU, ZM_DU, ZM_MD, ZM_ED, ZM_DP, ZM_DSUBCLD, ZM_JT, + ZM_MAXG, ZM_IDEEP) and the plume-ensemble updraft speed (MF_WUP), so + that convective tracer transport (convtran2) and aerosol convective + processing (aero_convproc) are driven by the MF plumes. The old + do_clubb_mf namelist variable is removed (it is derived from + deep_scheme). + - CLUBB+MF is only supported with cam7 physics (enforced in + build-namelist). + - History output of interpolated fields now supports an arbitrary number + of extra (non-horizontal) dimensions, which is needed to output the + plume-ensemble ('nens') diagnostics on an interpolated history grid. + +- CLUBB advected-moments read loop runs one level past state%q + (out-of-bounds) in clubb_intr.F90 (#1590) + The advected-moments read loop is now bounded by nzt_clubb rather than + nzm_clubb. The logicals do_rainturb and clubb_do_adv are also now + initialized to .false. + + Note: The clubb-mf update is a major refactor including new functionality and is + answer changing from the cam6_4_206 version of clubb_mf + +Related follow-up: the roots solver is duplicated in clubb_mf and uwshcu.F90 +(see #1696). +Related follow-up: Minimize space from 200+ clubb_mf variables that are unused when its not chosen as the deep scheme. +(see #1697). + +Describe any changes made to build system: N/A + (see build-namelist changes below) + +Describe any changes made to the namelist: +- deep_scheme: new valid value 'CLUBB_MF'. +- do_clubb_mf: removed. It is now derived from deep_scheme='CLUBB_MF'. +- New clubb_mf_nl namelist variables (defaults are only added by + build-namelist when deep_scheme='CLUBB_MF'): + do_clubb_mf_precip, do_clubb_mf_rad, do_clubb_mf_addtke, + clubb_mf_Lopt, clubb_mf_a0, clubb_mf_b0, clubb_mf_alphturb, + clubb_mf_max_L0, clubb_mf_fdd, do_clubb_mf_coldpool, clubb_mf_ddalph, + clubb_mf_ddbeta, clubb_mf_pwfac, clubb_mf_ddexp, clubb_mf_pwmin, + clubb_mf_pwmax, clubb_mf_cldfrac_fac, do_clubb_mf_ustar, + do_clubb_mf_mixd, clubb_mf_up_ndt, clubb_mf_cp_ndt, do_clubb_mf_rhtke, + do_clubb_mf_cmt, do_clubb_mf_lscale_perplume, do_clubb_mf_coldpool_init, + do_clubb_mf_coldpool_perplume, clubb_mf_kseed, do_clubb_mf_aloft, + do_clubb_mf_aspd, do_clubb_mf_pblcull, do_clubb_mf_invswitch +- do_clubb_mf_diag: documentation updated; note deep_scheme='CLUBB_MF' must + also be set. +- clubb_mf_Lopt (entrainment length scale option, default 6): valid values + are 0,1,2,3,6,7,8. Options 4 and 5 (dilute CAPE) are removed. +- Changed defaults for existing clubb_mf_nl variables (only used with + deep_scheme='CLUBB_MF'): + clubb_mf_L0: 50.0 -> 200.0 + clubb_mf_ent0: 0.22 -> 0.2 + clubb_mf_nup: 10 -> 25 +- New deep_scheme-dependent CLUBB defaults: + clubb_l_predict_upwp_vpwp = .false. for cam7 with deep_scheme='CLUBB_MF' + clubb_l_do_expldiff_rtm_thlm = .false. with clubb_sgs and + deep_scheme='CLUBB_MF' +- With deep_scheme='CLUBB_MF': convproc_do_aer is set to .true. and + use_gw_convect_dp is set to .false. (CLUBB_MF does not provide TTEND_DP). + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: +- For configurations that do not use deep_scheme='CLUBB_MF' + we carry 200+ extra 2d local variables which are being addressed in issue $1697) +- With CLUBB_MF the default number of plumes, clubb_mf_nup, increased + from 10 to 25.) + +Code reviewed by: cacraigucar, adamrher, jet + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M .gitmodules +M src/dynamics/fv3 + - Update the CAM_FV3_interface external tag from fv3int_061924 to + fv3int_100726 (updates the dummy write_interpolated_scalar/vector + interfaces to match the new extra-dimension signature). + +M bld/build-namelist + - Move the do_clubb_sgs handling ahead of the deep_scheme handling so it + is available for the CLUBB_MF dependency checks. + - Add checks that deep_scheme='CLUBB_MF' requires do_clubb_sgs to be + active and cam7 physics. + - Add default convproc_do_aer=.true. when deep_scheme='CLUBB_MF'. + - Add the CLUBB-MF namelist defaults (only when deep_scheme='CLUBB_MF'); + remove the do_clubb_mf default. + - clubb_l_predict_upwp_vpwp and clubb_l_do_expldiff_rtm_thlm defaults now + depend on deep_scheme. + - Set use_gw_convect_dp=.false. for deep_scheme='CLUBB_MF'. + - Reorder the microp_aero_wsub_scale/wsubi_scale add_default calls (no + change in values). + +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - New CLUBB+MF namelist variables, new deep_scheme value, removal of + do_clubb_mf, and changed/new defaults (see namelist section above). + +M cime_config/testdefs/testlist_cam.xml + - ERC_D_Ln9.ne3pg3_ne3pg3_mt232 nochem_clubbmf test: compset changed from + FHIST to FHISTC_LTso (CLUBB+MF requires cam7 physics). + +M cime_config/testdefs/testmods_dirs/cam/nochem_clubbmf/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_clubbmf/user_nl_cam + - Remove do_clubb_mf=.true. and change deep_scheme='off' to + deep_scheme='CLUBB_MF'. + +M src/chemistry/aerosol/aero_convproc.F90 + - When deep_scheme='CLUBB_MF', use the plume-ensemble updraft speed + (MF_WUP) for the aerosol activation updraft velocity in the deep + convective processing instead of the mu/(rhoair*zm_areafrac) estimate. + The ZM path is unchanged. + +M src/control/cam_history.F90 + - Pass the field's extra dimensions (fdims(2:frank)) to + write_interpolated for interpolated history output instead of a single + computed level count. + +M src/dynamics/fv/interp_mod.F90 +M src/dynamics/mpas/interp_mod.F90 + - Stub write_interpolated_scalar/vector interfaces: numlev replaced by + ext_dims(:) to match the SE interface. + +M src/dynamics/se/interp_mod.F90 + - write_interpolated_scalar/vector now take ext_dims(:) in place of numlev + and support up to 3 extra dimensions (endrun if more are requested). + +M src/physics/cam/clubb_intr.F90 + - Extend the CLUBB+MF interface to the new integrate_mf: new pbuf fields + (ZTOPMN, ZTOPMA, ZTOP_MACMIC, DDCP, DDCPMN, DDCP_MACMIC, CBM1, + CBM1_MACMIC and the *_MACMIC plume budget fields) and macmic + sub-cycle accumulation. + - New 'nens' history coordinate (plume ensemble) and 46 new edmf_* + history fields (plume ensemble properties, forcing/flux budget terms, + cold pool, CAPE, etc.). + - New internal routines compute_mf_plumes and output_mf_diagnostics, and + mf_pinterp. + - The MF plume cloud is attributed to the deep convection fields + (DP_FRAC/ICWMRDP) rather than the shallow fields; PREC_DP/SNOW_DP, + RPRDDP, NEVAPR_DPCU and the ZM_*/MF_WUP gathered arrays are populated + from the plume ensemble. + - Fix out-of-bounds advected-moments read loop (nzm_clubb -> nzt_clubb) + and initialize do_rainturb and clubb_do_adv (#1590). + +M src/physics/cam/clubb_mf.F90 + - Updated CLUBB+MF science and call interface (new integrate_mf + arguments; radiation coupling, microphysics, TKE contribution, cold + pool and other options controlled by the new namelist variables). + - Vertical-direction agnostic: loops and indexing adapt to top-down or + bottom-up input arrays. MF arrays are sized consistently with the + thermodynamic or momentum grid. + - New routines: buoyancy_sort_mixfrac (buoyancy-sorting mixing fraction, + module-level with an explicit interface), mf_pinterp, get_Lscale, + oneplume, roots, hybridRNG and hormann. + - The do_condensation option (and its arguments to get_Lscale and + oneplume) and its .false. path are removed. + - The clubb_mf_Lopt=4,5 (dilute CAPE) options are removed, along with the + routines copied from ZM that supported them (buoyan_dilute, + parcel_dilute, qsat_hPa). clubb_mf_readnl now aborts if clubb_mf_Lopt + is not one of 0,1,2,3,6,7,8. + - Hard-coded values are replaced by named parameters. + - Downdraft clamp replaced (adamrher): the sub-cloud downdraft profile now + ends (dnw=dna=0 below that level) when it decays to the minimum + downdraft speed, rather than being clamped at that speed and zeroed + afterwards. + - Bug fixes (answer changing), including: cbm1 is now set (to zm(ksfcm)) + before the early returns in integrate_mf; the plume-top/cloud-base + index search no longer indexes zm with an unset (zero) index (falls + back to the model top); an out-of-bounds array access is fixed. + - Order-of-operation differences relative to the original (cam6_4_124) + clubb_mf cause roundoff-level differences. + +M src/physics/cam/convect_deep.F90 + - Add deep_scheme='CLUBB_MF': register the standard deep convection pbuf + fields (ICWMRDP, RPRDDP, NEVAPR_DPCU, 'global' PREC_DP/SNOW_DP) plus the + ZM_* gathered arrays and MF_WUP; do not clear PREC_DP/SNOW_DP, set + fracis=1, and add clubb_mf_convtran2 to do convective tracer transport + (via zm_conv_convtran_run) with the plume-ensemble mass fluxes. + +M src/physics/cam/gw_drag_cam.F90 + - Only look up TTEND_DP when deep_scheme='ZM' (CLUBB_MF does not provide + it). + +M src/physics/cam/physpkg.F90 + - Comment only: CLUBB-MF is only supported with cam7 physics. + +M src/physics/cam7/physpkg.F90 + - For CLUBB+MF, accumulate PREC_DP, SNOW_DP, DP_FRAC, ICWMRDP and CONCLD + over the macmic sub-cycle and use the sub-cycle mean afterwards; rebuild + the total cloud fraction from the averaged deep fraction. + - Include the MF plume precipitation in the energy-check condensate flux + (flx_cnd), and avoid double-counting PREC_DP/SNOW_DP in the + convect_deep energy check. + - Remove the unused PREC_SH/SNOW_SH pbuf lookups. + +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. + +derecho/intel/aux_cam: + ERC_D_Ln9.f09_f09_mt232.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mt232.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERC_D_Ln9.mpasa120_mpasa120.FHISTC_LTso.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERC_D_Ln9.mpasa120_mpasa120.QPC7.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERC_D_Ln9.ne30pg2_ne30pg2_mt232.QPC7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERC_D_Ln9.ne30pg3_ne30pg3_mt232.F1850C_LTso.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERC_D_Ln9.ne3_ne3_mg37.QPC7.derecho_intel.cam-outfrq9s_rttov (Overall: DIFF) details: + ERC_Ln9.C96_C96_mt232.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERI_D_Ln18.f09_f09_mt232.FHIST.derecho_intel.cam-outfrq3s_eri (Overall: DIFF) details: + ERI_D_Ln18.ne30pg3_ne30pg3_mt232.FHISTC_LTso.derecho_intel.cam-outfrq3s_eri (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mt232.F1850C_MTso.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERR_Ln9.ne16pg3_ne16pg3_mt232.FHISTC_LTso.derecho_intel.cam-outfrq9s_bwic (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s_ltr (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mt232.FHISTC_MTso.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mt233.1850_CAM70%MT%CT4S2_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ln9.f19_f19_mt232.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + - DIFF due to scaling 4 output fields to different units. Only the 4 are different otherwise BFB + + ERP_Ld3.ne16pg3_ne16pg3_mg17.FHISTC_WAt1ma.derecho_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Ld3.ne30pg3_ne30pg3_mt232.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FHISTC_WAma.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.ne30pg3_ne30pg3_mg17.FHISTC_WXma.derecho_intel.cam-outfrq9s_ctem (Overall: NLFAIL) details: + SMS_C2_D_Ln9.ne16pg3_ne16pg3_mg17.FHISTC_WXma.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ld5.f09_f09_mt232.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FCARMA2000climo.derecho_intel.cam-outfrq9s_carma_rad_diag (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FCHIST_SLH.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mt232.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: NLFAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: NLFAIL) details: + - NLFAIL is expected and due to changes in namelist documented above. + SMS_D_Ln9_P1536x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + - intermittent failure in CTSM code (lnd_set_decomp_and_domain.F90) - It happened to work this time + +derecho/nvhpc/aux_cam: + ERS_Ln9.ne30pg3_ne30pg3_mt232.FHISTC_LTso.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: DIFF) + +izumi/nag/aux_cam: + ERC_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_nag.cam-outfrq3s_subcol (Overall: FAIL) + - pre-existing failure -- see https://github.com/ESCOMP/CAM/issues/1514 + + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq9s_tuvx_waccm_ma_mam5 (Overall: NLFAIL) + - NLFAIL is expected and due to changes in namelist documented above. + + ERC_D_Ln9.f10_f10_mt232.FHIST.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) + ERC_D_Ln9.mpasa480_mpasa480_mt232.QPC7.izumi_nag.cam-outfrq9s_mpasa480 (Overall: DIFF) + ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHISTC_LTso.izumi_nag.cam-cosp_rad_diags (Overall: DIFF) + ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHISTC_LTso.izumi_nag.cam-outfrq9s_nochem (Overall: DIFF) + SMS_D_Ln9.f10_f10_mt232.F1850.izumi_nag.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.ne3pg3_ne3pg3_mt232.QPC7.izumi_nag.cam-carma_test_tracers (Overall: DIFF) + - DIFF due to scaling 4 output fields to different units. Only the 4 are different otherwise BFB + +izumi/gnu/aux_cam: + ERC_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) + ERC_D_Ln9.f19_f19_mt232.FHIST.izumi_gnu.cam-lonlat_fv_diags (Overall: DIFF) + ERC_D_Ln9.mpasa480_mpasa480_mt232.FHISTC_LTso.izumi_gnu.cam-outfrq9s_mpasa480 (Overall: DIFF) + ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHISTC_LTso.izumi_gnu.cam-nochem_clubbmf (Overall: DIFF) + ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHISTC_LTso.izumi_gnu.cam-sat_lcltod (Overall: DIFF) + ERC_D_Ln9.ne3pg3_ne3pg3_mt232.QPC7.izumi_gnu.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 (Overall: DIFF) + SUB_D_Ln9.ne3pg3_ne3pg3_mt232.FHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) + - DIFF due to scaling 4 output fields to different units. Only the 4 are different otherwise BFB + + SMS_D_Ln3.ne3pg3_ne3pg3_mt232.PC7.izumi_gnu.cam-pc7_ne3pg3 (Overall: NLFAIL) + SMS_D_Ln9.f10_f10_mg37.FWmaHIST.izumi_gnu.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) + - NLFAILS are expected and due to changes in namelist documented above. + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: +- configurations using deep_scheme='CLUBB_MF' are climage changing compared to the old do_club_mf=.true. +- clubbmf is climate changing but off by default. +- all other configurations are B4B with the exception of the units change for 4 output fields +- what platforms/compilers: derecho/intel + =============================================================== Tag name: cam6_4_206