diff --git a/.gitmodules b/.gitmodules index 8f621bf7c2..dcc3b7cd98 100644 --- a/.gitmodules +++ b/.gitmodules @@ -104,7 +104,7 @@ url = https://github.com/larson-group/clubb_release fxrequired = AlwaysRequired fxsparse = ../.clubb_sparse_checkout - fxtag = clubb_4ncar_20240605_73d60f6_gpufixes_posinf + fxtag = clubb_4ncar_20260109_ddf5110 fxDONOTUSEurl = https://github.com/larson-group/clubb_release [submodule "rtm"] diff --git a/bld/build-namelist b/bld/build-namelist index 175aef4298..ed87e4bea1 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3503,6 +3503,7 @@ if ($clubb_sgs =~ /$TRUE/io) { die "$ProgName - ERROR: clubb_history = .true. with multiple threads is not supported. \n"; } + add_default($nl, 'clubb_l_ascending_grid'); add_default($nl, 'clubb_do_icesuper'); add_default($nl, 'clubb_do_energyfix'); add_default($nl, 'clubb_cloudtop_cooling'); @@ -3594,9 +3595,13 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_detphase_lowtemp'); add_default($nl, 'clubb_do_energyfix'); add_default($nl, 'clubb_do_liqsupersat'); + add_default($nl, 'clubb_grid_adapt_in_time_method'); + add_default($nl, 'clubb_fill_holes_type'); + add_default($nl, 'clubb_grid_remap_method'); add_default($nl, 'clubb_ipdf_call_placement'); add_default($nl, 'clubb_lambda0_stability_coef'); add_default($nl, 'clubb_lmin_coef'); + add_default($nl, 'clubb_l_add_dycore_grid'); add_default($nl, 'clubb_l_brunt_vaisala_freq_moist'); add_default($nl, 'clubb_l_call_pdf_closure_twice'); add_default($nl, 'clubb_l_damp_wp2_using_em'); @@ -3618,6 +3623,8 @@ if ($clubb_sgs =~ /$TRUE/io) { 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'); add_default($nl, 'clubb_l_smooth_Heaviside_tau_wpxp'); add_default($nl, 'clubb_l_stability_correct_tau_zm'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index c75c36c473..17202b3739 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2120,6 +2120,7 @@ 300.0D0 1.0D0 .false. + .false. @@ -2180,9 +2181,13 @@ 0.280 0.32 0.3 + 0 + 2 + 1 2 0.04 0.1 + .false. .false. .false. .true. @@ -2215,6 +2220,8 @@ .false. .false. .true. + .false. + .false. .false. .false. .false. diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index efb62cac72..b6ea1854fc 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3672,6 +3672,13 @@ Switch for CLUBB_ADV parameter that turns on advection of CLUBB pdf moments by the dynamics core. Very experimental. + +Causes advance_clubb_core to run in ascending mode, where the surface is at k=1, which is opposite +of the descending cam grid. This is mainly a testing/debugging option - it requires an expensive +data flipping step and should not change answers significantly. + + @@ -3940,6 +3947,32 @@ Gaussian PDF, and also decreases the difference between the means of w from each Gaussian. + +Specifier for method to construct a grid density function to adapt grid to. +Valid values: 0 (no grid adaptation), 1 (use Lscale and wp2) + + + +Selects which algorithm the fill_holes routine uses to correct +below threshold values in field solutions. +0: off - Skip the mass conservative hole filling step, rely on blunt clipping +1: global - Fast but minimally local, most methods use this as a fallback step +2: sliding_window - Expensive but highly local when possible, falls back to global fill if needed +3: widening_windows - Slightly parallelizable, local when possible, falls back to global if needed +4: smart_window - Uses hueristics to determine ranges to fill, fast and highly local when possible, falls back to global if needed +5: smart_window_smooth - Same as smart_window, but with experimental smoothing features that slightly increases cost, NO GLOBAL FALLBACK +6: parallel_fill - Highly local when possible, completely parallelizable but computationally wasteful, falls back to global if needed +See CLUBB_core/model_flags.F90 or CLUBB_core/fill_holes.F90 for more detail. + + + +Specifier for method to remap values from one grid to another. +Valid values: 1 (ullrich remapping) + + Selected option for the two-component normal (double Gaussian) PDF type to use for the w, rt, @@ -3966,6 +3999,11 @@ scale (Lscale) in a grid-spacing dependent formula. Increasing the value of clubb_lmin_coef increases the minimum allowable value for length scale. + +Flag to remap values from the dycore grid. + + Flag to uses an alternate equation to calculate the Brunt-Vaisala frequency. @@ -4147,6 +4185,18 @@ horizontal winds um and vm. When this flag is turned off, upwp and vpwp are calculated by down-gradient diffusion. + +Flag to implement the nontraditional Coriolis terms in the +prognostic equations of w'w', u'w', and u'u. + + + +Flag to implement the traditional Coriolis terms in the +prognostic equations of v'w' and u'w'. + + used in adj_low_res_nu. If .true., avg_deltaz = deltaz diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index d1cfa8efeb..dbb2340f67 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -20,7 +20,7 @@ module clubb_intr use shr_kind_mod, only: r8=>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 + use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi, rair, omega use air_composition, only: rairv, cpairv use cam_history_support, only: max_fieldname_len @@ -29,103 +29,87 @@ module clubb_intr 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 use ref_pres, only: top_lev => trop_cloud_top_lev + use scamMOD, only: single_column, scm_clubb_iop_name, scm_cambfb_mode #ifdef CLUBB_SGS - use clubb_api_module, only: pdf_parameter, implicit_coefs_terms - use clubb_api_module, only: clubb_config_flags_type, grid, stats, & + use clubb_api_module, only: pdf_parameter, implicit_coefs_terms, & + clubb_config_flags_type, grid, stats, & nu_vertical_res_dep, stats_metadata_type, & - hm_metadata_type, sclr_idx_type + hm_metadata_type, sclr_idx_type, & + nparams - use clubb_api_module, only: nparams use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag use cloud_fraction, only: dp1, dp2 #endif - use scamMOD, only: single_column,scm_clubb_iop_name,scm_cambfb_mode implicit none #ifdef CLUBB_SGS - ! Variables that contains all the statistics - type (stats), target, save :: stats_zt(pcols), & ! stats_zt grid - stats_zm(pcols), & ! stats_zm grid - stats_rad_zt(pcols), & ! stats_rad_zt grid - stats_rad_zm(pcols), & ! stats_rad_zm grid - stats_sfc(pcols) ! stats_sfc - type (hm_metadata_type) :: & - hm_metadata - - type (stats_metadata_type) :: & - stats_metadata - type (sclr_idx_type) :: & - sclr_idx - - integer :: & - nzm_clubb, & !Number of vertical levels used by CLUBB momentum variables - nzt_clubb !Number of vertical levels used by CLUBB thermodynamic variables #endif private - save - ! ----------------- ! - ! Public interfaces ! - ! ----------------- ! + save + ! Subroutines to make public public :: clubb_ini_cam, clubb_register_cam, clubb_tend_cam, clubb_emissions_cam, & -#ifdef CLUBB_SGS - ! This utilizes CLUBB specific variables in its interface - stats_init_clubb, & - stats_metadata, & - stats_zt, stats_zm, stats_sfc, & - stats_rad_zt, stats_rad_zm, & - stats_end_timestep_clubb, & -#endif - clubb_readnl, & - clubb_init_cnst, & - clubb_implements_cnst + clubb_readnl, clubb_init_cnst, clubb_implements_cnst #ifdef CLUBB_SGS - ! Both of these utilize CLUBB specific variables in their interface - private :: stats_zero, stats_avg -#endif + + ! NOTE: the only reason for anything in this section being set to public is for use with SILHS - logical, public :: do_cldcool - logical :: clubb_do_icesuper + public :: stats_init_clubb, stats_end_timestep_clubb -#ifdef CLUBB_SGS - type(clubb_config_flags_type), public :: clubb_config_flags - real(r8), dimension(nparams), public :: clubb_params_single_col ! Adjustable CLUBB parameters (C1, C2 ...) -#endif + type(clubb_config_flags_type), public :: & + clubb_config_flags + + real(r8), dimension(1,nparams), public :: & + clubb_params_single_col ! Adjustable CLUBB parameters (C1, C2 ...) + + ! Variables that contains all the statistics + type (stats), public :: & + stats_zt(pcols), & ! stats_zt grid + stats_zm(pcols), & ! stats_zm grid + stats_rad_zt(pcols), & ! stats_rad_zt grid + stats_rad_zm(pcols), & ! stats_rad_zm grid + stats_sfc(pcols) ! stats_sfc + + type (hm_metadata_type), public :: & + hm_metadata + + type (stats_metadata_type), public :: & + stats_metadata + + type (sclr_idx_type), public :: & + sclr_idx + + integer, public :: & + nzm_clubb, & ! Number of vertical levels used by CLUBB momentum variables + nzt_clubb ! Number of vertical levels used by CLUBB thermodynamic variables ! These are zero by default, but will be set by SILHS before they are used by subcolumns - integer :: & - hydromet_dim = 0, & - pdf_dim = 0 + integer, public :: & + hydromet_dim = 0, & + pdf_dim = 0 + type(pdf_parameter), allocatable, public :: & + pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary] - ! ------------------------ ! - ! Sometimes private data ! - ! ------------------------ ! -#ifdef CLUBB_SGS -#ifdef SILHS - ! If SILHS is in use, it will initialize these - public :: & - hydromet_dim, & - pdf_dim, & - hm_metadata -#else - ! If SILHS is not in use, there is no need for them to be public - private :: & - hydromet_dim, & - pdf_dim, & - hm_metadata -#endif + type(pdf_parameter), allocatable :: & + pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] + + type(implicit_coefs_terms), allocatable :: & + pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] + + real(r8), public :: & + ztodt ! model timestep #endif - ! ------------ ! - ! Private data ! - ! ------------ ! + ! ------------------------------------------------------------ ! + ! CONSTANTS ! + ! ------------------------------------------------------------ ! integer, parameter :: & grid_type = 3, & ! The 2 option specifies stretched thermodynamic levels @@ -137,9 +121,12 @@ module clubb_intr sclr_tol = 1.e-8_r8 ! Total water in kg/kg real(r8), parameter :: & - theta0 = 300._r8, & ! Reference temperature [K] - ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s] - p0_clubb = 100000._r8 + rtm_min = epsilon( rtm_min ), & ! Value below which rtm will be nudged [kg/kg] + rtm_nudge_max_altitude = 10000._r8, & ! Highest altitude at which to nudge rtm [m] + theta0 = 300._r8, & ! Reference temperature [K] + ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s] + p0_clubb = 100000._r8, & + inv_p0_clubb = 1._r8 / 100000._r8 real(r8), parameter :: & wp3_const = 1._r8 ! Constant to add to wp3 when moments are advected @@ -154,11 +141,68 @@ module clubb_intr rtpthlp_const = 0.01_r8 ! Constant to add to rtpthlp when moments are advected real(r8), parameter :: unset_r8 = huge(1.0_r8) + integer, parameter :: unset_i = huge(1) ! Commonly used temperature for the melting temp of ice crystals [K] real(r8), parameter :: meltpt_temp = 268.15_r8 + logical, parameter, private :: & + l_implemented = .true. ! Implemented in a host model (always true) + + ! ----------------------------------------------------------------- ! + ! Things shared between subroutines: generally because they are ! + ! set by an initialization routine, then used by clubb_tend_cam ! + ! ----------------------------------------------------------------- ! + + logical :: do_cldcool + logical :: clubb_do_icesuper + + logical :: & + 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 + ! 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 + logical :: clubb_do_liqsupersat = .false. + logical :: clubb_do_energyfix = .true. + integer :: edsclr_dim ! Number of scalars to transport in CLUBB + + integer :: & + ixthlp2 = 0, & + ixwpthlp = 0, & + ixwprtp = 0, & + ixwp2 = 0, & + ixwp3 = 0, & + ixrtpthlp = 0, & + ixrtp2 = 0, & + ixup2 = 0, & + ixvp2 = 0 + + ! Output arrays for CLUBB statistics + real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc + + ! Outputs from phys_getopts + character(len=16) :: eddy_scheme ! Default set in phys_control.F90 + character(len=16) :: deep_scheme ! Default set in phys_control.F90 + logical :: history_budget + integer :: history_budget_histfile_num + logical :: do_hb_above_clubb = .false. + + character(len=16) :: subcol_scheme + + ! For clubb_do_adv + integer, parameter :: ncnst=9 + character(len=8) :: cnst_names(ncnst) + logical :: do_cnst=.false. + + real(r8) :: clubb_timestep = unset_r8 ! Default CLUBB timestep, unless overwriten by namelist real(r8) :: clubb_rnevap_effic = unset_r8 @@ -219,157 +263,152 @@ module clubb_intr real(r8) :: clubb_z_displace = unset_r8 integer :: & - clubb_iiPDF_type, & ! Selected option for the two-component normal - ! (double Gaussian) PDF type to use for the w, rt, - ! and theta-l (or w, chi, and eta) portion of - ! CLUBB's multivariate, two-component PDF. - clubb_ipdf_call_placement = unset_i, & ! Selected option for the placement of the call to - ! CLUBB's PDF. - clubb_penta_solve_method = unset_i, & ! Specifier for method to solve the penta-diagonal system - clubb_tridiag_solve_method = unset_i,& ! Specifier for method to solve tri-diagonal systems - clubb_saturation_equation = unset_i ! Specifier for which saturation formula to use - + clubb_iiPDF_type, & ! Selected option for the two-component normal + ! (double Gaussian) PDF type to use for the w, rt, + ! and theta-l (or w, chi, and eta) portion of + ! CLUBB's multivariate, two-component PDF. + clubb_ipdf_call_placement = unset_i, & ! Selected option for the placement of the call to + ! CLUBB's PDF. + clubb_penta_solve_method = unset_i, & ! Specifier for method to solve the penta-diagonal system + clubb_tridiag_solve_method = unset_i, & ! Specifier for method to solve tri-diagonal systems + clubb_saturation_equation = unset_i, & ! Specifier for which saturation formula to use + clubb_grid_remap_method = unset_i, & ! Specifier for which method should be used to + ! map values from one grid to another + ! (starts at 1, so 0 is an invalid option for this flag) + 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 + ! fill_holes_vertical procedure - logical :: & - clubb_l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The - ! precipitation fraction is automatically set to 1 when this - ! flag is turned off. - clubb_l_predict_upwp_vpwp, & ! Flag to predict and along with and - ! alongside the advancement of , , , - ! , , and in subroutine - ! advance_xm_wpxp. Otherwise, and are still - ! approximated by eddy diffusivity when and are - ! advanced in subroutine advance_windm_edsclrm. - clubb_l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping - ! the overall correlation of w and x (w and rt, as well as w - ! and theta-l) within the limits of -max_mag_correlation_flux - ! to max_mag_correlation_flux. - clubb_l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and - ! thlp2) on keeping the overall correlation of w and x within - ! the limits of -max_mag_correlation_flux to - ! max_mag_correlation_flux. - clubb_l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the - ! turbulent dissipation coefficient, C2. - clubb_l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm - clubb_l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor - clubb_l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 - clubb_l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & - ! sclrpthlp. - clubb_l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtm, thlm, sclrm, um and vm. - clubb_l_uv_nudge, & ! For wind speed nudging. - clubb_l_rtm_nudge, & ! For rtm nudging - clubb_l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. - ! TKE = 1/2 (u'^2 + v'^2 + w'^2) - clubb_l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to - ! compute the varibles that are output from high order - ! closure - clubb_l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the - ! thermodynamic-level variables output from pdf_closure. - clubb_l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three - ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - - ! output from pdf_closure. - clubb_l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call - ! subroutine pdf_closure twice. If true, pdf_closure is - ! called first on thermodynamic levels and then on momentum - ! levels so that each variable is computed on its native - ! level. If false, pdf_closure is only called on - ! thermodynamic levels, and variables which belong on - ! momentum levels are interpolated. - clubb_l_standard_term_ta, & ! Use the standard discretization for the turbulent advection - ! terms. Setting to .false. means that a_1 and a_3 are - ! pulled outside of the derivative in - ! advance_wp2_wp3_module.F90 and in - ! advance_xp2_xpyp_module.F90. - clubb_l_partial_upwind_wp3, & ! Flag to use an "upwind" discretization rather - ! than a centered discretization for the portion - ! of the wp3 turbulent advection term for ADG1 - ! that is linearized in terms of wp3. - ! (Requires ADG1 PDF and clubb_l_standard_term_ta). - clubb_l_godunov_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent advection terms. - ! It affects wpxp only. - clubb_l_godunov_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent advection terms. It affects - ! xpyp only. - clubb_l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac - ! and rcm to help increase cloudiness at coarser grid - ! resolutions. - clubb_l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones - clubb_l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors - clubb_l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) - clubb_l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) - clubb_l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability - ! correction - clubb_l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of - ! -(2/3)*em/tau_zm, as in Bougeault (1981) - clubb_l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly - clubb_l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values - clubb_l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the - ! mixing length scale as Lscale = tau * tke - clubb_l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number - clubb_l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number - clubb_l_use_shear_Richardson, & ! Use shear in the calculation of Richardson number - clubb_l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in - ! saturated atmospheres (from Durran and Klemp, 1982) - clubb_l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency - clubb_l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water - clubb_l_lmm_stepping, & ! Apply Linear Multistep Method (LMM) Stepping - clubb_l_e3sm_config, & ! Run model with E3SM settings - clubb_l_vary_convect_depth, & ! Flag used to calculate convective velocity using - ! a variable estimate of layer depth based on the depth - ! over which wpthlp is positive near the ground when true - ! More information can be found by - ! Looking at issue #905 on the clubb repo - clubb_l_use_tke_in_wp3_pr_turb_term,& ! Use TKE formulation for wp3 pr_turb term - clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3 - clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Flag to activate mods on wp3 limiters for conv test - clubb_l_smooth_Heaviside_tau_wpxp, & ! Use smooth Heaviside 'Peskin' in computation of invrs_tau - clubb_l_modify_limiters_for_cnvg_test, & ! Flag to activate mods on limiters for conv test - clubb_l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats - clubb_l_linearize_pbl_winds, & ! Flag to turn on code to linearize PBL winds - clubb_l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and - ! rtpthlp - clubb_l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 - clubb_l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz - clubb_l_update_pressure, & ! Flag for having CLUBB update pressure and exner - clubb_l_mono_flux_lim_thlm, & ! Flag to turn on monotonic flux limiter for thlm - clubb_l_mono_flux_lim_rtm, & ! Flag to turn on monotonic flux limiter for rtm - clubb_l_mono_flux_lim_um, & ! Flag to turn on monotonic flux limiter for um - clubb_l_mono_flux_lim_vm, & ! Flag to turn on monotonic flux limiter for vm - clubb_l_mono_flux_lim_spikefix, & ! Flag to implement monotonic flux limiter code that - ! eliminates spurious drying tendencies at model top - clubb_l_host_applies_sfc_fluxes ! Whether the host model applies the surface fluxes logical :: & - clubb_l_intr_sfc_flux_smooth = .false. ! Add a locally calculated roughness to upwp and vpwp sfc fluxes - -! Constant parameters - logical, parameter, private :: & - l_implemented = .true. ! Implemented in a host model (always true) - - logical, parameter, private :: & - apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh)) - - logical :: lq(pcnst) - logical :: do_rainturb - logical :: clubb_do_adv - logical :: clubb_do_liqsupersat = .false. - logical :: clubb_do_energyfix = .true. - logical :: history_budget - logical :: do_hb_above_clubb = .false. - integer :: history_budget_histfile_num - integer :: edsclr_dim ! Number of scalars to transport in CLUBB - integer :: offset - -! define physics buffer indicies here + clubb_l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The + ! precipitation fraction is automatically set to 1 when this + ! flag is turned off. + clubb_l_predict_upwp_vpwp, & ! Flag to predict and along with and + ! alongside the advancement of , , , + ! , , and in subroutine + ! advance_xm_wpxp. Otherwise, and are still + ! approximated by eddy diffusivity when and are + ! advanced in subroutine advance_windm_edsclrm. + clubb_l_ho_nontrad_coriolis, & ! Flag to implement the nontraditional Coriolis terms in the + ! prognostic equations of , , and . + clubb_l_ho_trad_coriolis, & ! Flag to implement the traditional Coriolis terms in the + ! prognostic equations of and . + clubb_l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping + ! the overall correlation of w and x (w and rt, as well as w + ! and theta-l) within the limits of -max_mag_correlation_flux + ! to max_mag_correlation_flux. + clubb_l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and + ! thlp2) on keeping the overall correlation of w and x within + ! the limits of -max_mag_correlation_flux to + ! max_mag_correlation_flux. + clubb_l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the + ! turbulent dissipation coefficient, C2. + clubb_l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm + clubb_l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor + clubb_l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 + clubb_l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & + ! sclrpthlp. + clubb_l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtm, thlm, sclrm, um and vm. + clubb_l_uv_nudge, & ! For wind speed nudging. + clubb_l_rtm_nudge, & ! For rtm nudging + clubb_l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. + ! TKE = 1/2 (u'^2 + v'^2 + w'^2) + clubb_l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to + ! compute the varibles that are output from high order + ! closure + clubb_l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the + ! thermodynamic-level variables output from pdf_closure. + clubb_l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three + ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - + ! output from pdf_closure. + clubb_l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call + ! subroutine pdf_closure twice. If true, pdf_closure is + ! called first on thermodynamic levels and then on momentum + ! levels so that each variable is computed on its native + ! level. If false, pdf_closure is only called on + ! thermodynamic levels, and variables which belong on + ! momentum levels are interpolated. + clubb_l_standard_term_ta, & ! Use the standard discretization for the turbulent advection + ! terms. Setting to .false. means that a_1 and a_3 are + ! pulled outside of the derivative in + ! advance_wp2_wp3_module.F90 and in + ! advance_xp2_xpyp_module.F90. + clubb_l_partial_upwind_wp3, & ! Flag to use an "upwind" discretization rather + ! than a centered discretization for the portion + ! of the wp3 turbulent advection term for ADG1 + ! that is linearized in terms of wp3. + ! (Requires ADG1 PDF and clubb_l_standard_term_ta). + clubb_l_godunov_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. + ! It affects wpxp only. + clubb_l_godunov_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. It affects + ! xpyp only. + clubb_l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac + ! and rcm to help increase cloudiness at coarser grid + ! resolutions. + clubb_l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones + clubb_l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors + clubb_l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) + clubb_l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) + clubb_l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability + ! correction + clubb_l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of + ! -(2/3)*em/tau_zm, as in Bougeault (1981) + clubb_l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly + clubb_l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values + clubb_l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the + ! mixing length scale as Lscale = tau * tke + clubb_l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number + clubb_l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number + clubb_l_use_shear_Richardson, & ! Use shear in the calculation of Richardson number + clubb_l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in + ! saturated atmospheres (from Durran and Klemp, 1982) + clubb_l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency + clubb_l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water + clubb_l_lmm_stepping, & ! Apply Linear Multistep Method (LMM) Stepping + clubb_l_e3sm_config, & ! Run model with E3SM settings + clubb_l_vary_convect_depth, & ! Flag used to calculate convective velocity using + ! a variable estimate of layer depth based on the depth + ! over which wpthlp is positive near the ground when true + ! More information can be found by + ! Looking at issue #905 on the clubb repo + clubb_l_use_tke_in_wp3_pr_turb_term, & ! Use TKE formulation for wp3 pr_turb term + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3 + clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Flag to activate mods on wp3 limiters for conv test + clubb_l_smooth_Heaviside_tau_wpxp, & ! Use smooth Heaviside 'Peskin' in computation of invrs_tau + clubb_l_modify_limiters_for_cnvg_test, & ! Flag to activate mods on limiters for conv test + clubb_l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats + clubb_l_linearize_pbl_winds, & ! Flag to turn on code to linearize PBL winds + clubb_l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and + ! rtpthlp + clubb_l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 + clubb_l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz + clubb_l_update_pressure, & ! Flag for having CLUBB update pressure and exner + clubb_l_mono_flux_lim_thlm, & ! Flag to turn on monotonic flux limiter for thlm + clubb_l_mono_flux_lim_rtm, & ! Flag to turn on monotonic flux limiter for rtm + clubb_l_mono_flux_lim_um, & ! Flag to turn on monotonic flux limiter for um + clubb_l_mono_flux_lim_vm, & ! Flag to turn on monotonic flux limiter for vm + clubb_l_mono_flux_lim_spikefix, & ! Flag to implement monotonic flux limiter code that + ! eliminates spurious drying tendencies at model top + clubb_l_host_applies_sfc_fluxes, & ! Whether the host model applies the surface fluxes + clubb_l_wp2_fill_holes_tke, & ! Whether TKE is taken from up2 and vp2 to fill holes in wp2 + clubb_l_add_dycore_grid ! Flag to remap values from dycore grid + + ! ------------------------------------------------------------ ! + ! Indices for physics buffer (pbuf) ! + ! ------------------------------------------------------------ ! integer :: & wp2_idx, & ! vertical velocity variances wp3_idx, & ! third moment of vertical velocity @@ -386,26 +425,21 @@ module clubb_intr vp3_idx, & ! north-south wind 3rd order upwp_idx, & ! east-west momentum flux vpwp_idx, & ! north-south momentum flux - thlm_idx, & ! mean thetal - rtm_idx, & ! mean total water mixing ratio - um_idx, & ! mean of east-west wind - vm_idx, & ! mean of north-south wind wpthvp_idx, & ! buoyancy flux wp2thvp_idx, & ! second order buoyancy term + 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' > vprcp_idx, & ! < v' r_c' > - rc_coef_idx, & ! Coefficient of X'r_c' in Eq. (34) + rc_coef_zm_idx, & ! Coefficient of X'r_c' in Eq. (34) wp4_idx, & ! w'^4 wpup2_idx, & ! w'u'^2 wpvp2_idx, & ! w'v'^2 wp2up2_idx, & ! w'^2 u'^2 wp2vp2_idx, & ! w'^2 v'^2 - cloud_frac_idx, & ! CLUBB's cloud fraction cld_idx, & ! Cloud fraction concld_idx, & ! Convective cloud fraction ast_idx, & ! Stratiform cloud fraction @@ -415,38 +449,34 @@ module clubb_intr qist_idx, & ! Physical in-cloud IWC dp_frac_idx, & ! deep convection cloud fraction sh_frac_idx, & ! shallow convection cloud fraction - kvh_idx, & ! CLUBB eddy diffusivity on thermo levels + kvh_idx, & ! CLUBB eddy diffusivity on thermo levels pblh_idx, & ! PBL pbuf - icwmrdp_idx, & ! In cloud mixing ratio for deep convection + icwmrdp_idx, & ! In cloud mixing ratio for deep convection tke_idx, & ! turbulent kinetic energy tpert_idx, & ! temperature perturbation from PBL fice_idx, & ! fice_idx index in physics buffer cmeliq_idx, & ! cmeliq_idx index in physics buffer relvar_idx, & ! relative cloud water variance - accre_enhan_idx, & ! optional accretion enhancement factor for MG npccn_idx, & ! liquid ccn number concentration 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 - rcm_idx, & ! Cloud water mixing ratio for SILHS - ztodt_idx,& ! physics timestep for SILHS clubbtop_idx ! level index for CLUBB top - ! For Gravity Wave code + ! For Gravity Wave code integer :: & - ttend_clubb_idx, & - ttend_clubb_mc_idx, & - upwp_clubb_gw_idx, & - upwp_clubb_gw_mc_idx, & - vpwp_clubb_gw_idx, & - vpwp_clubb_gw_mc_idx, & - thlp2_clubb_gw_idx, & - thlp2_clubb_gw_mc_idx, & - wpthlp_clubb_gw_idx, & - wpthlp_clubb_gw_mc_idx + ttend_clubb_idx, & + ttend_clubb_mc_idx, & + upwp_clubb_gw_idx, & + upwp_clubb_gw_mc_idx, & + vpwp_clubb_gw_idx, & + vpwp_clubb_gw_mc_idx, & + thlp2_clubb_gw_idx, & + thlp2_clubb_gw_mc_idx, & + wpthlp_clubb_gw_idx, & + wpthlp_clubb_gw_mc_idx ! Indices for microphysical covariance tendencies integer :: & @@ -456,50 +486,16 @@ module clubb_intr wpthlp_mc_zt_idx, & rtpthlp_mc_zt_idx - integer :: & ! added pbuf fields for clubb to have restart bfb when ipdf_call_placement=2 + ! added pbuf fields for clubb to have restart bfb when ipdf_call_placement=2 + integer :: & pdf_zm_w_1_idx, & pdf_zm_w_2_idx, & pdf_zm_varnce_w_1_idx, & pdf_zm_varnce_w_2_idx, & pdf_zm_mixt_frac_idx - integer, public :: & - ixthlp2 = 0, & - ixwpthlp = 0, & - ixwprtp = 0, & - ixwp2 = 0, & - ixwp3 = 0, & - ixrtpthlp = 0, & - ixrtp2 = 0, & - ixup2 = 0, & - ixvp2 = 0 - - integer :: cmfmc_sh_idx = 0 - integer :: & - dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio. - dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen. - dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen. - - ! Output arrays for CLUBB statistics - real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc - - character(len=16) :: eddy_scheme ! Default set in phys_control.F90 - character(len=16) :: deep_scheme ! Default set in phys_control.F90 - character(len=16) :: subcol_scheme - - integer, parameter :: ncnst=9 - character(len=8) :: cnst_names(ncnst) - logical :: do_cnst=.false. - -#ifdef CLUBB_SGS - type(pdf_parameter), target, allocatable, public, protected :: & - pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary] - - type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] - - type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] -#endif + cmfmc_sh_idx = 0 contains @@ -550,94 +546,98 @@ 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 + nzm_clubb = pverp + 1 - top_lev + if (do_hb_above_clubb) then call pbuf_add_field('clubbtop', 'physpkg', dtype_i4, (/pcols/), clubbtop_idx) endif ! put pbuf_add calls here (see macrop_driver.F90 for sample) use indicies defined at top - call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) - call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) - call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx) - call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx) - call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx) - call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx) - call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx) - call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx) - 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('RAD_CLUBB', 'global', dtype_r8, (/pcols,pver/), radf_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('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx) - call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp3_idx) - call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wpthlp_idx) - call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wprtp_idx) - call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtpthlp_idx) - call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp2_idx) - call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp2_idx) - call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up2_idx) - call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx) - - call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp3_idx) - call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp3_idx) - call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up3_idx) - call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp3_idx) - - call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), upwp_idx) - call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vpwp_idx) - call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlm_idx) - call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtm_idx) - call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), um_idx) - call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vm_idx) - - call pbuf_add_field('WPTHVP', 'global', dtype_r8, (/pcols,pverp/), wpthvp_idx) - call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,pverp/), wp2thvp_idx) - call pbuf_add_field('RTPTHVP', 'global', dtype_r8, (/pcols,pverp/), rtpthvp_idx) - call pbuf_add_field('THLPTHVP', 'global', dtype_r8, (/pcols,pverp/), thlpthvp_idx) - call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pverp/), cloud_frac_idx) - call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,pverp/), ice_supersat_idx) - call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pverp/), rcm_idx) - call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) - call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pverp/), wp2rtp_idx) - call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pverp/), wp2thlp_idx) - call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,pverp/), uprcp_idx) - call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,pverp/), vprcp_idx) - call pbuf_add_field('RC_COEF', 'global', dtype_r8, (/pcols,pverp/), rc_coef_idx) - call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,pverp/), wp4_idx) - call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pverp/), wpup2_idx) - call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pverp/), wpvp2_idx) - call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,pverp/), wp2up2_idx) - call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,pverp/), wp2vp2_idx) + call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) + call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) + call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx) + call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx) + call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx) + call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx) + call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx) + call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx) + 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) ! pbuf fields for Gravity Wave scheme - call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver/), ttend_clubb_idx) - call pbuf_add_field('UPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_idx) - call pbuf_add_field('VPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_idx) - call pbuf_add_field('THLP2_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_idx) - call pbuf_add_field('WPTHLP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_idx) - - call pbuf_add_field('TTEND_CLUBB_MC', 'physpkg', dtype_r8, (/pcols,pverp/), ttend_clubb_mc_idx) - call pbuf_add_field('UPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_mc_idx) - call pbuf_add_field('VPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_mc_idx) - call pbuf_add_field('THLP2_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_mc_idx) - call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_mc_idx) + call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver /), ttend_clubb_idx ) + call pbuf_add_field('UPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_idx ) + call pbuf_add_field('VPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_idx ) + call pbuf_add_field('THLP2_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_idx ) + call pbuf_add_field('WPTHLP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_idx ) + ! For SILHS microphysical covariance contributions - call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pverp/), rtp2_mc_zt_idx) - call pbuf_add_field('thlp2_mc_zt','global', dtype_r8, (/pcols,pverp/), thlp2_mc_zt_idx) - call pbuf_add_field('wprtp_mc_zt','global', dtype_r8, (/pcols,pverp/), wprtp_mc_zt_idx) - call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pverp/), wpthlp_mc_zt_idx) - call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pverp/), rtpthlp_mc_zt_idx) - - call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_1_idx) - call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_2_idx) - call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_1_idx) - call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_2_idx) - call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_mixt_frac_idx) + call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), rtp2_mc_zt_idx) + call pbuf_add_field('thlp2_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), thlp2_mc_zt_idx) + call pbuf_add_field('wprtp_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), wprtp_mc_zt_idx) + call pbuf_add_field('wpthlp_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), wpthlp_mc_zt_idx) + call pbuf_add_field('rtpthlp_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), rtpthlp_mc_zt_idx) + + + ! Only in clubb_intr.F90, these are safe to dimensions (ngrdcol,nzm_clubb) or (ngrdcol,nzt_clubb) + call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_w_1_idx) + call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_w_2_idx) + call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_varnce_w_1_idx) + call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_varnce_w_2_idx) + call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_mixt_frac_idx) + + call pbuf_add_field('WPTHVP', 'global', dtype_r8, (/pcols,nzm_clubb/), wpthvp_idx) + call pbuf_add_field('RTPTHVP', 'global', dtype_r8, (/pcols,nzm_clubb/), rtpthvp_idx) + call pbuf_add_field('THLPTHVP', 'global', dtype_r8, (/pcols,nzm_clubb/), thlpthvp_idx) + call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,nzm_clubb/), uprcp_idx) + 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('WP2UP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2up2_idx) + call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2vp2_idx) + + call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,nzm_clubb/), upwp_idx) + call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,nzm_clubb/), vpwp_idx) + call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), wpthlp_idx) + call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), wprtp_idx) + call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), rtpthlp_idx) + call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), rtp2_idx) + call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), thlp2_idx) + + call pbuf_add_field('TTEND_CLUBB_MC', 'physpkg', dtype_r8, (/pcols,nzt_clubb/), ttend_clubb_mc_idx) + call pbuf_add_field('UPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), upwp_clubb_gw_mc_idx) + call pbuf_add_field('VPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), vpwp_clubb_gw_mc_idx) + call pbuf_add_field('THLP2_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), thlp2_clubb_gw_mc_idx) + call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), wpthlp_clubb_gw_mc_idx) + + call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thvp_idx) + call pbuf_add_field('WP2UP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2up_idx) + call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2rtp_idx) + call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thlp_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpvp2_idx) + + call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,nzt_clubb/), rtp3_idx) + call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,nzt_clubb/), thlp3_idx) + call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,nzt_clubb/), up3_idx) + call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,nzt_clubb/), vp3_idx) + call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,nzt_clubb/), wp3_idx) + + call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), up2_idx) + call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), vp2_idx) + call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2_idx) + + ! Only in clubb_intr.F90 or SILHS + call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), ice_supersat_idx) #endif @@ -777,7 +777,8 @@ subroutine clubb_readnl(nlfile) namelist /clubb_his_nl/ clubb_history, clubb_rad_history namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, & clubb_do_adv, clubb_timestep, & - clubb_rnevap_effic,clubb_do_icesuper + clubb_rnevap_effic, clubb_do_icesuper, & + clubb_l_ascending_grid namelist /clubb_params_nl/ clubb_beta, & clubb_bv_efold, & clubb_c1, & @@ -824,10 +825,14 @@ subroutine clubb_readnl(nlfile) clubb_do_liqsupersat, & clubb_gamma_coef, & clubb_gamma_coefb, & + clubb_grid_adapt_in_time_method, & + clubb_fill_holes_type, & + clubb_grid_remap_method, & clubb_iiPDF_type, & clubb_ipdf_call_placement, & clubb_lambda0_stability_coef, & clubb_lmin_coef, & + clubb_l_add_dycore_grid, & clubb_l_brunt_vaisala_freq_moist, & clubb_l_C2_cloud_frac, & clubb_l_calc_thlp2_rad, & @@ -858,6 +863,8 @@ subroutine clubb_readnl(nlfile) clubb_l_mono_flux_lim_vm, & clubb_l_partial_upwind_wp3, & clubb_l_predict_upwp_vpwp, & + clubb_l_ho_nontrad_coriolis, & + clubb_l_ho_trad_coriolis, & clubb_l_prescribed_avg_deltaz, & clubb_l_rcm_supersat_adj, & clubb_l_rtm_nudge, & @@ -902,6 +909,7 @@ subroutine clubb_readnl(nlfile) stats_metadata%l_output_rad_files = .false. ! Initialize to false do_cldcool = .false. ! Initialize to false do_rainturb = .false. ! Initialize to false + clubb_l_ascending_grid = .false. ! Initialize to false ! Initialize namelist variables to clubb defaults call set_default_clubb_config_flags_api( clubb_iiPDF_type, & ! Out @@ -909,8 +917,13 @@ subroutine clubb_readnl(nlfile) clubb_penta_solve_method, & ! Out clubb_tridiag_solve_method, & ! Out clubb_saturation_equation, & ! Out + clubb_grid_remap_method, & ! Out + clubb_grid_adapt_in_time_method, & ! Out + clubb_fill_holes_type, & ! Out clubb_l_use_precip_frac, & ! Out clubb_l_predict_upwp_vpwp, & ! Out + clubb_l_ho_nontrad_coriolis, & ! Out + clubb_l_ho_trad_coriolis, & ! Out clubb_l_min_wp2_from_corr_wx, & ! Out clubb_l_min_xp2_from_corr_wx, & ! Out clubb_l_C2_cloud_frac, & ! Out @@ -963,7 +976,9 @@ subroutine clubb_readnl(nlfile) clubb_l_mono_flux_lim_um, & ! Out clubb_l_mono_flux_lim_vm, & ! Out clubb_l_mono_flux_lim_spikefix, & ! Out - clubb_l_host_applies_sfc_fluxes ) ! Out + clubb_l_host_applies_sfc_fluxes, & ! Out + clubb_l_wp2_fill_holes_tke, & ! Out + clubb_l_add_dycore_grid ) ! Out ! Call CLUBB+MF namelist call clubb_mf_readnl(nlfile) @@ -1016,6 +1031,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rainevap_turb") call mpi_bcast(clubb_do_adv, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_adv") + call mpi_bcast(clubb_l_ascending_grid, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_ascending_grid") call mpi_bcast(clubb_timestep, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_timestep") call mpi_bcast(clubb_rnevap_effic, 1, mpi_real8, mstrid, mpicom, ierr) @@ -1158,6 +1175,10 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_damp_wp3_Skw_squared") call mpi_bcast(clubb_l_predict_upwp_vpwp, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_predict_upwp_vpwp") + call mpi_bcast(clubb_l_ho_nontrad_coriolis, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_ho_nontrad_coriolis") + call mpi_bcast(clubb_l_ho_trad_coriolis, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_ho_trad_coriolis") call mpi_bcast(clubb_l_min_wp2_from_corr_wx, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_min_wp2_from_corr_wx") call mpi_bcast(clubb_l_min_xp2_from_corr_wx, 1, mpi_logical, mstrid, mpicom, ierr) @@ -1214,12 +1235,22 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_spikefix") call mpi_bcast(clubb_l_host_applies_sfc_fluxes, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_host_applies_sfc_fluxes") + call mpi_bcast(clubb_l_wp2_fill_holes_tke, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_wp2_fill_holes_tke") + call mpi_bcast(clubb_l_add_dycore_grid, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_add_dycore_grid") call mpi_bcast(clubb_penta_solve_method, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_penta_solve_method") call mpi_bcast(clubb_tridiag_solve_method, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_tridiag_solve_method") call mpi_bcast(clubb_saturation_equation, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_saturation_equation") + call mpi_bcast(clubb_grid_remap_method, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_grid_remap_method") + call mpi_bcast(clubb_grid_adapt_in_time_method, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_grid_adapt_in_time_method") + call mpi_bcast(clubb_fill_holes_type, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_fill_holes_type") call mpi_bcast(clubb_l_intr_sfc_flux_smooth, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_intr_sfc_flux_smooth") call mpi_bcast(clubb_l_vary_convect_depth, 1, mpi_logical, mstrid, mpicom, ierr) @@ -1258,138 +1289,148 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_uv_nudge") ! Overwrite defaults if they are true - if (clubb_history) stats_metadata%l_stats = .true. - if (clubb_rad_history) stats_metadata%l_output_rad_files = .true. - if (clubb_cloudtop_cooling) do_cldcool = .true. - if (clubb_rainevap_turb) do_rainturb = .true. + if ( clubb_history ) stats_metadata%l_stats = .true. + if ( clubb_rad_history ) stats_metadata%l_output_rad_files = .true. + if ( clubb_cloudtop_cooling ) do_cldcool = .true. + if ( clubb_rainevap_turb ) do_rainturb = .true. ! Check that all namelists have been set - if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set") - if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set") - - if(clubb_c1 == unset_r8) call endrun(sub//": FATAL: clubb_c1 is not set") - if(clubb_c1b == unset_r8) call endrun(sub//": FATAL: clubb_c1b is not set") - if(clubb_C2rt == unset_r8) call endrun(sub//": FATAL: clubb_C2rt is not set") - if(clubb_C2thl == unset_r8) call endrun(sub//": FATAL: clubb_C2thl is not set") - if(clubb_C2rtthl == unset_r8) call endrun(sub//": FATAL: clubb_C2rtthl is not set") - if(clubb_C4 == unset_r8) call endrun(sub//": FATAL: clubb_C4 is not set") - if(clubb_C_uu_shr == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_shr is not set") - if(clubb_C_uu_buoy == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_buoy is not set") - if(clubb_c6rt == unset_r8) call endrun(sub//": FATAL: clubb_c6rt is not set") - if(clubb_c6rtb == unset_r8) call endrun(sub//": FATAL: clubb_c6rtb is not set") - if(clubb_c6rtc == unset_r8) call endrun(sub//": FATAL: clubb_c6rtc is not set") - if(clubb_c6thl == unset_r8) call endrun(sub//": FATAL: clubb_c6thl is not set") - if(clubb_c6thlb == unset_r8) call endrun(sub//": FATAL: clubb_c6thlb is not set") - if(clubb_c6thlc == unset_r8) call endrun(sub//": FATAL: clubb_c6thlc is not set") - if(clubb_wpxp_L_thresh == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_L_thresh is not set") - if(clubb_C8 == unset_r8) call endrun(sub//": FATAL: clubb_C8 is not set") - if(clubb_C8b == unset_r8) call endrun(sub//": FATAL: clubb_C8b is not set") - if(clubb_C7 == unset_r8) call endrun(sub//": FATAL: clubb_C7 is not set") - if(clubb_C7b == unset_r8) call endrun(sub//": FATAL: clubb_C7b is not set") - if(clubb_c11 == unset_r8) call endrun(sub//": FATAL: clubb_c11 is not set") - if(clubb_c11b == unset_r8) call endrun(sub//": FATAL: clubb_c11b is not set") - if(clubb_c14 == unset_r8) call endrun(sub//": FATAL: clubb_c14 is not set") - if(clubb_C_wp3_pr_turb == unset_r8) call endrun(sub//": FATAL: clubb_C_wp3_pr_turb is not set") - if(clubb_c_K1 == unset_r8) call endrun(sub//": FATAL: clubb_c_K1 is not set") - if(clubb_c_K2 == unset_r8) call endrun(sub//": FATAL: clubb_c_K2 is not set") - if(clubb_nu2 == unset_r8) call endrun(sub//": FATAL: clubb_nu2 is not set") - if(clubb_c_K8 == unset_r8) call endrun(sub//": FATAL: clubb_c_K8 is not set") - if(clubb_c_K9 == unset_r8) call endrun(sub//": FATAL: clubb_c_K9 is not set") - if(clubb_nu9 == unset_r8) call endrun(sub//": FATAL: clubb_nu9 is not set") - if(clubb_c_K10 == unset_r8) call endrun(sub//": FATAL: clubb_c_K10 is not set") - if(clubb_c_K10h == unset_r8) call endrun(sub//": FATAL: clubb_c_K10h is not set") - if(clubb_C_invrs_tau_bkgnd == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_bkgnd is not set") - if(clubb_C_invrs_tau_sfc == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_sfc is not set") - if(clubb_C_invrs_tau_shear == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_shear is not set") - if(clubb_C_invrs_tau_N2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2 is not set") - if(clubb_C_invrs_tau_N2_wp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wp2 is not set") - if(clubb_C_invrs_tau_N2_xp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_xp2 is not set") - if(clubb_C_invrs_tau_N2_wpxp == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wpxp is not set") - if(clubb_C_invrs_tau_N2_clear_wp3 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_clear_wp3 is not set") - if(clubb_gamma_coef == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coef is not set") - if(clubb_gamma_coefb == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coefb is not set") - if(clubb_beta == unset_r8) call endrun(sub//": FATAL: clubb_beta is not set") - if(clubb_lambda0_stability_coef == unset_r8) call endrun(sub//": FATAL: clubb_lambda0_stability_coef is not set") - if(clubb_lmin_coef == unset_r8) call endrun(sub//": FATAL: clubb_lmin_coef is not set") - if(clubb_mult_coef == unset_r8) call endrun(sub//": FATAL: clubb_mult_coef is not set") - if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set") - if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set") - if(clubb_up2_sfc_coef == unset_r8) call endrun(sub//": FATAL: clubb_up2_sfc_coef is not set") - if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splat is not set") - if(clubb_bv_efold == unset_r8) call endrun(sub//": FATAL: clubb_bv_efold is not set") - if(clubb_wpxp_Ri_exp == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_Ri_exp is not set") - if(clubb_z_displace == unset_r8) call endrun(sub//": FATAL: clubb_z_displace is not set") - if(clubb_detliq_rad == unset_r8) call endrun(sub//": FATAL: clubb_detliq_rad not set") - if(clubb_detice_rad == unset_r8) call endrun(sub//": FATAL: clubb_detice_rad not set") - if(clubb_ipdf_call_placement == unset_i) call endrun(sub//": FATAL: clubb_ipdf_call_placement not set") - if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set") - if(clubb_penta_solve_method == unset_i) call endrun(sub//": FATAL: clubb_penta_solve_method not set") - if(clubb_tridiag_solve_method == unset_i) call endrun(sub//": FATAL: clubb_tridiag_solve_method not set") - if(clubb_saturation_equation == unset_i) call endrun(sub//": FATAL: clubb_saturation_equation 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_l_use_precip_frac, & ! In - clubb_l_predict_upwp_vpwp, & ! In - clubb_l_min_wp2_from_corr_wx, & ! In - clubb_l_min_xp2_from_corr_wx, & ! In - clubb_l_C2_cloud_frac, & ! In - clubb_l_diffuse_rtm_and_thlm, & ! In - clubb_l_stability_correct_Kh_N2_zm, & ! In - clubb_l_calc_thlp2_rad, & ! In - clubb_l_upwind_xpyp_ta, & ! In - clubb_l_upwind_xm_ma, & ! In - clubb_l_uv_nudge, & ! In - clubb_l_rtm_nudge, & ! In - clubb_l_tke_aniso, & ! In - clubb_l_vert_avg_closure, & ! In - clubb_l_trapezoidal_rule_zt, & ! In - clubb_l_trapezoidal_rule_zm, & ! In - clubb_l_call_pdf_closure_twice, & ! In - clubb_l_standard_term_ta, & ! In - clubb_l_partial_upwind_wp3, & ! In - clubb_l_godunov_upwind_wpxp_ta, & ! In - clubb_l_godunov_upwind_xpyp_ta, & ! In - clubb_l_use_cloud_cover, & ! In - clubb_l_diagnose_correlations, & ! In - clubb_l_calc_w_corr, & ! In - clubb_l_const_Nc_in_cloud, & ! In - clubb_l_fix_w_chi_eta_correlations, & ! In - clubb_l_stability_correct_tau_zm, & ! In - clubb_l_damp_wp2_using_em, & ! In - clubb_l_do_expldiff_rtm_thlm, & ! In - clubb_l_Lscale_plume_centered, & ! In - clubb_l_diag_Lscale_from_tau, & ! In - clubb_l_use_C7_Richardson, & ! In - clubb_l_use_C11_Richardson, & ! In - clubb_l_use_shear_Richardson, & ! In - clubb_l_brunt_vaisala_freq_moist, & ! In - clubb_l_use_thvm_in_bv_freq, & ! In - clubb_l_rcm_supersat_adj, & ! In - clubb_l_damp_wp3_Skw_squared, & ! In - clubb_l_prescribed_avg_deltaz, & ! In - clubb_l_lmm_stepping, & ! In - clubb_l_e3sm_config, & ! In - clubb_l_vary_convect_depth, & ! In - clubb_l_use_tke_in_wp3_pr_turb_term, & ! In - clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In - clubb_l_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_config_flags ) ! Out + if ( clubb_timestep == unset_r8 ) call endrun( sub//": FATAL: clubb_timestep is not set") + if ( clubb_rnevap_effic == unset_r8 ) call endrun( sub//": FATAL:clubb_rnevap_effic is not set") + + if ( clubb_c1 == unset_r8 ) call endrun( sub//": FATAL: clubb_c1 is not set") + if ( clubb_c1b == unset_r8 ) call endrun( sub//": FATAL: clubb_c1b is not set") + if ( clubb_C2rt == unset_r8 ) call endrun( sub//": FATAL: clubb_C2rt is not set") + if ( clubb_C2thl == unset_r8 ) call endrun( sub//": FATAL: clubb_C2thl is not set") + if ( clubb_C2rtthl == unset_r8 ) call endrun( sub//": FATAL: clubb_C2rtthl is not set") + if ( clubb_C4 == unset_r8 ) call endrun( sub//": FATAL: clubb_C4 is not set") + if ( clubb_C_uu_shr == unset_r8 ) call endrun( sub//": FATAL: clubb_C_uu_shr is not set") + if ( clubb_C_uu_buoy == unset_r8 ) call endrun( sub//": FATAL: clubb_C_uu_buoy is not set") + if ( clubb_c6rt == unset_r8 ) call endrun( sub//": FATAL: clubb_c6rt is not set") + if ( clubb_c6rtb == unset_r8 ) call endrun( sub//": FATAL: clubb_c6rtb is not set") + if ( clubb_c6rtc == unset_r8 ) call endrun( sub//": FATAL: clubb_c6rtc is not set") + if ( clubb_c6thl == unset_r8 ) call endrun( sub//": FATAL: clubb_c6thl is not set") + if ( clubb_c6thlb == unset_r8 ) call endrun( sub//": FATAL: clubb_c6thlb is not set") + if ( clubb_c6thlc == unset_r8 ) call endrun( sub//": FATAL: clubb_c6thlc is not set") + if ( clubb_wpxp_L_thresh == unset_r8 ) call endrun( sub//": FATAL: clubb_wpxp_L_thresh is not set") + if ( clubb_C8 == unset_r8 ) call endrun( sub//": FATAL: clubb_C8 is not set") + if ( clubb_C8b == unset_r8 ) call endrun( sub//": FATAL: clubb_C8b is not set") + if ( clubb_C7 == unset_r8 ) call endrun( sub//": FATAL: clubb_C7 is not set") + if ( clubb_C7b == unset_r8 ) call endrun( sub//": FATAL: clubb_C7b is not set") + if ( clubb_c11 == unset_r8 ) call endrun( sub//": FATAL: clubb_c11 is not set") + if ( clubb_c11b == unset_r8 ) call endrun( sub//": FATAL: clubb_c11b is not set") + if ( clubb_c14 == unset_r8 ) call endrun( sub//": FATAL: clubb_c14 is not set") + if ( clubb_C_wp3_pr_turb == unset_r8 ) call endrun( sub//": FATAL: clubb_C_wp3_pr_turb is not set") + if ( clubb_c_K1 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K1 is not set") + if ( clubb_c_K2 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K2 is not set") + if ( clubb_nu2 == unset_r8 ) call endrun( sub//": FATAL: clubb_nu2 is not set") + if ( clubb_c_K8 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K8 is not set") + if ( clubb_c_K9 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K9 is not set") + if ( clubb_nu9 == unset_r8 ) call endrun( sub//": FATAL: clubb_nu9 is not set") + if ( clubb_c_K10 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K10 is not set") + if ( clubb_c_K10h == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K10h is not set") + if ( clubb_C_invrs_tau_bkgnd == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_bkgnd is not set") + if ( clubb_C_invrs_tau_sfc == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_sfc is not set") + if ( clubb_C_invrs_tau_shear == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_shear is not set") + if ( clubb_C_invrs_tau_N2 == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2 is not set") + if ( clubb_C_invrs_tau_N2_wp2 == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2_wp2 is not set") + if ( clubb_C_invrs_tau_N2_xp2 == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2_xp2 is not set") + if ( clubb_C_invrs_tau_N2_wpxp == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2_wpxp is not set") + if ( clubb_C_invrs_tau_N2_clear_wp3 == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2_clear_wp3 is not set") + if ( clubb_gamma_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_gamma_coef is not set") + if ( clubb_gamma_coefb == unset_r8 ) call endrun( sub//": FATAL: clubb_gamma_coefb is not set") + if ( clubb_beta == unset_r8 ) call endrun( sub//": FATAL: clubb_beta is not set") + if ( clubb_lambda0_stability_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_lambda0_stability_coef is not set") + if ( clubb_lmin_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_lmin_coef is not set") + if ( clubb_mult_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_mult_coef is not set") + if ( clubb_Skw_denom_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_Skw_denom_coef is not set") + if ( clubb_skw_max_mag == unset_r8 ) call endrun( sub//": FATAL: clubb_skw_max_mag is not set") + if ( clubb_up2_sfc_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_up2_sfc_coef is not set") + if ( clubb_C_wp2_splat == unset_r8 ) call endrun( sub//": FATAL: clubb_C_wp2_splat is not set") + if ( clubb_bv_efold == unset_r8 ) call endrun( sub//": FATAL: clubb_bv_efold is not set") + if ( clubb_wpxp_Ri_exp == unset_r8 ) call endrun( sub//": FATAL: clubb_wpxp_Ri_exp is not set") + if ( clubb_z_displace == unset_r8 ) call endrun( sub//": FATAL: clubb_z_displace is not set") + if ( clubb_detliq_rad == unset_r8 ) call endrun( sub//": FATAL: clubb_detliq_rad not set") + if ( clubb_detice_rad == unset_r8 ) call endrun( sub//": FATAL: clubb_detice_rad not set") + if ( clubb_ipdf_call_placement == unset_i ) call endrun( sub//": FATAL: clubb_ipdf_call_placement not set") + if ( clubb_penta_solve_method == unset_i ) call endrun( sub//": FATAL: clubb_penta_solve_method not set") + if ( clubb_tridiag_solve_method == unset_i ) call endrun( sub//": FATAL: clubb_tridiag_solve_method not set") + if ( clubb_saturation_equation == unset_i ) call endrun( sub//": FATAL: clubb_saturation_equation not set") + if ( clubb_grid_remap_method == unset_i ) call endrun( sub//": FATAL: clubb_grid_remap_method not set") + if ( clubb_grid_adapt_in_time_method == unset_i ) call endrun( sub//": FATAL: clubb_grid_adapt_in_time_method not set") + if ( clubb_fill_holes_type == unset_i ) call endrun( sub//": FATAL: clubb_fill_holes_type not set") + + if ( clubb_detphase_lowtemp == unset_r8 ) call endrun( sub//": FATAL: clubb_detphase_lowtemp not set") + if ( clubb_detphase_lowtemp >= meltpt_temp ) call endrun( sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") + + call initialize_clubb_config_flags_type_api( clubb_iiPDF_type, & ! In + clubb_ipdf_call_placement, & ! In + clubb_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_config_flags ) ! Out #endif end subroutine clubb_readnl @@ -1398,7 +1439,7 @@ end subroutine clubb_readnl ! ! ! =============================================================================== ! - subroutine clubb_ini_cam(pbuf2d) + subroutine clubb_ini_cam(pbuf_ini) !------------------------------------------------------------------------------- ! Description: ! Initialize UWM CLUBB. @@ -1410,8 +1451,6 @@ subroutine clubb_ini_cam(pbuf2d) ! None !------------------------------------------------------------------------------- - - #ifdef CLUBB_SGS ! From CAM libraries @@ -1434,16 +1473,17 @@ subroutine clubb_ini_cam(pbuf2d) use clubb_api_module, only: & print_clubb_config_flags_api, & - setup_parameters_model_api, & check_clubb_settings_api, & init_pdf_params_api, & time_precision, & core_rknd, & set_clubb_debug_level_api, & clubb_fatal_error, & ! Error code value to indicate a fatal error + err_info_type, & + init_default_err_info_api, & + cleanup_err_info_api, & nparams, & - set_default_parameters_api, & - read_parameters_api, & + init_clubb_params_api, & w_tol_sqd, & rt_tol, & thl_tol, & @@ -1452,17 +1492,18 @@ subroutine clubb_ini_cam(pbuf2d) saturation_flatau, & ! Constant for Flatau approximations of saturation saturation_lookup ! Use a lookup table for mixing length - use time_manager, only: is_first_step + use time_manager, only: is_first_step use constituents, only: cnst_get_ind use phys_control, only: phys_getopts - use spmd_utils, only: iam use cam_logfile, only: iulog #endif use physics_buffer, only: pbuf_get_index, pbuf_set_field, physics_buffer_desc + implicit none + ! Input Variables - type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_buffer_desc), pointer :: pbuf_ini(:,:) #ifdef CLUBB_SGS @@ -1471,7 +1512,9 @@ subroutine clubb_ini_cam(pbuf2d) ! The similar name to clubb_history is unfortunate... logical :: history_amwg, history_clubb - integer :: err_code ! Code for when CLUBB fails + 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 @@ -1512,11 +1555,6 @@ subroutine clubb_ini_cam(pbuf2d) call endrun('clubb_ini_cam: CLUBB library core_rknd must match CAM r8 and it does not') 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 - nzm_clubb = pverp + 1 - top_lev - ! Allocate PDF parameters across columns and chunks allocate( & pdf_params_chnk(begchunk:endchunk), & @@ -1577,29 +1615,27 @@ subroutine clubb_ini_cam(pbuf2d) if (stats_metadata%l_stats) stats_metadata%l_stats_samp = .true. ! Define physics buffers indexes - cld_idx = pbuf_get_index('CLD') ! Cloud fraction - concld_idx = pbuf_get_index('CONCLD') ! Convective cloud cover - ast_idx = pbuf_get_index('AST') ! Stratiform cloud fraction - alst_idx = pbuf_get_index('ALST') ! Liquid stratiform cloud fraction - aist_idx = pbuf_get_index('AIST') ! Ice stratiform cloud fraction - qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC - 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 - sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction - relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance - accre_enhan_idx = pbuf_get_index('ACCRE_ENHAN') ! accretion enhancement for MG - prer_evap_idx = pbuf_get_index('PRER_EVAP') - qrl_idx = pbuf_get_index('QRL') - cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') - naai_idx = pbuf_get_index('NAAI') - npccn_idx = pbuf_get_index('NPCCN') - - + cld_idx = pbuf_get_index('CLD') ! Cloud fraction + concld_idx = pbuf_get_index('CONCLD') ! Convective cloud cover + ast_idx = pbuf_get_index('AST') ! Stratiform cloud fraction + alst_idx = pbuf_get_index('ALST') ! Liquid stratiform cloud fraction + aist_idx = pbuf_get_index('AIST') ! Ice stratiform cloud fraction + qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC + 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 + 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') + qrl_idx = pbuf_get_index('QRL') + cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') + naai_idx = pbuf_get_index('NAAI') + npccn_idx = pbuf_get_index('NPCCN') + + ! Scalars aren't in use, set all indices to -1 sclr_idx%iisclr_rt = -1 sclr_idx%iisclr_thl = -1 sclr_idx%iisclr_CO2 = -1 - sclr_idx%iiedsclr_rt = -1 sclr_idx%iiedsclr_thl = -1 sclr_idx%iiedsclr_CO2 = -1 @@ -1609,120 +1645,69 @@ subroutine clubb_ini_cam(pbuf2d) ! ----------------------------------------------------------------- ! if (clubb_l_do_expldiff_rtm_thlm) then - offset = 2 ! diffuse temperature and moisture explicitly - edsclr_dim = edsclr_dim + offset + ! add 2 since we want to diffuse temperature and moisture explicitly as well + edsclr_dim = edsclr_dim + 2 endif ! ----------------------------------------------------------------- ! ! Setup CLUBB core ! ----------------------------------------------------------------- ! - ! Read in parameters for CLUBB. Just read in default values - call set_default_parameters_api( & - C1, C1b, C1c, C2rt, C2thl, C2rtthl, & - C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, & - C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & - C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & - c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & - slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & - coef_spread_DG_means_rt, coef_spread_DG_means_thl, & - gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & - omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & - lambda0_stability_coef, mult_coef, taumin, taumax, & - Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & - Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & - thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & - Skw_max_mag, xp3_coef_base, xp3_coef_slope, & - altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & - C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & - C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & - C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & - C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & - Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & - wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace ) - - call read_parameters_api( 1, -99, "", & - C1, C1b, C1c, C2rt, C2thl, C2rtthl, & - C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, & - C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & - C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & - c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & - slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & - coef_spread_DG_means_rt, coef_spread_DG_means_thl, & - gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & - omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & - lambda0_stability_coef, mult_coef, taumin, taumax, & - Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & - Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & - thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & - Skw_max_mag, xp3_coef_base, xp3_coef_slope, & - altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & - C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & - C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & - C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & - C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & - Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & - wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace, & - clubb_params_single_col ) - - clubb_params_single_col(iC2rtthl) = clubb_C2rtthl - clubb_params_single_col(iC8) = clubb_C8 - clubb_params_single_col(iC11) = clubb_c11 - clubb_params_single_col(iC11b) = clubb_c11b - clubb_params_single_col(iC14) = clubb_c14 - clubb_params_single_col(iC_wp3_pr_turb) = clubb_C_wp3_pr_turb - clubb_params_single_col(ic_K10) = clubb_c_K10 - clubb_params_single_col(imult_coef) = clubb_mult_coef - clubb_params_single_col(iSkw_denom_coef) = clubb_Skw_denom_coef - clubb_params_single_col(iC2rt) = clubb_C2rt - clubb_params_single_col(iC2thl) = clubb_C2thl - clubb_params_single_col(ibeta) = clubb_beta - clubb_params_single_col(iC6rt) = clubb_c6rt - clubb_params_single_col(iC6rtb) = clubb_c6rtb - clubb_params_single_col(iC6rtc) = clubb_c6rtc - clubb_params_single_col(iC6thl) = clubb_c6thl - clubb_params_single_col(iC6thlb) = clubb_c6thlb - clubb_params_single_col(iC6thlc) = clubb_c6thlc - clubb_params_single_col(iwpxp_L_thresh) = clubb_wpxp_L_thresh - clubb_params_single_col(iC7) = clubb_C7 - clubb_params_single_col(iC7b) = clubb_C7b - clubb_params_single_col(igamma_coef) = clubb_gamma_coef - clubb_params_single_col(ic_K10h) = clubb_c_K10h - clubb_params_single_col(ilambda0_stability_coef) = clubb_lambda0_stability_coef - clubb_params_single_col(ilmin_coef) = clubb_lmin_coef - clubb_params_single_col(iC8b) = clubb_C8b - clubb_params_single_col(iskw_max_mag) = clubb_skw_max_mag - clubb_params_single_col(iC1) = clubb_C1 - clubb_params_single_col(iC1b) = clubb_C1b - clubb_params_single_col(igamma_coefb) = clubb_gamma_coefb - clubb_params_single_col(iup2_sfc_coef) = clubb_up2_sfc_coef - clubb_params_single_col(iC4) = clubb_C4 - clubb_params_single_col(iC_uu_shr) = clubb_C_uu_shr - clubb_params_single_col(iC_uu_buoy) = clubb_C_uu_buoy - clubb_params_single_col(ic_K1) = clubb_c_K1 - clubb_params_single_col(ic_K2) = clubb_c_K2 - clubb_params_single_col(inu2) = clubb_nu2 - clubb_params_single_col(ic_K8) = clubb_c_K8 - clubb_params_single_col(ic_K9) = clubb_c_K9 - clubb_params_single_col(inu9) = clubb_nu9 - clubb_params_single_col(iC_wp2_splat) = clubb_C_wp2_splat - clubb_params_single_col(iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd - clubb_params_single_col(iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc - clubb_params_single_col(iC_invrs_tau_shear) = clubb_C_invrs_tau_shear - clubb_params_single_col(iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 - clubb_params_single_col(iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 - clubb_params_single_col(iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 - clubb_params_single_col(iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp - clubb_params_single_col(iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 - clubb_params_single_col(ibv_efold) = clubb_bv_efold - clubb_params_single_col(iwpxp_Ri_exp) = clubb_wpxp_Ri_exp - clubb_params_single_col(iz_displace) = clubb_z_displace + call init_clubb_params_api( 1, -99, "", & + clubb_params_single_col ) + + clubb_params_single_col(1,iC2rtthl) = clubb_C2rtthl + clubb_params_single_col(1,iC8) = clubb_C8 + clubb_params_single_col(1,iC11) = clubb_c11 + clubb_params_single_col(1,iC11b) = clubb_c11b + clubb_params_single_col(1,iC14) = clubb_c14 + clubb_params_single_col(1,iC_wp3_pr_turb) = clubb_C_wp3_pr_turb + clubb_params_single_col(1,ic_K10) = clubb_c_K10 + clubb_params_single_col(1,imult_coef) = clubb_mult_coef + clubb_params_single_col(1,iSkw_denom_coef) = clubb_Skw_denom_coef + clubb_params_single_col(1,iC2rt) = clubb_C2rt + clubb_params_single_col(1,iC2thl) = clubb_C2thl + clubb_params_single_col(1,ibeta) = clubb_beta + clubb_params_single_col(1,iC6rt) = clubb_c6rt + clubb_params_single_col(1,iC6rtb) = clubb_c6rtb + clubb_params_single_col(1,iC6rtc) = clubb_c6rtc + clubb_params_single_col(1,iC6thl) = clubb_c6thl + clubb_params_single_col(1,iC6thlb) = clubb_c6thlb + clubb_params_single_col(1,iC6thlc) = clubb_c6thlc + clubb_params_single_col(1,iwpxp_L_thresh) = clubb_wpxp_L_thresh + clubb_params_single_col(1,iC7) = clubb_C7 + clubb_params_single_col(1,iC7b) = clubb_C7b + clubb_params_single_col(1,igamma_coef) = clubb_gamma_coef + clubb_params_single_col(1,ic_K10h) = clubb_c_K10h + clubb_params_single_col(1,ilambda0_stability_coef) = clubb_lambda0_stability_coef + clubb_params_single_col(1,ilmin_coef) = clubb_lmin_coef + clubb_params_single_col(1,iC8b) = clubb_C8b + clubb_params_single_col(1,iskw_max_mag) = clubb_skw_max_mag + clubb_params_single_col(1,iC1) = clubb_C1 + clubb_params_single_col(1,iC1b) = clubb_C1b + clubb_params_single_col(1,igamma_coefb) = clubb_gamma_coefb + clubb_params_single_col(1,iup2_sfc_coef) = clubb_up2_sfc_coef + clubb_params_single_col(1,iC4) = clubb_C4 + clubb_params_single_col(1,iC_uu_shr) = clubb_C_uu_shr + clubb_params_single_col(1,iC_uu_buoy) = clubb_C_uu_buoy + clubb_params_single_col(1,ic_K1) = clubb_c_K1 + clubb_params_single_col(1,ic_K2) = clubb_c_K2 + clubb_params_single_col(1,inu2) = clubb_nu2 + clubb_params_single_col(1,ic_K8) = clubb_c_K8 + clubb_params_single_col(1,ic_K9) = clubb_c_K9 + clubb_params_single_col(1,inu9) = clubb_nu9 + clubb_params_single_col(1,iC_wp2_splat) = clubb_C_wp2_splat + clubb_params_single_col(1,iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd + clubb_params_single_col(1,iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc + clubb_params_single_col(1,iC_invrs_tau_shear) = clubb_C_invrs_tau_shear + clubb_params_single_col(1,iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 + clubb_params_single_col(1,iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 + clubb_params_single_col(1,iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 + clubb_params_single_col(1,iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp + clubb_params_single_col(1,iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 + clubb_params_single_col(1,ibv_efold) = clubb_bv_efold + clubb_params_single_col(1,iwpxp_Ri_exp) = clubb_wpxp_Ri_exp + clubb_params_single_col(1,iz_displace) = clubb_z_displace ! Override clubb default if ( trim(subcol_scheme) == 'SILHS' ) then @@ -1731,29 +1716,31 @@ subroutine clubb_ini_cam(pbuf2d) clubb_config_flags%saturation_formula = saturation_gfdl ! Goff & Gratch (1946) approximation for SVP end if - ! Define model constant parameters - call setup_parameters_model_api( theta0, ts_nudge, clubb_params_single_col(iSkw_max_mag) ) - ! Set up CLUBB core. Note that some of these inputs are overwritten ! when clubb_tend_cam is called. The reason is that heights can change ! at each time step, which is why dummy arrays are read in here for heights ! as they are immediately overwrote. + !! Initialize err_info with default values since info is not available here + call init_default_err_info_api(1, err_info) !$OMP PARALLEL - call check_clubb_settings_api( nzm_clubb, clubb_params_single_col, & ! Intent(in) - l_implemented, & ! Intent(in) - l_input_fields, & ! Intent(in) - clubb_config_flags, & ! intent(in) - err_code ) ! Intent(out) - - if ( err_code == clubb_fatal_error ) then - call endrun('clubb_ini_cam: FATAL ERROR CALLING SETUP_CLUBB_CORE') + call check_clubb_settings_api( 1, clubb_params_single_col, & ! Intent(in) + l_implemented, & ! Intent(in) + l_input_fields, & ! Intent(in) + clubb_config_flags, & ! intent(in) + err_info ) ! Intent(inout) + + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun('clubb_ini_cam: FATAL ERROR CALLING CHECK_CLUBB_SETTINGS_API') end if !$OMP END PARALLEL + ! Cleanup err_info since it is not needed anymore + call cleanup_err_info_api(err_info) + ! Print the list of CLUBB parameters if ( masterproc ) then do j = 1, nparams, 1 - write(iulog,*) params_list(j), " = ", clubb_params_single_col(j) + write(iulog,*) params_list(j), " = ", clubb_params_single_col(1,j) enddo endif @@ -1768,70 +1755,70 @@ subroutine clubb_ini_cam(pbuf2d) ! ----------------------------------------------------------------- ! ! 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 ('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 ('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 ('PDFP_RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2','PDF Rtot 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 ('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 ('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 ('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 ('PBLH', horiz_only, 'A', 'm', 'PBL height', 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 ('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 ('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 ('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 ('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 ('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 ('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 ('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 ('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 ('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 ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB', 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 ('QSATFAC', (/ 'lev' /), 'A', '-', 'Subgrid cloud water saturation scaling factor', 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 ('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 ('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.) ! ---------------------------------------------------------------------------- ! ! Below are for detailed analysis of EDMF Scheme ! @@ -1878,11 +1865,11 @@ subroutine clubb_ini_cam(pbuf2d) if (stats_metadata%l_stats) then call stats_init_clubb( .true., dum1, dum2, & - nzm_clubb, nzm_clubb, nzm_clubb, dum3, & + nzm_clubb, nzt_clubb, nzm_clubb, dum3, & stats_zt(:), stats_zm(:), stats_sfc(:), & stats_rad_zt(:), stats_rad_zm(:)) - allocate(out_zt(pcols,pverp,stats_zt(1)%num_output_fields), stat=ierr) + allocate(out_zt(pcols,pver,stats_zt(1)%num_output_fields), stat=ierr) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zt' ) allocate(out_zm(pcols,pverp,stats_zm(1)%num_output_fields), stat=ierr) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zm' ) @@ -1890,7 +1877,7 @@ subroutine clubb_ini_cam(pbuf2d) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_sfc' ) if ( stats_metadata%l_output_rad_files ) then - allocate(out_radzt(pcols,pverp,stats_rad_zt(1)%num_output_fields), stat=ierr) + allocate(out_radzt(pcols,pver,stats_rad_zt(1)%num_output_fields), stat=ierr) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzt' ) allocate(out_radzm(pcols,pverp,stats_rad_zm(1)%num_output_fields), stat=ierr) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzm' ) @@ -1903,48 +1890,48 @@ subroutine clubb_ini_cam(pbuf2d) ! ----------------------------------------------------------------- ! if (clubb_do_adv .or. history_clubb) then - call add_default('RELVAR', 1, ' ') - call add_default('RHO_CLUBB', 1, ' ') - call add_default('UP2_CLUBB', 1, ' ') - call add_default('VP2_CLUBB', 1, ' ') - call add_default('WP2_CLUBB', 1, ' ') - call add_default('WP2_ZT_CLUBB', 1, ' ') - call add_default('WP3_CLUBB', 1, ' ') - call add_default('UPWP_CLUBB', 1, ' ') - call add_default('VPWP_CLUBB', 1, ' ') - call add_default('WPTHLP_CLUBB', 1, ' ') - call add_default('WPRTP_CLUBB', 1, ' ') - call add_default('RTP2_CLUBB', 1, ' ') - call add_default('RTP2_ZT_CLUBB', 1, ' ') - call add_default('PDFP_RTP2_CLUBB', 1, ' ') - call add_default('THLP2_CLUBB', 1, ' ') - call add_default('THLP2_ZT_CLUBB', 1, ' ') - call add_default('RTPTHLP_CLUBB', 1, ' ') - call add_default('RCM_CLUBB', 1, ' ') - call add_default('RTM_CLUBB', 1, ' ') - call add_default('THLM_CLUBB', 1, ' ') - call add_default('WPRCP_CLUBB', 1, ' ') - call add_default('CLOUDFRAC_CLUBB', 1, ' ') - call add_default('RCMINLAYER_CLUBB', 1, ' ') - call add_default('CLOUDCOVER_CLUBB', 1, ' ') - call add_default('WPTHVP_CLUBB', 1, ' ') - call add_default('RVMTEND_CLUBB', 1, ' ') - call add_default('STEND_CLUBB', 1, ' ') - call add_default('RCMTEND_CLUBB', 1, ' ') - call add_default('RIMTEND_CLUBB', 1, ' ') - call add_default('UTEND_CLUBB', 1, ' ') - call add_default('VTEND_CLUBB', 1, ' ') - call add_default('ZT_CLUBB', 1, ' ') - call add_default('ZM_CLUBB', 1, ' ') - call add_default('UM_CLUBB', 1, ' ') - call add_default('VM_CLUBB', 1, ' ') - call add_default('WM_ZT_CLUBB', 1, ' ') - call add_default('PBLH', 1, ' ') - call add_default('CONCLD', 1, ' ') + call add_default('RELVAR', 1, ' ') + call add_default('RHO_CLUBB', 1, ' ') + call add_default('UP2_CLUBB', 1, ' ') + call add_default('VP2_CLUBB', 1, ' ') + call add_default('WP2_CLUBB', 1, ' ') + call add_default('WP2_ZT_CLUBB', 1, ' ') + call add_default('WP3_CLUBB', 1, ' ') + call add_default('UPWP_CLUBB', 1, ' ') + call add_default('VPWP_CLUBB', 1, ' ') + call add_default('WPTHLP_CLUBB', 1, ' ') + call add_default('WPRTP_CLUBB', 1, ' ') + call add_default('RTP2_CLUBB', 1, ' ') + call add_default('RTP2_ZT_CLUBB', 1, ' ') + call add_default('PDFP_RTP2_CLUBB', 1, ' ') + call add_default('THLP2_CLUBB', 1, ' ') + call add_default('THLP2_ZT_CLUBB', 1, ' ') + call add_default('RTPTHLP_CLUBB', 1, ' ') + call add_default('RCM_CLUBB', 1, ' ') + call add_default('RTM_CLUBB', 1, ' ') + call add_default('THLM_CLUBB', 1, ' ') + call add_default('WPRCP_CLUBB', 1, ' ') + call add_default('CLOUDFRAC_CLUBB', 1, ' ') + call add_default('RCMINLAYER_CLUBB', 1, ' ') + call add_default('CLOUDCOVER_CLUBB', 1, ' ') + call add_default('WPTHVP_CLUBB', 1, ' ') + call add_default('RVMTEND_CLUBB', 1, ' ') + call add_default('STEND_CLUBB', 1, ' ') + call add_default('RCMTEND_CLUBB', 1, ' ') + call add_default('RIMTEND_CLUBB', 1, ' ') + call add_default('UTEND_CLUBB', 1, ' ') + call add_default('VTEND_CLUBB', 1, ' ') + call add_default('ZT_CLUBB', 1, ' ') + call add_default('ZM_CLUBB', 1, ' ') + call add_default('UM_CLUBB', 1, ' ') + call add_default('VM_CLUBB', 1, ' ') + call add_default('WM_ZT_CLUBB', 1, ' ') + call add_default('PBLH', 1, ' ') + call add_default('CONCLD', 1, ' ') endif if (history_amwg) then - call add_default('PBLH', 1, ' ') + call add_default('PBLH', 1, ' ') end if if (do_clubb_mf_diag) then @@ -1992,74 +1979,70 @@ subroutine clubb_ini_cam(pbuf2d) ! Is this the first time step? If so then initialize CLUBB variables as follows if (is_first_step()) then - call pbuf_set_field(pbuf2d, wp2_idx, w_tol_sqd) - call pbuf_set_field(pbuf2d, wp3_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthlp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wprtp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rtpthlp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rtp2_idx, rt_tol**2) - call pbuf_set_field(pbuf2d, thlp2_idx, thl_tol**2) - call pbuf_set_field(pbuf2d, up2_idx, w_tol_sqd) - call pbuf_set_field(pbuf2d, vp2_idx, w_tol_sqd) - - call pbuf_set_field(pbuf2d, rtp3_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlp3_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, up3_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vp3_idx, 0.0_r8) - - call pbuf_set_field(pbuf2d, upwp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vpwp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthvp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2thvp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rtpthvp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlpthvp_idx,0.0_r8) - call pbuf_set_field(pbuf2d, rcm_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, cloud_frac_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, radf_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2rtp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2thlp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, uprcp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vprcp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rc_coef_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp4_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpup2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpvp2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2up2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2vp2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, ice_supersat_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2_idx, w_tol_sqd) + call pbuf_set_field(pbuf_ini, wp3_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthlp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wprtp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rtpthlp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rtp2_idx, rt_tol**2) + call pbuf_set_field(pbuf_ini, thlp2_idx, thl_tol**2) + call pbuf_set_field(pbuf_ini, up2_idx, w_tol_sqd) + call pbuf_set_field(pbuf_ini, vp2_idx, w_tol_sqd) + + call pbuf_set_field(pbuf_ini, rtp3_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, thlp3_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, up3_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, vp3_idx, 0.0_r8) + + call pbuf_set_field(pbuf_ini, upwp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, vpwp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthvp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2thvp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rtpthvp_idx, 0.0_r8) + 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, 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) + call pbuf_set_field(pbuf_ini, vprcp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rc_coef_zm_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp4_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpup2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpvp2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2up2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2vp2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ice_supersat_idx, 0.0_r8) ! Initialize SILHS covariance contributions - call pbuf_set_field(pbuf2d, rtp2_mc_zt_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlp2_mc_zt_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wprtp_mc_zt_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthlp_mc_zt_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rtpthlp_mc_zt_idx, 0.0_r8) - - call pbuf_set_field(pbuf2d, pdf_zm_w_1_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, pdf_zm_w_2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_1_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, pdf_zm_mixt_frac_idx, 0.0_r8) - - call pbuf_set_field(pbuf2d, ttend_clubb_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, upwp_clubb_gw_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vpwp_clubb_gw_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlp2_clubb_gw_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthlp_clubb_gw_idx, 0.0_r8) - - call pbuf_set_field(pbuf2d, ttend_clubb_mc_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, upwp_clubb_gw_mc_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vpwp_clubb_gw_mc_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlp2_clubb_gw_mc_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthlp_clubb_gw_mc_idx, 0.0_r8) - + 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) + call pbuf_set_field(pbuf_ini, wprtp_mc_zt_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthlp_mc_zt_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rtpthlp_mc_zt_idx, 0.0_r8) + + call pbuf_set_field(pbuf_ini, pdf_zm_w_1_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, pdf_zm_w_2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, pdf_zm_varnce_w_1_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, pdf_zm_varnce_w_2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, pdf_zm_mixt_frac_idx, 0.0_r8) + + call pbuf_set_field(pbuf_ini, ttend_clubb_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, upwp_clubb_gw_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, vpwp_clubb_gw_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, thlp2_clubb_gw_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthlp_clubb_gw_idx, 0.0_r8) + + call pbuf_set_field(pbuf_ini, ttend_clubb_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, upwp_clubb_gw_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, vpwp_clubb_gw_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, thlp2_clubb_gw_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthlp_clubb_gw_mc_idx, 0.0_r8) endif ! The following is physpkg, so it needs to be initialized every time - call pbuf_set_field(pbuf2d, fice_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, fice_idx, 0.0_r8) ! --------------- ! ! End ! @@ -2106,9 +2089,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef CLUBB_SGS use holtslag_boville_diff, only: hb_pbl_dependent_coefficients_run + use spmd_utils, only: iam use clubb_api_module, only: & nparams, & - setup_parameters_api, & + calc_derrived_params_api, & + check_parameters_api, & time_precision, & advance_clubb_core_api, & zt2zm_api, zm2zt_api, & @@ -2127,10 +2112,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_parameter, & init_pdf_params_api, & init_pdf_implicit_coefs_terms_api, & - setup_grid_api + setup_grid_api, & + cleanup_grid_api, & + iiPDF_new, & + iiPDF_new_hybrid + ! Import setup for CLUBB error messaging use clubb_api_module, only: & - clubb_fatal_error ! Error code value to indicate a fatal error + clubb_fatal_error, & ! Error code value to indicate a fatal error + err_info_type, & + init_err_info_api, & + cleanup_err_info_api use cldfrc2m, only: aist_vector, rhmini_const, rhmaxi_const, rhminis_const, rhmaxis_const use cam_history, only: outfld @@ -2170,6 +2162,88 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check + ! ---------------------------------------------------- ! + ! Pointers for pbuf ! + ! ---------------------------------------------------- ! + + real(r8), pointer, dimension(:,:) :: wp2_pbuf ! vertical velocity variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: wp3_pbuf ! third moment of vertical velocity [m^3/s^3] + real(r8), pointer, dimension(:,:) :: wpthlp_pbuf ! turbulent flux of thetal [m/s K] + real(r8), pointer, dimension(:,:) :: wprtp_pbuf ! turbulent flux of moisture [m/s kg/kg] + real(r8), pointer, dimension(:,:) :: rtpthlp_pbuf ! covariance of thetal and qt [kg/kg K] + real(r8), pointer, dimension(:,:) :: rtp2_pbuf ! moisture variance [kg^2/kg^2] + real(r8), pointer, dimension(:,:) :: thlp2_pbuf ! temperature variance [K^2] + real(r8), pointer, dimension(:,:) :: rtp3_pbuf ! moisture 3rd order [kg^3/kg^3] + real(r8), pointer, dimension(:,:) :: thlp3_pbuf ! temperature 3rd order [K^3] + real(r8), pointer, dimension(:,:) :: up2_pbuf ! east-west wind variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vp2_pbuf ! north-south wind variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: up3_pbuf ! east-west wind 3rd order [m^3/s^3] + real(r8), pointer, dimension(:,:) :: vp3_pbuf ! north-south wind 3rd order [m^3/s^3] + real(r8), pointer, dimension(:,:) :: upwp_pbuf ! east-west momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vpwp_pbuf ! north-south momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: wpthvp_pbuf ! w'th_v' (momentum levels) [m/s K] + real(r8), pointer, dimension(:,:) :: wp2thvp_pbuf ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] + real(r8), pointer, dimension(:,:) :: wp2up_pbuf ! w'^2 u' (thermodynamic levels) [m^3/s^3] + real(r8), pointer, dimension(:,:) :: rtpthvp_pbuf ! r_t'th_v' (momentum levels) [kg/kg K] + real(r8), pointer, dimension(:,:) :: thlpthvp_pbuf ! th_l'th_v' (momentum levels) [K^2] + real(r8), pointer, dimension(:,:) :: pdf_zm_w_1_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_w_2_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: wp2rtp_pbuf ! w'^2 rt' (thermodynamic levels) + 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_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(:,:) :: 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] + real(r8), pointer, dimension(:,:) :: alst_pbuf ! liquid stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: aist_pbuf ! ice stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: qlst_pbuf ! Physical in-stratus LWC [kg/kg] + real(r8), pointer, dimension(:,:) :: qist_pbuf ! Physical in-stratus IWC [kg/kg] + real(r8), pointer, dimension(:,:) :: deepcu_pbuf ! deep convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: shalcu_pbuf ! shallow convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: khzm_pbuf ! CLUBB's eddy diffusivity of heat/moisture on momentum levels [m^2/s] + 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(:,:) :: 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 + real(r8), pointer, dimension(:,:) :: cmeliq_pbuf + real(r8), pointer, dimension(:,:) :: cmfmc_sh_pbuf ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] + + real(r8), pointer, dimension(:,:) :: qsatfac_pbuf + real(r8), pointer, dimension(:,:) :: npccn_pbuf + real(r8), pointer, dimension(:,:) :: prer_evap_pbuf + real(r8), pointer, dimension(:,:) :: qrl_pbuf + + ! SILHS covariance contributions + real(r8), pointer, dimension(:,:) :: rtp2_mc_zt_pbuf + real(r8), pointer, dimension(:,:) :: thlp2_mc_zt_pbuf + real(r8), pointer, dimension(:,:) :: wprtp_mc_zt_pbuf + real(r8), pointer, dimension(:,:) :: wpthlp_mc_zt_pbuf + real(r8), pointer, dimension(:,:) :: rtpthlp_mc_zt_pbuf + + ! Connections to Gravity Wave parameterization + real(r8), pointer, dimension(:,:) :: ttend_clubb_pbuf + real(r8), pointer, dimension(:,:) :: upwp_clubb_gw_pbuf + real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw_pbuf + real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw_pbuf + real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_pbuf + + real(r8), pointer, dimension(:,:) :: ttend_clubb_mc_pbuf + real(r8), pointer, dimension(:,:) :: upwp_clubb_gw_mc_pbuf + real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw_mc_pbuf + real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw_mc_pbuf + real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc_pbuf ! ---------------------------------------------------- ! ! Local Variables ! @@ -2179,46 +2253,36 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef CLUBB_SGS - type(physics_state) :: state1 ! Local copy of state variable + real(r8), parameter :: & + rad2deg=180.0_r8/pi + + character(len=*), parameter :: subr='clubb_tend_cam' + + type(physics_state) :: state_loc ! Local copy of state variable type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all - integer :: j, k, t, ixind, nadv - integer :: ixcldice, ixcldliq, ixnumliq, ixnumice, ixq - integer :: itim_old - integer :: ncol, lchnk ! # of columns, and chunk identifier - integer :: err_code ! Diagnostic, for if some calculation goes amiss. - integer :: icnt - logical :: lq2(pcnst) - - integer :: iter - - integer :: clubbtop(pcols) - - real(r8) :: frac_limit, ic_limit - - real(r8) :: dtime ! CLUBB time step [s] - real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m] - real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m] - real(r8) :: ubar ! surface wind [m/s] - real(r8) :: ustar ! surface stress [m/s] - real(r8) :: z0 ! roughness height [m] - real(r8) :: bflx22(pcols) ! Variable for buoyancy flux for pbl [K m/s] - real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2] - real(r8) :: zo(pcols) ! roughness height [m] - real(r8) :: dz_g(pcols,pver) ! thickness of layer [m] - real(r8) :: relvarmax - real(r8) :: se_upper_a(pcols), se_upper_b(pcols), se_upper_diss(pcols) - real(r8) :: tw_upper_a(pcols), tw_upper_b(pcols), tw_upper_diss(pcols) - - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES + type(err_info_type) :: & + err_info ! err_info struct used in CLUBB containing err_code and err_header + + type(grid) :: & + gr ! CLUBB grid data structure + + type(nu_vertical_res_dep) :: & + nu_vert_res_dep ! Vertical resolution dependent nu values + + real(r8), dimension(state%ncol,nparams) :: & + clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) + real(r8), dimension(state%ncol) :: & - fcor, & ! Coriolis forcing [s^-1] - sfc_elevation, & ! Elevation of ground [m AMSL][m] + deltaz, & + fcor, & ! Coriolis forcing [s^-1] + fcor_y, & ! Non-traditional coriolis forcing [s^-1] + sfc_elevation, & ! Elevation of ground [m AMSL][m] wpthlp_sfc, & ! w' theta_l' at surface [(m K)/s] wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)] upwp_sfc, & ! u'w' at surface [m^2/s^2] vpwp_sfc, & ! v'w' at surface [m^2/s^2] + p_sfc, & ! pressure at surface [Pa] upwp_sfc_pert, & ! perturbed u'w' at surface [m^2/s^2] vpwp_sfc_pert, & ! perturbed v'w' at surface [m^2/s^2] grid_dx, grid_dy ! CAM grid [m] @@ -2229,379 +2293,262 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,edsclr_dim) :: & wpedsclrp_sfc ! Eddy-scalar flux at surface [{units vary} m/s] - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES + real(r8), dimension(state%ncol,nzt_clubb) :: & + rtm, & ! mean moisture mixing ratio [kg/kg] + thlm, & ! mean temperature [K] + rcm, & ! CLUBB cloud water mixing ratio [kg/kg] + um, & ! mean east-west wind [m/s] + vm, & ! mean north-south wind [m/s] + thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] + rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] + vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] + wm_zt, & ! w mean wind component on thermo. levels [m/s] + rtm_ref, & ! Initial profile of rtm [kg/kg] + thlm_ref, & ! Initial profile of thlm [K] + um_ref, & ! Initial profile of um [m/s] + vm_ref, & ! Initial profile of vm [m/s] + ug, & ! U geostrophic wind [m/s] + vg, & ! V geostrophic wind [m/s] + p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] + rho_zt, & ! Air density on thermo levels [kg/m^3] + exner, & ! Exner function (thermodynamic levels) [-] + rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] + invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] + thv_ds_zt, & ! Dry, base-state theta_v on thermo. levels [K] + rfrzm, & + rvm_in, & ! water vapor mixing ratio [kg/kg] + rtp2_zt, & ! CLUBB R-tot variance on thermo levs + thl2_zt, & ! CLUBB Theta-l variance on thermo levs [K^2] + wp2_zt, & ! CLUBB W variance on theromo levs [m^2/s^2] + cloud_frac_inout, & ! CLUBB output of cloud fraction [fraction] + um_pert_inout, & ! Perturbed U wind [m/s] + vm_pert_inout, & ! Perturbed V wind [m/s] + khzt_out, & ! eddy diffusivity on thermo grids [m^2/s] + w_up_in_cloud_out, & + w_down_in_cloud_out, & + cloudy_updraft_frac_out, & + cloudy_downdraft_frac_out, & + rcm_in_layer, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] + cloud_cover_out, & ! CLUBB output of in-cloud cloud fraction [fraction] + pre_in, & ! input for precip evaporation + qrl_clubb, & + qclvar_out, & ! cloud water variance [kg^2/kg^2] + zt_g, & ! Thermodynamic grid of CLUBB [m] + Lscale, & + dz_g, & ! thickness of layer [m] + + ! MF local thermodynamic vars + invrs_exner_zt,& ! thermodynamic grid + kappa_zt ! thermodynamic grid + real(r8), dimension(state%ncol,nzm_clubb) :: & - thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] - rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] - um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] - vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] + thlp2_rad, & wprtp_forcing, & wpthlp_forcing, & rtp2_forcing, & thlp2_forcing, & rtpthlp_forcing, & - wm_zm, & ! w mean wind component on momentum levels [m/s] - wm_zt, & ! w mean wind component on thermo. levels [m/s] - rtm_ref, & ! Initial profile of rtm [kg/kg] - thlm_ref, & ! Initial profile of thlm [K] - um_ref, & ! Initial profile of um [m/s] - vm_ref, & ! Initial profile of vm [m/s] - ug, & ! U geostrophic wind [m/s] - vg, & ! V geostrophic wind [m/s] - p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] - rho_zm, & ! Air density on momentum levels [kg/m^3] - rho_zt, & ! Air density on thermo levels [kg/m^3] - exner, & ! Exner function (thermodynamic levels) [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] - thv_ds_zt, & ! Dry, base-state theta_v on thermo. levels [K] - rfrzm, & - radf, & - um_in, & ! meridional wind [m/s] - vm_in, & ! zonal wind [m/s] - upwp_in, & ! meridional wind flux [m^2/s^2] - vpwp_in, & ! zonal wind flux [m^2/s^2] - up2_in, & ! meridional wind variance [m^2/s^2] - vp2_in, & ! zonal wind variance [m^2/s^2] - up3_in, & ! meridional wind third-order [m^3/s^3] - vp3_in, & ! zonal wind third-order [m^3/s^3] - thlm_in, & ! liquid water potential temperature (thetal) [K] - rvm_in, & ! water vapor mixing ratio [kg/kg] - rtm_in, & ! total water mixing ratio [kg/kg] - wprtp_in, & ! turbulent flux of total water [kg/kg m/s] - wpthlp_in, & ! turbulent flux of thetal [K m/s] - wp2_in, & ! vertical velocity variance (CLUBB) [m^2/s^2] - wp3_in, & ! third moment vertical velocity [m^3/s^3] - rtp2_in, & ! total water variance [kg^2/kg^2] - rtp2_zt, & ! CLUBB R-tot variance on thermo levs - thl2_zt, & ! CLUBB Theta-l variance on thermo levs [K^2] - wp2_zt, & ! CLUBB W variance on theromo levs [m^2/s^2] - rtp3_in, & ! total water 3rd order [kg^3/kg^3] - thlp2_in, & ! thetal variance [K^2] - thlp3_in, & ! thetal 3rd order [K^3] - rtpthlp_in, & ! covariance of thetal and qt [kg/kg K] - rcm_inout, & ! CLUBB output of liquid water mixing ratio [kg/kg] - rcm_out_zm, & - cloud_frac_inout, & ! CLUBB output of cloud fraction [fraction] - wpthvp_in, & ! w'th_v' (momentum levels) [m/s K] - wp2thvp_in, & ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] - rtpthvp_in, & ! r_t'th_v' (momentum levels) [kg/kg K] - thlpthvp_in, & ! th_l'th_v' (momentum levels) [K^2] - ice_supersat_frac_inout, & - um_pert_inout, & ! Perturbed U wind [m/s] - vm_pert_inout, & ! Perturbed V wind [m/s] - upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2] - vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2] - khzm_out, & ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] - khzt_out, & ! eddy diffusivity on thermo grids [m^2/s] - qclvar_out, & ! cloud water variance [kg^2/kg^2] + wm_zm, & ! w mean wind component on momentum levels [m/s] + rho_zm, & ! Air density on momentum levels [kg/m^3] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] + upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2] + vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2] + khzm_out, & ! Eddy diffusivity of heat/moisture on momentum levels [m^2/s] thlprcp_out, & - wprcp_out, & ! CLUBB output of flux of liquid water [kg/kg m/s] - w_up_in_cloud_out, & - w_down_in_cloud_out, & - cloudy_updraft_frac_out, & - cloudy_downdraft_frac_out,& - rcm_in_layer_out, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] - cloud_cover_out, & ! CLUBB output of in-cloud cloud fraction [fraction] - invrs_tau_zm_out, & ! CLUBB output of 1 divided by time-scale [1/s] + wprcp_out, & ! CLUBB output of flux of liquid water [kg/kg m/s] + invrs_tau_zm_out, & ! CLUBB output of 1 divided by time-scale [1/s] rtp2_mc_out, & ! total water tendency from rain evap thlp2_mc_out, & ! thetal tendency from rain evap wprtp_mc_out, & wpthlp_mc_out, & rtpthlp_mc_out, & - pre_in, & ! input for precip evaporation - qrl_clubb, & - qrl_zm, & - wp2rtp_inout, & ! w'^2 rt' (thermodynamic levels) - wp2thlp_inout, & ! w'^2 thl' (thermodynamic levels) - uprcp_inout, & ! < u' r_c' > (momentum levels) - vprcp_inout, & ! < v' r_c' > (momentum levels) - rc_coef_inout, & ! Coef. of X'r_c' in Eq. (34) (t-levs.) - wp4_inout, & ! w'^4 (momentum levels - wpup2_inout, & ! w'u'^2 (thermodynamic levels) - wpvp2_inout, & ! w'v'^2 (thermodynamic levels) - wp2up2_inout, & ! w'^2 u'^2 (momentum levels) - wp2vp2_inout, & ! w'^2 v'^2 (momentum levels) - zt_g, & ! Thermodynamic grid of CLUBB [m] - zi_g ! Momentum grid of CLUBB [m] - - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES - real(r8), dimension(state%ncol,nzm_clubb,sclr_dim) :: & - sclrm_forcing, & ! Passive scalar forcing [{units vary}/s] + zi_g, & ! Momentum grid of CLUBB [m] + + ! MF Plume + mf_dry_a, mf_moist_a, & + mf_dry_w, mf_moist_w, & + mf_dry_qt, mf_moist_qt, & + mf_dry_thl, mf_moist_thl, & + mf_dry_u, mf_moist_u, & + mf_dry_v, mf_moist_v, & + mf_moist_qc, & + s_ae, s_aw, & + s_awthl, s_awqt, & + s_awql, s_awqi, & + s_awu, s_awv, & + mf_thlflx, mf_qtflx, & + + ! MF local momentum vars + rtm_zm_in, thlm_zm_in, & ! momentum grid + kappa_zm, p_in_Pa_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] - sclrp3, & ! sclr'^3 (thermo. levels) [{units vary}^3] - sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] - sclrpthlp, & ! sclr'thlp' (momentum levels) [{units vary} (K)] + sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] + sclrpthlp, & ! sclr'thlp' (momentum levels) [{units vary} (K)] wpsclrp, & ! w'sclr' (momentum levels) [{units vary} m/s] sclrpthvp_inout ! sclr'th_v' (momentum levels) [{units vary} (K)] - real(r8), dimension(state%ncol,nzm_clubb,edsclr_dim) :: & - edsclrm_forcing, & ! Eddy passive scalar forcing [{units vary}/s] - edsclr_in ! Scalars to be diffused through CLUBB [units vary] + real(r8), dimension(state%ncol,nzt_clubb,edsclr_dim) :: & + edsclrm_forcing, & ! Eddy passive scalar forcing [{units vary}/s] + edsclr_inout ! Scalars to be diffused through CLUBB [units vary] - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES - real(r8), dimension(state%ncol,nzm_clubb,hydromet_dim) :: & - hydromet, & - wphydrometp, & + real(r8), dimension(state%ncol,nzt_clubb,hydromet_dim) :: & wp2hmp, & rtphmp_zt, & thlphmp_zt - ! Variables below are needed to compute energy integrals for conservation - ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines - real(r8) :: te_a, se_a, ke_a, wv_a, wl_a - real(r8) :: te_b, se_b, ke_b, wv_b, wl_b - real(r8) :: se_dis(pcols), clubb_s(pcols,pver), eleak(pcols) - - real(r8) :: inv_exner_clubb(pcols,pverp) ! Inverse exner function consistent with CLUBB [-] - real(r8) :: inv_exner_clubb_surf(pcols) ! Inverse exner function at the surface - real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2] - real(r8) :: wprtp_output(pcols,pverp) ! Total water flux output variable [W/m2] - real(r8) :: wp3_output(pcols,pverp) ! wp3 output [m^3/s^3] - real(r8) :: rtpthlp_output(pcols,pverp) ! rtpthlp ouptut [K kg/kg] - real(r8) :: qt_output(pcols,pver) ! Total water mixing ratio for output [kg/kg] - real(r8) :: thetal_output(pcols,pver) ! Liquid water potential temperature output [K] - real(r8) :: sl_output(pcols,pver) ! Liquid water static energy [J/kg] - real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2] - real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3] - real(r8) :: thv(pcols,pverp) ! virtual potential temperature [K] - real(r8) :: edsclr_out(pcols,pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] - real(r8) :: rcm_in_layer(pcols,pverp) ! CLUBB in-cloud liquid water mixing ratio [kg/kg] - real(r8) :: cloud_cover(pcols,pverp) ! CLUBB in-cloud cloud fraction [fraction] - real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg] - real(r8) :: wpthvp_diag(pcols,pverp) ! CLUBB buoyancy flux [W/m^2] - real(r8) :: rvm(pcols,pverp) - real(r8) :: pdfp_rtp2(pcols, pverp) ! Calculated R-tot variance from pdf_params [kg^2/kg^2] - real(r8) :: rtp2_zt_out(pcols, pverp) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] - real(r8) :: thl2_zt_out(pcols, pverp) ! CLUBB Theta-l variance on thermo levs - real(r8) :: wp2_zt_out(pcols, pverp) - real(r8) :: dlf_liq_out(pcols, pverp) ! Detrained liquid water from ZM [kg/kg/s] - real(r8) :: dlf_ice_out(pcols, pverp) ! Detrained ice water from ZM [kg/kg/s] - real(r8) :: wm_zt_out(pcols, pverp) ! CLUBB mean W on thermo levs output [m/s] - real(r8) :: mean_rt ! Calculated R-tot mean from pdf_params (temp) [kg/kg] - real(r8) :: dlf2(pcols,pver) ! Detraining cld H20 from shallow convection [kg/kg/day] - real(r8) :: eps ! Rv/Rd [-] - real(r8) :: dum1 ! dummy variable [units vary] - real(r8) :: obklen(pcols) ! Obukov length [m] - real(r8) :: kbfs(pcols) ! Kinematic Surface heat flux [K m/s] - real(r8) :: th(pcols,pver) ! potential temperature [K] - real(r8) :: dummy2(pcols) ! dummy variable [units vary] - real(r8) :: dummy3(pcols) ! dummy variable [units vary] - real(r8) :: kinheat(pcols) ! Kinematic Surface heat flux [K m/s] - real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3] - real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s] - real(r8) :: latsub - real(r8) :: thlp2_rad_out(pcols,nzm_clubb) - real(r8) :: apply_const, rtm_test - real(r8) :: dl_rad, di_rad, dt_low - - character(len=200) :: temp1, sub ! Strings needed for CLUBB output - real(kind=time_precision) :: time_elapsed ! time keep track of stats [s] - integer :: stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] - - real(r8) :: rtm_integral_vtend(pcols), & - rtm_integral_ltend(pcols) - - - real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing - - ! ---------------------------------------------------- ! - ! Pointers ! - ! ---------------------------------------------------- ! - - real(r8), pointer, dimension(:,:) :: wp2 ! vertical velocity variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: wp3 ! third moment of vertical velocity [m^3/s^3] - real(r8), pointer, dimension(:,:) :: wpthlp ! turbulent flux of thetal [m/s K] - real(r8), pointer, dimension(:,:) :: wprtp ! turbulent flux of moisture [m/s kg/kg] - real(r8), pointer, dimension(:,:) :: rtpthlp ! covariance of thetal and qt [kg/kg K] - real(r8), pointer, dimension(:,:) :: rtp2 ! moisture variance [kg^2/kg^2] - real(r8), pointer, dimension(:,:) :: thlp2 ! temperature variance [K^2] - real(r8), pointer, dimension(:,:) :: rtp3 ! moisture 3rd order [kg^3/kg^3] - real(r8), pointer, dimension(:,:) :: thlp3 ! temperature 3rd order [K^3] - real(r8), pointer, dimension(:,:) :: up2 ! east-west wind variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: vp2 ! north-south wind variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: up3 ! east-west wind 3rd order [m^3/s^3] - real(r8), pointer, dimension(:,:) :: vp3 ! north-south wind 3rd order [m^3/s^3] - real(r8), pointer, dimension(:,:) :: upwp ! east-west momentum flux [m^2/s^2] - real(r8), pointer, dimension(:,:) :: vpwp ! north-south momentum flux [m^2/s^2] - real(r8), pointer, dimension(:,:) :: wpthvp ! w'th_v' (momentum levels) [m/s K] - real(r8), pointer, dimension(:,:) :: wp2thvp ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] - real(r8), pointer, dimension(:,:) :: rtpthvp ! r_t'th_v' (momentum levels) [kg/kg K] - real(r8), pointer, dimension(:,:) :: thlpthvp ! th_l'th_v' (momentum levels) [K^2] - real(r8), pointer, dimension(:,:) :: cloud_frac ! Cloud fraction (thermodynamic levels) [K^2] - real(r8), pointer, dimension(:,:) :: pdf_zm_w_1 !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_w_2 !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1 !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2 !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: wp2rtp ! w'^2 rt' (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: wp2thlp ! w'^2 thl' (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: uprcp ! < u' r_c' > (momentum levels) - real(r8), pointer, dimension(:,:) :: vprcp ! < v' r_c' > (momentum levels) - real(r8), pointer, dimension(:,:) :: rc_coef ! Coef. of X'r_c' in Eq. (34) (t-levs.) - real(r8), pointer, dimension(:,:) :: wp4 ! w'^4 (momentum levels - real(r8), pointer, dimension(:,:) :: wpup2 ! w'u'^2 (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: wpvp2 ! w'v'^2 (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: wp2up2 ! w'^2 u'^2 (momentum levels) - real(r8), pointer, dimension(:,:) :: wp2vp2 ! w'^2 v'^2 (momentum levels) - real(r8), pointer, dimension(:,:) :: thlm ! mean temperature [K] - real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: rcm ! CLUBB cloud water mixing ratio [kg/kg] - real(r8), pointer, dimension(:) :: ztodtptr ! timestep to send to SILHS - real(r8), pointer, dimension(:,:) :: um ! mean east-west wind [m/s] - real(r8), pointer, dimension(:,:) :: vm ! mean north-south wind [m/s] - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: concld ! convective cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: ast ! stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: alst ! liquid stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: aist ! ice stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: qlst ! Physical in-stratus LWC [kg/kg] - real(r8), pointer, dimension(:,:) :: qist ! Physical in-stratus IWC [kg/kg] - real(r8), pointer, dimension(:,:) :: deepcu ! deep convection cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: shalcu ! shallow convection cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: khzm ! CLUBB's eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] - real(r8), pointer, dimension(:) :: pblh ! planetary boundary layer height [m] - real(r8), pointer, dimension(:,:) :: tke ! turbulent kinetic energy [m^2/s^2] - real(r8), pointer, dimension(:,:) :: dp_icwmr ! deep convection in cloud mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! Cloud fraction of ice clouds (pverp)[fraction] - real(r8), pointer, dimension(:,:) :: relvar ! relative cloud water variance [-] - real(r8), pointer, dimension(:,:) :: accre_enhan ! accretion enhancement factor [-] - real(r8), pointer, dimension(:,:) :: naai - real(r8), pointer, dimension(:,:) :: cmeliq - real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] - - real(r8), pointer, dimension(:,:) :: qsatfac - real(r8), pointer, dimension(:,:) :: npccn - real(r8), pointer, dimension(:,:) :: prer_evap - real(r8), pointer, dimension(:,:) :: qrl - real(r8), pointer, dimension(:,:) :: radf_clubb + real(r8), dimension(state%ncol,nzm_clubb,hydromet_dim) :: & + wphydrometp - ! SILHS covariance contributions - real(r8), pointer, dimension(:,:) :: rtp2_mc_zt - real(r8), pointer, dimension(:,:) :: thlp2_mc_zt - real(r8), pointer, dimension(:,:) :: wprtp_mc_zt - real(r8), pointer, dimension(:,:) :: wpthlp_mc_zt - real(r8), pointer, dimension(:,:) :: rtpthlp_mc_zt - ! Connections to Gravity Wave parameterization - real(r8), pointer, dimension(:,:) :: ttend_clubb - real(r8), pointer, dimension(:,:) :: upwp_clubb_gw - real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw - real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw - real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw - - real(r8), pointer, dimension(:,:) :: ttend_clubb_mc - real(r8), pointer, dimension(:,:) :: upwp_clubb_gw_mc - real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw_mc - real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw_mc - real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc - - - real(r8) qitend(pcols,pver) - real(r8) initend(pcols,pver) ! Needed for ice supersaturation adjustment calculation - - ! ZM microphysics - real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. - real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen. - real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen. - - real(r8) :: stend(pcols,pver) - real(r8) :: qvtend(pcols,pver) - real(r8) :: qctend(pcols,pver) - real(r8) :: inctend(pcols,pver) - real(r8) :: fqtend(pcols,pver) - real(r8) :: rhmini(pcols) - real(r8) :: rhmaxi(pcols) - integer :: troplev(pcols) - logical :: lqice(pcnst) - logical :: apply_to_surface(pcols) - - ! 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(pcols,pverp) :: mf_dry_a_output, mf_moist_a_output, & - mf_dry_w_output, mf_moist_w_output, & - mf_dry_qt_output, mf_moist_qt_output, & - mf_dry_thl_output, mf_moist_thl_output, & - mf_dry_u_output, mf_moist_u_output, & - mf_dry_v_output, mf_moist_v_output, & - mf_moist_qc_output, & - s_ae_output, s_aw_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 - ! MF Plume - ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines - real(r8), dimension(pcols,pverp) :: mf_dry_a, mf_moist_a, & - mf_dry_w, mf_moist_w, & - mf_dry_qt, mf_moist_qt, & - mf_dry_thl, mf_moist_thl, & - mf_dry_u, mf_moist_u, & - mf_dry_v, mf_moist_v, & - mf_moist_qc, & - s_ae, s_aw, & - s_awthl, s_awqt, & - s_awql, s_awqi, & - s_awu, s_awv, & - mf_thlflx, mf_qtflx - - real(r8) :: inv_rh2o ! To reduce the number of divisions in clubb_tend - - ! MF local vars - real(r8), dimension(pcols,pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid - dzt, invrs_dzt, & ! thermodynamic grid - invrs_exner_zt,& ! thermodynamic grid - kappa_zt, qc_zt, & ! thermodynamic grid - kappa_zm, p_in_Pa_zm, & ! momentum grid - invrs_exner_zm ! momentum grid - - real(r8) :: temp2d(pcols,pver), temp2dp(pcols,pverp) ! temporary array for holding scaled outputs + ! Variables used for output (zm) + real(r8), dimension(pcols,pverp) :: & + zi_output, & ! output for momentum CLUBB grid [m] + wpthlp_output, & ! Heat flux output variable [W/m2] + rtpthlp_output, & ! rtpthlp ouptut [K kg/kg] + wprtp_output, & ! Total water flux output variable [W/m2] + wp2_output, & + up2_output, & + vp2_output, & + upwp_output, & + vpwp_output, & + rtp2_output, & + wprcp_clubb_output, & + wpthvp_clubb_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] + + ! 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, & + mf_dry_thl_output, mf_moist_thl_output, & + mf_dry_u_output, mf_moist_u_output, & + mf_dry_v_output, mf_moist_v_output, & + mf_moist_qc_output, & + s_ae_output, s_aw_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 + + ! Variables used for output (zt) + real(r8), dimension(pcols,pver) :: & + rvmtend_clubb_output, & + rcmtend_clubb_output, & + rimtend_clubb_output, & + stend_clubb_output, & + utend_clubb_output, & + vtend_clubb_output, & + dpdlfliq_output, & + dpdlfice_output, & + dpdlft_output, & + detnliquid_output, & + zt_output, & ! output for the thermo CLUBB grid [m] + 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, & + 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] + rcm_output, & + rtm_output, & + thlm_output, & + um_output, & + vm_output + + real(r8), dimension(pcols) :: & + rhmini, & + rhmaxi, & + se_dis, & + eleak, & + ustar2, & ! Surface stress for PBL height [m2/s2] + obklen, & ! Obukov length [m] + kbfs, & ! Kinematic Surface heat flux [K m/s] + kinheat, & ! Kinematic Surface heat flux [K m/s] + rrho, & ! Inverse of air density [1/kg/m^3] + kinwat, & ! Kinematic water vapor flux [m/s] + dummy2, & ! dummy variable [units vary] + dummy3 ! dummy variable [units vary] real(r8), dimension(pcols,pver) :: & - rvmtend_clubb, & - rcmtend_clubb, & - rimtend_clubb, & - stend_clubb, & - utend_clubb, & - vtend_clubb, & - dpdlfliq, & - dpdlfice, & - dpdlft, & - detnliquid + invrs_cpairv, & + temp2d, & ! temporary array for holding scaled outputs + qitend, & + initend, & ! Needed for ice supersaturation adjustment calculation + stend, & + qvtend, & + qctend, & + inctend, & + clubb_s, & + thv, & ! virtual potential temperature [K] + th ! potential temperature [K] real(r8), dimension(pcols,pverp) :: & - wprcp_clubb, & - wpthvp_clubb + rho ! Midpoint density in CAM [kg/m^3] - intrinsic :: max + real(r8) :: & + invrs_dz_g, & ! Inverse of layer thickness [1/m] + 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, & + invrs_macmic_num_steps, & + lmin, & + mixt_frac_max_mag, & + dtime, & ! CLUBB time step [s] + ubar, & ! surface wind [m/s] + ustar, & ! surface stress [m/s] + bflx22, & ! Variable for buoyancy flux for pbl [K m/s] + zo, & ! roughness height [m] + relvarmax, & + frac_limit, & + ic_limit, & + mean_rt, & ! Calculated R-tot mean from pdf_params (temp) [kg/kg] + latsub, & + apply_const, & + dl_rad, di_rad, dt_low, & + rrho_tmp, & + ! 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 - character(len=*), parameter :: subr='clubb_tend_cam' - real(r8), parameter :: rad2deg=180.0_r8/pi - real(r8) :: tmp_lon1, tmp_lonN + intrinsic :: max - type(grid) :: gr + logical, dimension(pcnst) :: & + lq2, & + lqice - type(nu_vertical_res_dep) :: nu_vert_res_dep ! Vertical resolution dependent nu values - real(r8) :: lmin + character(len=200) :: temp1, sub ! Strings needed for CLUBB output + character(len=512) :: errmsg - real(r8), dimension(state%ncol,nparams) :: & - clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) + integer, dimension(pcols) :: & + clubbtop, & + troplev integer :: & - sclr, & - edsclr, & - n - - ! dummy outputs for CCPP-ized subroutines - character(len=512) :: errmsg - integer :: errflg + errflg, & + j, k, t, ixind, nadv, n, & ! Loop variables + k_cam, k_clubb, sclr, edsclr, & ! Loop variables + ixcldice, ixcldliq, ixnumliq, & + ixnumice, ixq, & + itim_old, & + ncol, lchnk, & ! # of columns, and chunk identifier + icnt, & + stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] #endif @@ -2616,10 +2563,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef _OPENACC ! These options have not been GPUized - if ( do_clubb_mf ) call endrun(subr//': do_clubb_mf=.true. not available when compiling with OpenACC') - if ( do_rainturb ) call endrun(subr//': do_rainturb=.true. not available when compiling with OpenACC') - if ( do_cldcool ) call endrun(subr//': do_cldcool=.true. not available when compiling with OpenACC') - if ( clubb_do_icesuper ) call endrun(subr//': clubb_do_icesuper=.true. not available when compiling with OpenACC') + if ( clubb_l_ascending_grid ) call endrun(subr//': clubb_l_ascending_grid=.true. not available when compiling with OpenACC') + if ( do_clubb_mf ) call endrun(subr//': do_clubb_mf=.true. not available when compiling with OpenACC') + if ( do_rainturb ) call endrun(subr//': do_rainturb=.true. not available when compiling with OpenACC') + if ( do_cldcool ) call endrun(subr//': do_cldcool=.true. not available when compiling with OpenACC') + if ( clubb_do_icesuper ) call endrun(subr//': clubb_do_icesuper=.true. not available when compiling with OpenACC') if ( single_column .and. .not. scm_cambfb_mode ) then call endrun(subr//': (single_column && !scm_cambfb_mode)=.true. not available when compiling with OpenACC') end if @@ -2629,7 +2577,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! MAIN COMPUTATION BEGINS HERE ! !-----------------------------------------------------------------------------------! - call t_startf('clubb_tend_cam:NAR') + call t_startf('clubb_tend_cam:non_acc_region') ! Get indicees for cloud and ice mass and cloud and ice number call cnst_get_ind('Q',ixq) @@ -2642,120 +2590,112 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & itim_old = pbuf_old_tim_idx() ! Establish associations between pointers and physics buffer fields - call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wprtp_idx, wprtp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtp2_idx, rtp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, thlp2_idx, thlp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, up2_idx, up2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vp2_idx, vp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - - call pbuf_get_field(pbuf, rtp3_idx, rtp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, thlp3_idx, thlp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, up3_idx, up3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vp3_idx, vp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - - call pbuf_get_field(pbuf, upwp_idx, upwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vpwp_idx, vpwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wpthvp_idx, wpthvp) - call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp) - call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp) - call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp) - call pbuf_get_field(pbuf, rcm_idx, rcm) - call pbuf_get_field(pbuf, cloud_frac_idx, cloud_frac) - - call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, pdf_zm_varnce_w_1_idx, pdf_zm_varnce_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, pdf_zm_varnce_w_2_idx, pdf_zm_varnce_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, pdf_zm_mixt_frac_idx, pdf_zm_mixt_frac, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - - call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp) - call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp) - call pbuf_get_field(pbuf, uprcp_idx, uprcp) - call pbuf_get_field(pbuf, vprcp_idx, vprcp) - call pbuf_get_field(pbuf, rc_coef_idx, rc_coef) - call pbuf_get_field(pbuf, wp4_idx, wp4) - call pbuf_get_field(pbuf, wpup2_idx, wpup2) - call pbuf_get_field(pbuf, wpvp2_idx, wpvp2) - call pbuf_get_field(pbuf, wp2up2_idx, wp2up2) - call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2) - call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - - call pbuf_get_field(pbuf, tke_idx, tke) - call pbuf_get_field(pbuf, qrl_idx, qrl) - call pbuf_get_field(pbuf, radf_idx, radf_clubb) - - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - call pbuf_get_field(pbuf, qsatfac_idx, qsatfac) - - call pbuf_get_field(pbuf, prer_evap_idx, prer_evap) - call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan) - call pbuf_get_field(pbuf, cmeliq_idx, cmeliq) - call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) - call pbuf_get_field(pbuf, ztodt_idx, ztodtptr) - call pbuf_get_field(pbuf, relvar_idx, relvar) - call pbuf_get_field(pbuf, dp_frac_idx, deepcu) - call pbuf_get_field(pbuf, sh_frac_idx, shalcu) - call pbuf_get_field(pbuf, kvh_idx, khzm) - call pbuf_get_field(pbuf, pblh_idx, pblh) - call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr) - call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh) + call pbuf_get_field(pbuf, wp2_idx, wp2_pbuf ) + call pbuf_get_field(pbuf, wp3_idx, wp3_pbuf ) + call pbuf_get_field(pbuf, wpthlp_idx, wpthlp_pbuf ) + call pbuf_get_field(pbuf, wprtp_idx, wprtp_pbuf ) + call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp_pbuf ) + call pbuf_get_field(pbuf, rtp2_idx, rtp2_pbuf ) + call pbuf_get_field(pbuf, thlp2_idx, thlp2_pbuf ) + call pbuf_get_field(pbuf, up2_idx, up2_pbuf ) + call pbuf_get_field(pbuf, vp2_idx, vp2_pbuf ) + + call pbuf_get_field(pbuf, rtp3_idx, rtp3_pbuf ) + call pbuf_get_field(pbuf, thlp3_idx, thlp3_pbuf ) + call pbuf_get_field(pbuf, up3_idx, up3_pbuf ) + call pbuf_get_field(pbuf, vp3_idx, vp3_pbuf ) + + call pbuf_get_field(pbuf, upwp_idx, upwp_pbuf ) + call pbuf_get_field(pbuf, vpwp_idx, vpwp_pbuf ) + call pbuf_get_field(pbuf, wpthvp_idx, wpthvp_pbuf) + call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp_pbuf) + call pbuf_get_field(pbuf, wp2up_idx, wp2up_pbuf) + call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp_pbuf) + call pbuf_get_field(pbuf, thlpthvp_idx, thlpthvp_pbuf) + + call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1_pbuf ) + call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2_pbuf ) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_1_idx, pdf_zm_varnce_w_1_pbuf ) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_2_idx, pdf_zm_varnce_w_2_pbuf ) + call pbuf_get_field(pbuf, pdf_zm_mixt_frac_idx, pdf_zm_mixt_frac_pbuf ) + + call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp_pbuf ) + call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp_pbuf ) + call pbuf_get_field(pbuf, uprcp_idx, uprcp_pbuf ) + call pbuf_get_field(pbuf, vprcp_idx, vprcp_pbuf ) + call pbuf_get_field(pbuf, rc_coef_zm_idx, rc_coef_zm_pbuf ) + call pbuf_get_field(pbuf, wp4_idx, wp4_pbuf ) + call pbuf_get_field(pbuf, wpup2_idx, wpup2_pbuf ) + call pbuf_get_field(pbuf, wpvp2_idx, wpvp2_pbuf ) + call pbuf_get_field(pbuf, wp2up2_idx, wp2up2_pbuf ) + call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2_pbuf ) + + call pbuf_get_field(pbuf, tke_idx, tke_pbuf) + call pbuf_get_field(pbuf, qrl_idx, qrl_pbuf) + + call pbuf_get_field(pbuf, cld_idx, cld_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, concld_idx, concld_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, ast_idx, ast_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, alst_idx, alst_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, aist_idx, aist_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, qlst_idx, qlst_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, qist_idx, qist_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, qsatfac_idx, qsatfac_pbuf) + + call pbuf_get_field(pbuf, prer_evap_idx, prer_evap_pbuf) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_pbuf) + call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac_pbuf) + call pbuf_get_field(pbuf, relvar_idx, relvar_pbuf) + call pbuf_get_field(pbuf, dp_frac_idx, deepcu_pbuf) + call pbuf_get_field(pbuf, sh_frac_idx, shalcu_pbuf) + 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, cmfmc_sh_idx, cmfmc_sh_pbuf) ! SILHS covariance contributions - call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt) - call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt) - call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) - call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) - call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) + 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) + call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt_pbuf) + call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt_pbuf) + call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt_pbuf) ! For Gravity Wave - call pbuf_get_field(pbuf, ttend_clubb_idx, ttend_clubb ) - call pbuf_get_field(pbuf, thlp2_clubb_gw_idx, thlp2_clubb_gw ) - call pbuf_get_field(pbuf, upwp_clubb_gw_idx, upwp_clubb_gw ) - call pbuf_get_field(pbuf, vpwp_clubb_gw_idx, vpwp_clubb_gw ) - call pbuf_get_field(pbuf, wpthlp_clubb_gw_idx, wpthlp_clubb_gw ) - - call pbuf_get_field(pbuf, ttend_clubb_mc_idx, ttend_clubb_mc ) - call pbuf_get_field(pbuf, thlp2_clubb_gw_mc_idx, thlp2_clubb_gw_mc ) - call pbuf_get_field(pbuf, upwp_clubb_gw_mc_idx, upwp_clubb_gw_mc ) - call pbuf_get_field(pbuf, vpwp_clubb_gw_mc_idx, vpwp_clubb_gw_mc ) - call pbuf_get_field(pbuf, wpthlp_clubb_gw_mc_idx, wpthlp_clubb_gw_mc ) + call pbuf_get_field(pbuf, ttend_clubb_idx, ttend_clubb_pbuf ) + call pbuf_get_field(pbuf, thlp2_clubb_gw_idx, thlp2_clubb_gw_pbuf ) + call pbuf_get_field(pbuf, upwp_clubb_gw_idx, upwp_clubb_gw_pbuf ) + call pbuf_get_field(pbuf, vpwp_clubb_gw_idx, vpwp_clubb_gw_pbuf ) + call pbuf_get_field(pbuf, wpthlp_clubb_gw_idx, wpthlp_clubb_gw_pbuf ) + + call pbuf_get_field(pbuf, ttend_clubb_mc_idx, ttend_clubb_mc_pbuf ) + call pbuf_get_field(pbuf, thlp2_clubb_gw_mc_idx, thlp2_clubb_gw_mc_pbuf ) + call pbuf_get_field(pbuf, upwp_clubb_gw_mc_idx, upwp_clubb_gw_mc_pbuf ) + call pbuf_get_field(pbuf, vpwp_clubb_gw_mc_idx, vpwp_clubb_gw_mc_pbuf ) + call pbuf_get_field(pbuf, wpthlp_clubb_gw_mc_idx, wpthlp_clubb_gw_mc_pbuf ) if (clubb_do_icesuper) then - call pbuf_get_field(pbuf, naai_idx, naai) + call pbuf_get_field(pbuf, naai_idx, naai_pbuf) end if ! Initialize physics tendency arrays call physics_ptend_init(ptend_all, state%psetcols, 'clubb') - ! Copy the state to state1 array to use in this routine - call physics_state_copy(state, state1) + ! Copy the state to state_loc array to use in this routine + call physics_state_copy(state, state_loc) ! Constituents are all treated as dry mmr by clubb. Convert the water species to ! a dry basis. - call set_wet_to_dry(state1, convert_cnst_type='wet') + call set_wet_to_dry(state_loc, convert_cnst_type='wet') if (clubb_do_liqsupersat) then - call pbuf_get_field(pbuf, npccn_idx, npccn) + call pbuf_get_field(pbuf, npccn_idx, npccn_pbuf) endif ! Define the grid box size. CLUBB needs this information to determine what ! the maximum length scale should be. This depends on the column for ! variable mesh grids and lat-lon grids - call grid_size(state1, grid_dx, grid_dy) + call grid_size(state_loc, grid_dx, grid_dy) ! Determine number of columns and which chunk computation is to be performed on ncol = state%ncol @@ -2763,24 +2703,34 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Allocate pdf_params only if they aren't allocated already. if ( .not. allocated(pdf_params_chnk(lchnk)%mixt_frac) ) then - call init_pdf_params_api( nzm_clubb, ncol, pdf_params_chnk(lchnk) ) - call init_pdf_params_api( nzm_clubb, ncol, pdf_params_zm_chnk(lchnk) ) + call init_pdf_params_api( nzt_clubb, ncol, pdf_params_chnk(lchnk) ) end if - if ( .not. allocated(pdf_implicit_coefs_terms_chnk(lchnk)%coef_wp4_implicit) ) then - call init_pdf_implicit_coefs_terms_api( nzm_clubb, ncol, sclr_dim, & - pdf_implicit_coefs_terms_chnk(lchnk) ) + ! pdf_params_zm are only used if l_call_pdf_closure_twice=.true. + if ( clubb_config_flags%l_call_pdf_closure_twice ) then + if ( .not. allocated(pdf_params_zm_chnk(lchnk)%mixt_frac) ) then + call init_pdf_params_api( nzm_clubb, ncol, pdf_params_zm_chnk(lchnk) ) + end if end if - !--------------------- Scalar Setting -------------------- + ! pdf_implicit_coefs_terms are only used if iiPDF_type = iiPDF_new or iiPDF_new_hybrid + if ( clubb_config_flags%iiPDF_type == iiPDF_new .or. & + clubb_config_flags%iiPDF_type == iiPDF_new_hybrid ) then - dl_rad = clubb_detliq_rad - di_rad = clubb_detice_rad - dt_low = clubb_detphase_lowtemp + if ( .not. allocated(pdf_implicit_coefs_terms_chnk(lchnk)%coef_wp4_implicit) ) then + call init_pdf_implicit_coefs_terms_api( nzt_clubb, ncol, sclr_dim, & + pdf_implicit_coefs_terms_chnk(lchnk) ) + end if - frac_limit = 0.01_r8 - ic_limit = 1.e-12_r8 - inv_rh2o = 1._r8/rh2o + end if + + ! 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) + + !--------------------- Scalar Setting -------------------- + + ! Set the ztodt timestep in pbuf for SILHS, this is needed because hdtime is not input to silhs + ztodt = 1.0_r8 * hdtime ! Determine CLUBB time step and make it sub-step friendly ! For now we want CLUBB time step to be 5 min since that is @@ -2820,6 +2770,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! host time step divided by CLUBB time step nadv = max(hdtime/dtime,1._r8) + ! Precalculte the hdtime inverse + invrs_hdtime = 1._r8 / hdtime + ! Set stats output and increment equal to CLUBB and host dt stats_metadata%stats_tsamp = dtime @@ -2836,166 +2789,139 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif ! Initialize the apply_const variable (note special logic is due to eulerian backstepping) - if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) == 0._r8))) then + if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp_pbuf(1:ncol,:) == 0._r8))) then apply_const = 0._r8 ! On first time through do not remove constant ! from moments since it has not been added yet endif - !--------------------- Initializations -------------------- + !----------------------------------------- BEGIN GPU SECTION ----------------------------------------- + ! 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 - ! Set the ztodt timestep in pbuf for SILHS - ztodtptr(:) = 1.0_r8*hdtime - - call t_stopf('clubb_tend_cam:NAR') + call t_stopf('clubb_tend_cam:non_acc_region') call t_startf('clubb_tend_cam:acc_copyin') - !$acc data copyin( sclr_idx, clubb_params_single_col, grid_dx, grid_dy, rairv, cpairv, radf_clubb, qrl, & - !$acc pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & - !$acc state1, state1%q, state1%u, state1%v, state1%t, state1%pmid, state1%s, state1%pint, & - !$acc state1%zm, state1%zi, state1%pdeldry, state1%pdel, state1%omega, state1%phis, & - !$acc cam_in, cam_in%shf, cam_in%wsx, cam_in%wsy, cam_in%cflx, & - !$acc rrho, prer_evap, rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, wpthlp_mc_zt, rtpthlp_mc_zt ) & - !$acc copy( um, vm, upwp, vpwp, wpthvp, wp2thvp, rtpthvp, thlpthvp, up2, vp2, up3, vp3, & - !$acc wp2, wp3, rtp2, thlp2, rtp3, thlp3, thlm, rtm, rvm, wprtp, wpthlp, rtpthlp, & - !$acc pdf_zm_w_1, pdf_zm_w_2, pdf_zm_varnce_w_1, pdf_zm_varnce_w_2, pdf_zm_mixt_frac, & - !$acc cloud_frac, wp2rtp, wp2thlp, uprcp, vprcp, rc_coef, wp4, wpup2, wpvp2, & - !$acc ttend_clubb_mc, upwp_clubb_gw_mc, vpwp_clubb_gw_mc, thlp2_clubb_gw_mc, wpthlp_clubb_gw_mc, & - !$acc ttend_clubb, upwp_clubb_gw, vpwp_clubb_gw, thlp2_clubb_gw, wpthlp_clubb_gw, & - !$acc wp2up2, wp2vp2, ice_supersat_frac, & + !$acc data copyin( pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), sclr_idx, & + !$acc state_loc, state_loc%q, state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, & + !$acc state_loc%zm, state_loc%phis, state_loc%pdel, state_loc%pdeldry, state_loc%s, & + !$acc state_loc%pint, state_loc%zi, state_loc%omega, state_loc%lat, & + !$acc cam_in, cam_in%wsx, cam_in%wsy, cam_in%cflx, cam_in%shf, & + !$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, & + !$acc qclvar_out, wprcp_out, rcm_in_layer, rcm, cloud_frac_inout, thlm, rtm, & + !$acc um, vm, wm_zt, exner, zt_g, zi_g, invrs_cpairv, & + !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & + !$acc pdf_params_chnk(lchnk)%varnce_rt_1, pdf_params_chnk(lchnk)%varnce_rt_2, & + !$acc pdf_params_chnk(lchnk)%mixt_frac ) & + !$acc copy( khzm_pbuf, upwp_pbuf, vpwp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, wprtp_pbuf, & + !$acc wpthlp_pbuf, wp2_pbuf, wp3_pbuf, rtp2_pbuf, rtp3_pbuf, thlp2_pbuf, thlp3_pbuf, & + !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, wp2up_pbuf, ice_supersat_frac_pbuf, & + !$acc rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, & + !$acc rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, wp2up2_pbuf, wp2vp2_pbuf ) & + !$acc create( um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, khzm_out, & + !$acc khzt_out, thlprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, cloudy_updraft_frac_out, & + !$acc cloudy_downdraft_frac_out, cloud_cover_out, invrs_tau_zm_out, Lscale, & + !$acc invrs_exner_zt, fcor, fcor_y, sfc_elevation, thlm_forcing, rtm_forcing, um_forcing, & + !$acc vm_forcing, wprtp_forcing, wpthlp_forcing, rtp2_forcing, thlp2_forcing, & + !$acc rtpthlp_forcing, wm_zm, wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & + !$acc p_sfc, upwp_sfc_pert, vpwp_sfc_pert, rtm_ref, thlm_ref, um_ref, vm_ref, & + !$acc ug, vg, p_in_Pa, rho_zm, rho_zt, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + !$acc invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, clubb_params, deltaz, err_info%err_code, & + !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & + !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & + !$acc pdf_params_chnk(lchnk)%thl_1, pdf_params_chnk(lchnk)%thl_2, & + !$acc pdf_params_chnk(lchnk)%varnce_thl_1, pdf_params_chnk(lchnk)%varnce_thl_2, & + !$acc pdf_params_chnk(lchnk)%corr_w_rt_1, pdf_params_chnk(lchnk)%corr_w_rt_2, & + !$acc pdf_params_chnk(lchnk)%corr_w_thl_1, pdf_params_chnk(lchnk)%corr_w_thl_2, & + !$acc pdf_params_chnk(lchnk)%corr_rt_thl_1, pdf_params_chnk(lchnk)%corr_rt_thl_2,& + !$acc pdf_params_chnk(lchnk)%alpha_thl, pdf_params_chnk(lchnk)%alpha_rt, & + !$acc pdf_params_chnk(lchnk)%crt_1, pdf_params_chnk(lchnk)%crt_2, & + !$acc pdf_params_chnk(lchnk)%cthl_1, pdf_params_chnk(lchnk)%cthl_2, & + !$acc pdf_params_chnk(lchnk)%chi_1, pdf_params_chnk(lchnk)%chi_2, & + !$acc pdf_params_chnk(lchnk)%stdev_chi_1, pdf_params_chnk(lchnk)%stdev_chi_2, & + !$acc pdf_params_chnk(lchnk)%stdev_eta_1, pdf_params_chnk(lchnk)%stdev_eta_2, & + !$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)%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, & + !$acc pdf_params_chnk(lchnk)%ice_supersat_frac_1, pdf_params_chnk(lchnk)%ice_supersat_frac_2 ) + + !$acc data if( clubb_config_flags%l_call_pdf_closure_twice ) & + !$acc copy( pdf_zm_w_1_pbuf, pdf_zm_w_2_pbuf, pdf_zm_varnce_w_1_pbuf, pdf_zm_varnce_w_2_pbuf, pdf_zm_mixt_frac_pbuf, & !$acc pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & !$acc pdf_params_zm_chnk(lchnk)%varnce_w_1, pdf_params_zm_chnk(lchnk)%varnce_w_2, & !$acc pdf_params_zm_chnk(lchnk)%mixt_frac ) & - !$acc copyout( temp2d, temp2dp, rtp2_zt_out, thl2_zt_out, wp2_zt_out, pdfp_rtp2, wm_zt_out, inv_exner_clubb, & - !$acc rcm, wprcp, rcm_in_layer, cloud_cover, zt_out, zi_out, khzm, qclvar, thv, dz_g, & - !$acc clubbtop, se_dis, eleak, clubb_s, wpthvp_clubb, wprcp_clubb ) & - !$acc create( upwp_sfc_pert, vpwp_sfc_pert, khzt_out, khzm_out, & - !$acc fcor, um_in, vm_in, upwp_in, vpwp_in, wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & - !$acc up2_in, vp2_in, up3_in, vp3_in, wp2_in, wp3_in, rtp2_in, thlp2_in, rtp3_in, & - !$acc thlp3_in, thlm_in, rtm_in, rvm_in, wprtp_in, wpthlp_in, rtpthlp_in, cloud_frac_inout, & - !$acc rcm_inout, wp2rtp_inout, wp2thlp_inout, uprcp_inout, vprcp_inout, & - !$acc rc_coef_inout, wp4_inout, wpup2_inout, wpvp2_inout, wp2up2_inout, wp2vp2_inout, & - !$acc ice_supersat_frac_inout, pre_in, kappa_zt, qc_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & - !$acc invrs_exner_zm, cloud_cover_out, rcm_in_layer_out, wprcp_out, & - !$acc qclvar_out, rtp2_zt, thl2_zt, wp2_zt, w_up_in_cloud_out, cloudy_downdraft_frac_out, & - !$acc w_down_in_cloud_out, invrs_tau_zm_out, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & - !$acc thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & - !$acc wprtp_forcing, wpthlp_forcing, rtp2_forcing, thlp2_forcing, & - !$acc rtpthlp_forcing, wm_zm, wm_zt, rho_zm, rho_zt, rho_ds_zm, rho_ds_zt, & - !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, & - !$acc radf, wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & - !$acc rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, p_in_Pa, exner, um_pert_inout, & - !$acc inv_exner_clubb_surf, thlprcp_out, zi_g, zt_g, qrl_clubb, & - !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & - !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & - !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & - !$acc pdf_params_chnk(lchnk)%varnce_rt_1, pdf_params_chnk(lchnk)%varnce_rt_2, & - !$acc pdf_params_chnk(lchnk)%thl_1, pdf_params_chnk(lchnk)%thl_2, & - !$acc pdf_params_chnk(lchnk)%varnce_thl_1, pdf_params_chnk(lchnk)%varnce_thl_2, & - !$acc pdf_params_chnk(lchnk)%corr_w_rt_1, pdf_params_chnk(lchnk)%corr_w_rt_2, & - !$acc pdf_params_chnk(lchnk)%corr_w_thl_1, pdf_params_chnk(lchnk)%corr_w_thl_2, & - !$acc pdf_params_chnk(lchnk)%corr_rt_thl_1, pdf_params_chnk(lchnk)%corr_rt_thl_2,& - !$acc pdf_params_chnk(lchnk)%alpha_thl, pdf_params_chnk(lchnk)%alpha_rt, & - !$acc pdf_params_chnk(lchnk)%crt_1, pdf_params_chnk(lchnk)%crt_2, pdf_params_chnk(lchnk)%cthl_1, & - !$acc pdf_params_chnk(lchnk)%cthl_2, pdf_params_chnk(lchnk)%chi_1, & - !$acc pdf_params_chnk(lchnk)%chi_2, pdf_params_chnk(lchnk)%stdev_chi_1, & - !$acc pdf_params_chnk(lchnk)%stdev_chi_2, pdf_params_chnk(lchnk)%stdev_eta_1, & - !$acc pdf_params_chnk(lchnk)%stdev_eta_2, pdf_params_chnk(lchnk)%covar_chi_eta_1, & - !$acc pdf_params_chnk(lchnk)%covar_chi_eta_2, pdf_params_chnk(lchnk)%corr_w_chi_1, & - !$acc pdf_params_chnk(lchnk)%corr_w_chi_2, pdf_params_chnk(lchnk)%corr_w_eta_1, & - !$acc pdf_params_chnk(lchnk)%corr_w_eta_2, pdf_params_chnk(lchnk)%corr_chi_eta_1, & - !$acc pdf_params_chnk(lchnk)%corr_chi_eta_2, pdf_params_chnk(lchnk)%rsatl_1, & - !$acc pdf_params_chnk(lchnk)%rsatl_2, 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, & - !$acc pdf_params_chnk(lchnk)%mixt_frac, pdf_params_chnk(lchnk)%ice_supersat_frac_1, & - !$acc pdf_params_chnk(lchnk)%ice_supersat_frac_2, & - !$acc pdf_params_zm_chnk(lchnk)%rt_1, pdf_params_zm_chnk(lchnk)%rt_2, & - !$acc pdf_params_zm_chnk(lchnk)%varnce_rt_1, pdf_params_zm_chnk(lchnk)%varnce_rt_2, & - !$acc pdf_params_zm_chnk(lchnk)%thl_1, pdf_params_zm_chnk(lchnk)%thl_2, & - !$acc pdf_params_zm_chnk(lchnk)%varnce_thl_1, pdf_params_zm_chnk(lchnk)%varnce_thl_2, & - !$acc pdf_params_zm_chnk(lchnk)%corr_w_rt_1, pdf_params_zm_chnk(lchnk)%corr_w_rt_2, & - !$acc pdf_params_zm_chnk(lchnk)%corr_w_thl_1, pdf_params_zm_chnk(lchnk)%corr_w_thl_2, & - !$acc pdf_params_zm_chnk(lchnk)%corr_rt_thl_1, pdf_params_zm_chnk(lchnk)%corr_rt_thl_2,& - !$acc pdf_params_zm_chnk(lchnk)%alpha_thl, pdf_params_zm_chnk(lchnk)%alpha_rt, & - !$acc pdf_params_zm_chnk(lchnk)%crt_1, pdf_params_zm_chnk(lchnk)%crt_2, pdf_params_zm_chnk(lchnk)%cthl_1, & - !$acc pdf_params_zm_chnk(lchnk)%cthl_2, pdf_params_zm_chnk(lchnk)%chi_1, & - !$acc pdf_params_zm_chnk(lchnk)%chi_2, pdf_params_zm_chnk(lchnk)%stdev_chi_1, & - !$acc pdf_params_zm_chnk(lchnk)%stdev_chi_2, pdf_params_zm_chnk(lchnk)%stdev_eta_1, & - !$acc pdf_params_zm_chnk(lchnk)%stdev_eta_2, pdf_params_zm_chnk(lchnk)%covar_chi_eta_1, & - !$acc pdf_params_zm_chnk(lchnk)%covar_chi_eta_2, pdf_params_zm_chnk(lchnk)%corr_w_chi_1, & - !$acc pdf_params_zm_chnk(lchnk)%corr_w_chi_2, pdf_params_zm_chnk(lchnk)%corr_w_eta_1, & - !$acc pdf_params_zm_chnk(lchnk)%corr_w_eta_2, pdf_params_zm_chnk(lchnk)%corr_chi_eta_1, & - !$acc pdf_params_zm_chnk(lchnk)%corr_chi_eta_2, pdf_params_zm_chnk(lchnk)%rsatl_1, & - !$acc pdf_params_zm_chnk(lchnk)%rsatl_2, pdf_params_zm_chnk(lchnk)%rc_1, pdf_params_zm_chnk(lchnk)%rc_2, & - !$acc pdf_params_zm_chnk(lchnk)%cloud_frac_1, pdf_params_zm_chnk(lchnk)%cloud_frac_2, & + !$acc create( pdf_params_zm_chnk(lchnk)%rt_1, pdf_params_zm_chnk(lchnk)%rt_2, & + !$acc pdf_params_zm_chnk(lchnk)%varnce_rt_1, pdf_params_zm_chnk(lchnk)%varnce_rt_2, & + !$acc pdf_params_zm_chnk(lchnk)%thl_1, pdf_params_zm_chnk(lchnk)%thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%varnce_thl_1, pdf_params_zm_chnk(lchnk)%varnce_thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_rt_1, pdf_params_zm_chnk(lchnk)%corr_w_rt_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_thl_1, pdf_params_zm_chnk(lchnk)%corr_w_thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_rt_thl_1, pdf_params_zm_chnk(lchnk)%corr_rt_thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%alpha_thl, pdf_params_zm_chnk(lchnk)%alpha_rt, & + !$acc pdf_params_zm_chnk(lchnk)%crt_1, pdf_params_zm_chnk(lchnk)%crt_2, & + !$acc pdf_params_zm_chnk(lchnk)%cthl_1, pdf_params_zm_chnk(lchnk)%cthl_2, & + !$acc pdf_params_zm_chnk(lchnk)%chi_1, pdf_params_zm_chnk(lchnk)%chi_2, & + !$acc pdf_params_zm_chnk(lchnk)%stdev_chi_1, pdf_params_zm_chnk(lchnk)%stdev_chi_2, & + !$acc pdf_params_zm_chnk(lchnk)%stdev_eta_1, pdf_params_zm_chnk(lchnk)%stdev_eta_2, & + !$acc pdf_params_zm_chnk(lchnk)%covar_chi_eta_1, pdf_params_zm_chnk(lchnk)%covar_chi_eta_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_chi_1, pdf_params_zm_chnk(lchnk)%corr_w_chi_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_eta_1, pdf_params_zm_chnk(lchnk)%corr_w_eta_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_chi_eta_1, pdf_params_zm_chnk(lchnk)%corr_chi_eta_2, & + !$acc pdf_params_zm_chnk(lchnk)%rsatl_1, pdf_params_zm_chnk(lchnk)%rsatl_2, & + !$acc pdf_params_zm_chnk(lchnk)%rc_1, pdf_params_zm_chnk(lchnk)%rc_2, & + !$acc pdf_params_zm_chnk(lchnk)%cloud_frac_1, pdf_params_zm_chnk(lchnk)%cloud_frac_2, & !$acc pdf_params_zm_chnk(lchnk)%ice_supersat_frac_1, pdf_params_zm_chnk(lchnk)%ice_supersat_frac_2 ) !$acc data if( sclr_dim > 0 ) & - !$acc create( wpsclrp_sfc, sclrm_forcing, sclrm, wpsclrp, sclrp2, sclrp3, sclrprtp, sclrpthlp, sclrpthvp_inout) & + !$acc create( wpsclrp_sfc, sclrm_forcing, sclrm, wpsclrp, sclrp2, sclrp3, sclrprtp, sclrpthlp, sclrpthvp_inout ) & !$acc copyin( sclr_tol ) !$acc data if( edsclr_dim > 0 ) & - !$acc create( wpedsclrp_sfc, edsclrm_forcing, edsclr_in ) & - !$acc copyout( edsclr_out ) + !$acc copyout( edsclr_inout ) & + !$acc create( wpedsclrp_sfc, edsclrm_forcing ) !$acc data if( hydromet_dim > 0 ) & - !$acc create( hydromet, wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) & - !$acc copyin( hm_metadata, hm_metadata%l_mix_rat_hm ) + !$acc copyin( hm_metadata, hm_metadata%l_mix_rat_hm ) & + !$acc create( wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) call t_stopf('clubb_tend_cam:acc_copyin') - call t_startf('clubb_tend_cam:ACCR') - - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pverp - do i = 1, pcols - rtp2_zt_out(i,k) = 0._r8 - thl2_zt_out(i,k) = 0._r8 - wp2_zt_out(i,k) = 0._r8 - pdfp_rtp2(i,k) = 0._r8 - wm_zt_out(i,k) = 0._r8 - temp2dp(i,k) = 0._r8 - end do - end do + call t_startf('clubb_tend_cam:acc_region') - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pver - do i = 1, pcols - temp2d(i,k) = 0._r8 - end do - end do + !----------------------------------------- Zeroing ----------------------------------------- !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzm_clubb + do k = 1, nzt_clubb do i = 1, ncol ! Define forcings from CAM to CLUBB as zero for momentum and thermo, ! forcings already applied through CAM - thlm_forcing(i,k) = 0._r8 - rtm_forcing(i,k) = 0._r8 - um_forcing(i,k) = 0._r8 - vm_forcing(i,k) = 0._r8 - - rtm_ref(i,k) = 0.0_r8 - thlm_ref(i,k) = 0.0_r8 - um_ref(i,k) = 0.0_r8 - vm_ref(i,k) = 0.0_r8 - ug(i,k) = 0.0_r8 - vg(i,k) = 0.0_r8 + thlm_forcing(i,k) = 0._r8 + rtm_forcing(i,k) = 0._r8 + um_forcing(i,k) = 0._r8 + vm_forcing(i,k) = 0._r8 + + rtm_ref(i,k) = 0.0_r8 + thlm_ref(i,k) = 0.0_r8 + um_ref(i,k) = 0.0_r8 + vm_ref(i,k) = 0.0_r8 + ug(i,k) = 0.0_r8 + vg(i,k) = 0.0_r8 + + ! Perturbed winds are not used in CAM + um_pert_inout(i,k) = 0.0_r8 + vm_pert_inout(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 ! Perturbed winds are not used in CAM - um_pert_inout(i,k) = 0.0_r8 - vm_pert_inout(i,k) = 0.0_r8 upwp_pert_inout(i,k) = 0.0_r8 vpwp_pert_inout(i,k) = 0.0_r8 - - ! Initialize these to prevent crashing behavior - wprcp_out(i,k) = 0._r8 - rcm_in_layer_out(i,k) = 0._r8 - cloud_cover_out(i,k) = 0._r8 - khzm_out(i,k) = 0._r8 - khzt_out(i,k) = 0._r8 end do end do @@ -3005,60 +2931,59 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & upwp_sfc_pert(i) = 0.0_r8 vpwp_sfc_pert(i) = 0.0_r8 - ! Determine Coriolis force at given latitude. This is never used - ! when CLUBB is implemented in a host model, therefore just set - ! to zero. - fcor(i) = 0._r8 + ! When run in host models, CLUBB does not apply Coriolis tendencies to the + ! mean horizontal wind components (this is controlled by the `l_implemented` + ! flag, which should be hardcoded to .true. in this file). + ! + ! However, enabling `clubb_l_ho_nontrad_coriolis` or `clubb_l_ho_trad_coriolis` + ! introduces Coriolis effects in higher-order moments (e.g., wp2up). + ! Therefore, we still compute the Coriolis parameters here for potential + ! use by those higher-order terms. + fcor(i) = 2._r8 * omega * sin( state_loc%lat(i) ) + fcor_y(i) = 2._r8 * omega * cos( state_loc%lat(i) ) end do if ( sclr_dim > 0 ) then ! higher order scalar stuff, put to zero !$acc parallel loop gang vector collapse(3) default(present) do sclr = 1, sclr_dim - do k = 1, nzm_clubb - do i=1, ncol + do k = 1, nzt_clubb + do i = 1, ncol sclrm(i,k,sclr) = 0._r8 + sclrp3(i,k,sclr) = 0._r8 + sclrm_forcing(i,k,sclr) = 0._r8 + end do + end do + end do + + ! higher order scalar stuff, put to zero + !$acc parallel loop gang vector collapse(3) default(present) + do sclr = 1, sclr_dim + do k = 1, nzm_clubb + do i = 1, ncol wpsclrp(i,k,sclr) = 0._r8 sclrp2(i,k,sclr) = 0._r8 - sclrp3(i,k,sclr) = 0._r8 sclrprtp(i,k,sclr) = 0._r8 sclrpthlp(i,k,sclr) = 0._r8 sclrpthvp_inout(i,k,sclr) = 0._r8 - sclrm_forcing(i,k,sclr) = 0._r8 end do end do end do !$acc parallel loop gang vector collapse(2) default(present) do sclr = 1, sclr_dim - do i=1, ncol + do i = 1, ncol wpsclrp_sfc(i,sclr) = 0._r8 end do end do end if - if ( hydromet_dim > 0 ) then - !$acc parallel loop gang vector collapse(3) default(present) - do ixind=1, hydromet_dim - do k=1, nzm_clubb - do i=1, ncol - hydromet(i,k,ixind) = 0._r8 - wphydrometp(i,k,ixind) = 0._r8 - wp2hmp(i,k,ixind) = 0._r8 - rtphmp_zt(i,k,ixind) = 0._r8 - thlphmp_zt(i,k,ixind) = 0._r8 - end do - end do - end do - end if - if ( edsclr_dim > 0 ) then !$acc parallel loop gang vector collapse(3) default(present) do edsclr = 1, edsclr_dim - do i = 1, ncol - do k = 1, nzm_clubb + do k = 1, nzt_clubb + do i = 1, ncol edsclrm_forcing(i,k,edsclr) = 0._r8 - edsclr_in(i,k,edsclr) = 0._r8 end do end do end do @@ -3073,51 +2998,32 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end if - ! need to initialize macmic coupling to zero - if ( macmic_it == 1 ) then - !$acc parallel loop gang vector collapse(2) default(present) - do i = 1, ncol - do k = 1, pverp - ttend_clubb_mc(i,k) = 0._r8 - upwp_clubb_gw_mc(i,k) = 0._r8 - vpwp_clubb_gw_mc(i,k) = 0._r8 - thlp2_clubb_gw_mc(i,k) = 0._r8 - wpthlp_clubb_gw_mc(i,k) = 0._r8 - end do - end do - end if + if ( hydromet_dim > 0 ) then - ! Initialize EDMF outputs - if (do_clubb_mf) then - do k = 1, pverp - do i = 1, pcols - 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_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 + !$acc parallel loop gang vector collapse(3) default(present) + do ixind = 1, hydromet_dim + do k = 1, nzt_clubb + do i = 1, ncol + wp2hmp(i,k,ixind) = 0._r8 + rtphmp_zt(i,k,ixind) = 0._r8 + thlphmp_zt(i,k,ixind) = 0._r8 + end do + end do + end do + + !$acc parallel loop gang vector collapse(3) default(present) + do ixind = 1, hydromet_dim + do k = 1, nzm_clubb + do i = 1, ncol + wphydrometp(i,k,ixind) = 0._r8 + end do end do end do + end if + !----------------------------------------- Initializing arrays ----------------------------------------- + if (clubb_do_icesuper) then ! -------------------------------------- ! @@ -3133,8 +3039,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 ) - do i = 1, ncol - do k = 1, pver + do k = 1, pver + do i = 1, ncol stend(i,k) = 0._r8 qvtend(i,k) = 0._r8 qitend(i,k) = 0._r8 @@ -3143,16 +3049,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do call t_startf('clubb_tend_cam:ice_macro_tend') - call ice_macro_tend(naai(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & - state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,1), & - state1%q(1:ncol,top_lev:pver,ixcldice), state1%q(1:ncol,top_lev:pver,ixnumice), & - latsub, hdtime, stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), & - qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver), ncol*(pver-top_lev+1)) + call ice_macro_tend( ncol * nzt_clubb, latsub, hdtime, & ! in + naai_pbuf(1:ncol,top_lev:pver), state_loc%t(1:ncol,top_lev:pver), & ! in + state_loc%pmid(1:ncol,top_lev:pver), state_loc%q(1:ncol,top_lev:pver,1), & ! in + state_loc%q(1:ncol,top_lev:pver,ixcldice), state_loc%q(1:ncol,top_lev:pver,ixnumice), & ! in + stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), & ! out + qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver) ) ! out call t_stopf('clubb_tend_cam:ice_macro_tend') ! update local copy of state with the tendencies - do i = 1, ncol - do k = top_lev, pver + do k = top_lev, pver + do i = 1, ncol ptend_loc%q(i,k,1) = qvtend(i,k) ptend_loc%q(i,k,ixcldice) = qitend(i,k) ptend_loc%q(i,k,ixnumice) = initend(i,k) @@ -3164,12 +3071,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_sum(ptend_loc, ptend_all, ncol) ! ptend_loc is reset to zero by this call - call physics_update(state1, ptend_loc, hdtime) + call physics_update(state_loc, ptend_loc, hdtime) ! Write output for tendencies: - do i = 1, ncol - do k = 1, pver - temp2d(i,k) = stend(i,k) / cpairv(i,k,lchnk) + do k = 1, pver + do i = 1, ncol + temp2d(i,k) = stend(i,k) * invrs_cpairv(i,k) end do end do @@ -3180,24 +3087,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif - if (clubb_do_adv) then + 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, pver + do k = 1, nzm_clubb do i = 1, ncol - thlp2(i,k) = state1%q(i,k,ixthlp2) - rtp2(i,k) = state1%q(i,k,ixrtp2) - rtpthlp(i,k) = state1%q(i,k,ixrtpthlp) - ( rtpthlp_const * apply_const ) - wpthlp(i,k) = state1%q(i,k,ixwpthlp) - ( wpthlp_const * apply_const ) - wprtp(i,k) = state1%q(i,k,ixwprtp) - ( wprtp_const * apply_const ) - wp2(i,k) = state1%q(i,k,ixwp2) - wp3(i,k) = state1%q(i,k,ixwp3) - ( wp3_const * apply_const ) - up2(i,k) = state1%q(i,k,ixup2) - vp2(i,k) = state1%q(i,k,ixvp2) + 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 ) + wp3_pbuf(i,k) = state_loc%q(i,k_cam, ixwp3) - ( wp3_const * apply_const ) + wp2_pbuf(i,k) = max( w_tol_sqd, state_loc%q(i,k_cam, ixwp2) ) + thlp2_pbuf(i,k) = max( thl_tol**2, state_loc%q(i,k_cam, ixthlp2) ) + rtp2_pbuf(i,k) = max( rt_tol**2, state_loc%q(i,k_cam, ixrtp2) ) + up2_pbuf(i,k) = max( w_tol_sqd, state_loc%q(i,k_cam, ixup2) ) + vp2_pbuf(i,k) = max( w_tol_sqd, state_loc%q(i,k_cam, ixvp2) ) enddo enddo @@ -3211,129 +3119,216 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & apply_const = 0._r8 endif + endif + + !$acc parallel loop gang vector collapse(2) default(present) + do n = 1, nparams do i = 1, ncol - thlp2(i,pverp) = thlp2(i,pver) - rtp2(i,pverp) = rtp2(i,pver) - rtpthlp(i,pverp) = rtpthlp(i,pver) - wpthlp(i,pverp) = wpthlp(i,pver) - wprtp(i,pverp) = wprtp(i,pver) - wp2(i,pverp) = wp2(i,pver) - wp3(i,pverp) = wp3(i,pver) - up2(i,pverp) = up2(i,pver) - vp2(i,pverp) = vp2(i,pver) + clubb_params(i,n) = clubb_params_single_col(1,n) end do + end do - endif + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, pver + do i = 1, ncol + invrs_cpairv(i,k) = 1._r8 / cpairv(i,k,lchnk) + end do + end do - ! Define the CLUBB momentum grid (in height, units of m) + ! Compute thermodynamic stuff needed for CLUBB on thermo levels. !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzm_clubb - do i=1, ncol - zi_g(i,k) = state1%zi(i,pverp-k+1) - state1%zi(i,pver+1) + do k = 1, nzt_clubb + do i = 1, ncol + + 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) + + invrs_dz_g = 1._r8 / ( state_loc%zi(i,k_cam) - state_loc%zi(i,k_cam+1) ) ! compute thickness + + rho_zt(i,k) = rga * state_loc%pdel(i,k_cam) * invrs_dz_g + + rho_ds_zt(i,k) = rga * state_loc%pdeldry(i,k_cam) * invrs_dz_g + + invrs_rho_ds_zt(i,k) = 1._r8 / rho_ds_zt(i,k) + end do end do !$acc parallel loop gang vector collapse(2) default(present) - do k=1, pver - do i=1, ncol + do k = 1, nzt_clubb + do i = 1, ncol + 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 - ! (such as thlm), use "inv_exner_clubb" otherwise use the exner in state - inv_exner_clubb(i,k) = 1._r8 / ( ( state1%pmid(i,k) / p0_clubb )**( rairv(i,k,lchnk) / cpairv(i,k,lchnk) ) ) + ! (such as thlm), use "invrs_exner_zt" otherwise use the exner in state + exner(i,k) = ( p_in_Pa(i,k) * inv_p0_clubb )**( rairv(i,k_cam,lchnk) * invrs_cpairv(i,k_cam) ) - ! Compute virtual potential temperature, which is needed for CLUBB - thv(i,k) = state1%t(i,k) * inv_exner_clubb(i,k) & - * ( 1._r8 + zvir * state1%q(i,k,ixq) - state1%q(i,k,ixcldliq) ) + invrs_exner_zt(i,k) = 1._r8 / exner(i,k) - dz_g(i,k) = state1%zi(i,k) - state1%zi(i,k+1) ! compute thickness + ! exception - setting this to moist thv_ds_zt + thv_ds_zt(i,k) = state_loc%t(i,k_cam) * invrs_exner_zt(i,k) & + * (1._r8 + zvir * state_loc%q(i,k_cam,ixq) - state_loc%q(i,k_cam,ixcldliq)) - ! At each CLUBB call, initialize mean momentum and thermo CLUBB state - ! from the CAM state - rtm(i,k) = state1%q(i,k,ixq) + state1%q(i,k,ixcldliq) - rvm(i,k) = state1%q(i,k,ixq) - um(i,k) = state1%u(i,k) - vm(i,k) = state1%v(i,k) - thlm(i,k) = ( state1%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state1%q(i,k,ixcldliq) ) & - * inv_exner_clubb(i,k) + rcm(i,k) = state_loc%q(i,k_cam,ixcldliq) + rtm(i,k) = state_loc%q(i,k_cam,ixq) + state_loc%q(i,k_cam,ixcldliq) - enddo - enddo + 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) - !$acc parallel loop gang vector default(present) - do i = 1, ncol - rtm(i,pverp) = rtm(i,pver) - um(i,pverp) = state1%u(i,pver) - vm(i,pverp) = state1%v(i,pver) - thlm(i,pverp) = thlm(i,pver) - - ! Compute exner at the surface for converting the sensible heat fluxes - ! to a flux of potential temperature for use as clubb's boundary conditions - inv_exner_clubb_surf(i) = inv_exner_clubb(i,pver) + end do end do - ! Compute thermodynamic stuff needed for CLUBB on thermo levels. - ! Inputs for the momentum levels are set below setup_clubb core !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb do i = 1, ncol - ! Define the CLUBB thermodynamic grid (in units of m) - zt_g(i,k+1) = state1%zm(i,pver-k+1) - state1%zi(i,pver+1) + k_cam = top_lev - 1 + k - ! base state (dry) variables - rho_ds_zt(i,k+1) = rga * ( state1%pdeldry(i,pver-k+1) / dz_g(i,pver-k+1) ) - invrs_rho_ds_zt(i,k+1) = 1._r8 / rho_ds_zt(i,k+1) + ! 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 ) - ! full state (moist) variables - p_in_Pa(i,k+1) = state1%pmid(i,pver-k+1) - exner(i,k+1) = 1._r8 / inv_exner_clubb(i,pver-k+1) - thv(i,k+1) = state1%t(i,pver-k+1) * inv_exner_clubb(i,pver-k+1) & - * ( 1._r8 + zvir * state1%q(i,pver-k+1,ixq) - state1%q(i,pver-k+1,ixcldliq) ) - rho_zt(i,k+1) = rga * state1%pdel(i,pver-k+1) / dz_g(i,pver-k+1) + cloud_frac_inout(i,k) = cld_pbuf(i,k_cam) - ! exception - setting this to moist thv - thv_ds_zt(i,k+1) = thv(i,k+1) + um(i,k) = state_loc%u(i,k_cam) + vm(i,k) = state_loc%v(i,k_cam) - rfrzm(i,k+1) = state1%q(i,pver-k+1,ixcldice) - radf(i,k+1) = radf_clubb(i,pver-k+1) - qrl_clubb(i,k+1) = qrl(i,pver-k+1) / ( cpairv(i,k,lchnk) * state1%pdeldry(i,pver-k+1) ) + rfrzm(i,k) = state_loc%q(i,k_cam,ixcldice) - ! Compute mean w wind on thermo grid, convert from omega to w - wm_zt(i,k+1) = -1._r8 * ( state1%omega(i,pver-k+1) - state1%omega(i,pver) ) & - / ( rho_zt(i,k+1) * gravit ) end do end do - ! Below computes the same stuff for the ghost point. May or may - ! not be needed, just to be safe to avoid NaN's !$acc parallel loop gang vector default(present) do i = 1, ncol - zt_g(i,1) = -1._r8 * zt_g(i,2) - rho_ds_zt(i,1) = rho_ds_zt(i,2) - invrs_rho_ds_zt(i,1) = invrs_rho_ds_zt(i,2) - p_in_Pa(i,1) = p_in_Pa(i,2) - exner(i,1) = exner(i,2) - thv(i,1) = thv(i,2) - rho_zt(i,1) = rho_zt(i,2) - thv_ds_zt(i,1) = thv_ds_zt(i,2) - rfrzm(i,1) = rfrzm(i,2) - radf(i,1) = radf(i,2) - qrl_clubb(i,1) = qrl_clubb(i,2) - wm_zt(i,1) = wm_zt(i,2) + + deltaz(i) = state_loc%zi(i,pverp-1) - state_loc%zi(i,pverp) + + ! For consistency, set surface pressure to p_in_Pa at the first thermo. + ! level above the surface (according to the CLUBB ascending grid). + p_sfc(i) = state_loc%pmid(i,pver) ! Set the elevation of the surface - sfc_elevation(i) = state1%zi(i,pverp) + sfc_elevation(i) = state_loc%zi(i,pverp) + + end do + + ! Define the CLUBB momentum grid (in height, units of m) + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + 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 + !----------------------------------------- Initializing CLUBB grid ----------------------------------------- + ! this needs to preceed anything that uses clubb grid type, "gr", such as zt2zm_api/zm2zt_api + ! Note: these few routines, setup_grid_api, calc_derrived_params_api, and check_parameters_api are not + ! GPUized yet, so we need to copy data to and from the GPU. + + ! Heights need to be set at each timestep. Therefore, recall + ! setup_grid and calc_derrived_params for this. + ! IMPORTANT NOTE: do not make any calls that use CLUBB grid-height + ! operators (such as zt2zm_api, etc.) until AFTER the + ! call to setup_grid_heights_api. + call t_stopf('clubb_tend_cam:acc_region') + call t_startf('clubb_tend_cam:non_acc_region') + !$acc update host( deltaz, zi_g, zt_g, clubb_params, sfc_elevation ) + + ! Calculate grid assuming a descending grid (cam grid), since we want to + ! confine ascending behavior to advance_clubb_core + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + .false., grid_type, & ! intent(in) + deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) + zi_g, zt_g, & ! intent(in) + gr, err_info ) ! intent(inout) + + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(subr//': '//err_info%err_header_global//NEW_LINE('a')// & + 'in CLUBB setup_grid') + end if + + call calc_derrived_params_api( gr, ncol, grid_type, deltaz, & ! Intent(in) + clubb_params, & ! Intent(in) + clubb_config_flags%l_prescribed_avg_deltaz, & ! Intent(in) + nu_vert_res_dep, lmin, & ! intent(inout) + mixt_frac_max_mag ) ! intent(inout) + + call check_parameters_api( ncol, clubb_params, lmin, & ! Intent(in) + err_info ) ! Intent(inout) + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(subr//': '//err_info%err_header_global//NEW_LINE('a')// & + 'in CLUBB check_parameters_api') + end if + + ! CLUBB's grid data structure (gr) and nu_vert_res_dep contain arrays that need to + ! be copied to the GPU + call t_stopf('clubb_tend_cam:non_acc_region') + call t_startf('clubb_tend_cam:acc_copyin') + !$acc data copyin( gr, gr%zm, gr%zt, gr%dzm, gr%dzt, gr%invrs_dzt, gr%invrs_dzm, & + !$acc gr%weights_zt2zm, gr%weights_zm2zt, & + !$acc nu_vert_res_dep, nu_vert_res_dep%nu2, nu_vert_res_dep%nu9, & + !$acc nu_vert_res_dep%nu1, nu_vert_res_dep%nu8, nu_vert_res_dep%nu10, & + !$acc nu_vert_res_dep%nu6) + 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,:) ) + thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt_pbuf(1:ncol,:) ) + wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt_pbuf(1:ncol,:) ) + wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt_pbuf(1:ncol,:) ) + rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt_pbuf(1:ncol,:) ) + + ! Zero out SILHS covariance contribution terms + do k = 1, nzt_clubb + do i = 1, pcols + rtp2_mc_zt_pbuf(i,k) = 0.0_r8 + thlp2_mc_zt_pbuf(i,k) = 0.0_r8 + wprtp_mc_zt_pbuf(i,k) = 0.0_r8 + wpthlp_mc_zt_pbuf(i,k) = 0.0_r8 + rtpthlp_mc_zt_pbuf(i,k) = 0.0_r8 + end do + end do +#else + ! Set forcings to zero if not using SILHS !$acc parallel loop gang vector collapse(2) default(present) - do i = 1, ncol - do n = 1, nparams - clubb_params(i,n) = clubb_params_single_col(n) + do k = 1, nzm_clubb + do i = 1, ncol + rtp2_forcing(i,k) = 0._r8 + thlp2_forcing(i,k) = 0._r8 + wprtp_forcing(i,k) = 0._r8 + wpthlp_forcing(i,k) = 0._r8 + rtpthlp_forcing(i,k) = 0._r8 end do end do +#endif + + ! Compute some inputs from the thermodynamic grid to the momentum grid + rho_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rho_ds_zt ) + invrs_rho_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, invrs_rho_ds_zt ) + rho_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rho_zt ) + thv_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thv_ds_zt ) + wm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wm_zt ) + + ! Surface fluxes provided by host model + !$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) + wprtp_sfc(i) = cam_in%cflx(i,1) / rho_ds_zm(i,nzm_clubb) ! Moisture flux + end do + ! ------------------------------------------------- ! ! Begin case specific code for SCAM cases. ! @@ -3344,13 +3339,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Initialize zo if variable ustar is used if (cam_in%landfrac(1) >= 0.5_r8) then - zo(1) = 0.035_r8 + zo = 0.035_r8 else - zo(1) = 0.0001_r8 + zo = 0.0001_r8 endif ! Compute surface wind (ubar) - ubar = sqrt(um(1,pver)**2+vm(1,pver)**2) + ubar = sqrt(um(1,nzt_clubb)**2+vm(1,nzt_clubb)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 ! Below denotes case specifics for surface momentum @@ -3375,307 +3370,118 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & trim(scm_clubb_iop_name) == 'ARM_CC') then - bflx22(1) = (gravit/theta0)*wpthlp_sfc(1) - ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1)) + bflx22 = (gravit/theta0)*wpthlp_sfc(1) + ustar = diag_ustar(zt_g(1,nzt_clubb-1),bflx22,ubar,zo) endif ! Compute the surface momentum fluxes, if this is a SCAM simulation - upwp_sfc(1) = -um(1,pver)*ustar**2/ubar - vpwp_sfc(1) = -vm(1,pver)*ustar**2/ubar - - end if - - - ! Heights need to be set at each timestep. Therefore, recall - ! setup_grid and setup_parameters for this. - - ! Set-up CLUBB core at each CLUBB call because heights can change - ! Important note: do not make any calls that use CLUBB grid-height - ! operators (such as zt2zm_api, etc.) until AFTER the - ! call to setup_grid_heights_api. - - call t_stopf('clubb_tend_cam:ACCR') - call t_startf('clubb_tend_cam:NAR') - !$acc update host( zi_g, zt_g, clubb_params, sfc_elevation ) - - call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - grid_type, zi_g(:,2), zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) - zi_g, zt_g, & ! intent(in) - gr ) ! intent(out) - + upwp_sfc(1) = -um(1,nzt_clubb)*ustar**2/ubar + vpwp_sfc(1) = -vm(1,nzt_clubb)*ustar**2/ubar - call setup_parameters_api( zi_g(:,2), clubb_params, gr, ncol, grid_type, & ! intent(in) - clubb_config_flags%l_prescribed_avg_deltaz, & ! intent(in) - lmin, nu_vert_res_dep, err_code ) ! intent(out) - - if ( err_code == clubb_fatal_error ) then - call endrun(subr//': Fatal error in CLUBB setup_parameters') end if - - call t_stopf('clubb_tend_cam:NAR') - call t_startf('clubb_tend_cam:acc_copyin') - !$acc data copyin( gr, gr%zm, gr%zt, gr%dzm, gr%dzt, gr%invrs_dzt, gr%invrs_dzm, & - !$acc gr%weights_zt2zm, gr%weights_zm2zt, & - !$acc nu_vert_res_dep, nu_vert_res_dep%nu2, nu_vert_res_dep%nu9, & - !$acc nu_vert_res_dep%nu1, nu_vert_res_dep%nu8, nu_vert_res_dep%nu10, & - !$acc nu_vert_res_dep%nu6) - call t_stopf('clubb_tend_cam:acc_copyin') - call t_startf('clubb_tend_cam:ACCR') - - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzm_clubb - do i = 1, ncol - rtp2_forcing(i,k) = rtp2_mc_zt(i,k) - thlp2_forcing(i,k) = thlp2_mc_zt(i,k) - wprtp_forcing(i,k) = wprtp_mc_zt(i,k) - wpthlp_forcing(i,k) = wpthlp_mc_zt(i,k) - rtpthlp_forcing(i,k) = rtpthlp_mc_zt(i,k) - end do - end do - - ! Add forcings for SILHS covariance contributions - rtp2_forcing = zt2zm_api( nzm_clubb, ncol, gr, rtp2_forcing ) - thlp2_forcing = zt2zm_api( nzm_clubb, ncol, gr, thlp2_forcing ) - wprtp_forcing = zt2zm_api( nzm_clubb, ncol, gr, wprtp_forcing ) - wpthlp_forcing = zt2zm_api( nzm_clubb, ncol, gr, wpthlp_forcing ) - rtpthlp_forcing = zt2zm_api( nzm_clubb, ncol, gr, rtpthlp_forcing ) - - ! Zero out SILHS covariance contribution terms - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pverp - do i = 1, pcols - rtp2_mc_zt(i,k) = 0.0_r8 - thlp2_mc_zt(i,k) = 0.0_r8 - wprtp_mc_zt(i,k) = 0.0_r8 - wpthlp_mc_zt(i,k) = 0.0_r8 - rtpthlp_mc_zt(i,k) = 0.0_r8 - end do - end do - - ! Compute some inputs from the thermodynamic grid to the momentum grid - rho_ds_zm = zt2zm_api( nzm_clubb, ncol, gr, rho_ds_zt ) - rho_zm = zt2zm_api( nzm_clubb, ncol, gr, rho_zt ) - invrs_rho_ds_zm = zt2zm_api( nzm_clubb, ncol, gr, invrs_rho_ds_zt ) - thv_ds_zm = zt2zm_api( nzm_clubb, ncol, gr, thv_ds_zt ) - wm_zm = zt2zm_api( nzm_clubb, ncol, gr, wm_zt ) - - ! Surface fluxes provided by host model - !$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,1)) ! Sensible heat flux - wpthlp_sfc(i) = wpthlp_sfc(i)*inv_exner_clubb_surf(i) ! Potential temperature flux - wprtp_sfc(i) = cam_in%cflx(i,1)/rho_ds_zm(i,1) ! Moisture flux - end do - + ! 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 - call t_stopf('clubb_tend_cam:ACCR') - call t_startf('clubb_tend_cam:NAR') - !$acc update host( state1%u, state1%v, state1%t, state1%pmid, cam_in%wsx, cam_in%wsy, rrho ) + call t_stopf('clubb_tend_cam:acc_region') + call t_startf('clubb_tend_cam:non_acc_region') + !$acc update host( state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, cam_in%wsx, cam_in%wsy ) ! Adjust surface stresses using winds from the prior macmic iteration - do i=1,ncol - ubar = sqrt(state1%u(i,pver)**2+state1%v(i,pver)**2) + do i = 1, ncol + ubar = sqrt(state_loc%u(i,pver)**2+state_loc%v(i,pver)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 - rrho(i) = calc_ideal_gas_rrho(rair, state1%t(i,pver), state1%pmid(i,pver)) - ustar = calc_friction_velocity(cam_in%wsx(i), cam_in%wsy(i), rrho(i)) + 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) - upwp_sfc(i) = -state1%u(i,pver)*ustar**2/ubar - vpwp_sfc(i) = -state1%v(i,pver)*ustar**2/ubar + upwp_sfc(i) = -state_loc%u(i,pver)*ustar**2/ubar + vpwp_sfc(i) = -state_loc%v(i,pver)*ustar**2/ubar end do !$acc update device( upwp_sfc, vpwp_sfc ) - call t_stopf('clubb_tend_cam:NAR') - call t_startf('clubb_tend_cam:ACCR') + call t_stopf('clubb_tend_cam:non_acc_region') + call t_startf('clubb_tend_cam:acc_region') else !$acc parallel loop gang vector default(present) - do i=1,ncol - upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,1) ! Surface meridional momentum flux - vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,1) ! Surface zonal momentum flux + do i = 1, ncol + upwp_sfc(i) = cam_in%wsx(i) / rho_ds_zm(i,nzm_clubb) ! Surface meridional momentum flux + vpwp_sfc(i) = cam_in%wsy(i) / rho_ds_zm(i,nzm_clubb) ! Surface zonal momentum flux end do endif - call t_startf('clubb_tend_cam:flip-index') - - ! Need to flip arrays around for CLUBB core - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzm_clubb - do i = 1, ncol - - um_in(i,k) = um(i,pverp-k+1) - vm_in(i,k) = vm(i,pverp-k+1) - upwp_in(i,k) = upwp(i,pverp-k+1) - vpwp_in(i,k) = vpwp(i,pverp-k+1) - wpthvp_in(i,k) = wpthvp(i,pverp-k+1) - wp2thvp_in(i,k) = wp2thvp(i,pverp-k+1) - rtpthvp_in(i,k) = rtpthvp(i,pverp-k+1) - thlpthvp_in(i,k)= thlpthvp(i,pverp-k+1) - up2_in(i,k) = up2(i,pverp-k+1) - vp2_in(i,k) = vp2(i,pverp-k+1) - up3_in(i,k) = up3(i,pverp-k+1) - vp3_in(i,k) = vp3(i,pverp-k+1) - wp2_in(i,k) = wp2(i,pverp-k+1) - wp3_in(i,k) = wp3(i,pverp-k+1) - rtp2_in(i,k) = rtp2(i,pverp-k+1) - thlp2_in(i,k) = thlp2(i,pverp-k+1) - rtp3_in(i,k) = rtp3(i,pverp-k+1) - thlp3_in(i,k) = thlp3(i,pverp-k+1) - thlm_in(i,k) = thlm(i,pverp-k+1) - rtm_in(i,k) = rtm(i,pverp-k+1) - rvm_in(i,k) = rvm(i,pverp-k+1) - wprtp_in(i,k) = wprtp(i,pverp-k+1) - wpthlp_in(i,k) = wpthlp(i,pverp-k+1) - rtpthlp_in(i,k) = rtpthlp(i,pverp-k+1) - cloud_frac_inout(i,k) = cloud_frac(i,pverp-k+1) - if (k>1) then - rcm_inout(i,k) = state1%q(i,pverp-k+1,ixcldliq) - end if - - wp2rtp_inout(i,k) = wp2rtp(i,pverp-k+1) - wp2thlp_inout(i,k) = wp2thlp(i,pverp-k+1) - uprcp_inout(i,k) = uprcp(i,pverp-k+1) - vprcp_inout(i,k) = vprcp(i,pverp-k+1) - rc_coef_inout(i,k) = rc_coef(i,pverp-k+1) - wp4_inout(i,k) = wp4(i,pverp-k+1) - wpup2_inout(i,k) = wpup2(i,pverp-k+1) - wpvp2_inout(i,k) = wpvp2(i,pverp-k+1) - wp2up2_inout(i,k) = wp2up2(i,pverp-k+1) - wp2vp2_inout(i,k) = wp2vp2(i,pverp-k+1) - ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,pverp-k+1) - end do - end do - - ! We only need to copy pdf_params from pbuf if this is a restart and - ! we're calling pdf_closure at the end of advance_clubb_core + ! 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 & .and. clubb_config_flags%ipdf_call_placement .eq. ipdf_post_advance_fields ) then + !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol - pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,pverp-k+1) - pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,pverp-k+1) - pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1(i,pverp-k+1) - pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2(i,pverp-k+1) - pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1_pbuf(i,k) + pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2_pbuf(i,k) + pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1_pbuf(i,k) + pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2_pbuf(i,k) + pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac_pbuf(i,k) end do end do - end if - !$acc parallel loop gang vector collapse(2) default(present) - do k=2, nzm_clubb - do i=1,ncol - pre_in(i,k) = prer_evap(i,pverp-k+1) - end do - end do - - !$acc parallel loop gang vector default(present) - do i=1,ncol - pre_in(i,1) = pre_in(i,2) - rcm_inout(i,1) = rcm_inout(i,2) - end do + end if ! pressure,exner on momentum grid needed for mass flux calc. if (do_clubb_mf) then - do k=1,pver - do i=1,ncol - kappa_zt(i,k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) - qc_zt(i,k+1) = state1%q(i,pver-k+1,ixcldliq) - invrs_exner_zt(i,k+1) = inv_exner_clubb(i,pver-k+1) + do k = 1, nzt_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + kappa_zt(i,k) = rairv(i,k_cam,lchnk) * invrs_cpairv(i,k_cam) + dz_g(i,k) = state_loc%zi(i,k_cam) - state_loc%zi(i,k_cam+1) ! compute thickness end do end do - do i=1,ncol - kappa_zt(i,1) = kappa_zt(i,2) - qc_zt(i,1) = qc_zt(i,2) - invrs_exner_zt(i,1) = invrs_exner_zt(i,2) - end do - - kappa_zm(1:ncol,:) = zt2zm_api(nzm_clubb, ncol, gr, kappa_zt(1:ncol,:)) + kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt ) - do k=1,pverp - do i=1,ncol - p_in_Pa_zm(i,k) = state1%pint(i,pverp-k+1) - invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k))) + 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) + invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k)*inv_p0_clubb)**kappa_zm(i,k) ) end do end do end if - if (clubb_do_adv) then - if (macmic_it == 1) then - - wp2_in = zt2zm_api(nzm_clubb, ncol, gr, wp2_in ) - wpthlp_in = zt2zm_api(nzm_clubb, ncol, gr, wpthlp_in ) - wprtp_in = zt2zm_api(nzm_clubb, ncol, gr, wprtp_in ) - up2_in = zt2zm_api(nzm_clubb, ncol, gr, up2_in ) - vp2_in = zt2zm_api(nzm_clubb, ncol, gr, vp2_in ) - thlp2_in = zt2zm_api(nzm_clubb, ncol, gr, thlp2_in ) - rtp2_in = zt2zm_api(nzm_clubb, ncol, gr, rtp2_in ) - rtpthlp_in = zt2zm_api(nzm_clubb, ncol, gr, rtpthlp_in ) - - do k = 1, nzm_clubb - do i = 1, ncol - thlp2_in(i,k) = max(thl_tol**2,thlp2_in(i,k)) - rtp2_in(i,k) = max(rt_tol**2,rtp2_in(i,k)) - wp2_in(i,k) = max(w_tol_sqd,wp2_in(i,k)) - up2_in(i,k) = max(w_tol_sqd,up2_in(i,k)) - vp2_in(i,k) = max(w_tol_sqd,vp2_in(i,k)) - end do - end do - - end if - end if + if ( edsclr_dim > 0 ) then - ! Do the same for tracers - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then + ! 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 + do ixind = 1, pcnst + if (lq(ixind)) then - icnt = icnt+1 + icnt = icnt+1 - !$acc parallel loop gang vector collapse(2) default(present) - do k=1,nzt_clubb - do i=1,ncol - edsclr_in(i,k+1,icnt) = state1%q(i,pver-k+1,ixind) + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzt_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + edsclr_inout(i,k,icnt) = state_loc%q(i,k_cam,ixind) + end do end do - end do - - !$acc parallel loop gang vector default(present) - do i=1,ncol - edsclr_in(i,1,icnt) = edsclr_in(i,2,icnt) - end do - - end if - end do - - if (clubb_l_do_expldiff_rtm_thlm) then - !$acc parallel loop gang vector collapse(2) default(present) - do k=1,nzt_clubb - do i=1, ncol - edsclr_in(i,k+1,icnt+1) = thlm(i,pver-k+1) - edsclr_in(i,k+1,icnt+2) = rtm(i,pver-k+1) - end do - end do - - !$acc parallel loop gang vector default(present) - do i=1, ncol - edsclr_in(i,1,icnt+1) = edsclr_in(i,2,icnt+1) - edsclr_in(i,1,icnt+2) = edsclr_in(i,2,icnt+2) + end if end do - endif - - call t_stopf('clubb_tend_cam:flip-index') + end if - do t=1,nadv ! do needed number of "sub" timesteps for each CAM step + !----------------------------------------- Substepping loop ----------------------------------------- + do t = 1, nadv ! do needed number of "sub" timesteps for each CAM step ! Increment the statistics then begin stats timestep if (stats_metadata%l_stats) then @@ -3689,26 +3495,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') - do k=2,pverp - do i=1, ncol - dzt(i,k) = zi_g(i,k) - zi_g(i,k-1) - end do - end do - - do i=1, ncol - dzt(i,1) = dzt(i,2) - invrs_dzt(i,:) = 1._r8/dzt(i,:) - end do + rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm(:ncol,:) ) + thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm(:ncol,:) ) - rtm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, ncol, gr, rtm_in(1:ncol,:) ) - thlm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, ncol, gr, thlm_in(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( pverp, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input - um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv(i,:), & ! input - thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input - wpthlp_sfc(i), wprtp_sfc(i), pblh(i), & ! input + 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 + um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input + thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input + wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics mf_dry_w(i,:), mf_moist_w(i,:), & ! output - plume diagnostics mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - plume diagnostics @@ -3716,141 +3515,506 @@ 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_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 + s_ae(i,:), s_aw(i,:), & ! output - plume diagnostics + s_awthl(i,:), s_awqt(i,:), & ! output - plume diagnostics + s_awql(i,:), s_awqi(i,:), & ! output - plume diagnostics + s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics + mf_thlflx(i,:), mf_qtflx(i,:) ) ! output - variables needed for solver end do - ! pass MF turbulent advection term as CLUBB explicit forcing term - do i=1, ncol - rtm_forcing(i,1) = 0._r8 - thlm_forcing(i,1)= 0._r8 - end do + !--------------------------------------- END integrate_mf call --------------------------------------- - do k=2,pverp - do i=1, ncol - rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & - ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k-1) * mf_qtflx(i,k-1))) + ! 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) * ( 1._r8 / dz_g(i,k) ) * & + ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflx(i,k+1))) - thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & - ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k-1) * mf_thlflx(i,k-1))) + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * ( 1._r8 / dz_g(i,k) ) * & + ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflx(i,k+1))) end do end do 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') + + 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) + invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) + thv_ds_zt = thv_ds_zt(:,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_inout = cloud_frac_inout(:,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_inout = um_pert_inout(:,nzt_clubb:1:-1) + vm_pert_inout = vm_pert_inout(:,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_inout = upwp_pert_inout(:,nzm_clubb:1:-1) + vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) + + if ( edsclr_dim > 0 ) then + edsclr_inout = edsclr_inout(:,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_inout = sclrpthvp_inout(:,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') - call advance_clubb_core_api( gr, nzm_clubb, ncol, & - l_implemented, dtime, fcor, sfc_elevation, & + + ! These updates are required because the pbuf variables are dimensioned with pcols, when + ! we only need ncol. This requires us to slice the arrays when inputting to advance_clubb_core_api, + ! which happens on the CPU, so we need the CPU version of these to be correct. + ! REMOVECAM: This will be unnecessary once pbuf is gone and these are dimensioned ncol. + !$acc update host( upwp_pbuf, vpwp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, wprtp_pbuf, & + !$acc wpthlp_pbuf, wp2_pbuf, wp3_pbuf, rtp2_pbuf, rtp3_pbuf, thlp2_pbuf, thlp3_pbuf, & + !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, wp2up_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, & + !$acc wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & + !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) + + call advance_clubb_core_api( gr, nzm_clubb, nzt_clubb, ncol, & ! Inputs + l_implemented, dtime, fcor, fcor_y, sfc_elevation, & hydromet_dim, & sclr_dim, sclr_tol, edsclr_dim, sclr_idx, & thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & sclrm_forcing, edsclrm_forcing, wprtp_forcing, & wpthlp_forcing, rtp2_forcing, thlp2_forcing, & rtpthlp_forcing, wm_zm, wm_zt, & - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, p_sfc, & wpsclrp_sfc, wpedsclrp_sfc, & upwp_sfc_pert, vpwp_sfc_pert, & rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, & p_in_Pa, rho_zm, rho_zt, exner, & rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & - hydromet, hm_metadata%l_mix_rat_hm, & - rfrzm, radf, & + hm_metadata%l_mix_rat_hm, & + rfrzm, & wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & grid_dx, grid_dy, & clubb_params, nu_vert_res_dep, lmin, & + mixt_frac_max_mag, theta0, ts_nudge, & + rtm_min, rtm_nudge_max_altitude, & clubb_config_flags, & stats_metadata, & - stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & - um_in, vm_in, upwp_in, vpwp_in, up2_in, vp2_in, up3_in, vp3_in, & - thlm_in, rtm_in, wprtp_in, wpthlp_in, & - wp2_in, wp3_in, rtp2_in, rtp3_in, thlp2_in, thlp3_in, rtpthlp_in, & + stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & ! InOuts + um, vm, upwp_pbuf(:ncol,:), vpwp_pbuf(:ncol,:), & + up2_pbuf(:ncol,:), vp2_pbuf(:ncol,:), up3_pbuf(:ncol,:), vp3_pbuf(:ncol,:), & + thlm, rtm, wprtp_pbuf(:ncol,:), wpthlp_pbuf(:ncol,:), & + wp2_pbuf(:ncol,:), wp3_pbuf(:ncol,:), rtp2_pbuf(:ncol,:), rtp3_pbuf(:ncol,:), & + thlp2_pbuf(:ncol,:), thlp3_pbuf(:ncol,:), rtpthlp_pbuf(:ncol,:), & sclrm, & sclrp2, sclrp3, sclrprtp, sclrpthlp, & - wpsclrp, edsclr_in, err_code, & - rcm_inout, cloud_frac_inout, & - wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & + wpsclrp, edsclr_inout, err_info, & + rcm, cloud_frac_inout, & + wpthvp_pbuf(:ncol,:), wp2thvp_pbuf(:ncol,:), wp2up_pbuf(:ncol,:), rtpthvp_pbuf(:ncol,:), thlpthvp_pbuf(:ncol,:), & sclrpthvp_inout, & - wp2rtp_inout, wp2thlp_inout, uprcp_inout, & - vprcp_inout, rc_coef_inout, & - wp4_inout, wpup2_inout, wpvp2_inout, & - wp2up2_inout, wp2vp2_inout, ice_supersat_frac_inout, & + wp2rtp_pbuf(:ncol,:), wp2thlp_pbuf(:ncol,:), uprcp_pbuf(:ncol,:), & + vprcp_pbuf(:ncol,:), rc_coef_zm_pbuf(:ncol,:), & + wp4_pbuf(:ncol,:), wpup2_pbuf(:ncol,:), wpvp2_pbuf(:ncol,:), & + wp2up2_pbuf(:ncol,:), wp2vp2_pbuf(:ncol,:), ice_supersat_frac_pbuf(:ncol,:), & um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & pdf_implicit_coefs_terms_chnk(lchnk), & - khzm_out, khzt_out, & + khzm_out, khzt_out, & ! Outputs qclvar_out, thlprcp_out, & wprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, & cloudy_updraft_frac_out, cloudy_downdraft_frac_out, & - rcm_in_layer_out, cloud_cover_out, invrs_tau_zm_out ) + rcm_in_layer, cloud_cover_out, invrs_tau_zm_out, & + Lscale ) + + ! The "unslice" copyback step updates the CPU (host) variables, so we need to copy those back to GPU. + ! REMOVECAM: This will be unnecessary once pbuf is gone and these are dimensioned ncol. + !$acc update device( upwp_pbuf, vpwp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, wprtp_pbuf, & + !$acc wpthlp_pbuf, wp2_pbuf, wp3_pbuf, rtp2_pbuf, rtp3_pbuf, thlp2_pbuf, thlp3_pbuf, & + !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, wp2up_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, & + !$acc wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & + !$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 + ! 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) + invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) + thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) + khzt_out = khzt_out(:,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_inout = cloud_frac_inout(:,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) + qclvar_out = qclvar_out(:,nzt_clubb:1:-1) + cloud_cover_out = cloud_cover_out(:,nzt_clubb:1:-1) + w_up_in_cloud_out = w_up_in_cloud_out(:,nzt_clubb:1:-1) + w_down_in_cloud_out = w_down_in_cloud_out(:,nzt_clubb:1:-1) + cloudy_updraft_frac_out = cloudy_updraft_frac_out(:,nzt_clubb:1:-1) + cloudy_downdraft_frac_out = cloudy_downdraft_frac_out(:,nzt_clubb:1:-1) + rcm_in_layer = rcm_in_layer(:,nzt_clubb:1:-1) + ice_supersat_frac_pbuf = ice_supersat_frac_pbuf(:,nzt_clubb:1:-1) + um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) + vm_pert_inout = vm_pert_inout(:,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) + Lscale = Lscale(:,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_inout = upwp_pert_inout(:,nzm_clubb:1:-1) + vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) + khzm_out = khzm_out(:,nzm_clubb:1:-1) + thlprcp_out = thlprcp_out(:,nzm_clubb:1:-1) + wprcp_out = wprcp_out(:,nzm_clubb:1:-1) + invrs_tau_zm_out = invrs_tau_zm_out(:,nzm_clubb:1:-1) + + if ( edsclr_dim > 0 ) then + edsclr_inout = edsclr_inout(:,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_inout = sclrpthvp_inout(:,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 ) + + ! recalculate descending grid + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + .false., grid_type, & ! intent(in) + deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) + zi_g, zt_g, & ! intent(in) + gr, err_info ) ! intent(inout) + + call t_stopf('clubb_tend_cam:ascending_grid_flip') + + end if + ! Note that CLUBB does not produce an error code specific to any column, and ! one value only for the entire chunk - if ( err_code == clubb_fatal_error ) then - write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep() - write(fstderr,*) "LAT Range: ", state1%lat(1)*rad2deg, & - " -- ", state1%lat(ncol)*rad2deg - tmp_lon1 = state1%lon(1)*rad2deg - tmp_lon1 = state1%lon(ncol)*rad2deg - if(tmp_lon1.gt.180.0_r8) tmp_lon1=tmp_lon1-360.0_r8 - if(tmp_lonN.gt.180.0_r8) tmp_lonN=tmp_lonN-360.0_r8 - write(fstderr,*) "LON: Range:", tmp_lon1, " -- ", tmp_lonN - call endrun(subr//': Fatal error in CLUBB library') + if ( any(err_info%err_code == clubb_fatal_error) ) then + write(fstderr,*) "Fatal error in CLUBB advance_clubb_core: at timestep ", get_nstep() + call endrun(subr//': '//err_info%err_header_global//NEW_LINE('a')//'Fatal error in CLUBB advance_clubb_core') end if if ( do_rainturb ) then + call t_startf('clubb_tend_cam:do_rainturb') - do k=1,nzm_clubb - do i=1,ncol - rvm_in(i,k) = rtm_in(i,k) - rcm_inout(i,k) + do k = 1, nzt_clubb + do i = 1, ncol + rvm_in(i,k) = rtm(i,k) - rcm(i,k) + pre_in(i,k) = prer_evap_pbuf(i,k_cam) end do end do - call update_xp2_mc_api( gr, nzm_clubb, ncol, dtime, cloud_frac_inout, & - rcm_inout, rvm_in, thlm_in, wm_zt, & - exner, pre_in, pdf_params_chnk(lchnk), & - rtp2_mc_out, thlp2_mc_out, & - wprtp_mc_out, wpthlp_mc_out, & - rtpthlp_mc_out) + call update_xp2_mc_api( gr, nzm_clubb, nzt_clubb, ncol, dtime, cloud_frac_inout, & + rcm(:ncol,:), rvm_in, thlm(:ncol,:), wm_zt, & + exner, pre_in, pdf_params_chnk(lchnk), & + rtp2_mc_out, thlp2_mc_out, & + wprtp_mc_out, wpthlp_mc_out, & + rtpthlp_mc_out) - do k=1,nzm_clubb - do i=1,ncol + do k = 1, nzm_clubb + do i = 1, ncol dum1 = (1._r8 - cam_in%landfrac(i)) ! update turbulent moments based on rain evaporation - rtp2_in(i,k) = rtp2_in(i,k) + clubb_rnevap_effic * dum1 * rtp2_mc_out(i,k) * dtime - thlp2_in(i,k) = thlp2_in(i,k) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,k) * dtime - wprtp_in(i,k) = wprtp_in(i,k) + clubb_rnevap_effic * dum1 * wprtp_mc_out(i,k) * dtime - wpthlp_in(i,k) = wpthlp_in(i,k) + clubb_rnevap_effic * dum1 * wpthlp_mc_out(i,k) * dtime + rtp2_pbuf(i,k) = rtp2_pbuf(i,k) + clubb_rnevap_effic * dum1 * rtp2_mc_out(i,k) * dtime + thlp2_pbuf(i,k) = thlp2_pbuf(i,k) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,k) * dtime + wprtp_pbuf(i,k) = wprtp_pbuf(i,k) + clubb_rnevap_effic * dum1 * wprtp_mc_out(i,k) * dtime + wpthlp_pbuf(i,k) = wpthlp_pbuf(i,k) + clubb_rnevap_effic * dum1 * wpthlp_mc_out(i,k) * dtime end do end do call t_stopf('clubb_tend_cam:do_rainturb') + end if if (do_cldcool) then - call t_startf('clubb_tend_cam:do_cldcool') - rcm_out_zm = zt2zm_api(nzm_clubb, ncol, gr, rcm_inout ) - qrl_zm = zt2zm_api(nzm_clubb, ncol, gr, qrl_clubb ) - thlp2_rad_out(:,:) = 0._r8 + call t_startf('clubb_tend_cam:do_cldcool') - do i=1, ncol - call calculate_thlp2_rad_api(nzm_clubb, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params(i,:), & - thlp2_rad_out(i,:)) + thlp2_rad(:,:) = 0._r8 + + do k = 1, nzt_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + qrl_clubb(i,k) = qrl_pbuf(i,k_cam) / ( cpairv(i,k_cam,lchnk) * state_loc%pdeldry(i,k_cam) ) + end do end do - do i=1, ncol - thlp2_in(i,:) = thlp2_in(i,:) + thlp2_rad_out(i,:) * dtime - thlp2_in(i,:) = max(thl_tol**2,thlp2_in(i,:)) + call calculate_thlp2_rad_api( ncol, nzm_clubb, nzt_clubb, gr, & + rcm(:ncol,:), thlprcp_out, qrl_clubb, clubb_params, & + thlp2_rad ) + + do k = 1, nzm_clubb + do i = 1, ncol + thlp2_pbuf(i,k) = max( thl_tol**2, thlp2_pbuf(i,k) + thlp2_rad(i,k) * dtime ) + end do end do + call t_stopf('clubb_tend_cam:do_cldcool') end if @@ -3859,243 +4023,75 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! output arrays to make them conformable to CAM output if (stats_metadata%l_stats) then call t_startf('clubb_tend_cam:stats_end_timestep_clubb') - do i=1, ncol + do i = 1, ncol call stats_end_timestep_clubb(i, stats_zt(i), stats_zm(i), stats_rad_zt(i), stats_rad_zm(i), stats_sfc(i), & out_zt, out_zm, out_radzt, out_radzm, out_sfc) end do call t_stopf('clubb_tend_cam:stats_end_timestep_clubb') end if - enddo ! end time loop + end do ! end time loop + !----------------------------------------- END substepping loop ----------------------------------------- - if (clubb_do_adv) then - if (macmic_it == cld_macmic_num_steps) then - wp2_in = zm2zt_api( nzm_clubb, ncol, gr, wp2_in ) - wpthlp_in = zm2zt_api( nzm_clubb, ncol, gr, wpthlp_in ) - wprtp_in = zm2zt_api( nzm_clubb, ncol, gr, wprtp_in ) - up2_in = zm2zt_api( nzm_clubb, ncol, gr, up2_in ) - vp2_in = zm2zt_api( nzm_clubb, ncol, gr, vp2_in ) - thlp2_in = zm2zt_api( nzm_clubb, ncol, gr, thlp2_in ) - rtp2_in = zm2zt_api( nzm_clubb, ncol, gr, rtp2_in ) - rtpthlp_in = zm2zt_api( nzm_clubb, ncol, gr, rtpthlp_in ) - - do k=1,nzm_clubb - do i=1, ncol - thlp2_in(i,k) = max(thl_tol**2, thlp2_in(i,k)) - rtp2_in(i,k) = max(rt_tol**2, rtp2_in(i,k)) - wp2_in(i,k) = max(w_tol_sqd, wp2_in(i,k)) - up2_in(i,k) = max(w_tol_sqd, up2_in(i,k)) - vp2_in(i,k) = max(w_tol_sqd, vp2_in(i,k)) - end do - end do - - end if - end if - - ! Convert RTP2 and THLP2 to thermo grid for output - rtp2_zt = zm2zt_api( nzm_clubb, ncol, gr, rtp2_in ) - thl2_zt = zm2zt_api( nzm_clubb, ncol, gr, thlp2_in ) - wp2_zt = zm2zt_api( nzm_clubb, ncol, gr, wp2_in ) - - call t_startf('clubb_tend_cam:flip-index') - - ! Arrays need to be "flipped" to CAM grid !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzm_clubb - do i=1, ncol - um(i,pverp-k+1) = um_in(i,k) - vm(i,pverp-k+1) = vm_in(i,k) - upwp(i,pverp-k+1) = upwp_in(i,k) - vpwp(i,pverp-k+1) = vpwp_in(i,k) - wpthvp(i,pverp-k+1) = wpthvp_in(i,k) - wp2thvp(i,pverp-k+1) = wp2thvp_in(i,k) - rtpthvp(i,pverp-k+1) = rtpthvp_in(i,k) - thlpthvp(i,pverp-k+1) = thlpthvp_in(i,k) - up2(i,pverp-k+1) = up2_in(i,k) - vp2(i,pverp-k+1) = vp2_in(i,k) - up3(i,pverp-k+1) = up3_in(i,k) - vp3(i,pverp-k+1) = vp3_in(i,k) - thlm(i,pverp-k+1) = thlm_in(i,k) - rtm(i,pverp-k+1) = rtm_in(i,k) - wprtp(i,pverp-k+1) = wprtp_in(i,k) - wpthlp(i,pverp-k+1) = wpthlp_in(i,k) - wp2(i,pverp-k+1) = wp2_in(i,k) - wp3(i,pverp-k+1) = wp3_in(i,k) - rtp2(i,pverp-k+1) = rtp2_in(i,k) - thlp2(i,pverp-k+1) = thlp2_in(i,k) - rtp3(i,pverp-k+1) = rtp3_in(i,k) - thlp3(i,pverp-k+1) = thlp3_in(i,k) - rtpthlp(i,pverp-k+1) = rtpthlp_in(i,k) - rcm(i,pverp-k+1) = rcm_inout(i,k) - wprcp(i,pverp-k+1) = wprcp_out(i,k) - cloud_frac(i,pverp-k+1) = min(cloud_frac_inout(i,k),1._r8) - pdf_zm_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_1(i,k) - pdf_zm_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_2(i,k) - pdf_zm_varnce_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) - pdf_zm_varnce_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) - pdf_zm_mixt_frac(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) - rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(i,k) - cloud_cover(i,pverp-k+1) = min(cloud_cover_out(i,k),1._r8) - zt_out(i,pverp-k+1) = zt_g(i,k) - zi_out(i,pverp-k+1) = zi_g(i,k) - khzm(i,pverp-k+1) = khzm_out(i,k) - qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(i,k)) - wm_zt_out(i,pverp-k+1) = wm_zt(i,k) - wp2rtp(i,pverp-k+1) = wp2rtp_inout(i,k) - wp2thlp(i,pverp-k+1) = wp2thlp_inout(i,k) - uprcp(i,pverp-k+1) = uprcp_inout(i,k) - vprcp(i,pverp-k+1) = vprcp_inout(i,k) - rc_coef(i,pverp-k+1) = rc_coef_inout(i,k) - wp4(i,pverp-k+1) = wp4_inout(i,k) - wpup2(i,pverp-k+1) = wpup2_inout(i,k) - wpvp2(i,pverp-k+1) = wpvp2_inout(i,k) - wp2up2(i,pverp-k+1) = wp2up2_inout(i,k) - wp2vp2(i,pverp-k+1) = wp2vp2_inout(i,k) - ice_supersat_frac(i,pverp-k+1) = ice_supersat_frac_inout(i,k) - - rtp2_zt_out(i,pverp-k+1) = rtp2_zt(i,k) - thl2_zt_out(i,pverp-k+1) = thl2_zt(i,k) - wp2_zt_out(i,pverp-k+1) = wp2_zt(i,k) - + do k = 1, nzt_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + qclvar_out(i,k) = min( 1._r8, qclvar_out(i,k) ) ! We should move this clipping inside clubb end do end do - if ( edsclr_dim > 0 ) then - !$acc parallel loop gang vector collapse(3) default(present) - do ixind=1,edsclr_dim - do k=1, nzm_clubb - do i=1, ncol - edsclr_out(i,pverp-k+1,ixind) = edsclr_in(i,k,ixind) - end do - end do + !$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_out(i,k) end do - end if + end do - if (do_clubb_mf) then - do k=1, nzm_clubb - do i=1, ncol - mf_dry_a_output(i,pverp-k+1) = mf_dry_a(i,k) - mf_moist_a_output(i,pverp-k+1) = mf_moist_a(i,k) - mf_dry_w_output(i,pverp-k+1) = mf_dry_w(i,k) - mf_moist_w_output(i,pverp-k+1) = mf_moist_w(i,k) - mf_dry_qt_output(i,pverp-k+1) = mf_dry_qt(i,k) - mf_moist_qt_output(i,pverp-k+1) = mf_moist_qt(i,k) - mf_dry_thl_output(i,pverp-k+1) = mf_dry_thl(i,k) - mf_moist_thl_output(i,pverp-k+1) = mf_moist_thl(i,k) - mf_dry_u_output(i,pverp-k+1) = mf_dry_u(i,k) - mf_moist_u_output(i,pverp-k+1) = mf_moist_u(i,k) - mf_dry_v_output(i,pverp-k+1) = mf_dry_v(i,k) - mf_moist_v_output(i,pverp-k+1) = mf_moist_v(i,k) - mf_moist_qc_output(i,pverp-k+1) = mf_moist_qc(i,k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) - s_ae_output(i,pverp-k+1) = s_ae(i,k) - s_aw_output(i,pverp-k+1) = s_aw(i,k) - s_awthl_output(i,pverp-k+1) = s_awthl(i,k) - s_awqt_output(i,pverp-k+1) = s_awqt(i,k) - s_awql_output(i,pverp-k+1) = s_awql(i,k) - s_awqi_output(i,pverp-k+1) = s_awqi(i,k) - s_awu_output(i,pverp-k+1) = s_awu(i,k) - s_awv_output(i,pverp-k+1) = s_awv(i,k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) + ! 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) + do k = 1, nzm_clubb + do i = 1, ncol + pdf_zm_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_1(i,k) + pdf_zm_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_2(i,k) + pdf_zm_varnce_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) + pdf_zm_varnce_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) + pdf_zm_mixt_frac_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) end do end do end if +!---- TODO: there seems to a an above top_lev interaction here that changes answers. +! The error occured because we were zeroing out the [1:top_lev-1] values in +! in rcm (when it still contained those levels), when it should've been +! set to state_loc%q(:,:,ixcldliq) and unchanged by clubb. + ! Compute static energy using CLUBB's variables !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzm_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) - - pdfp_rtp2(i,pverp-k+1) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & - * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & - + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & - + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & - * ( ( pdf_params_chnk(lchnk)%rt_2(i,k) - mean_rt )**2 & - + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) ) - end do - end do - - call t_stopf('clubb_tend_cam:flip-index') - - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, pverp - do i=1, ncol - - ! Accumulate vars through macmic subcycle - upwp_clubb_gw_mc(i,k) = upwp_clubb_gw_mc(i,k) + upwp(i,k) - vpwp_clubb_gw_mc(i,k) = vpwp_clubb_gw_mc(i,k) + vpwp(i,k) - thlp2_clubb_gw_mc(i,k) = thlp2_clubb_gw_mc(i,k) + thlp2(i,k) - wpthlp_clubb_gw_mc(i,k) = wpthlp_clubb_gw_mc(i,k) + wpthlp(i,k) - - ! And average at last macmic step - if (macmic_it == cld_macmic_num_steps) then - upwp_clubb_gw(i,k) = upwp_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) - vpwp_clubb_gw(i,k) = vpwp_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) - thlp2_clubb_gw(i,k) = thlp2_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) - wpthlp_clubb_gw(i,k) = wpthlp_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) - end if + do k = 1, top_lev-1 + do i = 1, ncol + ! This can be simplified algebraically, but left like this to maintain BFBness + clubb_s(i,k) = cpairv(i,k,lchnk) * state_loc%t(i,k) - latvap * state_loc%q(i,k,ixcldliq) & + + latvap * 0._r8 & ! error kept for BFBness + !+ latvap * state_loc%q(i,k,ixcldliq) & ! correct line + + gravit * state_loc%zm(i,k) + state_loc%phis(i) 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(i,k) = 0._r8 - vpwp(i,k) = 0._r8 - rcm(i,k) = 0._r8 - wprcp(i,k) = 0._r8 - cloud_frac(i,k) = 0._r8 - rcm_in_layer(i,k) = 0._r8 - zt_out(i,k) = 0._r8 - zi_out(i,k) = 0._r8 - khzm(i,k) = 0._r8 - qclvar(i,k) = 2._r8 - end do - end do - - ! Fill up arrays needed for McICA. Note we do not want the ghost point, - ! thus why the second loop is needed. - !$acc parallel loop gang vector default(present) - do i=1, pcols - zi_out(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_out(i,k,icnt) = state1%q(i,k,ixind) - end do - end do - - end if - end do - - ! Compute static energy using CLUBB's variables - !$acc parallel loop gang vector collapse(2) default(present) - do k=1,pver - do i=1, ncol - clubb_s(i,k) = cpairv(i,k,lchnk) * thlm(i,k) / inv_exner_clubb(i,k) & - + latvap * rcm(i,k) & - + gravit * state1%zm(i,k) + state1%phis(i) + do k = top_lev, pver + do i = 1, ncol + k_clubb = k + 1 - top_lev + clubb_s(i,k) = cpairv(i,k,lchnk) * thlm(i,k_clubb) / invrs_exner_zt(i,k_clubb) & + + latvap * rcm(i,k_clubb) & + + gravit * state_loc%zm(i,k) + state_loc%phis(i) end do end do +!--------------------------------- END TODO --------------------------------- ! Section below is concentrated on energy fixing for conservation. ! because CLUBB and CAM's thermodynamic variables are different. @@ -4103,15 +4099,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Initialize clubbtop to top_lev, for finding the highlest level CLUBB is ! active for informing where to apply the energy fixer. !$acc parallel loop gang vector default(present) - do i=1, ncol + do i = 1, ncol clubbtop(i) = top_lev - do while ((rtp2(i,clubbtop(i)) <= 1.e-15_r8 .and. rcm(i,clubbtop(i)) == 0._r8) .and. clubbtop(i) < pver) + k_clubb = clubbtop(i) + 1 - top_lev + do while ((rtp2_pbuf(i,k_clubb) <= 1.e-15_r8 .and. rcm(i,k_clubb) == 0._r8) .and. clubbtop(i) < pver) clubbtop(i) = clubbtop(i) + 1 + k_clubb = clubbtop(i) + 1 - top_lev end do end do !$acc parallel loop gang vector default(present) - do i=1, ncol + do i = 1, ncol se_a = 0._r8 ke_a = 0._r8 @@ -4123,24 +4121,41 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wv_b = 0._r8 wl_b = 0._r8 - do k=1,pver +!---- TODO: there seems to a an above top_lev interaction here that changes answers. +! The error occured because we were zeroing out the [1:top_lev-1] values in +! in rcm (when it still contained those levels), when it should've been +! set to state_loc%q(:,:,ixcldliq) and unchanged by clubb. + do k = 1, top_lev-1 ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water ! after CLUBB is called. This is for energy conservation purposes. - se_a = se_a + clubb_s(i,k)*state1%pdel(i,k)*rga - ke_a = ke_a + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)*rga - wv_a = wv_a + (rtm(i,k)-rcm(i,k))*state1%pdeldry(i,k)*rga - wl_a = wl_a + (rcm(i,k))*state1%pdeldry(i,k)*rga + se_a = se_a + clubb_s(i,k)*state_loc%pdel(i,k)*rga + ke_a = ke_a + 0.5_r8*(state_loc%u(i,k)**2+state_loc%v(i,k)**2)*state_loc%pdel(i,k)*rga + wv_a = wv_a + ( state_loc%q(i,k,ixq) + state_loc%q(i,k,ixcldliq) ) * state_loc%pdeldry(i,k) * rga ! error kept for BFBness + wl_a = wl_a + 0.0_r8 ! error kept for BFBness + !wv_a = wv_a + state_loc%q(i,k,ixq)*state_loc%pdeldry(i,k)*rga ! correct way + !wl_a = wl_a + state_loc%q(i,k,ixcldliq)*state_loc%pdeldry(i,k)*rga ! correct way end do + ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water + ! after CLUBB is called. This is for energy conservation purposes. + do k = top_lev, pver + k_clubb = k + 1 - top_lev + se_a = se_a + clubb_s(i,k)*state_loc%pdel(i,k)*rga + ke_a = ke_a + 0.5_r8*(um(i,k_clubb)**2+vm(i,k_clubb)**2)*state_loc%pdel(i,k)*rga + wv_a = wv_a + (rtm(i,k_clubb)-rcm(i,k_clubb))*state_loc%pdeldry(i,k)*rga + wl_a = wl_a + (rcm(i,k_clubb))*state_loc%pdeldry(i,k)*rga + end do +!--------------------------------- END TODO --------------------------------- + ! Based on these integrals, compute the total energy after CLUBB call te_a = se_a + ke_a + (latvap+latice) * wv_a + latice * wl_a - do k=1, pver + do k = 1, pver ! Do the same as above, but for before CLUBB was called. - se_b = se_b + state1%s(i,k)*state1%pdel(i,k)*rga - ke_b = ke_b + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)*rga - wv_b = wv_b + state1%q(i,k,ixq)*state1%pdeldry(i,k)*rga - wl_b = wl_b + state1%q(i,k,ixcldliq)*state1%pdeldry(i,k)*rga + se_b = se_b + state_loc%s(i,k)*state_loc%pdel(i,k)*rga + ke_b = ke_b + 0.5_r8*(state_loc%u(i,k)**2+state_loc%v(i,k)**2)*state_loc%pdel(i,k)*rga + wv_b = wv_b + state_loc%q(i,k,ixq)*state_loc%pdeldry(i,k)*rga + wl_b = wl_b + state_loc%q(i,k,ixcldliq)*state_loc%pdeldry(i,k)*rga end do ! Based on these integrals, compute the total energy before CLUBB call @@ -4151,9 +4166,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & te_b = te_b + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime ! Compute the disbalance of total energy, over depth where CLUBB is active - se_dis(i) = ( te_a - te_b ) / ( state1%pint(i,pverp) - state1%pint(i,clubbtop(i)) ) + se_dis(i) = ( te_a - te_b ) / ( state_loc%pint(i,pverp) - state_loc%pint(i,clubbtop(i)) ) - eleak(i) = ( te_a - te_b ) / hdtime + eleak(i) = ( te_a - te_b ) * invrs_hdtime end do @@ -4167,27 +4182,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (clubb_do_energyfix) then !$acc parallel loop gang vector default(present) - do i=1, ncol + do i = 1, ncol - do k=clubbtop(i),pver - clubb_s(i,k) = clubb_s(i,k) - se_dis(i)*gravit + do k = clubbtop(i), pver + clubb_s(i,k) = clubb_s(i,k) - se_dis(i) * gravit end do ! convert to units of +ve [K] - se_dis(i) = -1._r8*se_dis(i)*gravit/cpairv(i,pver,lchnk) + se_dis(i) = -1._r8 * se_dis(i) * gravit * invrs_cpairv(i,pver) end do endif - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, pverp - do i=1, ncol - wpthvp_clubb(i,k) = wpthvp(i,k) * cpair - wprcp_clubb(i,k) = wprcp(i,k) * latvap - end do - end do - - call t_stopf('clubb_tend_cam:ACCR') + call t_stopf('clubb_tend_cam:acc_region') call t_startf('clubb_tend_cam:acc_copyout') !$acc end data @@ -4195,46 +4202,195 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc end data !$acc end data !$acc end data + !$acc end data call t_stopf('clubb_tend_cam:acc_copyout') - call t_startf('clubb_tend_cam:NAR') + call t_startf('clubb_tend_cam:non_acc_region') + + ! ------------------------------------------------- ! + ! Diagnose relative cloud water variance ! + ! ------------------------------------------------- ! + + if (deep_scheme == 'CLUBB_SGS') then + relvarmax = 2.0_r8 + else + relvarmax = 10.0_r8 + endif + + do k = 1, pver + do i = 1, ncol + relvar_pbuf(i,k) = relvarmax ! default + end do + end do + + if (deep_scheme .ne. 'CLUBB_SGS') then + do k = top_lev, pver + do i = 1, ncol + k_clubb = k + 1 - top_lev + if ( rcm(i,k_clubb) /= 0 .and. qclvar_out(i,k_clubb) /= 0 ) then + relvar_pbuf(i,k) = min( relvarmax, max(0.001_r8, rcm(i,k_clubb)**2 / qclvar_out(i,k_clubb) ) ) + end if + end do + end do + endif + + ! turbulent kinetic energy + 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) ) + enddo + enddo + + ! --------------------------------------------------------------------------------- ! + ! Diagnose some quantities that are computed in macrop_tend here. ! + ! These are inputs required for the microphysics calculation. ! + ! ! + ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION ! + ! --------------------------------------------------------------------------------- ! + + ! initialize variables + alst_pbuf(:,:) = 0.0_r8 + qlst_pbuf(:,:) = 0.0_r8 + + do k = top_lev, pver + do i = 1, ncol + k_clubb = k + 1 - top_lev + alst_pbuf(i,k) = cloud_frac_inout(i,k_clubb) + qlst_pbuf(i,k) = rcm(i,k_clubb) / max( 0.01_r8, alst_pbuf(i,k) ) ! Incloud stratus condensate mixing ratio + enddo + enddo + + ! --------------------------------------------------------------------------------- ! + ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! + ! --------------------------------------------------------------------------------- ! + + frac_limit = 0.01_r8 + ic_limit = 1.e-12_r8 + deepcu_pbuf(:,:) = 0.0_r8 + 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 (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 +!----------------- TODO: the way we set alst_pbuf (with clubb's cloud fraction) +! this simplifies to the uncommented version. Seems weird, since it relies +! on only deepcu_pbuf, but not a clear bug + !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 +!------------------------------------------------------------------------------------- + + 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. & + trim(scm_clubb_iop_name) == 'DYCOMSrf01_4day' .or. & + trim(scm_clubb_iop_name) == 'DYCOMSrf02_06hr' .or. & + trim(scm_clubb_iop_name) == 'RICO_3day' .or. & + trim(scm_clubb_iop_name) == 'ARM_CC') then + + deepcu_pbuf(:,:) = 0.0_r8 + concld_pbuf(:,:) = 0.0_r8 + + endif + endif call physics_ptend_init( ptend_loc, state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq ) - ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point - ! for all variables and therefore is never called in this loop - do i=1, ncol +!---- TODO: there seems to a an above top_lev interaction here that changes answers. +! The error occured because we were zeroing out the [1:top_lev-1] values in +! in rcm (when it still contained those levels), when it should've been +! set to state_loc%q(:,:,ixcldliq) and unchanged by clubb. Had it been set correctly +! the ptend_loc%q terms would simplify to zero. I've left the (erroneous?) interaction +! for now to maintain BFBness + do k = 1, top_lev-1 + do i = 1, ncol + ptend_loc%u(i,k) = 0.0_r8 + ptend_loc%v(i,k) = 0.0_r8 + ptend_loc%q(i,k,ixq) = ( state_loc%q(i,k,ixcldliq)) * invrs_hdtime ! error kept for BFBness + ptend_loc%q(i,k,ixcldliq) = ( - state_loc%q(i,k,ixcldliq)) * invrs_hdtime ! error kept for BFBness + ! ptend_loc%q(i,k,ixq) = 0.0_r8 ! correct line + ! ptend_loc%q(i,k,ixcldliq) = 0.0_r8 ! correct line + ptend_loc%s(i,k) = (clubb_s(i,k) - state_loc%s(i,k)) * invrs_hdtime ! Tendency of static energy + end do + end do + + do k = top_lev, pver + do i = 1, ncol + k_clubb = k + 1 - top_lev + ptend_loc%u(i,k) = ( um(i,k_clubb) - state_loc%u(i,k)) * invrs_hdtime ! east-west wind + ptend_loc%v(i,k) = ( vm(i,k_clubb) - state_loc%v(i,k)) * invrs_hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = ( rtm(i,k_clubb) - rcm(i,k_clubb) & + -state_loc%q(i,k,ixq) ) * invrs_hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = ( rcm(i,k_clubb) - state_loc%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = ( clubb_s(i,k) - state_loc%s(i,k)) * invrs_hdtime ! Tendency of static energy + end do + end do +!--------------------------------- END TODO --------------------------------- - rtm_integral_vtend(i) = 0._r8 - rtm_integral_ltend(i) = 0._r8 + invrs_macmic_num_steps = 1.0_r8 / REAL(cld_macmic_num_steps,r8) - do k=1, pver + do k = top_lev, pver + do i = 1, ncol - ptend_loc%u(i,k) = (um(i,k) - state1%u(i,k)) / hdtime ! east-west wind - ptend_loc%v(i,k) = (vm(i,k) - state1%v(i,k)) / hdtime ! north-south wind - ptend_loc%q(i,k,ixq) = (rtm(i,k) - rcm(i,k)-state1%q(i,k,ixq)) / hdtime ! water vapor - ptend_loc%q(i,k,ixcldliq) = (rcm(i,k) - state1%q(i,k,ixcldliq)) / hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) / hdtime ! Tendency of static energy + k_clubb = k + 1 - top_lev - rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k) - rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k) + ! need to initialize macmic coupling to zero + if ( macmic_it == 1 ) then + ttend_clubb_mc_pbuf(i,k_clubb) = 0._r8 + end if - end do + ! Accumulate vars through macmic subcycle for Gravity Wave parameterization + ttend_clubb_mc_pbuf(i,k_clubb) = ttend_clubb_mc_pbuf(i,k_clubb) + ptend_loc%s(i,k) / cpair - rtm_integral_ltend(i) = rtm_integral_ltend(i)/gravit - rtm_integral_vtend(i) = rtm_integral_vtend(i)/gravit + ! And average at last macmic step + if (macmic_it == cld_macmic_num_steps) then + ttend_clubb_pbuf(i,k) = ttend_clubb_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps + end if + end do end do - ! Accumulate Air Temperature Tendency (TTEND) for Gravity Wave parameterization - do k=1, pver - do i=1, ncol - ttend_clubb_mc(i,k) = ttend_clubb_mc(i,k) + ptend_loc%s(i,k)/cpair + do k = top_lev, pverp + do i = 1, ncol + + k_clubb = k + 1 - top_lev + + ! need to initialize macmic coupling to zero + if ( macmic_it == 1 ) then + upwp_clubb_gw_mc_pbuf(i,k_clubb) = 0._r8 + vpwp_clubb_gw_mc_pbuf(i,k_clubb) = 0._r8 + thlp2_clubb_gw_mc_pbuf(i,k_clubb) = 0._r8 + wpthlp_clubb_gw_mc_pbuf(i,k_clubb) = 0._r8 + end if + + ! Accumulate vars through macmic subcycle for Gravity Wave parameterization + upwp_clubb_gw_mc_pbuf (i,k_clubb) = upwp_clubb_gw_mc_pbuf(i,k_clubb) + upwp_pbuf (i,k_clubb) + vpwp_clubb_gw_mc_pbuf (i,k_clubb) = vpwp_clubb_gw_mc_pbuf(i,k_clubb) + vpwp_pbuf (i,k_clubb) + thlp2_clubb_gw_mc_pbuf (i,k_clubb) = thlp2_clubb_gw_mc_pbuf(i,k_clubb) + thlp2_pbuf (i,k_clubb) + wpthlp_clubb_gw_mc_pbuf(i,k_clubb) = wpthlp_clubb_gw_mc_pbuf(i,k_clubb) + wpthlp_pbuf(i,k_clubb) - ! Average at last macmic step + ! And average at last macmic step if (macmic_it == cld_macmic_num_steps) then - ttend_clubb(i,k) = ttend_clubb_mc(i,k) / REAL(cld_macmic_num_steps,r8) + upwp_clubb_gw_pbuf (i,k) = upwp_clubb_gw_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps + vpwp_clubb_gw_pbuf (i,k) = vpwp_clubb_gw_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps + thlp2_clubb_gw_pbuf (i,k) = thlp2_clubb_gw_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps + wpthlp_clubb_gw_pbuf(i,k) = wpthlp_clubb_gw_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps end if end do @@ -4243,49 +4399,35 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then - do k=1, pver - do i=1, ncol + do k = top_lev, pver + do i = 1, ncol + + k_clubb = k + 1 - top_lev + + thlp2_pbuf(i,k_clubb) = max( thl_tol**2, thlp2_pbuf(i,k_clubb) ) + rtp2_pbuf (i,k_clubb) = max( rt_tol**2, rtp2_pbuf(i,k_clubb) ) + wp2_pbuf (i,k_clubb) = max( w_tol_sqd, wp2_pbuf(i,k_clubb) ) + up2_pbuf (i,k_clubb) = max( w_tol_sqd, up2_pbuf(i,k_clubb) ) + vp2_pbuf (i,k_clubb) = max( w_tol_sqd, vp2_pbuf(i,k_clubb) ) ! Here add a constant to moments which can be either positive or ! negative. This is to prevent clipping when dynamics tries to ! make all constituents positive - wp3(i,k) = wp3(i,k) + wp3_const - rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const - wpthlp(i,k) = wpthlp(i,k) + wpthlp_const - wprtp(i,k) = wprtp(i,k) + wprtp_const - - ptend_loc%q(i,k,ixthlp2) = (thlp2(i,k) - state1%q(i,k,ixthlp2)) / hdtime ! THLP Variance - ptend_loc%q(i,k,ixrtp2) = (rtp2(i,k) - state1%q(i,k,ixrtp2)) / hdtime ! RTP Variance - ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp(i,k) - state1%q(i,k,ixrtpthlp)) / hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) / hdtime ! WPTHLP - ptend_loc%q(i,k,ixwprtp) = (wprtp(i,k) - state1%q(i,k,ixwprtp)) / hdtime ! WPRTP - ptend_loc%q(i,k,ixwp2) = (wp2(i,k) - state1%q(i,k,ixwp2)) / hdtime ! WP2 - ptend_loc%q(i,k,ixwp3) = (wp3(i,k) - state1%q(i,k,ixwp3)) / hdtime ! WP3 - ptend_loc%q(i,k,ixup2) = (up2(i,k) - state1%q(i,k,ixup2)) / hdtime ! UP2 - ptend_loc%q(i,k,ixvp2) = (vp2(i,k) - state1%q(i,k,ixvp2)) / hdtime ! VP2 - - end do - end do - - ! Add constant to ghost point so that output is not corrupted - wp3(:,pverp) = wp3(:,pverp) + wp3_const - rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const - wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const - wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const - - else + wp3_pbuf (i,k_clubb) = wp3_pbuf(i,k_clubb) + wp3_const + rtpthlp_pbuf(i,k_clubb) = rtpthlp_pbuf(i,k_clubb) + rtpthlp_const + wpthlp_pbuf (i,k_clubb) = wpthlp_pbuf(i,k_clubb) + wpthlp_const + wprtp_pbuf (i,k_clubb) = wprtp_pbuf(i,k_clubb) + wprtp_const + + ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp_pbuf(i,k_clubb) - state_loc%q(i,k,ixrtpthlp) ) * invrs_hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp) = ( wpthlp_pbuf(i,k_clubb) - state_loc%q(i,k,ixwpthlp) ) * invrs_hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp) = ( wprtp_pbuf(i,k_clubb) - state_loc%q(i,k,ixwprtp) ) * invrs_hdtime ! WPRTP + ptend_loc%q(i,k,ixwp3) = ( wp3_pbuf(i,k_clubb) - state_loc%q(i,k,ixwp3) ) * invrs_hdtime ! WP3 + ptend_loc%q(i,k,ixwp2) = ( wp2_pbuf(i,k_clubb) - state_loc%q(i,k,ixwp2) ) * invrs_hdtime ! WP2 + ptend_loc%q(i,k,ixthlp2) = ( thlp2_pbuf(i,k_clubb) - state_loc%q(i,k,ixthlp2) ) * invrs_hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2) = ( rtp2_pbuf(i,k_clubb) - state_loc%q(i,k,ixrtp2) ) * invrs_hdtime ! RTP Variance + ptend_loc%q(i,k,ixup2) = ( up2_pbuf(i,k_clubb) - state_loc%q(i,k,ixup2) ) * invrs_hdtime ! UP2 + ptend_loc%q(i,k,ixvp2) = ( vp2_pbuf(i,k_clubb) - state_loc%q(i,k,ixvp2) ) * invrs_hdtime ! VP2 - do k=1, pver - do i=1, ncol - ptend_loc%q(i,k,ixthlp2) = 0._r8 - ptend_loc%q(i,k,ixrtp2) = 0._r8 - ptend_loc%q(i,k,ixrtpthlp) = 0._r8 - ptend_loc%q(i,k,ixwpthlp) = 0._r8 - ptend_loc%q(i,k,ixwprtp) = 0._r8 - ptend_loc%q(i,k,ixwp2) = 0._r8 - ptend_loc%q(i,k,ixwp3) = 0._r8 - ptend_loc%q(i,k,ixup2) = 0._r8 - ptend_loc%q(i,k,ixvp2) = 0._r8 end do end do @@ -4295,9 +4437,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. ! Loading up this array doesn't mean the tendencies are applied. - ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed + ! edsclr_inout is compressed with just the constituents being used, ptend and state are not compressed icnt=0 - do ixind=1,pcnst + do ixind = 1, pcnst if (lq(ixind)) then icnt=icnt+1 if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.& @@ -4306,9 +4448,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then - do k=1, pver - do i=1, ncol - ptend_loc%q(i,k,ixind) = (edsclr_out(i,k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents + + ! Zero out levels above top_lev + do k = 1, top_lev-1 + do i = 1, ncol + 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 + k_clubb = k + 1 - top_lev + ptend_loc%q(i,k,ixind) = (edsclr_inout(i,k_clubb,icnt)-state_loc%q(i,k,ixind)) / hdtime ! transported constituents end do end do @@ -4316,13 +4468,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if end do - rvmtend_clubb(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - rcmtend_clubb(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - rimtend_clubb(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - stend_clubb(:ncol,:pver) = ptend_loc%s(:ncol,:pver) - utend_clubb(:ncol,:pver) = ptend_loc%u(:ncol,:pver) - vtend_clubb(:ncol,:pver) = ptend_loc%v(:ncol,:pver) - cmeliq(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + do k = 1, pver + do i = 1, ncol + rvmtend_clubb_output(i,k) = ptend_loc%q(i,k,ixq) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + rcmtend_clubb_output(i,k) = ptend_loc%q(i,k,ixcldliq) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + rimtend_clubb_output(i,k) = ptend_loc%q(i,k,ixcldice) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + cmeliq_pbuf (i,k) = ptend_loc%q(i,k,ixcldliq) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + stend_clubb_output (i,k) = ptend_loc%s(i,k) + utend_clubb_output (i,k) = ptend_loc%u(i,k) + vtend_clubb_output (i,k) = ptend_loc%v(i,k) + end do + end do ! ! set pbuf field so that HB scheme is only applied above CLUBB top @@ -4337,7 +4493,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! ------------------------------------------------- ! call physics_ptend_sum(ptend_loc,ptend_all,ncol) - call physics_update(state1,ptend_loc,hdtime) + call physics_update(state_loc,ptend_loc,hdtime) ! Due to the order of operation of CLUBB, which closes on liquid first, ! then advances it's predictive equations second, this can lead to @@ -4365,39 +4521,39 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qctend(:ncol,:)=0._r8 inctend(:ncol,:)=0._r8 - call liquid_macro_tend(npccn(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & - state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,ixq), & - state1%q(1:ncol,top_lev:pver,ixcldliq), state1%q(1:ncol,top_lev:pver,ixnumliq), & + call liquid_macro_tend(npccn_pbuf(1:ncol,top_lev:pver), state_loc%t(1:ncol,top_lev:pver), & + state_loc%pmid(1:ncol,top_lev:pver), state_loc%q(1:ncol,top_lev:pver,ixq), & + state_loc%q(1:ncol,top_lev:pver,ixcldliq), state_loc%q(1:ncol,top_lev:pver,ixnumliq), & latvap, hdtime, stend(1:ncol,top_lev:pver),qvtend(1:ncol,top_lev:pver), & - qctend(1:ncol,top_lev:pver), inctend(1:ncol,top_lev:pver), ncol*(pver-top_lev+1)) + qctend(1:ncol,top_lev:pver), inctend(1:ncol,top_lev:pver), ncol * nzt_clubb ) ! update local copy of state with the tendencies - ptend_loc%q(:ncol,top_lev:pver,ixq)=qvtend(:ncol,top_lev:pver) - ptend_loc%q(:ncol,top_lev:pver,ixcldliq)=qctend(:ncol,top_lev:pver) - ptend_loc%q(:ncol,top_lev:pver,ixnumliq)=inctend(:ncol,top_lev:pver) - ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver) + ptend_loc%q(:ncol,top_lev:pver,ixq) = qvtend(:ncol,top_lev:pver) + ptend_loc%q(:ncol,top_lev:pver,ixcldliq) = qctend(:ncol,top_lev:pver) + ptend_loc%q(:ncol,top_lev:pver,ixnumliq) = inctend(:ncol,top_lev:pver) + ptend_loc%s(:ncol,top_lev:pver) = stend(:ncol,top_lev:pver) ! Add the ice tendency to the output tendency call physics_ptend_sum(ptend_loc, ptend_all, ncol) ! ptend_loc is reset to zero by this call - call physics_update(state1, ptend_loc, hdtime) + call physics_update(state_loc, ptend_loc, hdtime) ! Write output for tendencies: ! oufld: QVTENDICE,QCTENDICE,NCTENDICE,FQTENDICE - temp2d(:ncol,:pver) = stend(:ncol,:pver)/cpairv(:ncol,:pver,lchnk) + temp2d(:ncol,:pver) = stend(:ncol,:pver) * invrs_cpairv(:ncol,:pver) call outfld( 'TTENDICE', temp2d, pcols, lchnk ) call outfld( 'QVTENDICE', qvtend, pcols, lchnk ) call outfld( 'QCTENDICE', qctend, pcols, lchnk ) call outfld( 'NCTENDICE', inctend, pcols, lchnk ) where(qctend .ne. 0._r8) - fqtend = 1._r8 + temp2d = 1._r8 elsewhere - fqtend = 0._r8 + temp2d = 0._r8 end where - call outfld( 'FQTENDICE', fqtend, pcols, lchnk ) + call outfld( 'FQTENDICE', temp2d, pcols, lchnk ) call t_stopf('clubb_cam_tend:do_liqsupersat') end if @@ -4412,7 +4568,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! --------------------------------------------------------------------------------- ! ! Initialize the shallow convective detrainment rate, will always be zero - dlf2(:,:) = 0.0_r8 + dlf2 = 0.0_r8 dlf_liq_out(:,:) = 0.0_r8 dlf_ice_out(:,:) = 0.0_r8 @@ -4422,28 +4578,32 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & lqice(ixnumliq) = .true. lqice(ixnumice) = .true. + dl_rad = clubb_detliq_rad + di_rad = clubb_detice_rad + dt_low = clubb_detphase_lowtemp + call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lq=lqice) - do k=1,pver - do i=1,ncol + do k = 1, pver + do i = 1, ncol - if( state1%t(i,k) > meltpt_temp ) then + if( state_loc%t(i,k) > meltpt_temp ) then dum1 = 0.0_r8 - elseif ( state1%t(i,k) < dt_low ) then + elseif ( state_loc%t(i,k) < dt_low ) then dum1 = 1.0_r8 else - dum1 = ( meltpt_temp - state1%t(i,k) ) / ( meltpt_temp - dt_low ) + dum1 = ( meltpt_temp - state_loc%t(i,k) ) / ( meltpt_temp - dt_low ) endif ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 - ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) & + ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2 )) * ( 1._r8 - dum1 ) ) & / (4._r8*3.14_r8*dl_rad**3*997._r8) + & ! Deep Convection - 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & + 3._r8 * ( dlf2 * ( 1._r8 - dum1 ) ) & / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection - ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) & + ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2 )) * dum1 ) & / (4._r8*3.14_r8*di_rad**3*500._r8) + & ! Deep Convection - 3._r8 * ( dlf2(i,k) * dum1 ) & + 3._r8 * ( dlf2 * dum1 ) & / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice @@ -4451,25 +4611,30 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dlf_ice_out(i,k) = dlf(i,k) * dum1 ! convert moist dlf tendencies to dry - ptend_loc%q(i,k,ixcldliq) = ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/state1%pdeldry(i,k) - ptend_loc%q(i,k,ixcldice) = ptend_loc%q(i,k,ixcldice)*state1%pdel(i,k)/state1%pdeldry(i,k) + ptend_loc%q(i,k,ixcldliq) = ptend_loc%q(i,k,ixcldliq)*state_loc%pdel(i,k)/state_loc%pdeldry(i,k) + ptend_loc%q(i,k,ixcldice) = ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/state_loc%pdeldry(i,k) ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep ! track of the integrals of ice and static energy that is effected from conversion to ice ! so that the energy checker doesn't complain. - det_s(i) = det_s(i) + ptend_loc%s(i,k)*state1%pdel(i,k)*rga - det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state1%pdeldry(i,k)*rga + det_s(i) = det_s(i) + ptend_loc%s(i,k) * state_loc%pdel(i,k) * rga + det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice) * state_loc%pdeldry(i,k) * rga enddo enddo - det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water - dpdlfliq(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - dpdlfice(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - dpdlft(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpairv(:ncol,:pver, lchnk) - detnliquid(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixnumliq) + det_ice(:ncol) = det_ice(:ncol) / 1000._r8 ! divide by density of water + + do k = 1, pver + do i = 1, ncol + dpdlfliq_output(i,k) = ptend_loc%q(i,k,ixcldliq) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + dpdlfice_output(i,k) = ptend_loc%q(i,k,ixcldice) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + dpdlft_output(i,k) = ptend_loc%s(i,k) * invrs_cpairv(i,k) + detnliquid_output(i,k) = ptend_loc%q(i,k,ixnumliq) + end do + end do call physics_ptend_sum(ptend_loc,ptend_all,ncol) - call physics_update(state1,ptend_loc,hdtime) + call physics_update(state_loc,ptend_loc,hdtime) ! ptend_all now has all accumulated tendencies. Convert the tendencies for the ! wet constituents to wet air basis. @@ -4477,143 +4642,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (lq(ixind) .and. cnst_type(ixind) == 'wet') then do k = 1, pver do i = 1, ncol - ptend_all%q(i,k,ixind) = ptend_all%q(i,k,ixind)*state1%pdeldry(i,k)/state1%pdel(i,k) + ptend_all%q(i,k,ixind) = ptend_all%q(i,k,ixind)*state_loc%pdeldry(i,k)/state_loc%pdel(i,k) end do end do end if end do - ! ------------------------------------------------- ! - ! Diagnose relative cloud water variance ! - ! ------------------------------------------------- ! - - if (deep_scheme == 'CLUBB_SGS') then - relvarmax = 2.0_r8 - else - relvarmax = 10.0_r8 - endif - - do i = 1, ncol - do k = 1, pver - relvar(i,k) = relvarmax ! default - end do - end do - - if (deep_scheme .ne. 'CLUBB_SGS') then - do i = 1, ncol - do k = 1, pver - if ( rcm(i,k) /= 0 .and. qclvar(i,k) /= 0 ) then - relvar(i,k) = min( relvarmax, max(0.001_r8, rcm(i,k)**2 / qclvar(i,k) ) ) - end if - end do - end do - endif - - ! ------------------------------------------------- ! - ! Optional Accretion enhancement factor ! - ! ------------------------------------------------- ! - accre_enhan(:ncol,:pver) = 1._r8 - - ! ------------------------------------------------- ! - ! Diagnose some output variables ! - ! ------------------------------------------------- ! - - ! density - rho(1:ncol,1:pver) = rga*state1%pdel(1:ncol,1:pver)/(state1%zi(1:ncol,1:pver)-state1%zi(1:ncol,2:pverp)) - rho(1:ncol,pverp) = rho(1:ncol,pver) - - wpthvp_diag(:,:) = 0.0_r8 - do k=1,pver - do i=1,ncol - eps = rairv(i,k,lchnk)*inv_rh2o - ! buoyancy flux - wpthvp_diag(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))+((1._r8-eps)/eps)*theta0* & - (wprtp(i,k)-(apply_const*wprtp_const))+((latvap/cpairv(i,k,lchnk))* & - state1%exner(i,k)-(1._r8/eps)*theta0)*wprcp(i,k) - - ! total water mixing ratio - qt_output(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq)+state1%q(i,k,ixcldice) - ! liquid water potential temperature - thetal_output(i,k) = (state1%t(i,k)*state1%exner(i,k))-(latvap/cpairv(i,k,lchnk))*state1%q(i,k,ixcldliq) - ! liquid water static energy - sl_output(i,k) = cpairv(i,k,lchnk)*state1%t(i,k)+gravit*state1%zm(i,k)-latvap*state1%q(i,k,ixcldliq) - enddo - enddo - - do k=1,pverp - do i=1,ncol - wpthlp_output(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux - wprtp_output(i,k) = (wprtp(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux - rtpthlp_output(i,k) = rtpthlp(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output - wp3_output(i,k) = wp3(i,k) - (apply_const*wp3_const) ! wp3 output - tke(i,k) = 0.5_r8*(up2(i,k)+vp2(i,k)+wp2(i,k)) ! turbulent kinetic energy - if (do_clubb_mf) then - mf_thlflx_output(i,k) = mf_thlflx_output(i,k)*rho(i,k)*cpair - mf_qtflx_output(i,k) = mf_qtflx_output(i,k)*rho(i,k)*latvap - end if - enddo - enddo - - ! --------------------------------------------------------------------------------- ! - ! Diagnose some quantities that are computed in macrop_tend here. ! - ! These are inputs required for the microphysics calculation. ! - ! ! - ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION ! - ! --------------------------------------------------------------------------------- ! - - ! initialize variables - alst(:,:) = 0.0_r8 - qlst(:,:) = 0.0_r8 - - do k=1,pver - do i=1,ncol - alst(i,k) = cloud_frac(i,k) - qlst(i,k) = rcm(i,k)/max(0.01_r8,alst(i,k)) ! Incloud stratus condensate mixing ratio - enddo - enddo - - ! --------------------------------------------------------------------------------- ! - ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! - ! --------------------------------------------------------------------------------- ! - - deepcu(:,:) = 0.0_r8 - shalcu(:,:) = 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(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh(i,k+1))),0.6_r8)) - shalcu(i,k) = 0._r8 - - if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then - deepcu(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 - concld(i,k) = min(cloud_frac(i,k)-alst(i,k)+deepcu(i,k),0.80_r8) - enddo - enddo - - 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. & - trim(scm_clubb_iop_name) == 'DYCOMSrf01_4day' .or. & - trim(scm_clubb_iop_name) == 'DYCOMSrf02_06hr' .or. & - trim(scm_clubb_iop_name) == 'RICO_3day' .or. & - trim(scm_clubb_iop_name) == 'ARM_CC') then - - deepcu(:,:) = 0.0_r8 - concld(:,:) = 0.0_r8 - - endif - endif - ! --------------------------------------------------------------------------------- ! ! COMPUTE THE ICE CLOUD FRACTION PORTION ! ! use the aist_vector function to compute the ice cloud fraction ! @@ -4624,8 +4658,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !REMOVECAM_END call tropopause_findChemTrop( state, troplev ) - aist(:,:top_lev-1) = 0._r8 - qsatfac(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below + 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 do k = top_lev, pver @@ -4646,12 +4680,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end where if ( trim(subcol_scheme) == 'SILHS' ) then - call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & - state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol ) + call aist_vector(state_loc%q(:,k,ixq),state_loc%t(:,k),state_loc%pmid(:,k),state_loc%q(:,k,ixcldice), & + state_loc%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist_pbuf(:,k),ncol ) else - call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & - state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol,& - qsatfac_out=qsatfac(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) + call aist_vector(state_loc%q(:,k,ixq),state_loc%t(:,k),state_loc%pmid(:,k),state_loc%q(:,k,ixcldice), & + state_loc%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist_pbuf(:,k),ncol,& + qsatfac_out=qsatfac_pbuf(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) endif enddo @@ -4663,39 +4697,37 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! fraction that was coded in macrop_driver ! ! --------------------------------------------------------------------------------- ! - ! Recompute net stratus fraction using maximum over-lapping assumption, as done - ! in macrophysics code, using alst computed above and aist read in from physics buffer + do k = 1, pver + do i = 1, ncol - do k=1,pver - do i=1,ncol - ast(i,k) = max(alst(i,k),aist(i,k)) - qist(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist(i,k)) - enddo - enddo + ! Recompute net stratus fraction using maximum over-lapping assumption, as done + ! in macrophysics code, using alst computed above and aist read in from physics buffer + ast_pbuf(i,k) = max(alst_pbuf(i,k),aist_pbuf(i,k)) + qist_pbuf(i,k) = state_loc%q(i,k,ixcldice)/max(0.01_r8,aist_pbuf(i,k)) + + ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just + ! be outputting the shallow convective cloud fraction + cld_pbuf(i,k) = min(ast_pbuf(i,k)+deepcu_pbuf(i,k),1.0_r8) - ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just - ! be outputting the shallow convective cloud fraction - do k=1,pver - do i=1,ncol - cloud_frac(i,k) = min(ast(i,k)+deepcu(i,k),1.0_r8) enddo enddo + ! --------------------------------------------------------------------------------- ! ! DIAGNOSE THE PBL DEPTH ! ! this is needed for aerosol code ! ! --------------------------------------------------------------------------------- ! - do i=1,ncol - do k=1,pver + do k = 1, pver + do i = 1, ncol !subroutine pblind expects "Stull" definition of Exner - th(i,k) = state1%t(i,k)*state1%exner(i,k) + th(i,k) = state_loc%t(i,k)*state_loc%exner(i,k) !thv should have condensate loading to be consistent with earlier def's in this module - thv(i,k) = th(i,k)*(1.0_r8+zvir*state1%q(i,k,ixq) - state1%q(i,k,ixcldliq)) + thv(i,k) = th(i,k)*(1.0_r8+zvir*state_loc%q(i,k,ixq) - state_loc%q(i,k,ixcldliq)) enddo enddo ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth) - rrho (1:ncol) = calc_ideal_gas_rrho(rair, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver)) + rrho (1:ncol) = calc_ideal_gas_rrho(rair, state_loc%t(1:ncol,pver), state_loc%pmid(1:ncol,pver)) ustar2 (1:ncol) = calc_friction_velocity(cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), rrho(1:ncol)) ! use correct qflux from coupler kinheat(1:ncol) = calc_kinematic_heat_flux(cam_in%shf(1:ncol), rrho(1:ncol), cpair) @@ -4709,7 +4741,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Compute PBL depth according to Holtslag-Boville Scheme -- only pblh is needed here ! and other outputs are discarded !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists - pblh(:) = 0._r8 + pblh_pbuf(:) = 0._r8 dummy2(:) = 0._r8 dummy3(:) = 0._r8 !REMOVECAM_END @@ -4718,97 +4750,263 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pver = pver, & pverp = pverp, & gravit = gravit, & - z = state1%zm(:ncol,:pver), & - zi = state1%zi(:ncol,:pverp), & - u = state1%u(:ncol,:pver), & - v = state1%v(:ncol,:pver), & - cldn = cloud_frac(:ncol,:pver), & + z = state_loc%zm(:ncol,:pver), & + zi = state_loc%zi(:ncol,:pverp), & + u = state_loc%u(:ncol,:pver), & + v = state_loc%v(:ncol,:pver), & + cldn = cld_pbuf(:ncol,:pver), & ! Inputs from CLUBB (not HB coefficients) thv = thv(:ncol,:pver), & ustar = ustar2(:ncol), & kbfs = kbfs(:ncol), & obklen = obklen(:ncol), & ! Output variables - pblh = pblh(:ncol), & + pblh = pblh_pbuf(:ncol), & wstar = dummy2(:ncol), & bge = dummy3(:ncol), & errmsg = errmsg, & errflg = errflg) - ! Assign the first pver levels of cloud_frac back to cld - cld(:,1:pver) = cloud_frac(:,1:pver) - ! --------------------------------------------------------------------------------- ! - ! END CLOUD FRACTION DIAGNOSIS, begin to store variables back into buffer ! + ! END CLOUD FRACTION DIAGNOSIS ! ! --------------------------------------------------------------------------------- ! - call outfld( 'DETNLIQTND', detnliquid,pcols, lchnk ) + !----------------------------------------- Output section ----------------------------------------- + ! TODO: Do we always want to be outputting all of this? Should we surround some/most of this with a flag? + + call outfld( 'DETNLIQTND', detnliquid_output,pcols, lchnk ) ! Output CLUBB tendencies (convert dry basis to wet for consistency with history variable definition) - call outfld( 'RVMTEND_CLUBB', rvmtend_clubb, pcols, lchnk) - call outfld( 'RCMTEND_CLUBB', rcmtend_clubb, pcols, lchnk) - call outfld( 'RIMTEND_CLUBB', rimtend_clubb, pcols, lchnk) - call outfld( 'STEND_CLUBB', stend_clubb, pcols, lchnk) - call outfld( 'UTEND_CLUBB', utend_clubb, pcols, lchnk) - call outfld( 'VTEND_CLUBB', vtend_clubb, pcols, lchnk) + call outfld( 'RVMTEND_CLUBB', rvmtend_clubb_output, pcols, lchnk) + call outfld( 'RCMTEND_CLUBB', rcmtend_clubb_output, pcols, lchnk) + call outfld( 'RIMTEND_CLUBB', rimtend_clubb_output, pcols, lchnk) + call outfld( 'STEND_CLUBB', stend_clubb_output, pcols, lchnk) + call outfld( 'UTEND_CLUBB', utend_clubb_output, pcols, lchnk) + call outfld( 'VTEND_CLUBB', vtend_clubb_output, pcols, lchnk) - call outfld( 'CMELIQ', cmeliq, pcols, lchnk) + call outfld( 'CMELIQ', cmeliq_pbuf, pcols, lchnk) ! output moist basis to be consistent with history variable definition - call outfld( 'DPDLFLIQ', dpdlfliq, pcols, lchnk) - call outfld( 'DPDLFICE', dpdlfice, pcols, lchnk) - call outfld( 'DPDLFT', dpdlft, pcols, lchnk) + call outfld( 'DPDLFLIQ', dpdlfliq_output, pcols, lchnk) + call outfld( 'DPDLFICE', dpdlfice_output, pcols, lchnk) + call outfld( 'DPDLFT', dpdlft_output, pcols, lchnk) ! Output the PBL depth - call outfld('PBLH', pblh, pcols, lchnk) + call outfld('PBLH', pblh_pbuf, pcols, lchnk) - call outfld('KVH_CLUBB', khzm, pcols, lchnk) + call outfld('KVH_CLUBB', khzm_pbuf, pcols, lchnk) call outfld('ELEAK_CLUBB', eleak, pcols, lchnk) call outfld('TFIX_CLUBB', se_dis, pcols, lchnk) + ! density + do k = 1, pver + do i = 1, ncol + rho(i,k) = rga * state_loc%pdel(i,k) / ( state_loc%zi(i,k) - state_loc%zi(i,k+1) ) + end do + end do + rho(1:ncol,pverp) = rho(1:ncol,pver) + + do k = top_lev, pverp + do i = 1, ncol + + k_clubb = k + 1 - top_lev + + zi_output(i,k) = zi_g(i,k_clubb) + wp2_output(i,k) = wp2_pbuf(i,k_clubb) + up2_output(i,k) = up2_pbuf(i,k_clubb) + vp2_output(i,k) = vp2_pbuf(i,k_clubb) + 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_out(i,k_clubb) * latvap + wpthvp_clubb_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(i,k) * cpair ! liquid water potential temperature flux + wprtp_output(i,k) = ( wprtp_pbuf(i,k_clubb) - (apply_const * wprtp_const) ) * rho(i,k) * latvap ! total water mixig ratio flux + rtpthlp_output(i,k) = rtpthlp_pbuf(i,k_clubb) - (apply_const * rtpthlp_const) + + end do + end do + + ! 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,:) ) + wp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_pbuf(:ncol,:) ) + + do k = top_lev, pver + do i = 1, ncol + + k_clubb = k + 1 - top_lev + + rcm_output(i,k) = rcm(i,k_clubb) + rtm_output(i,k) = rtm(i,k_clubb) + thlm_output(i,k) = thlm(i,k_clubb) + um_output(i,k) = um(i,k_clubb) + vm_output(i,k) = vm(i,k_clubb) + rcm_in_layer_output(i,k) = rcm_in_layer(i,k_clubb) + zt_output(i,k) = zt_g(i,k_clubb) + wm_zt_output(i,k) = wm_zt(i,k_clubb) + rtp2_zt_output(i,k) = rtp2_zt(i,k_clubb) + thl2_zt_output(i,k) = thl2_zt(i,k_clubb) + wp2_zt_output(i,k) = wp2_zt(i,k_clubb) + wp3_output(i,k) = wp3_pbuf(i,k_clubb) - (apply_const*wp3_const) + + end do + end do + + 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 + + do k = 1, top_lev-1 + do i = 1, ncol + wp2_output(i,k) = 0._r8 + up2_output(i,k) = 0._r8 + vp2_output(i,k) = 0._r8 + rtp2_output(i,k) = 0._r8 + thlp2_output(i,k) = 0._r8 + zt_output(i,k) = 0._r8 + rtp2_zt_output(i,k) = 0._r8 + wp3_output(i,k) = 0._r8 + thl2_zt_output(i,k) = 0._r8 + wp2_zt_output(i,k) = 0._r8 + rcm_in_layer_output(i,k) = 0._r8 + pdfp_rtp2_output(i,k) = 0._r8 + wm_zt_output(i,k) = 0._r8 + rcm_output(i,k) = 0._r8 + rtm_output(i,k) = 0._r8 + thlm_output(i,k) = 0._r8 + um_output(i,k) = 0._r8 + vm_output(i,k) = 0._r8 + zi_output(i,k) = 0._r8 + wpthlp_output(i,k) = 0._r8 + rtpthlp_output(i,k) = 0._r8 + 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 + end do + end do + ! Output calls of variables goes here - call outfld( 'RELVAR', relvar, pcols, lchnk ) - call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) - call outfld( 'WP2_CLUBB', wp2, pcols, lchnk ) - call outfld( 'UP2_CLUBB', up2, pcols, lchnk ) - call outfld( 'VP2_CLUBB', vp2, pcols, lchnk ) - call outfld( 'WP3_CLUBB', wp3_output(:,1:pver), pcols, lchnk ) - call outfld( 'UPWP_CLUBB', upwp, pcols, lchnk ) - call outfld( 'VPWP_CLUBB', vpwp, pcols, lchnk ) - call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) - call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) - call outfld( 'RTP2_CLUBB', rtp2, pcols, lchnk ) - call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) - call outfld( 'RCM_CLUBB', rcm(:,1:pver), pcols, lchnk ) - call outfld( 'RTM_CLUBB', rtm(:,1:pver), pcols, lchnk ) - call outfld( 'THLM_CLUBB', thlm(:,1:pver), pcols, lchnk ) - call outfld( 'WPRCP_CLUBB', wprcp_clubb, pcols, lchnk ) - call outfld( 'WPTHVP_CLUBB', wpthvp_clubb, pcols, lchnk ) - call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_out(:,1:pver), pcols, lchnk ) - call outfld( 'THLP2_ZT_CLUBB', thl2_zt_out(:,1:pver), pcols, lchnk ) - call outfld( 'WP2_ZT_CLUBB', wp2_zt_out(:,1:pver), pcols, lchnk ) - call outfld( 'PDFP_RTP2_CLUBB', pdfp_rtp2, pcols, lchnk ) - call outfld( 'THLP2_CLUBB', thlp2, pcols, lchnk ) - call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer(:,1:pver), pcols, lchnk ) - call outfld( 'CLOUDFRAC_CLUBB', alst, pcols, lchnk ) - call outfld( 'CLOUDCOVER_CLUBB', cloud_frac(:,1:pver), pcols, lchnk ) - call outfld( 'ZT_CLUBB', zt_out(:,1:pver), pcols, lchnk ) - call outfld( 'ZM_CLUBB', zi_out, pcols, lchnk ) - call outfld( 'UM_CLUBB', um(:,1:pver), pcols, lchnk ) - call outfld( 'VM_CLUBB', vm(:,1:pver), pcols, lchnk ) - call outfld( 'WM_ZT_CLUBB', wm_zt_out(:,1:pver), pcols, lchnk ) - call outfld( 'CONCLD', concld, pcols, lchnk ) - call outfld( 'DP_CLD', deepcu, pcols, lchnk ) - call outfld( 'ZMDLF', dlf_liq_out, pcols, lchnk ) - call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) - call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) - call outfld( 'QSATFAC', qsatfac, pcols, lchnk) + call outfld( 'WP2_CLUBB', wp2_output, pcols, lchnk ) + call outfld( 'UP2_CLUBB', up2_output, pcols, lchnk ) + call outfld( 'VP2_CLUBB', vp2_output, pcols, lchnk ) + call outfld( 'WP3_CLUBB', wp3_output, pcols, lchnk ) + call outfld( 'UPWP_CLUBB', upwp_output, pcols, lchnk ) + call outfld( 'VPWP_CLUBB', vpwp_output, pcols, lchnk ) + call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) + call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) + call outfld( 'RTP2_CLUBB', rtp2_output, pcols, lchnk ) + call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) + 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( '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 ) + call outfld( 'PDFP_RTP2_CLUBB', pdfp_rtp2_output, pcols, lchnk ) + call outfld( 'THLP2_CLUBB', thlp2_output, pcols, lchnk ) + call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer_output, pcols, lchnk ) + call outfld( 'ZT_CLUBB', zt_output, pcols, lchnk ) + call outfld( 'ZM_CLUBB', zi_output, pcols, lchnk ) + call outfld( 'UM_CLUBB', um_output, pcols, lchnk ) + call outfld( 'VM_CLUBB', vm_output, pcols, lchnk ) + call outfld( 'WM_ZT_CLUBB', wm_zt_output, pcols, lchnk ) + + call outfld( 'RELVAR', relvar_pbuf, pcols, lchnk ) + call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) + call outfld( 'CLOUDCOVER_CLUBB', cld_pbuf, pcols, lchnk ) + call outfld( 'CLOUDFRAC_CLUBB', alst_pbuf, pcols, lchnk ) + call outfld( 'CONCLD', concld_pbuf, pcols, lchnk ) + call outfld( 'DP_CLD', deepcu_pbuf, pcols, lchnk ) + call outfld( 'ZMDLF', dlf_liq_out, pcols, lchnk ) + call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) + call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) + call outfld( 'QSATFAC', qsatfac_pbuf, pcols, lchnk ) ! --------------------------------------------------------------- ! ! Writing state variables after EDMF scheme for detailed analysis ! ! --------------------------------------------------------------- ! if (do_clubb_mf) then + + 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_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(i,k)*cpair + mf_qtflx_output(i,k) = mf_qtflx(i,k_clubb)*rho(i,k)*latvap + end do + 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_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 + end do + end do + 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 ) @@ -4830,12 +5028,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'edmf_S_AWV' , s_awv_output, pcols, lchnk ) call outfld( 'edmf_thlflx' , mf_thlflx_output, pcols, lchnk ) call outfld( 'edmf_qtflx' , mf_qtflx_output, pcols, lchnk ) + end if ! Output CLUBB history here if (stats_metadata%l_stats) then - do j=1,stats_zt(1)%num_output_fields + do j = 1, stats_zt(1)%num_output_fields temp1 = trim(stats_zt(1)%file%grid_avg_var(j)%name) sub = temp1 @@ -4844,7 +5043,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld(trim(sub), out_zt(:,:,j), pcols, lchnk ) enddo - do j=1,stats_zm(1)%num_output_fields + do j = 1, stats_zm(1)%num_output_fields temp1 = trim(stats_zm(1)%file%grid_avg_var(j)%name) sub = temp1 @@ -4854,21 +5053,24 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo if (stats_metadata%l_output_rad_files) then - do j=1,stats_rad_zt(1)%num_output_fields + 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 + 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 + 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:NAR') + 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') @@ -4919,12 +5121,12 @@ subroutine clubb_emissions_cam (state, cam_in, ptend) call physics_ptend_init(ptend,state%psetcols, "clubb emissions", lq=lq) ! Apply tracer fluxes to lowest model level (except water vapor) - do m = 2,pcnst + do m = 2, pcnst ptend%q(:ncol,pver,m) = cam_in%cflx(:ncol,m)*state%rpdel(:ncol,pver)*gravit end do ! Convert tendencies of dry constituents to dry basis. - do m = 2,pcnst + do m = 2, pcnst if (cnst_type(m).eq.'dry') then ptend%q(:ncol,pver,m) = ptend%q(:ncol,pver,m)*state%pdel(:ncol,pver)*state%rpdeldry(:ncol,pver) endif @@ -4938,7 +5140,9 @@ end subroutine clubb_emissions_cam ! Saturation adjustment for ice ! Add ice mass if supersaturated -subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nitend,vlen) +subroutine ice_macro_tend(vlen,xxls,deltat, & + naai,t,p,qv,qi,ni,& + stend,qvtend,qitend,nitend) use wv_sat_methods, only: wv_sat_qsat_ice @@ -4990,81 +5194,79 @@ subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nite end subroutine ice_macro_tend #ifdef CLUBB_SGS -! ---------------------------------------------------------------------- -! -! DISCLAIMER : this code appears to be correct but has not been -! very thouroughly tested. If you do notice any -! anomalous behaviour then please contact Andy and/or -! Bjorn -! -! Function diag_ustar: returns value of ustar using the below -! similarity functions and a specified buoyancy flux (bflx) given in -! kinematic units -! -! phi_m (zeta > 0) = (1 + am * zeta) -! phi_m (zeta < 0) = (1 - bm * zeta)^(-1/4) -! -! where zeta = z/lmo and lmo = (theta_rev/g*vonk) * (ustar^2/tstar) -! -! Ref: Businger, 1973, Turbulent Transfer in the Atmospheric Surface -! Layer, in Workshop on Micormeteorology, pages 67-100. -! -! Code writen March, 1999 by Bjorn Stevens -! - -real(r8) function diag_ustar( z, bflx, wnd, z0 ) - -use shr_const_mod, only : shr_const_karman, shr_const_pi, shr_const_g + ! ---------------------------------------------------------------------- + ! + ! DISCLAIMER : this code appears to be correct but has not been + ! very thouroughly tested. If you do notice any + ! anomalous behaviour then please contact Andy and/or + ! Bjorn + ! + ! Function diag_ustar: returns value of ustar using the below + ! similarity functions and a specified buoyancy flux (bflx) given in + ! kinematic units + ! + ! phi_m (zeta > 0) = (1 + am * zeta) + ! phi_m (zeta < 0) = (1 - bm * zeta)^(-1/4) + ! + ! where zeta = z/lmo and lmo = (theta_rev/g*vonk) * (ustar^2/tstar) + ! + ! Ref: Businger, 1973, Turbulent Transfer in the Atmospheric Surface + ! Layer, in Workshop on Micormeteorology, pages 67-100. + ! + ! Code writen March, 1999 by Bjorn Stevens + ! -implicit none + real(r8) function diag_ustar( z, bflx, wnd, z0 ) -real(r8), parameter :: am = 4.8_r8 ! " " " -real(r8), parameter :: bm = 19.3_r8 ! " " " + use shr_const_mod, only : shr_const_karman, shr_const_pi, shr_const_g -real(r8), parameter :: grav = shr_const_g -real(r8), parameter :: vonk = shr_const_karman -real(r8), parameter :: pi = shr_const_pi + implicit none -real(r8), intent (in) :: z ! height where u locates -real(r8), intent (in) :: bflx ! surface buoyancy flux (m^2/s^3) -real(r8), intent (in) :: wnd ! wind speed at z -real(r8), intent (in) :: z0 ! momentum roughness height + real(r8), parameter :: am = 4.8_r8 ! " " " + real(r8), parameter :: bm = 19.3_r8 ! " " " + real(r8), parameter :: grav = shr_const_g + real(r8), parameter :: vonk = shr_const_karman + real(r8), parameter :: pi = shr_const_pi -integer :: iterate -real(r8) :: lnz, klnz, c1, x, psi1, zeta, lmo, ustar + real(r8), intent (in) :: z ! height where u locates + real(r8), intent (in) :: bflx ! surface buoyancy flux (m^2/s^3) + real(r8), intent (in) :: wnd ! wind speed at z + real(r8), intent (in) :: z0 ! momentum roughness height -lnz = log( z / z0 ) -klnz = vonk/lnz -c1 = pi / 2.0_r8 - 3.0_r8*log( 2.0_r8 ) -ustar = wnd*klnz -if (abs(bflx) > 1.e-6_r8) then - do iterate=1,4 + integer :: iterate + real(r8) :: lnz, klnz, c1, x, psi1, zeta, lmo, ustar - if (ustar > 1.e-6_r8) then - lmo = -ustar**3 / ( vonk * bflx ) - zeta = z/lmo - if (zeta > 0._r8) then - ustar = vonk*wnd /(lnz + am*zeta) - else - x = sqrt( sqrt( 1.0_r8 - bm*zeta ) ) - psi1 = 2._r8*log( 1.0_r8+x ) + log( 1.0_r8+x*x ) - 2._r8*atan( x ) + c1 - ustar = wnd*vonk/(lnz - psi1) - end if + lnz = log( z / z0 ) + klnz = vonk/lnz + c1 = pi / 2.0_r8 - 3.0_r8*log( 2.0_r8 ) - endif + ustar = wnd*klnz + if (abs(bflx) > 1.e-6_r8) then + do iterate = 1, 4 - end do -end if + if (ustar > 1.e-6_r8) then + lmo = -ustar**3 / ( vonk * bflx ) + zeta = z/lmo + if (zeta > 0._r8) then + ustar = vonk*wnd /(lnz + am*zeta) + else + x = sqrt( sqrt( 1.0_r8 - bm*zeta ) ) + psi1 = 2._r8*log( 1.0_r8+x ) + log( 1.0_r8+x*x ) - 2._r8*atan( x ) + c1 + ustar = wnd*vonk/(lnz - psi1) + end if + endif -diag_ustar = ustar + end do + end if -return + diag_ustar = ustar + return -end function diag_ustar + end function diag_ustar #endif ! =============================================================================== ! @@ -5240,7 +5442,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & endif stats_zt(j)%num_output_fields = ntot - stats_zt(j)%kk = nnzp + stats_zt(j)%kk = nnzp - 1 allocate( stats_zt(j)%z( stats_zt(j)%kk ), stat=ierr ) if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%z") @@ -5529,9 +5731,9 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st stats_sfc ! stats_sfc ! Inout variables - real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) + real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pver,stats_zt%num_output_fields) real(r8), intent(inout) :: out_zm(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) - real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pverp,stats_rad_zt%num_output_fields) + real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pver,stats_rad_zt%num_output_fields) real(r8), intent(inout) :: out_radzm(:,:,:) ! (pcols,pverp,rad_zm%num_output_fields) real(r8), intent(inout) :: out_sfc(:,:,:) ! (pcols,1,sfc%num_output_fields) @@ -5563,30 +5765,62 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st ! in the vertical level to be the same as CAM output. do i = 1, stats_zt%num_output_fields do k = 1, stats_zt%kk - out_zt(thecol,pverp-k+1,i) = stats_zt%accum_field_values(1,1,k,i) - if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8 + + ! The data stored in stats types are ascending if clubb_l_ascending_grid = .true. + if ( clubb_l_ascending_grid ) then + out_zt(thecol,pver+1-k,i) = stats_zt%accum_field_values(1,1,k,i) + else + out_zt(thecol,top_lev-1+k,i) = stats_zt%accum_field_values(1,1,k,i) + end if + + if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8 + enddo enddo do i = 1, stats_zm%num_output_fields - do k = 1, stats_zt%kk - out_zm(thecol,pverp-k+1,i) = stats_zm%accum_field_values(1,1,k,i) - if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8 + do k = 1, stats_zm%kk + + ! The data stored in stats types are ascending if clubb_l_ascending_grid = .true. + if ( clubb_l_ascending_grid ) then + out_zm(thecol,pverp+1-k,i) = stats_zm%accum_field_values(1,1,k,i) + else + out_zm(thecol,top_lev-1+k,i) = stats_zm%accum_field_values(1,1,k,i) + end if + + if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8 + enddo enddo if (stats_metadata%l_output_rad_files) then do i = 1, stats_rad_zt%num_output_fields do k = 1, stats_rad_zt%kk - out_radzt(thecol,pverp-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i) + + ! The data stored in stats types are ascending if clubb_l_ascending_grid = .true. + if ( clubb_l_ascending_grid ) then + out_radzt(thecol,pver+1-k,i) = stats_rad_zt%accum_field_values(1,1,k,i) + else + out_radzt(thecol,top_lev-1+k,i) = stats_rad_zt%accum_field_values(1,1,k,i) + end if + if(is_nan(out_radzt(thecol,k,i))) out_radzt(thecol,k,i) = 0.0_r8 + enddo enddo do i = 1, stats_rad_zm%num_output_fields do k = 1, stats_rad_zm%kk - out_radzm(thecol,pverp-k+1,i) = stats_rad_zm%accum_field_values(1,1,k,i) + + ! The data stored in stats types are ascending if clubb_l_ascending_grid = .true. + if ( clubb_l_ascending_grid ) then + out_radzm(thecol,pverp+1-k,i) = stats_rad_zm%accum_field_values(1,1,k,i) + else + out_radzm(thecol,top_lev-1+k,i) = stats_rad_zm%accum_field_values(1,1,k,i) + end if + if(is_nan(out_radzm(thecol,k,i))) out_radzm(thecol,k,i) = 0.0_r8 + enddo enddo @@ -5695,8 +5929,8 @@ subroutine stats_avg( kk, num_output_fields, x, n ) ! Compute averages - do m=1,num_output_fields - do k=1,kk + do m = 1, num_output_fields + 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) ) @@ -5728,7 +5962,7 @@ subroutine grid_size(state, grid_dx, grid_dy) integer :: i ! determine the column area in radians - do i=1,state%ncol + do i = 1, state%ncol column_area = get_area_p(state%lchnk,i) degree = sqrt(column_area)*(180._r8/shr_const_pi) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 898c42004d..de85d1ef70 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1,682 +1,684 @@ 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 - - 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 ! + ! Mass-flux module for use with CLUBB ! + ! Together (CLUBB+MF) they comprise a eddy-diffusivity mass-flux approach (EDMF) ! ! =============================================================================== ! - - 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 + + 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 - 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( nz, 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) :: nz - real(r8), dimension(nz), intent(in) :: u, v, & ! thermodynamic grid - thl, thv, & ! thermodynamic grid - qt, & ! thermodynamic grid - dzt, & ! thermodynamic grid - p_zt, iexner_zt, & ! thermodynamic grid - 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(nz), 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(nz) :: moist_th, dry_th, & ! momentum grid - awqv, awth ! momentum grid - ! - ! updraft properties - real(r8), dimension(nz,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(nz,clubb_mf_nup) :: ent, entf ! thermodynamic grid - integer, dimension(nz,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(1)*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=1,nz - entf(k,i) = dzt(k) / clubb_mf_L0 + + 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 - enddo - - ! get poisson, P(dz/L0) - call poisson( nz, clubb_mf_nup, entf, enti, u(2:5)) - - ! get entrainment, ent=ent0/dz*P(dz/L0) - do i=1,clubb_mf_nup - do k=1,nz - ent(k,i) = real( enti(k,i))*clubb_mf_ent0/dzt(k) + + ! 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 - enddo - - end if - - ! get surface conditions - wstar = max( wstarmin, (gravit/thv(1)*wthv*pblh)**(1._r8/3._r8) ) - qstar = wqt / wstar - thvstar = wthv / wstar - - sigmaw = alphw * wstar - sigmaqt = alphqt * abs(qstar) - sigmathv = alphthv * abs(thvstar) - - wmin = sigmaw * pwmin - wmax = sigmaw * pwmax - - 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(1,i) = 0.5_r8 * (wlv+wtv) - upa(1,i) = 0.5_r8 * erf( wtv/(sqrt(2._r8)*sigmaw) ) & - - 0.5_r8 * erf( wlv/(sqrt(2._r8)*sigmaw) ) - - upu(1,i) = u(1) - upv(1,i) = v(1) - - upqt(1,i) = qt(1) + cwqt * upw(1,i) * sigmaqt/sigmaw - upthv(1,i) = thv(1) + cwthv * upw(1,i) * sigmathv/sigmaw - upthl(1,i) = upthv(1,i) / (1._r8+zvir*upqt(1,i)) - - ! get cloud, lowest momentum level - if (do_condensation) then - call condensation_mf(upqt(1,i), upthl(1,i), p_zm(1), iexner_zm(1), & - thvn, qcn, thn, qln, qin, qsn, lmixn) - upthv(1,i) = thvn - upqc(1,i) = qcn - upql(1,i) = qln - upqi(1,i) = qin - upqs(1,i) = qsn - if (qcn > 0._r8) zcb(i) = zm(1) - else - ! assume no cldliq - upqc(1,i) = 0._r8 + end if - - enddo - - ! get updraft properties - do i=1,clubb_mf_nup - do k=1,nz-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 - else - supqt = 0._r8 - supthl = 0._r8 - end if - - ! 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 - - ! get cloud, momentum levels + + ! get surface conditions + wstar = max( wstarmin, (gravit/thv(nzt)*wthv*pblh)**(1._r8/3._r8) ) + qstar = wqt / wstar + thvstar = wthv / wstar + + sigmaw = alphw * wstar + sigmaqt = alphqt * abs(qstar) + sigmathv = alphthv * abs(thvstar) + + wmin = sigmaw * pwmin + wmax = sigmaw * pwmax + + 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(qtn, thln, p_zm(k+1), iexner_zm(k+1), & + call condensation_mf(upqt(nzm,i), upthl(nzm,i), p_zm(nzm), iexner_zm(nzm), & thvn, qcn, thn, qln, qin, qsn, lmixn) - if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(k+1) - 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 - end if - 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) + 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) 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) - 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 - else - exit + ! assume no cldliq + upqc(nzm,i) = 0._r8 end if + enddo - enddo - - ! writing updraft properties for output - do k=1,nz - - ! first sum over all i-updrafts + + ! get updraft properties 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) + 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 + else + supqt = 0._r8 + supthl = 0._r8 + end if + + ! 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 + + ! get cloud, momentum levels + if (do_condensation) then + call condensation_mf(qtn, thln, p_zm(k-1), iexner_zm(k-1), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(k-1) + 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 + end if + 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) + 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) + 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 + else + exit + end if + enddo + enddo + + ! writing updraft properties for output + do k=nzm,1,-1 + + ! 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 + 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_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) + 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 + 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 - - 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) - 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 - endif - - enddo - - do k=1,nz - 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) + + 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) 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 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,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 knuth(kiss_gen,lambda(i,j),poi(i,j)) + t = thl/iex+get_alhl(wf)/cpair*qc + + call qsat(t,p,es,qs) + qc = max(qt-qs,0._r8) + thv = (thl+get_alhl(wf)/cpair*iex*qc)*(1._r8+zvir*(qt-qc)-qc) + lmix = get_alhl(wf) + th = t*iex + qi = qc*(1._r8-wf) + ql = qc*wf + + contains + + function get_watf(t) + real(r8) :: t,get_watf,tc + real(r8), parameter :: & + tmax=-10._r8, & + tmin=-40._r8 + + tc=t-h2otrip + + if (tc>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,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 enddo - 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) - end do - kout = k - 1 - - end subroutine knuth - -end module clubb_mf + + 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) + end do + kout = k - 1 + + end subroutine knuth + + end module clubb_mf + diff --git a/src/physics/cam/microp_aero.F90 b/src/physics/cam/microp_aero.F90 index d14d4d5967..50609acf02 100644 --- a/src/physics/cam/microp_aero.F90 +++ b/src/physics/cam/microp_aero.F90 @@ -658,9 +658,10 @@ subroutine microp_aero_run ( & call pbuf_get_field(pbuf, tke_idx, tke) case ('CLUBB_SGS') itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/),kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wp2_idx, wp2 ) allocate(tke(pcols,pverp)) - tke(:ncol,:) = (3._r8/2._r8)*wp2(:ncol,:) + tke(:ncol,top_lev:pverp) = (3._r8/2._r8)*wp2(:ncol,1:pverp-top_lev+1) + tke(:ncol,1:top_lev-1) = 0._r8 case default call pbuf_get_field(pbuf, kvh_idx, kvh) diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 05653b9f03..9ed3166c4e 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -1,306 +1,303 @@ module subcol_SILHS - !--------------------------------------------------------------------------- - ! Purpose: - ! - ! Implement a subcolumn scheme based on the Subgrid Importance Latin Hypercube - ! Sampling (SILHS) functionality of the CLUBB moist turbulence parameterization. - ! - !--------------------------------------------------------------------------- - - use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 - use physics_types, only: physics_state, physics_tend, physics_ptend - use ppgrid, only: pcols, psubcols, pver, pverp, begchunk, endchunk - use constituents, only: pcnst, cnst_get_ind - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use cam_history, only: addfld, add_default, outfld, horiz_only - use ref_pres, only: top_lev => trop_cloud_top_lev + !--------------------------------------------------------------------------- + ! Purpose: + ! + ! Implement a subcolumn scheme based on the Subgrid Importance Latin Hypercube + ! Sampling (SILHS) functionality of the CLUBB moist turbulence parameterization. + ! + !--------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 + use physics_types, only: physics_state, physics_tend, physics_ptend + use ppgrid, only: pcols, psubcols, pver, pverp, begchunk, endchunk + use constituents, only: pcnst, cnst_get_ind + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use cam_history, only: addfld, add_default, outfld, horiz_only + use ref_pres, only: top_lev => trop_cloud_top_lev #ifdef CLUBB_SGS #ifdef SILHS - use clubb_intr, only: & - clubb_config_flags, & - clubb_params_single_col, & - stats_metadata, & - stats_zt, stats_zm, stats_sfc, & - pdf_params_chnk, & - hm_metadata, & - hydromet_dim, & - pdf_dim - - use clubb_api_module, only: & - hmp2_ip_on_hmm2_ip_slope_type, & - hmp2_ip_on_hmm2_ip_intrcpt_type, & - precipitation_fractions, & - stats, & - core_rknd - - use silhs_api_module, only: & - silhs_config_flags_type + use clubb_intr, only: & + clubb_config_flags, & + clubb_params_single_col, & + stats_metadata, & + stats_zt, stats_zm, stats_sfc, & + pdf_params_chnk, & + hm_metadata, & + hydromet_dim, & + pdf_dim, & + nzm_clubb, & + nzt_clubb + + use clubb_api_module, only: & + hmp2_ip_on_hmm2_ip_slope_type, & + hmp2_ip_on_hmm2_ip_intrcpt_type, & + precipitation_fractions, & + stats, & + core_rknd + + use silhs_api_module, only: & + silhs_config_flags_type #endif #endif - use physconst, only: cpair, gravit, latvap, latice, rair, rga, cappa - - implicit none - private - save - - public :: subcol_register_SILHS ! - public :: subcol_init_SILHS ! Initialize - public :: subcol_gen_SILHS ! Generate subcolumn fields by calling SILHS - public :: subcol_readnl_SILHS ! SILHS namelist reader - public :: subcol_ptend_avg_SILHS - public :: subcol_SILHS_var_covar_driver - public :: subcol_SILHS_fill_holes_conserv - public :: subcol_SILHS_hydromet_conc_tend_lim - public :: init_state_subcol - private :: fill_holes_sedimentation - private :: fill_holes_same_phase_vert + use physconst, only: cpair, gravit, latvap, latice, rair, rga, cappa + + implicit none + private + save + + public :: subcol_register_SILHS ! + public :: subcol_init_SILHS ! Initialize + public :: subcol_gen_SILHS ! Generate subcolumn fields by calling SILHS + public :: subcol_readnl_SILHS ! SILHS namelist reader + public :: subcol_ptend_avg_SILHS + public :: subcol_SILHS_var_covar_driver + public :: subcol_SILHS_fill_holes_conserv + public :: subcol_SILHS_hydromet_conc_tend_lim + public :: init_state_subcol + private :: fill_holes_sedimentation + private :: fill_holes_same_phase_vert #ifdef SILHS - ! Calc subcol mean ! Calc subcol variance - private :: meansc - private :: stdsc - - type (stats), target :: stats_lh_zt, & - stats_lh_sfc - !$omp threadprivate(stats_lh_zt, stats_lh_sfc) + ! Calc subcol mean ! Calc subcol variance + private :: meansc + private :: stdsc - real( kind = core_rknd ), dimension(:,:), allocatable :: & - corr_array_n_cloud, & - corr_array_n_below + real( kind = core_rknd ), dimension(:,:), allocatable :: & + corr_array_n_cloud, & + corr_array_n_below #endif - !----- - ! Private module vars - !----- - - ! constituent indicies - integer :: & - ixq = 0, & - ixcldliq = 0, & - ixnumliq = 0, & - ixcldice = 0, & - ixnumice = 0, & - ixrain = 0, & - ixnumrain= 0, & - ixsnow = 0, & - ixnumsnow= 0 - - ! Pbuf indicies - integer :: thlm_idx, rtm_idx, ice_supersat_idx, & - alst_idx, cld_idx, qrain_idx, qsnow_idx, & - nrain_idx, nsnow_idx, ztodt_idx, tke_idx, kvh_idx, & - prec_pcw_idx, snow_pcw_idx, prec_str_idx, snow_str_idx, & - qcsedten_idx, qrsedten_idx, qisedten_idx, qssedten_idx, & - vtrmc_idx, umr_idx, vtrmi_idx, ums_idx, qcsevap_idx, qisevap_idx - - logical :: subcol_SILHS_weight ! if set, sets up weights for averaging subcolumns for SILHS - integer :: subcol_SILHS_numsubcol ! number of subcolumns for this run - logical :: docldfracscaling = .false. ! Weight tendencies by cloud fraction - - character(len=256) :: subcol_SILHS_corr_file_path - character(len=16) :: subcol_SILHS_corr_file_name - - logical :: subcol_SILHS_q_to_micro, & - subcol_SILHS_n_to_micro, & - subcol_SILHS_use_clear_col, & - subcol_SILHS_meanice, & - subcol_SILHS_constrainmn - - logical :: subcol_SILHS_var_covar_src - - real(r8) :: subcol_SILHS_ncnp2_on_ncnm2 - - ! There may or may not be a better place to put this. - real(r8), parameter :: p0_clubb = 100000._r8 + !----- + ! Private module vars + !----- + + ! constituent indicies + integer :: & + ixq = 0, & + ixcldliq = 0, & + ixnumliq = 0, & + ixcldice = 0, & + ixnumice = 0, & + ixrain = 0, & + ixnumrain= 0, & + ixsnow = 0, & + ixnumsnow= 0 + + ! Pbuf indicies + integer :: ice_supersat_idx, & + alst_idx, cld_idx, qrain_idx, qsnow_idx, & + nrain_idx, nsnow_idx, tke_idx, kvh_idx, & + prec_pcw_idx, snow_pcw_idx, prec_str_idx, snow_str_idx, & + qcsedten_idx, qrsedten_idx, qisedten_idx, qssedten_idx, & + vtrmc_idx, umr_idx, vtrmi_idx, ums_idx, qcsevap_idx, qisevap_idx + + logical :: subcol_SILHS_weight ! if set, sets up weights for averaging subcolumns for SILHS + integer :: subcol_SILHS_numsubcol ! number of subcolumns for this run + logical :: docldfracscaling = .false. ! Weight tendencies by cloud fraction + + character(len=256) :: subcol_SILHS_corr_file_path + character(len=16) :: subcol_SILHS_corr_file_name + + logical :: subcol_SILHS_q_to_micro, & + subcol_SILHS_n_to_micro, & + subcol_SILHS_use_clear_col, & + subcol_SILHS_meanice, & + subcol_SILHS_constrainmn + + logical :: subcol_SILHS_var_covar_src + + real(r8) :: subcol_SILHS_ncnp2_on_ncnm2 + + ! There may or may not be a better place to put this. + real(r8), parameter :: p0_clubb = 100000._r8 ! real(r8) :: subcol_SILHS_c6rt, subcol_SILHS_c7, subcol_SILHS_c8, subcol_SILHS_c11, & ! subcol_SILHS_c11b, subcol_SILHS_gamma_coef, & ! subcol_SILHS_mult_coef, subcol_SILHS_mu - real(r8) :: ztodt ! model timestep #ifdef CLUBB_SGS #ifdef SILHS - type(hmp2_ip_on_hmm2_ip_slope_type) :: subcol_SILHS_hmp2_ip_on_hmm2_ip_slope - type(hmp2_ip_on_hmm2_ip_intrcpt_type) :: subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt + type(hmp2_ip_on_hmm2_ip_slope_type) :: subcol_SILHS_hmp2_ip_on_hmm2_ip_slope + type(hmp2_ip_on_hmm2_ip_intrcpt_type) :: subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt - type(silhs_config_flags_type) :: silhs_config_flags + type(silhs_config_flags_type) :: silhs_config_flags #endif #endif contains - subroutine subcol_register_SILHS() + subroutine subcol_register_SILHS() - !-------------------------------- - ! Register fields needed by SILHS in the physics buffer - ! Currently, most fields needed by SILHS but calculated by CLUBB are registered - ! by clubb in clubb_intr.F90. - ! - !-------------------------------- + !-------------------------------- + ! Register fields needed by SILHS in the physics buffer + ! Currently, most fields needed by SILHS but calculated by CLUBB are registered + ! by clubb in clubb_intr.F90. + ! + !-------------------------------- #ifdef CLUBB_SGS #ifdef SILHS #endif #endif - end subroutine subcol_register_SILHS + end subroutine subcol_register_SILHS - subroutine subcol_readnl_SILHS(nlfile) + subroutine subcol_readnl_SILHS(nlfile) #ifdef CLUBB_SGS #ifdef SILHS - use namelist_utils, only: find_group_name - use spmd_utils, only: masterproc, masterprocid, mpicom - use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8, iam - use clubb_api_module, only: core_rknd - use silhs_api_module, only: set_default_silhs_config_flags_api, & - initialize_silhs_config_flags_type_api, & - print_silhs_config_flags_api + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, masterprocid, mpicom + use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8, iam + use clubb_api_module, only: core_rknd + use silhs_api_module, only: set_default_silhs_config_flags_api, & + initialize_silhs_config_flags_type_api, & + print_silhs_config_flags_api #endif #endif - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - ! Local variables - integer :: unitn, ierr + ! Local variables + integer :: unitn, ierr #ifdef CLUBB_SGS #ifdef SILHS - integer :: & - cluster_allocation_strategy - - logical :: & - subcol_silhs_l_lh_importance_sampling, & - subcol_silhs_l_Lscale_vert_avg, & - subcol_silhs_l_lh_straight_mc, & - subcol_silhs_l_lh_clustered_sampling, & - subcol_silhs_l_rcm_in_cloud_k_lh_start, & - subcol_silhs_l_random_k_lh_start, & - subcol_silhs_l_max_overlap_in_cloud, & - subcol_silhs_l_lh_instant_var_covar_src, & - subcol_silhs_l_lh_limit_weights, & - subcol_silhs_l_lh_var_frac, & - subcol_silhs_l_lh_normalize_weights - - namelist /subcol_SILHS_nl/ subcol_SILHS_weight, & - subcol_SILHS_numsubcol, & - subcol_SILHS_corr_file_path, & - subcol_SILHS_corr_file_name, & - subcol_SILHS_q_to_micro, & - subcol_SILHS_n_to_micro, & - subcol_SILHS_ncnp2_on_ncnm2, & - subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & - subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt, & - subcol_SILHS_meanice, & - subcol_SILHS_use_clear_col, & - subcol_SILHS_constrainmn, & - subcol_SILHS_var_covar_src + integer :: & + cluster_allocation_strategy + + logical :: & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + + namelist /subcol_SILHS_nl/ subcol_SILHS_weight, & + subcol_SILHS_numsubcol, & + subcol_SILHS_corr_file_path, & + subcol_SILHS_corr_file_name, & + subcol_SILHS_q_to_micro, & + subcol_SILHS_n_to_micro, & + subcol_SILHS_ncnp2_on_ncnm2, & + subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & + subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt, & + subcol_SILHS_meanice, & + subcol_SILHS_use_clear_col, & + subcol_SILHS_constrainmn, & + subcol_SILHS_var_covar_src ! subcol_SILHS_c6rt, subcol_SILHS_c7, & ! subcol_SILHS_c8, subcol_SILHS_c11, subcol_SILHS_c11b, & ! subcol_SILHS_gamma_coef, subcol_SILHS_mult_coef, subcol_SILHS_mu - namelist /silhs_config_flags_nl/ subcol_silhs_l_lh_importance_sampling, & - subcol_silhs_l_Lscale_vert_avg, & - subcol_silhs_l_lh_straight_mc, & - subcol_silhs_l_lh_clustered_sampling, & - subcol_silhs_l_rcm_in_cloud_k_lh_start, & - subcol_silhs_l_random_k_lh_start, & - subcol_silhs_l_max_overlap_in_cloud, & - subcol_silhs_l_lh_instant_var_covar_src, & - subcol_silhs_l_lh_limit_weights, & - subcol_silhs_l_lh_var_frac, & - subcol_silhs_l_lh_normalize_weights - - !----------------------------------------------------------------------------- - ! Set defaults - - ! Eric Raut changed a default. - subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ni = 0.0_core_rknd - subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni = 0.5_core_rknd - - if (masterproc) then - open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'subcol_SILHS_nl', status=ierr) - if (ierr == 0) then - read(unitn, subcol_SILHS_nl, iostat=ierr) - if (ierr /= 0) then - call endrun('subcol_readnl_SILHS: ERROR reading namelist') - end if - end if - close(unitn) - end if - - ! Set default silhs_config_flags entires - call set_default_silhs_config_flags_api( cluster_allocation_strategy, & - subcol_silhs_l_lh_importance_sampling, & - subcol_silhs_l_Lscale_vert_avg, & - subcol_silhs_l_lh_straight_mc, & - subcol_silhs_l_lh_clustered_sampling, & - subcol_silhs_l_rcm_in_cloud_k_lh_start, & - subcol_silhs_l_random_k_lh_start, & - subcol_silhs_l_max_overlap_in_cloud, & - subcol_silhs_l_lh_instant_var_covar_src, & - subcol_silhs_l_lh_limit_weights, & - subcol_silhs_l_lh_var_frac, & - subcol_silhs_l_lh_normalize_weights ) - - ! Get silhs_config_flags entries from namelist - if (masterproc) then + namelist /silhs_config_flags_nl/ subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + + !----------------------------------------------------------------------------- + ! Set defaults + + ! Eric Raut changed a default. + subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ni = 0.0_core_rknd + subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni = 0.5_core_rknd + + if (masterproc) then open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'silhs_config_flags_nl', status=ierr) + call find_group_name(unitn, 'subcol_SILHS_nl', status=ierr) if (ierr == 0) then - read(unitn, silhs_config_flags_nl, iostat=ierr) - if (ierr /= 0) then - call endrun('silhs_config_flags_nl: ERROR reading namelist') - end if + read(unitn, subcol_SILHS_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('subcol_readnl_SILHS: ERROR reading namelist') + end if end if close(unitn) - end if - - ! Save silhs_config_flags entries into module variable silhs_config_flags - call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & - subcol_silhs_l_lh_importance_sampling, & - subcol_silhs_l_Lscale_vert_avg, & - subcol_silhs_l_lh_straight_mc, & - subcol_silhs_l_lh_clustered_sampling, & - subcol_silhs_l_rcm_in_cloud_k_lh_start, & - subcol_silhs_l_random_k_lh_start, & - subcol_silhs_l_max_overlap_in_cloud, & - subcol_silhs_l_lh_instant_var_covar_src, & - subcol_silhs_l_lh_limit_weights, & - subcol_silhs_l_lh_var_frac, & - subcol_silhs_l_lh_normalize_weights, & - silhs_config_flags ) - - ! Print the SILHS configurable flags - call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) + end if + + ! Set default silhs_config_flags entires + call set_default_silhs_config_flags_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights ) + + ! Get silhs_config_flags entries from namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'silhs_config_flags_nl', status=ierr) + if (ierr == 0) then + read(unitn, silhs_config_flags_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('silhs_config_flags_nl: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Save silhs_config_flags entries into module variable silhs_config_flags + call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights, & + silhs_config_flags ) + + ! Print the SILHS configurable flags + call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) #ifdef SPMD - ! Broadcast namelist variables - call mpi_bcast(subcol_SILHS_weight, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_numsubcol, 1, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_corr_file_path, len(subcol_SILHS_corr_file_path), & - mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_corr_file_name, len(subcol_SILHS_corr_file_name), & - mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_use_clear_col, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_constrainmn, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_meanice, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_q_to_micro, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_n_to_micro, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_var_covar_src,1,mpi_logical,masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_ncnp2_on_ncnm2, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%rr, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Nr, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%ri, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ni, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%rs, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ns, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%rr, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Nr, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%ri, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%rs, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ns, 1, mpir8, masterprocid, mpicom, ierr) + ! Broadcast namelist variables + call mpi_bcast(subcol_SILHS_weight, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_numsubcol, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_corr_file_path, len(subcol_SILHS_corr_file_path), & + mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_corr_file_name, len(subcol_SILHS_corr_file_name), & + mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_use_clear_col, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_constrainmn, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_meanice, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_q_to_micro, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_n_to_micro, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_var_covar_src,1,mpi_logical,masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_ncnp2_on_ncnm2, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%rr, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Nr, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%ri, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ni, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%rs, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ns, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%rr, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Nr, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%ri, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%rs, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ns, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_c6rt, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_c7, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_c8, 1, mpir8, masterprocid, mpicom, ierr) @@ -309,17 +306,17 @@ subroutine subcol_readnl_SILHS(nlfile) ! call mpi_bcast(subcol_SILHS_gamma_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mult_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mu, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_importance_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_Lscale_vert_avg, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_straight_mc, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_clustered_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_rcm_in_cloud_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_random_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_max_overlap_in_cloud, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_instant_var_covar_src, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_limit_weights, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_var_frac, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_normalize_weights, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_importance_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_Lscale_vert_avg, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_straight_mc, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_clustered_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_rcm_in_cloud_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_random_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_max_overlap_in_cloud, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_instant_var_covar_src, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_limit_weights, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_var_frac, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_normalize_weights, 1, mpi_logical, masterprocid, mpicom, ierr) ! SPMD #endif @@ -327,74 +324,74 @@ subroutine subcol_readnl_SILHS(nlfile) #endif ! CLUBB_SGS #endif - end subroutine subcol_readnl_SILHS + end subroutine subcol_readnl_SILHS - subroutine subcol_init_SILHS(pbuf2d) + subroutine subcol_init_SILHS(pbuf2d) - !-------------------------------- - ! Read in parameters and initialize SILHS PDF fields. - ! Set up indexes into Pbuf fields. - ! Register history outputs. - !-------------------------------- + !-------------------------------- + ! Read in parameters and initialize SILHS PDF fields. + ! Set up indexes into Pbuf fields. + ! Register history outputs. + !-------------------------------- - use physics_buffer, only: physics_buffer_desc, pbuf_get_field, & - dtype_r8, pbuf_get_index + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, & + dtype_r8, pbuf_get_index #ifdef CLUBB_SGS #ifdef SILHS - use clubb_api_module, only: core_rknd, & - setup_corr_varnce_array_api, & - init_pdf_hydromet_arrays_api, & - set_clubb_debug_level_api + use clubb_api_module, only: core_rknd, & + setup_corr_varnce_array_api, & + init_pdf_hydromet_arrays_api, & + set_clubb_debug_level_api #endif #endif - type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) #ifdef CLUBB_SGS #ifdef SILHS - integer :: iunit = 501 ! Default value, will get iunit from CAM - !character(len=*), parameter :: default_corr_case = "arm_97" - character(len=*), parameter :: & - cloud_file_ext = "_corr_array_cloud.in", & ! File extensions for corr files - below_file_ext = "_corr_array_below.in" - character(len=256) :: corr_file_path_cloud, corr_file_path_below - - ! To set up CLUBB hydromet indices - integer :: & - iirr, & ! Hydrometeor array index for rain water mixing ratio, rr - iirs, & ! Hydrometeor array index for snow mixing ratio, rs - iiri, & ! Hydrometeor array index for ice mixing ratio, ri - iirg, & ! Hydrometeor array index for graupel mixing ratio, rg - iiNr, & ! Hydrometeor array index for rain drop concentration, Nr - iiNs, & ! Hydrometeor array index for snow concentration, Ns - iiNi, & ! Hydrometeor array index for ice concentration, Ni - iiNg ! Hydrometeor array index for graupel concentration, Ng - - integer :: l, ierr=0 ! Loop variable, error check - - ! Set CLUBB's debug level - ! This is called in module clubb_intr; no need to do it here. + integer :: iunit = 501 ! Default value, will get iunit from CAM + !character(len=*), parameter :: default_corr_case = "arm_97" + character(len=*), parameter :: & + cloud_file_ext = "_corr_array_cloud.in", & ! File extensions for corr files + below_file_ext = "_corr_array_below.in" + character(len=256) :: corr_file_path_cloud, corr_file_path_below + + ! To set up CLUBB hydromet indices + integer :: & + iirr, & ! Hydrometeor array index for rain water mixing ratio, rr + iirs, & ! Hydrometeor array index for snow mixing ratio, rs + iiri, & ! Hydrometeor array index for ice mixing ratio, ri + iirg, & ! Hydrometeor array index for graupel mixing ratio, rg + iiNr, & ! Hydrometeor array index for rain drop concentration, Nr + iiNs, & ! Hydrometeor array index for snow concentration, Ns + iiNi, & ! Hydrometeor array index for ice concentration, Ni + iiNg ! Hydrometeor array index for graupel concentration, Ng + + integer :: l, ierr=0 ! Loop variable, error check + + ! Set CLUBB's debug level + ! This is called in module clubb_intr; no need to do it here. ! call set_clubb_debug_level_api( 0 ) - !------------------------------- - ! CLUBB-SILHS Parameters (global module variables) - !------------------------------- - clubb_config_flags%l_fix_w_chi_eta_correlations = .true. - clubb_config_flags%l_diagnose_correlations = .false. - clubb_config_flags%l_calc_w_corr = .false. + !------------------------------- + ! CLUBB-SILHS Parameters (global module variables) + !------------------------------- + clubb_config_flags%l_fix_w_chi_eta_correlations = .true. + clubb_config_flags%l_diagnose_correlations = .false. + clubb_config_flags%l_calc_w_corr = .false. ! l_prescribed_avg_deltaz = .false. - clubb_config_flags%l_use_cloud_cover = .false. - clubb_config_flags%l_const_Nc_in_cloud = .true. + clubb_config_flags%l_use_cloud_cover = .false. + clubb_config_flags%l_const_Nc_in_cloud = .true. - ! Values from the namelist - docldfracscaling = subcol_SILHS_use_clear_col + ! Values from the namelist + docldfracscaling = subcol_SILHS_use_clear_col - ! Namelist "tuning" or set correlations - ! KTC Todo: Move these to a tuning "in" file or into the namelist - ! JHTODO: we might want these on CLUBB's API and ultimatively on a namelist for tuning + ! Namelist "tuning" or set correlations + ! KTC Todo: Move these to a tuning "in" file or into the namelist + ! JHTODO: we might want these on CLUBB's API and ultimatively on a namelist for tuning ! C6rt = subcol_SILHS_c6rt ! C7 = subcol_SILHS_c7 ! to all ice clouds ! C8 = subcol_SILHS_c8 @@ -404,3759 +401,3606 @@ subroutine subcol_init_SILHS(pbuf2d) ! mult_coef = subcol_SILHS_mult_coef ! mu = subcol_SILHS_mu - !call set_clubb_debug_level( 0 ) !#KTCtodo: Add a namelist variable to set debug level - - ! Get constituent indices - call cnst_get_ind('Q', ixq) - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('NUMLIQ', ixnumliq) - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('NUMICE', ixnumice) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('NUMRAI', ixnumrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - call cnst_get_ind('NUMSNO', ixnumsnow, abort=.false.) - - ! Get physics buffer indexes - thlm_idx = pbuf_get_index('THLM') - rtm_idx = pbuf_get_index('RTM') - cld_idx = pbuf_get_index('CLD') - alst_idx = pbuf_get_index('ALST') ! SILHS expects clubb's cloud_frac liq stratus fraction - ztodt_idx = pbuf_get_index('ZTODT') - ice_supersat_idx = pbuf_get_index('ISS_FRAC') - tke_idx = pbuf_get_index('tke') - kvh_idx = pbuf_get_index('kvh') - prec_pcw_idx = pbuf_get_index('PREC_PCW') - snow_pcw_idx = pbuf_get_index('SNOW_PCW') - prec_str_idx = pbuf_get_index('PREC_STR') - snow_str_idx = pbuf_get_index('SNOW_STR') - qcsedten_idx = pbuf_get_index('QCSEDTEN') - qrsedten_idx = pbuf_get_index('QRSEDTEN') - qisedten_idx = pbuf_get_index('QISEDTEN') - qssedten_idx = pbuf_get_index('QSSEDTEN') - vtrmc_idx = pbuf_get_index('VTRMC') - umr_idx = pbuf_get_index('UMR') - vtrmi_idx = pbuf_get_index('VTRMI') - ums_idx = pbuf_get_index('UMS') - qcsevap_idx = pbuf_get_index('QCSEVAP') - qisevap_idx = pbuf_get_index('QISEVAP') - qrain_idx = pbuf_get_index('QRAIN') - qsnow_idx = pbuf_get_index('QSNOW') - nrain_idx = pbuf_get_index('NRAIN') - nsnow_idx = pbuf_get_index('NSNOW') - - !------------------------------- - ! Set up SILHS hydrometeors #KTCtodo: move microphys specification to config time, - ! Steve wants to set up a microphysics query so I can ask the microphysics - ! scheme which hydrometeors to use. For the future. - !------------------------------- - iirr = 1 - iirs = 3 - iiri = 5 - iirg = -1 - - iiNr = 2 - iiNs = 4 - iiNi = 6 - iiNg = -1 - - hydromet_dim = 6 - - ! Set up pdf indices, hydromet indicies, hydromet arrays, and hydromet variance ratios - call init_pdf_hydromet_arrays_api( 1.0_core_rknd, 1.0_core_rknd, hydromet_dim, & ! intent(in) - iirr, iiNr, iiri, iiNi, & ! intent(in) - iirs, iiNs, iirg, iiNg, & ! intent(in) - subcol_SILHS_ncnp2_on_ncnm2, & ! intent(in) - hm_metadata, pdf_dim, & ! intent(out) - subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & ! optional(in) - subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt ) ! optional(in) - - !------------------------------- - ! Set up hydrometeors and correlation arrays for SILHS - !------------------------------- - allocate( corr_array_n_cloud(pdf_dim,pdf_dim), corr_array_n_below(pdf_dim,pdf_dim), stat=ierr) - if( ierr /= 0 ) call endrun(' subcol_init_SILHS: failed to allocate corr_array fields ') - - corr_file_path_cloud = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//cloud_file_ext - corr_file_path_below = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//below_file_ext - - call setup_corr_varnce_array_api( corr_file_path_cloud, corr_file_path_below, & - pdf_dim, hm_metadata, newunit(iunit), & - clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In - corr_array_n_cloud, corr_array_n_below ) - - !------------------------------- - ! Register output fields from SILHS - !------------------------------- - call addfld('SILHS_NCLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & - 'Subcolumn Cloud Number Concentration', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_NRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & - 'Subcolumn Number Concentration of Rain from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_OMEGA_SCOL', (/'psubcols', 'ilev '/), 'I', 'Pa/s', & - 'Subcolumn vertical pressure velocity', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_RCM_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Cloud Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_RICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Cloud Ice Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_NICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Cloud Ice Number Conc from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_RRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Precipitating Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_RT_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg ', & - 'Subcolumn Total Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_THLM_SCOL', (/'psubcols', 'ilev '/), 'I', 'K', & - 'Subcolumn liquid water pot temperature', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_WEIGHT_SCOL', (/'psubcols'/), 'I', 'frac', & - 'Weights for each subcolumn', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_WM_SCOL', (/'psubcols', 'ilev '/), 'I', 'm/s', & - 'Subcolumn vertical velocity from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - - call addfld('NR_IN_LH', (/ 'lev' /), 'I', 'm^-3', & - 'Num Rain Conc as input to SILHS', sampled_on_subcycle=.true.) - call addfld('SILHS_RTM', (/ 'ilev' /), 'I', 'kg/kg', & - 'Input total water mixing ratio', sampled_on_subcycle=.true.) - call addfld('SILHS_THLM', (/ 'ilev' /), 'I', 'K', & - 'Input liquid water potential temperature', sampled_on_subcycle=.true.) - call addfld('SILHS_QC_IN', (/ 'lev' /), 'I', 'kg/kg', & - 'Input cloud water mixing ratio', sampled_on_subcycle=.true.) - call addfld('SILHS_QI_IN', (/ 'lev' /), 'I', 'kg/kg', & - 'Input cloud ice mixing ratio', sampled_on_subcycle=.true.) - call addfld('SILHS_NC_IN', (/ 'lev' /), 'I', '#/kg', & - 'Input cloud water number concentration', sampled_on_subcycle=.true.) - call addfld('SILHS_NI_IN', (/ 'lev' /), 'I', '#/kg', & - 'Input cloud ice number concentration', sampled_on_subcycle=.true.) - call addfld('AKM_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & - 'Exact Kessler autoconversion', sampled_on_subcycle=.true.) - call addfld('AKM_LH_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & - 'Monte Carlo estimate of Kessler autoconversion', sampled_on_subcycle=.true.) - call addfld('INVS_EXNER', (/ 'lev' /), 'I', 'none', & - 'inverse EXNER function from state in subcol_SILHS', sampled_on_subcycle=.true.) - call addfld('SILHS_ZTODT', horiz_only, 'I', 's', & - 'Length of Physics timestep (for debugging)', sampled_on_subcycle=.true.) - if ( subcol_SILHS_constrainmn ) then - call addfld('SILHS_MSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & - 'Mean Cloud Ice across subcolumns', sampled_on_subcycle=.true.) - call addfld('SILHS_STDSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & - 'Standard deviation of Ice across subcolumns', sampled_on_subcycle=.true.) - if ( ixsnow > 0 ) then - call addfld('SILHS_MSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & - 'Mean Cloud Liquid across subcolumns', sampled_on_subcycle=.true.) - call addfld('SILHS_STDSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & - 'Standard deviation of Liquid across subcolumns', sampled_on_subcycle=.true.) - call addfld('SILHS_MSC_Q', (/ 'lev' /), 'A', 'kg/kg', & - 'Mean water vapor across subcolumns', sampled_on_subcycle=.true.) - call addfld('SILHS_STDSC_Q', (/ 'lev' /), 'A', 'kg/kg', & - 'Standard deviation of water vapor across subcolumns', sampled_on_subcycle=.true.) - endif ! ixsnow > 0 - endif ! subcol_SILHS_constrainmn - call addfld('SILHS_EFF_CLDFRAC', (/ 'lev' /), 'A', 'frac', & - 'Calculated cloud fraction from subcolumn liq or ice', sampled_on_subcycle=.true.) - - call addfld('SILHS_CLUBB_PRECIP_FRAC', (/ 'lev' /), 'A', 'frac', & - 'Precipitation fraction from CLUBB (set_up_pdf_params_incl_hydromet)', sampled_on_subcycle=.true.) - call addfld('SILHS_CLUBB_ICE_SS_FRAC', (/ 'lev' /), 'A', 'frac', & - 'Ice supersaturation fraction from CLUBB', sampled_on_subcycle=.true.) - - call addfld ('QVHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Water vapor mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('QCHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('QRHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain water mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('QIHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('QSHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('THFTEN', (/ 'lev' /), 'A', 'K/s', 'Temperature tendency from hole filling', sampled_on_subcycle=.true.) + !call set_clubb_debug_level( 0 ) !#KTCtodo: Add a namelist variable to set debug level + + ! Get constituent indices + call cnst_get_ind('Q', ixq) + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('NUMLIQ', ixnumliq) + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('NUMICE', ixnumice) + call cnst_get_ind('RAINQM', ixrain, abort=.false.) + call cnst_get_ind('NUMRAI', ixnumrain, abort=.false.) + call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) + call cnst_get_ind('NUMSNO', ixnumsnow, abort=.false.) + + ! Get physics buffer indexes + cld_idx = pbuf_get_index('CLD') + alst_idx = pbuf_get_index('ALST') ! SILHS expects clubb's cloud_frac liq stratus fraction + ice_supersat_idx = pbuf_get_index('ISS_FRAC') + tke_idx = pbuf_get_index('tke') + kvh_idx = pbuf_get_index('kvh') + prec_pcw_idx = pbuf_get_index('PREC_PCW') + snow_pcw_idx = pbuf_get_index('SNOW_PCW') + prec_str_idx = pbuf_get_index('PREC_STR') + snow_str_idx = pbuf_get_index('SNOW_STR') + qcsedten_idx = pbuf_get_index('QCSEDTEN') + qrsedten_idx = pbuf_get_index('QRSEDTEN') + qisedten_idx = pbuf_get_index('QISEDTEN') + qssedten_idx = pbuf_get_index('QSSEDTEN') + vtrmc_idx = pbuf_get_index('VTRMC') + umr_idx = pbuf_get_index('UMR') + vtrmi_idx = pbuf_get_index('VTRMI') + ums_idx = pbuf_get_index('UMS') + qcsevap_idx = pbuf_get_index('QCSEVAP') + qisevap_idx = pbuf_get_index('QISEVAP') + qrain_idx = pbuf_get_index('QRAIN') + qsnow_idx = pbuf_get_index('QSNOW') + nrain_idx = pbuf_get_index('NRAIN') + nsnow_idx = pbuf_get_index('NSNOW') + + !------------------------------- + ! Set up SILHS hydrometeors #KTCtodo: move microphys specification to config time, + ! Steve wants to set up a microphysics query so I can ask the microphysics + ! scheme which hydrometeors to use. For the future. + !------------------------------- + iirr = 1 + iirs = 3 + iiri = 5 + iirg = -1 + + iiNr = 2 + iiNs = 4 + iiNi = 6 + iiNg = -1 + + hydromet_dim = 6 + + ! Set up pdf indices, hydromet indicies, hydromet arrays, and hydromet variance ratios + call init_pdf_hydromet_arrays_api( 1.0_core_rknd, 1.0_core_rknd, hydromet_dim, & ! intent(in) + iirr, iiNr, iiri, iiNi, & ! intent(in) + iirs, iiNs, iirg, iiNg, & ! intent(in) + subcol_SILHS_ncnp2_on_ncnm2, & ! intent(in) + hm_metadata, pdf_dim, & ! intent(out) + subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & ! optional(in) + subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt ) ! optional(in) + + !------------------------------- + ! Set up hydrometeors and correlation arrays for SILHS + !------------------------------- + allocate( corr_array_n_cloud(pdf_dim,pdf_dim), corr_array_n_below(pdf_dim,pdf_dim), stat=ierr) + if( ierr /= 0 ) call endrun(' subcol_init_SILHS: failed to allocate corr_array fields ') + + corr_file_path_cloud = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//cloud_file_ext + corr_file_path_below = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//below_file_ext + + call setup_corr_varnce_array_api( corr_file_path_cloud, corr_file_path_below, & + pdf_dim, hm_metadata, newunit(iunit), & + clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In + corr_array_n_cloud, corr_array_n_below ) + + !------------------------------- + ! Register output fields from SILHS + !------------------------------- + call addfld('SILHS_NCLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & + 'Subcolumn Cloud Number Concentration', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_NRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & + 'Subcolumn Number Concentration of Rain from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_OMEGA_SCOL', (/'psubcols', 'ilev '/), 'I', 'Pa/s', & + 'Subcolumn vertical pressure velocity', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_RCM_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & + 'Subcolumn Cloud Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_RICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & + 'Subcolumn Cloud Ice Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_NICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & + 'Subcolumn Cloud Ice Number Conc from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_RRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & + 'Subcolumn Precipitating Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_RT_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg ', & + 'Subcolumn Total Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_THLM_SCOL', (/'psubcols', 'ilev '/), 'I', 'K', & + 'Subcolumn liquid water pot temperature', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_WEIGHT_SCOL', (/'psubcols'/), 'I', 'frac', & + 'Weights for each subcolumn', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_WM_SCOL', (/'psubcols', 'ilev '/), 'I', 'm/s', & + 'Subcolumn vertical velocity from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + + call addfld('NR_IN_LH', (/ 'lev' /), 'I', 'm^-3', & + 'Num Rain Conc as input to SILHS') + call addfld('SILHS_THLM', (/ 'ilev' /), 'I', 'K', & + 'Input liquid water potential temperature') + call addfld('SILHS_QC_IN', (/ 'lev' /), 'I', 'kg/kg', & + 'Input cloud water mixing ratio') + call addfld('SILHS_QI_IN', (/ 'lev' /), 'I', 'kg/kg', & + 'Input cloud ice mixing ratio') + call addfld('SILHS_NC_IN', (/ 'lev' /), 'I', '#/kg', & + 'Input cloud water number concentration') + call addfld('SILHS_NI_IN', (/ 'lev' /), 'I', '#/kg', & + 'Input cloud ice number concentration') + call addfld('AKM_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & + 'Exact Kessler autoconversion') + call addfld('AKM_LH_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & + 'Monte Carlo estimate of Kessler autoconversion') + call addfld('INVS_EXNER', (/ 'lev' /), 'I', 'none', & + 'inverse EXNER function from state in subcol_SILHS') + if ( subcol_SILHS_constrainmn ) then + call addfld('SILHS_MSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & + 'Mean Cloud Ice across subcolumns') + call addfld('SILHS_STDSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & + 'Standard deviation of Ice across subcolumns') + if ( ixsnow > 0 ) then + call addfld('SILHS_MSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & + 'Mean Cloud Liquid across subcolumns') + call addfld('SILHS_STDSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & + 'Standard deviation of Liquid across subcolumns') + call addfld('SILHS_MSC_Q', (/ 'lev' /), 'A', 'kg/kg', & + 'Mean water vapor across subcolumns') + call addfld('SILHS_STDSC_Q', (/ 'lev' /), 'A', 'kg/kg', & + 'Standard deviation of water vapor across subcolumns') + endif ! ixsnow > 0 + endif ! subcol_SILHS_constrainmn + call addfld('SILHS_EFF_CLDFRAC', (/ 'lev' /), 'A', 'frac', & + 'Calculated cloud fraction from subcolumn liq or ice') + + call addfld('SILHS_CLUBB_PRECIP_FRAC', (/ 'lev' /), 'A', 'frac', & + 'Precipitation fraction from CLUBB (set_up_pdf_params_incl_hydromet)') + call addfld('SILHS_CLUBB_ICE_SS_FRAC', (/ 'lev' /), 'A', 'frac', & + 'Ice supersaturation fraction from CLUBB') + + call addfld ('QVHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Water vapor mixing ratio tendency from hole filling') + call addfld ('QCHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from hole filling') + call addfld ('QRHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain water mixing ratio tendency from hole filling') + call addfld ('QIHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from hole filling') + call addfld ('QSHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from hole filling') + call addfld ('THFTEN', (/ 'lev' /), 'A', 'K/s', 'Temperature tendency from hole filling') #endif #endif - end subroutine subcol_init_SILHS + end subroutine subcol_init_SILHS !==============================================================! - subroutine init_state_subcol(state, tend, state_sc, tend_sc) - - use ppgrid, only : pver, pverp, pcols - - use subcol_utils, only : subcol_set_subcols - - implicit none + subroutine init_state_subcol(state, tend, state_sc, tend_sc) + + use ppgrid, only : pver, pverp, pcols + + use subcol_utils, only : subcol_set_subcols + + implicit none + + type(physics_state), intent(inout) :: state + type(physics_tend), intent(inout) :: tend + type(physics_state), intent(inout) :: state_sc ! sub-column state + type(physics_tend), intent(inout) :: tend_sc ! sub-column tend + + integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct + + numsubcol_arr(:) = 0 ! Start over each chunk + numsubcol_arr(:state%ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns + call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) + + end subroutine init_state_subcol +!==================================================================! + subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) + !------------------------------- + ! This is where the subcolumns are created, and the call to + ! generate_silhs_sample_mod_api + ! goes out. Variables needed to make this call are pulled from the + ! pbuf, from module data, and calculated based on the CAM state. + !------------------------------- + + use physics_buffer, only : physics_buffer_desc, pbuf_get_index, & + pbuf_get_field + use time_manager, only : get_nstep + use subcol_utils, only : subcol_set_subcols, subcol_set_weight + use subcol_pack_mod, only : subcol_pack + use phys_control, only : phys_getopts + use spmd_utils, only : masterproc, iam + use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RHOFW + +#ifdef CLUBB_SGS +#ifdef SILHS + use clubb_intr, only: & + ztodt ! model timestep + + use clubb_api_module, only : setup_pdf_parameters_api, & + + zm2zt_api, setup_grid_heights_api, & + + core_rknd, & + + w_tol_sqd, zero_threshold, & + em_min, cloud_frac_min, & ! rc_tol, & + + nparams, ic_K, & + Cp, Lv, & + grid, setup_grid_api, & + init_precip_fracs_api, & + clubb_fatal_error, & + err_info_type, & + init_err_info_api, & + cleanup_err_info_api + + use silhs_api_module, only : generate_silhs_sample_api, & ! Ncn_to_Nc, & + clip_transform_silhs_output_api, & + genrand_intg, genrand_init_api, & + est_kessler_microphys_api, & + vert_decorr_coef + +#endif +#endif + ! CAM data structures type(physics_state), intent(inout) :: state type(physics_tend), intent(inout) :: tend type(physics_state), intent(inout) :: state_sc ! sub-column state type(physics_tend), intent(inout) :: tend_sc ! sub-column tend + type(physics_buffer_desc), pointer :: pbuf(:) + +#ifdef CLUBB_SGS +#ifdef SILHS + !---------------- + ! Local variables + !---------------- + logical, parameter :: & + l_implemented = .true. ! Implemented in a host model + logical, parameter :: rx_Nc = .false. ! Use NC calculated based on grid mean effective radius + integer, parameter :: & + grid_type = 3 ! The 3 grid centered on momentum levels + real(r8), parameter :: cldmin = 0.001_r8 ! To use when cld frac = 0.0 to be consistant with micro_mg + real(r8), parameter :: min_num_conc = 1.0e-12_r8 + real(r8), parameter :: qsmall = 1.0e-18_r8 ! Microphysics cut-off for cloud + + integer :: i, j, k, ngrdcol, ncol, lchnk, stncol + real(r8) :: sfc_elevation(state%ngrdcol) ! Surface elevation - integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct + real(r8), dimension(state%ngrdcol,nzt_clubb) :: zt_g ! Thermo grid for clubb + real(r8), dimension(state%ngrdcol,nzm_clubb) :: zi_g ! Momentum grid for clubb - numsubcol_arr(:) = 0 ! Start over each chunk - numsubcol_arr(:state%ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns - call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) + real(r8), dimension(pver) :: scfrac ! cloud fraction based on sc distributions + real(r8) :: msc, std, maxcldfrac, maxsccldfrac + real(r8) :: scale = 1.0_r8 + + real(r8) :: c_K ! CLUBB parameter c_K (for eddy diffusivity) + + integer( kind = genrand_intg ) :: & + lh_seed ! Seed used in random number generator that will be different + ! for each column, yet reproducible for a restart run + + type(err_info_type) :: & + err_info ! err_info struct used in CLUBB containing err_code and err_header + + real(r8), parameter :: rad2deg=180.0_r8/SHR_CONST_PI + + !---------------- + ! Required for set_up_pdf_params_incl_hydromet + !---------------- + real(r8), dimension(state%ngrdcol,nzt_clubb) :: cld_frac_in ! Cloud fraction + + real(r8), dimension(state%ngrdcol, nzt_clubb, pdf_dim, pdf_dim) :: & + corr_array_1, corr_array_2 ! Correlation matrix for pdf components + + real(r8), dimension(state%ngrdcol, nzt_clubb, pdf_dim) :: & + mu_x_1, mu_x_2, & ! Mean array for PDF components + sigma_x_1, sigma_x_2 ! Std dev arr for PDF components + + real(r8), dimension(state%ngrdcol, nzt_clubb, pdf_dim, pdf_dim) :: & + corr_cholesky_mtx_1, corr_cholesky_mtx_2 ! Transposed corr cholesky mtx + + real(r8), dimension(state%ngrdcol, nzt_clubb) :: Nc_in_cloud + real(r8), dimension(state%ngrdcol, nzm_clubb, hydromet_dim) :: hydrometp2 + + + !---------------- + ! Input to generate_silhs_sample + !---------------- + integer :: iter ! CLUBB iteration + integer :: num_subcols ! Number of subcolumns + integer, parameter :: sequence_length = 1 ! Number of timesteps btn subcol calls + + real(r8), dimension(state%ngrdcol) :: deltaz - end subroutine init_state_subcol -!==================================================================! - subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) - !------------------------------- - ! This is where the subcolumns are created, and the call to - ! generate_silhs_sample_mod_api - ! goes out. Variables needed to make this call are pulled from the - ! pbuf, from module data, and calculated based on the CAM state. - !------------------------------- - - use physics_buffer, only : physics_buffer_desc, pbuf_get_index, & - pbuf_get_field - use time_manager, only : get_nstep - use subcol_utils, only : subcol_set_subcols, subcol_set_weight - use subcol_pack_mod, only : subcol_pack - use phys_control, only : phys_getopts - use spmd_utils, only : masterproc - use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RHOFW + real(r8), dimension(state%ngrdcol,nzt_clubb) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs + real(r8), dimension(state%ngrdcol,pver) :: dz_g ! thickness of layer + + real(r8), dimension(state%ngrdcol,nzt_clubb,hydromet_dim) :: hydromet ! Hydrometeor species + real(r8), dimension(state%ngrdcol,nzm_clubb,hydromet_dim) :: wphydrometp ! Hydrometeor flux + real(r8), dimension(state%ngrdcol,nzt_clubb) :: Ncm ! Mean cloud droplet concentration, + + real(r8), dimension(state%ngrdcol,nzm_clubb) :: tke ! TKE + real(r8), dimension(state%ngrdcol,nzm_clubb) :: khzm ! Eddy diffusivity coef + real(r8), dimension(state%ngrdcol,nzm_clubb) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels + real(r8), dimension(state%ngrdcol,nzt_clubb) :: Lscale ! CLUBB's length scale + + logical, parameter :: & + l_calc_weights_all_levs = .false. ! .false. if all time steps use the same + ! weights at all vertical grid levels + logical :: & + l_calc_weights_all_levs_itime, & ! .true. if we calculate sample weights separately at all + ! grid levels at the current time step + l_rad_itime ! .true. if we calculate radiation at the current time step + + !--------------- + !Output from generate_silhs_sample + !-------------- + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,nzt_clubb,pdf_dim) :: X_nl_all_levs ! Sample transformed to normal-lognormal + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,nzt_clubb) :: lh_sample_point_weights ! Subcolumn weights + integer, dimension(state%ngrdcol,subcol_SILHS_numsubcol,nzt_clubb) :: X_mixt_comp_all_levs ! Which Mixture Component + + real(r8), dimension(state%ngrdcol,nzt_clubb, subcol_SILHS_numsubcol) :: & + rc_all_points, & ! Calculate RCM from LH output + rain_all_pts, & ! Calculate Rain from LH output + nrain_all_pts, & ! Calculate Rain Conc from LH + snow_all_pts, & ! Calculate Snow from LH output + nsnow_all_pts, & ! Calculate Snow Conc from LH + w_all_points, & ! Calculate W from LH output + ice_all_pts, & ! Calculate Cld Ice from LH output + nice_all_pts, & ! Calculate Num cld ice from LH + nclw_all_pts ! Calculate Num cld wat from LH + + type (stats), dimension(state%ngrdcol) :: stats_lh_zt, & + stats_lh_sfc + + !---------------- + ! Output from clip_transform_silhs_output_api + !---------------- + real( kind = core_rknd ), dimension(state%ngrdcol,subcol_SILHS_numsubcol,nzt_clubb) :: & + lh_rt_clipped, & ! rt generated from silhs sample points + lh_thl_clipped, & ! thl generated from silhs sample points + lh_rc_clipped, & ! rc generated from silhs sample points + lh_rv_clipped, & ! rv generated from silhs sample points + lh_Nc_clipped ! Nc generated from silhs sample points -#ifdef CLUBB_SGS -#ifdef SILHS - use clubb_api_module, only : setup_pdf_parameters_api, & + logical, parameter :: & + l_use_Ncn_to_Nc = .true. ! Whether to call Ncn_to_Nc (.true.) or not (.false.); + ! Ncn_to_Nc might cause problems with the MG microphysics + ! since the changes made here (Nc-tendency) are not fed into + ! the microphysics + + + !---------------- + ! Output to history + !---------------- + ! V. Larson note: These variables are on the zt levels + ! The variables in this paragraph are oriented like CAM variables (k=1 is + ! the model top). + ! They are flipped versions of CLUBB variables, for the entire chunk. + real(r8), dimension(pcols*psubcols, pver) :: RT_lh_out + real(r8), dimension(pcols*psubcols, pver) :: THL_lh_out + real(r8), dimension(pcols*psubcols, pver) :: OMEGA_lh_out + real(r8), dimension(pcols*psubcols, pver) :: WM_lh_out + real(r8), dimension(pcols*psubcols, pver) :: RVM_lh_out + real(r8), dimension(pcols*psubcols, pver) :: RCM_lh_out + real(r8), dimension(pcols*psubcols, pver) :: NCLW_lh_out + real(r8), dimension(pcols*psubcols, pver) :: ICE_lh_out + real(r8), dimension(pcols*psubcols, pver) :: NICE_lh_out + real(r8), dimension(pcols*psubcols, pver) :: RAIN_lh_out + real(r8), dimension(pcols*psubcols, pver) :: NRAIN_lh_out + real(r8), dimension(pcols*psubcols, pver) :: SNOW_lh_out + real(r8), dimension(pcols*psubcols, pver) :: NSNOW_lh_out + + real(r8), dimension(state_sc%psetcols) :: weights ! Subcol weights + + real(r8), dimension(pcols, pver) :: meansc_ice + real(r8), dimension(pcols, pver) :: stdsc_ice + + real(r8), dimension(pcols, pver) :: meansc_liq + real(r8), dimension(pcols, pver) :: stdsc_liq + + real(r8), dimension(pcols, pver) :: meansc_vap + real(r8), dimension(pcols, pver) :: stdsc_vap + real(r8), dimension(pcols, pver) :: grmn_eff_rad + real(r8), dimension(pcols, pver) :: eff_cldfrac + real(r8), dimension(pcols, pver) :: precip_frac_out + + real(r8) :: tmp_mean, diff_mean, rcubed + + !---------------- + ! Output from Est_Kessler_microphys + !---------------- + real(r8), dimension(state%ngrdcol,nzt_clubb) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKm ! Exact Kessler autoconversion + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKstd ! Exact Stdev of gba Kessler + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKm_rcm ! Exact local gba Kessler auto based on rcm + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc + real(r8), dimension(state%ngrdcol,nzt_clubb) :: lh_rcm_avg ! LH estimate of grid box avg liquid water + real(r8), dimension(pcols,pver) :: lh_AKm_out, AKm_out + + !---------------- + ! Needed to update State + !---------------- + real(r8), dimension(pver) :: Temp_prof ! Subcolumn LWPT converted to Abs Temp + real(r8), dimension(pver) :: SE_prof ! Static Energy calculated from Abs Temp + real(r8), dimension(pver) :: No_cloud = 0.0_r8 ! Clear air condensate profile + real(r8), dimension(pcols, pver) :: invs_exner ! inverse exner sent to conversion codw + ! pcols for output to history + real(r8) :: eff_rad_coef = 1.0_r8/(4.0_r8/3.0_r8*SHR_CONST_RHOFW*SHR_CONST_PI) + + !---------------- + ! Pointers + !---------------- + real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! ice cloud fraction + real(r8), pointer, dimension(:,:) :: cld ! CAM cloud fraction + real(r8), pointer, dimension(:,:) :: alst ! CLUBB liq cloud fraction + real(r8), pointer, dimension(:,:) :: qrain ! micro_mg rain from previous step + real(r8), pointer, dimension(:,:) :: qsnow + real(r8), pointer, dimension(:,:) :: nrain ! micro_mg rain num conc + real(r8), pointer, dimension(:,:) :: nsnow + + real(r8), pointer, dimension(:,:) :: tke_in ! TKE + real(r8), pointer, dimension(:,:) :: khzm_in ! Eddy diffusivity coef + + logical, parameter :: l_est_kessler_microphys = .false. + logical, parameter :: l_outfld_subcol = .false. + + type(grid) :: gr + + type(precipitation_fractions) :: precip_fracs + + ! Used as shortcuts to avoid typing hm_metadata%iiPDF_xx + integer :: & + iiPDF_chi, iiPDF_rr, iiPDF_w, iiPDF_Nr, & + iiPDF_ri, iiPDF_Ni, iiPDF_Ncn, iiPDF_rs, iiPDF_Ns, & + iirr, iiNr, iirs, iiri, & + iirg, iiNs, iiNi, iiNg - zm2zt_api, setup_grid_heights_api, & + integer :: k_cam + + !------------------------------------------------ + ! Begin Code + !------------------------------------------------ + +#ifdef SILHS_OPENACC + if ( l_est_kessler_microphys ) then + call endrun('subcol_gen error: compilation with OpenACC requires l_est_kessler_microphys = .false.') + end if + + if ( subcol_SILHS_constrainmn ) then + call endrun('subcol_gen error: compilation with OpenACC requires subcol_SILHS_constrainmn = .false.') + end if + + if ( subcol_SILHS_weight ) then + call endrun('subcol_gen error: Importance sampling is not enabled for SILHS when using OpenACC. Set subcol_SILHS_weight to false.') + end if +#endif - core_rknd, & + if (.not. allocated(state_sc%lat)) then + call endrun('subcol_gen error: state_sc must be allocated before calling subcol_gen') + end if + + if( rx_Nc ) then + call endrun('subcol_gen_SILHS: rx_Nc not enabled') + endif + + if (subcol_SILHS_meanice) then + call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') + end if - w_tol_sqd, zero_threshold, & - em_min, cloud_frac_min, & ! rc_tol, & + ! Determine num of columns and which chunk we're working on and what timestep + ngrdcol = state%ngrdcol + ncol = state%ncol - genrand_intg, genrand_init_api, & + print *, " ngrdcol = ", ngrdcol + print *, " ncol = ", ncol + + lchnk = state%lchnk + iter = get_nstep() ! #KTCtodo: The model iteration is passed into SILHS without taking + ! substepping into account. I may need to change this in + ! the future. Also, why does SILHS need an iter, but CLUBB + ! does not? + ! #ERDBG: The model iteration number is not used in SILHS unless + ! sequence_length > 1, but nobody runs with that option. + + ! Copy hm_metadata indices to shortcuts + iiPDF_chi = hm_metadata%iiPDF_chi + iiPDF_Ncn = hm_metadata%iiPDF_Ncn + iiPDF_rr = hm_metadata%iiPDF_rr + iiPDF_w = hm_metadata%iiPDF_w + iiPDF_Nr = hm_metadata%iiPDF_Nr + iiPDF_ri = hm_metadata%iiPDF_ri + iiPDF_Ni = hm_metadata%iiPDF_Ni + iiPDF_rs = hm_metadata%iiPDF_rs + iiPDF_Ns = hm_metadata%iiPDF_Ns + iirr = hm_metadata%iirr + iiNr = hm_metadata%iiNr + iirs = hm_metadata%iirs + iiri = hm_metadata%iiri + iirg = hm_metadata%iirg + iiNs = hm_metadata%iiNs + iiNi = hm_metadata%iiNi + iiNg = hm_metadata%iiNg + + !---------------- + ! Establish associations between pointers and physics buffer fields + !---------------- + call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) + call pbuf_get_field(pbuf, alst_idx, alst) + call pbuf_get_field(pbuf, cld_idx, cld) + call pbuf_get_field(pbuf, qrain_idx, qrain) + call pbuf_get_field(pbuf, qsnow_idx, qsnow) + call pbuf_get_field(pbuf, nrain_idx, nrain) + call pbuf_get_field(pbuf, nsnow_idx, nsnow) + call pbuf_get_field(pbuf, tke_idx, tke_in) + call pbuf_get_field(pbuf, kvh_idx, khzm_in) + + ! Pull c_K from clubb parameters. + c_K = clubb_params_single_col(1,ic_K) + + ! Initialize err_info with parallelization and geographical info + call init_err_info_api(ncol, iam, lchnk, state%lat*rad2deg, state%lon*rad2deg, err_info) + + ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels + call init_precip_fracs_api( nzt_clubb, ngrdcol, & + precip_fracs ) - nparams, ic_K, & - read_parameters_api, & - Cp, Lv, & - grid, setup_grid_api, & - init_precip_fracs_api - - use silhs_api_module, only : generate_silhs_sample_api, & ! Ncn_to_Nc, & - clip_transform_silhs_output_api, & - est_kessler_microphys_api, & - vert_decorr_coef + !---------------- + ! Copy state and populate numbers and values of sub-columns + !---------------- + num_subcols = subcol_SILHS_numsubcol -#endif -#endif - - ! CAM data structures - type(physics_state), intent(inout) :: state - type(physics_tend), intent(inout) :: tend - type(physics_state), intent(inout) :: state_sc ! sub-column state - type(physics_tend), intent(inout) :: tend_sc ! sub-column tend - type(physics_buffer_desc), pointer :: pbuf(:) + ! Calculate sample weights separately at all grid levels when + ! radiation is not called + l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs + ! when the weights vary with height. + ! Don't set to true until this is fixed!! -#ifdef CLUBB_SGS -#ifdef SILHS - !---------------- - ! Local variables - !---------------- - logical, parameter :: & - l_implemented = .true. ! Implemented in a host model - logical, parameter :: rx_Nc = .false. ! Use NC calculated based on grid mean effective radius - integer, parameter :: & - grid_type = 3 ! The 3 grid centered on momentum levels - real(r8), parameter :: cldmin = 0.001_r8 ! To use when cld frac = 0.0 to be consistant with micro_mg - real(r8), parameter :: min_num_conc = 1.0e-12_r8 - real(r8), parameter :: qsmall = 1.0e-18_r8 ! Microphysics cut-off for cloud - - integer :: i, j, k, ngrdcol, ncol, lchnk, stncol - real(r8) :: sfc_elevation(state%ngrdcol) ! Surface elevation - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: zt_g, zi_g ! Thermo & Momentum grids for clubb - - real(r8), dimension(pverp) :: scfrac ! cloud fraction based on sc distributions - real(r8) :: msc, std, maxcldfrac, maxsccldfrac - real(r8) :: scale = 1.0_r8 - - real(r8) :: c_K ! CLUBB parameter c_K (for eddy diffusivity) - - integer( kind = genrand_intg ) :: & - lh_seed ! Seed used in random number generator that will be different - ! for each column, yet reproducible for a restart run - - !---------------- - ! Required for set_up_pdf_params_incl_hydromet - !---------------- - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: cld_frac_in ! Cloud fraction - - real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & - corr_array_1, corr_array_2 ! Correlation matrix for pdf components - - real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim) :: & - mu_x_1, mu_x_2, & ! Mean array for PDF components - sigma_x_1, sigma_x_2 ! Std dev arr for PDF components - - real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & - corr_cholesky_mtx_1, corr_cholesky_mtx_2 ! Transposed corr cholesky mtx - - real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: Nc_in_cloud - real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: ice_supersat_frac_in - real(r8), dimension(state%ngrdcol, pverp-top_lev+1, hydromet_dim) :: hydrometp2 - - - !---------------- - ! Input to generate_silhs_sample - !---------------- - integer :: iter ! CLUBB iteration - integer :: num_subcols ! Number of subcolumns - integer, parameter :: sequence_length = 1 ! Number of timesteps btn subcol calls - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs - real(r8), dimension(state%ngrdcol,pver) :: dz_g ! thickness of layer - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: delta_zm ! Difference in u wind altitudes - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species - real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Ncm ! Mean cloud droplet concentration, - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: tke ! TKE - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: khzm ! Eddy diffusivity coef - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale ! CLUBB's length scale - - logical, parameter :: & - l_calc_weights_all_levs = .false. ! .false. if all time steps use the same - ! weights at all vertical grid levels - logical :: & - l_calc_weights_all_levs_itime, & ! .true. if we calculate sample weights separately at all - ! grid levels at the current time step - l_rad_itime ! .true. if we calculate radiation at the current time step - - !--------------- - !Output from generate_silhs_sample - !-------------- - real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1,pdf_dim) :: X_nl_all_levs ! Sample transformed to normal-lognormal - real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: lh_sample_point_weights ! Subcolumn weights - integer, dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: X_mixt_comp_all_levs ! Which Mixture Component - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1, subcol_SILHS_numsubcol) :: & - rc_all_points, & ! Calculate RCM from LH output - rain_all_pts, & ! Calculate Rain from LH output - nrain_all_pts, & ! Calculate Rain Conc from LH - snow_all_pts, & ! Calculate Snow from LH output - nsnow_all_pts, & ! Calculate Snow Conc from LH - w_all_points, & ! Calculate W from LH output - ice_all_pts, & ! Calculate Cld Ice from LH output - nice_all_pts, & ! Calculate Num cld ice from LH - nclw_all_pts ! Calculate Num cld wat from LH - - !---------------- - ! Output from clip_transform_silhs_output_api - !---------------- - real( kind = core_rknd ), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: & - lh_rt_clipped, & ! rt generated from silhs sample points - lh_thl_clipped, & ! thl generated from silhs sample points - lh_rc_clipped, & ! rc generated from silhs sample points - lh_rv_clipped, & ! rv generated from silhs sample points - lh_Nc_clipped ! Nc generated from silhs sample points - - logical, parameter :: & - l_use_Ncn_to_Nc = .true. ! Whether to call Ncn_to_Nc (.true.) or not (.false.); - ! Ncn_to_Nc might cause problems with the MG microphysics - ! since the changes made here (Nc-tendency) are not fed into - ! the microphysics + ! Setup the CLUBB vertical grid object. This must be done for each + ! column as the z-distance between hybrid pressure levels can + ! change easily. + ! Define the CLUBB momentum grid (in height, units of m) + do k = 1, nzm_clubb + do i = 1, ngrdcol + k_cam = top_lev - 1 + k + zi_g(i,k) = state%zi(i,k_cam)-state%zi(i,pverp) + end do + end do - !---------------- - ! Output to history - !---------------- - ! V. Larson note: These variables are on the zt (full) levels: why do they - ! have dimension pverp? The pverp level corresponds to the CLUBB - ! below-ground level. - ! The variables in this paragraph are oriented like CAM variables (k=1 is - ! the model top). - ! They are flipped versions of CLUBB variables, for the entire chunk. - real(r8), dimension(pcols*psubcols, pverp) :: RT_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: THL_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: OMEGA_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: WM_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: RVM_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: RCM_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: NCLW_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: ICE_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: NICE_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: RAIN_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: NRAIN_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: SNOW_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: NSNOW_lh_out - - real(r8), dimension(state_sc%psetcols) :: weights ! Subcol weights - - real(r8), dimension(pcols, pver) :: meansc_ice - real(r8), dimension(pcols, pver) :: stdsc_ice - - real(r8), dimension(pcols, pver) :: meansc_liq - real(r8), dimension(pcols, pver) :: stdsc_liq - - real(r8), dimension(pcols, pver) :: meansc_vap - real(r8), dimension(pcols, pver) :: stdsc_vap - real(r8), dimension(pcols, pver) :: grmn_eff_rad - real(r8), dimension(pcols, pver) :: eff_cldfrac - real(r8), dimension(pcols, pver) :: precip_frac_out - - real(r8) :: tmp_mean, diff_mean, rcubed - - !---------------- - ! Output from Est_Kessler_microphys - !---------------- - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm ! Exact Kessler autoconversion - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water - real(r8), dimension(pcols,pverp) :: lh_AKm_out, AKm_out - - !---------------- - ! Needed to update State - !---------------- - real(r8), dimension(pver) :: Temp_prof ! Subcolumn LWPT converted to Abs Temp - real(r8), dimension(pver) :: SE_prof ! Static Energy calculated from Abs Temp - real(r8), dimension(pver) :: No_cloud = 0.0_r8 ! Clear air condensate profile - real(r8), dimension(pcols, pver) :: invs_exner ! inverse exner sent to conversion codw - ! pcols for output to history - real(r8) :: eff_rad_coef = 1.0_r8/(4.0_r8/3.0_r8*SHR_CONST_RHOFW*SHR_CONST_PI) + ! Define the CLUBB thermodynamic grid (in units of m) + do k = 1, nzt_clubb + do i = 1, ngrdcol + k_cam = top_lev - 1 + k + zt_g(i,k) = state%zm(i,k_cam) - state%zi(i,pverp) + end do + end do - !---------------- - ! Pointers - !---------------- - real(r8), pointer, dimension(:) :: ztodt_ptr - real(r8), pointer, dimension(:,:) :: thlm ! Mean temperature - real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! ice cloud fraction - real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio - real(r8), pointer, dimension(:,:) :: cld ! CAM cloud fraction - real(r8), pointer, dimension(:,:) :: alst ! CLUBB liq cloud fraction - real(r8), pointer, dimension(:,:) :: qrain ! micro_mg rain from previous step - real(r8), pointer, dimension(:,:) :: qsnow - real(r8), pointer, dimension(:,:) :: nrain ! micro_mg rain num conc - real(r8), pointer, dimension(:,:) :: nsnow - - real(r8), pointer, dimension(:,:) :: tke_in ! TKE - real(r8), pointer, dimension(:,:) :: khzm_in ! Eddy diffusivity coef - - logical, parameter :: l_est_kessler_microphys = .false. - logical, parameter :: l_outfld_subcol = .false. - - type(grid) :: gr - - type(precipitation_fractions) :: precip_fracs - - ! Used as shortcuts to avoid typing hm_metadata%iiPDF_xx - integer :: & - iiPDF_chi, iiPDF_rr, iiPDF_w, iiPDF_Nr, & - iiPDF_ri, iiPDF_Ni, iiPDF_Ncn, iiPDF_rs, iiPDF_Ns, & - iirr, iiNr, iirs, iiri, & - iirg, iiNs, iiNi, iiNg - - !------------------------------------------------ - ! Begin Code - !------------------------------------------------ - -#ifdef SILHS_OPENACC - if ( l_est_kessler_microphys ) then - call endrun('subcol_gen error: compilation with OpenACC requires l_est_kessler_microphys = .false.') - end if - - if ( subcol_SILHS_constrainmn ) then - call endrun('subcol_gen error: compilation with OpenACC requires subcol_SILHS_constrainmn = .false.') - end if - - if ( subcol_SILHS_weight ) then - call endrun('subcol_gen error: Importance sampling is not enabled for SILHS when using OpenACC. Set subcol_SILHS_weight to false.') - end if -#endif + do i=1, ncol - if (.not. allocated(state_sc%lat)) then - call endrun('subcol_gen error: state_sc must be allocated before calling subcol_gen') - end if - - if( rx_Nc ) then - call endrun('subcol_gen_SILHS: rx_Nc not enabled') - endif - - if (subcol_SILHS_meanice) then - call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') - end if + ! Set the elevation of the surface + sfc_elevation(i) = state%zi(i,pverp) - ! Determine num of columns and which chunk we're working on and what timestep - ngrdcol = state%ngrdcol - ncol = state%ncol - lchnk = state%lchnk - iter = get_nstep() ! #KTCtodo: The model iteration is passed into SILHS without taking - ! substepping into account. I may need to change this in - ! the future. Also, why does SILHS need an iter, but CLUBB - ! does not? - ! #ERDBG: The model iteration number is not used in SILHS unless - ! sequence_length > 1, but nobody runs with that option. - - ! Copy hm_metadata indices to shortcuts - iiPDF_chi = hm_metadata%iiPDF_chi - iiPDF_Ncn = hm_metadata%iiPDF_Ncn - iiPDF_rr = hm_metadata%iiPDF_rr - iiPDF_w = hm_metadata%iiPDF_w - iiPDF_Nr = hm_metadata%iiPDF_Nr - iiPDF_ri = hm_metadata%iiPDF_ri - iiPDF_Ni = hm_metadata%iiPDF_Ni - iiPDF_rs = hm_metadata%iiPDF_rs - iiPDF_Ns = hm_metadata%iiPDF_Ns - iirr = hm_metadata%iirr - iiNr = hm_metadata%iiNr - iirs = hm_metadata%iirs - iiri = hm_metadata%iiri - iirg = hm_metadata%iirg - iiNs = hm_metadata%iiNs - iiNi = hm_metadata%iiNi - iiNg = hm_metadata%iiNg - - !---------------- - ! Establish associations between pointers and physics buffer fields - !---------------- - call pbuf_get_field(pbuf, thlm_idx, thlm) - call pbuf_get_field(pbuf, ztodt_idx, ztodt_ptr) - call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) - call pbuf_get_field(pbuf, rtm_idx, rtm) - call pbuf_get_field(pbuf, alst_idx, alst) - call pbuf_get_field(pbuf, cld_idx, cld) - call pbuf_get_field(pbuf, qrain_idx, qrain) - call pbuf_get_field(pbuf, qsnow_idx, qsnow) - call pbuf_get_field(pbuf, nrain_idx, nrain) - call pbuf_get_field(pbuf, nsnow_idx, nsnow) - call pbuf_get_field(pbuf, tke_idx, tke_in) - call pbuf_get_field(pbuf, kvh_idx, khzm_in) - - ! Pull c_K from clubb parameters. - c_K = clubb_params_single_col(ic_K) - - !---------------- - ! Copy state and populate numbers and values of sub-columns - !---------------- - ztodt = ztodt_ptr(1) - num_subcols = subcol_SILHS_numsubcol - - ! The number of vertical grid levels used in CLUBB is pverp, which is originally - ! set in the call to setup_clubb_core_api from subroutine clubb_ini_cam. This - ! is stored in CLUBB in the object gr%nz. This isn't changed in CLUBB. - ! However, when SILHS is used, SILHS only uses pverp - top_lev + 1 vertical grid - ! levels and also uses the gr%nz object. The value of gr%nz needs to be reset - ! for SILHS here and then set again for CLUBB in subroutine clubb_tend_cam. - gr%nz = pverp - top_lev + 1 - - ! Calculate sample weights separately at all grid levels when - ! radiation is not called - l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs - ! when the weights vary with height. - ! Don't set to true until this is fixed!! + deltaz(i) = state%zi(i,pverp-1) - state%zi(i,pverp) + end do - - ! Setup the CLUBB vertical grid object. This must be done for each - ! column as the z-distance between hybrid pressure levels can - ! change easily. - ! Define the CLUBB momentum grid (in height, units of m) - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - zi_g(i,k) = state%zi(i,pverp-k+1)-state%zi(i,pverp) - end do - end do + ! Heights need to be set at each timestep. + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + .false., grid_type, & + deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) + zi_g, zt_g, & ! intent(in) + gr, err_info ) + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(err_info%err_header_global//NEW_LINE('a')// & + 'CAM subcol_gen_SILHS: Fatal error calling setup_grid_api') + end if + + do k = top_lev, pver + do i = 1, ngrdcol + + ! Calculate the distance between grid levels on the host model grid, + ! using host model grid indices. + dz_g(i,k) = state%zi(i,k)-state%zi(i,k+1) + + ! Calculate a clubb-specific exner function + ! (This is grid mean, as pressure levels do not change in + ! the subcolumn state) + invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) + + end do + end do - ! Define the CLUBB thermodynamic grid (in units of m) - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - zt_g(i,k+1) = state%zm(i,pver-k+1)-state%zi(i,pverp) - - ! Thermodynamic ghost point is below surface - zt_g(i,1) = -1._r8*zt_g(i,2) - end do - end do - - do i=1, ncol - ! Set the elevation of the surface - sfc_elevation(i) = state%zi(i,pver+1) - end do + ! Compute dry static density on CLUBB vertical grid + do k = 1, nzt_clubb + do i = 1, ngrdcol + k_cam = top_lev - 1 + k + rho_ds_zt(i,k) = (rga)*state%pdel(i,k_cam)/dz_g(i,k_cam) + end do + end do - ! Heights need to be set at each timestep. - call setup_grid_api( pverp+1-top_lev, ncol, sfc_elevation(1:ncol), l_implemented, & ! intent(in) - grid_type, zi_g(1:ncol,2), zi_g(1:ncol,1), zi_g(1:ncol,pverp+1-top_lev), & ! intent(in) - zi_g(1:ncol,:), zt_g(1:ncol,:), & ! intent(in) - gr ) - - ! Calculate the distance between grid levels on the host model grid, - ! using host model grid indices. - do k = top_lev, pver - do i = 1, ngrdcol - dz_g(i,k) = state%zi(i,k)-state%zi(i,k+1) - end do - end do + do k = 1, nzt_clubb + do i = 1, ngrdcol + + k_cam = top_lev - 1 + k + + ! Set up hydromet array, flipped from CAM vert grid to CLUBB + if ( iirr > 0 ) then + ! If ixrain and family are greater than zero, then MG2 is + ! being used, and rain and snow are part of state. Otherwise, + ! diagnostic rain and snow from MG1 are used in hydromet. + if (ixrain > 0) then + hydromet(i,k,iirr) = state%q(i,k_cam,ixrain) + else + hydromet(i,k,iirr) = qrain(i,k_cam) + endif + endif - ! Inverse delta_zm is required for the 3-level L-scale averaging - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - delta_zm(i,k+1) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) - - ! Handle CLUBB sub-sfc ghost point as done in clubb grid_class.F90 - delta_zm(i,1) = delta_zm(i,2) - end do - end do - - ! Compute dry static density on CLUBB vertical grid - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - rho_ds_zt(i,k+1) = (rga)*state%pdel(i,pverp-k)/dz_g(i,pverp-k) - - ! CLUBB ghost point under the surface - rho_ds_zt(i,1) = rho_ds_zt(i,2) - end do - end do - - ! Set up hydromet array, flipped from CAM vert grid to CLUBB - if ( iirr > 0 ) then - ! If ixrain and family are greater than zero, then MG2 is - ! being used, and rain and snow are part of state. Otherwise, - ! diagnostic rain and snow from MG1 are used in hydromet. - if (ixrain > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iirr) = state%q(i,pver-k+1,ixrain) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iirr) = qrain(i,pver-k+1) - end do - end do + if ( iiNr > 0 ) then + if (ixnumrain > 0) then + hydromet(i,k,iiNr) = state%q(i,k_cam,ixnumrain) + else + hydromet(i,k,iiNr) = nrain(i,k_cam) + endif endif - endif - - if ( iiNr > 0 ) then - if (ixnumrain > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNr) = state%q(i,pver-k+1,ixnumrain) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNr) = nrain(i,pver-k+1) - end do - end do + + if ( iirs > 0 ) then + if (ixsnow > 0) then + hydromet(i,k,iirs) = state%q(i,k_cam,ixsnow) + else + hydromet(i,k,iirs) = qsnow(i,k_cam) + endif endif - endif - - if ( iirs > 0 ) then - if (ixsnow > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iirs) = state%q(i,pver-k+1,ixsnow) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iirs) = qsnow(i,pver-k+1) - end do - end do + + if ( iiNs > 0 ) then + if (ixnumsnow > 0) then + hydromet(i,k,iiNs) = state%q(i,k_cam,ixnumsnow) + else + hydromet(i,k,iiNs) = nsnow(i,k_cam) + endif endif - endif - - if ( iiNs > 0 ) then - if (ixnumsnow > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNs) = state%q(i,pver-k+1,ixnumsnow) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNs) = nsnow(i,pver-k+1) - end do - end do + + if ( iiri > 0 ) then + hydromet(i,k,iiri) = state%q(i,k_cam,ixcldice) endif - endif - - if ( iiri > 0 ) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiri) = state%q(i,pver-k+1,ixcldice) - end do - end do - endif - - if ( iiNi > 0 ) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNi) = state%q(i,pver-k+1,ixnumice) - end do - end do - endif - - do k = 1, hydromet_dim ! ghost point below the surface - do i = 1, ngrdcol - hydromet(i,1,k) = hydromet(i,2,k) - end do - end do - - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - Ncm(i,k+1) = state%q(i,pver-k+1,ixnumliq) - Ncm(i,1) = Ncm(i,2) - end do - end do - - ! Convert from CAM vertical grid to CLUBB - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - ice_supersat_frac_in(i,k) = ice_supersat_frac(i,pverp-k+1) - end do - end do - - - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - cld_frac_in(i,k+1) = alst(i,pver-k+1) - cld_frac_in(i,1) = cld_frac_in(i,2) ! Ghost pt below surface - end do - end do - - ! Calculate a clubb-specific exner function - ! (This is grid mean, as pressure levels do not change in - ! the subcolumn state) - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) - end do + + if ( iiNi > 0 ) then + hydromet(i,k,iiNi) = state%q(i,k_cam,ixnumice) + endif + end do + end do - ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS - ! Compute Num concentration of cloud nuclei - do k = 1, pverp-top_lev+1 + do k = 1, nzt_clubb do i = 1, ngrdcol + + k_cam = top_lev - 1 + k + + Ncm(i,k) = state%q(i,k_cam,ixnumliq) + + cld_frac_in(i,k) = alst(i,k_cam) + + ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS + ! Compute Num concentration of cloud nuclei Nc_in_cloud(i,k) = Ncm(i,k) / max( cld_frac_in(i,k), cloud_frac_min ) end do end do - ! The variable wphydrometp is only used when l_calc_w_corr is enabled. - ! The l_calc_w_corr flag is turned off by default, so wphydrometp will - ! simply be set to 0 to simplify matters. - wphydrometp = 0.0_r8 + ! The variable wphydrometp is only used when l_calc_w_corr is enabled. + ! The l_calc_w_corr flag is turned off by default, so wphydrometp will + ! simply be set to 0 to simplify matters. + wphydrometp = 0.0_r8 - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - khzm(i,k) = khzm_in(i,pverp-k+1) - end do - end do - - ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels - call init_precip_fracs_api( pverp-top_lev+1, ngrdcol, & - precip_fracs ) - - call setup_pdf_parameters_api( gr, pverp-top_lev+1, ngrdcol, pdf_dim, hydromet_dim, ztodt, & ! In - Nc_in_cloud, cld_frac_in, khzm, & ! In - ice_supersat_frac_in, hydromet, wphydrometp, & ! In - corr_array_n_cloud, corr_array_n_below, & ! In - hm_metadata, & ! In - pdf_params_chnk(lchnk), & ! In - clubb_params_single_col, & ! In - clubb_config_flags%iiPDF_type, & ! In - clubb_config_flags%l_use_precip_frac, & ! In - clubb_config_flags%l_predict_upwp_vpwp, & ! In - clubb_config_flags%l_diagnose_correlations, & ! In - clubb_config_flags%l_calc_w_corr, & ! In - clubb_config_flags%l_const_Nc_in_cloud, & ! In - clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In - stats_metadata, & ! In - stats_zt, stats_zm, stats_sfc, & ! In - hydrometp2, & ! Inout - mu_x_1, mu_x_2, & ! Out - sigma_x_1, sigma_x_2, & ! Out - corr_array_1, corr_array_2, & ! Out - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out - precip_fracs ) ! Inout - - ! In order for Lscale to be used properly, it needs to be passed out of - ! advance_clubb_core, saved to the pbuf, and then pulled out of the - ! pbuf for use here. The profile of Lscale is passed into subroutine - ! generate_silhs_sample_api for use in calculating the vertical - ! correlation coefficient. Rather than output Lscale directly, its - ! value can be calculated from other fields that are already output to - ! pbuf. The equation relating Lscale to eddy diffusivity is: - ! - ! Kh = c_K * Lscale * sqrt( TKE ). - ! - ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted - ! from CLUBB's tunable parameters. The equation for Lscale is: - ! - ! Lscale = Kh / ( c_K * sqrt( TKE ) ). - ! - ! Since Kh and TKE are output on momentum (interface) grid levels, the - ! resulting calculation of Lscale is also found on momentum levels. It - ! needs to be interpolated back to thermodynamic (midpoint) grid levels - ! for further use. - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - tke(i,k) = tke_in(i,pverp-k+1) - end do - end do - - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - Lscale_zm(i,k) = khzm(i,k) / ( c_K * sqrt( max( tke(i,k), em_min ) ) ) - end do - end do + do k = 1, nzm_clubb + do i = 1, ngrdcol + k_cam = top_lev - 1 + k + khzm(i,k) = khzm_in(i,k_cam) + tke(i,k) = tke_in(i,k_cam) + end do + end do - do i = 1, ngrdcol - Lscale(i,1) = Lscale_zm(i,1) + ( Lscale_zm(i,2) - Lscale_zm(i,1) ) & - * ( zt_g(i,1) - zi_g(i,1) ) / ( zi_g(i,2) - zi_g(i,1) ) - end do - - do k = 2, pverp-top_lev+1 - do i = 1, ngrdcol - Lscale(i,k) = Lscale_zm(i,k-1) + ( Lscale_zm(i,k) - Lscale_zm(i,k-1) ) & - * ( zt_g(i,k) - zi_g(i,k-1) ) / ( zi_g(i,k) - zi_g(i,k-1) ) - end do - end do + call setup_pdf_parameters_api( gr, nzm_clubb, nzt_clubb, ngrdcol, pdf_dim, & ! In + hydromet_dim, ztodt, Nc_in_cloud, cld_frac_in, khzm, & ! In + ice_supersat_frac, hydromet, wphydrometp, & ! In + corr_array_n_cloud, corr_array_n_below, & ! In + hm_metadata, & ! In + pdf_params_chnk(lchnk), & ! In + clubb_params_single_col(1,:), & ! In + clubb_config_flags%iiPDF_type, & ! In + clubb_config_flags%l_use_precip_frac, & ! In + clubb_config_flags%l_predict_upwp_vpwp, & ! In + clubb_config_flags%l_diagnose_correlations, & ! In + clubb_config_flags%l_calc_w_corr, & ! In + clubb_config_flags%l_const_Nc_in_cloud, & ! In + clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In + stats_metadata, & ! In + stats_zt, stats_zm, stats_sfc, err_info, & ! In + hydrometp2, & ! Inout + mu_x_1, mu_x_2, & ! Out + sigma_x_1, sigma_x_2, & ! Out + corr_array_1, corr_array_2, & ! Out + corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out + precip_fracs ) ! Inout - do k = 2, pverp-top_lev+1 - do i = 1, ngrdcol - Lscale(i,:) = max( Lscale(i,:), 0.01_r8 ) - end do - end do - - !$acc data create( X_mixt_comp_all_levs, X_nl_all_levs, lh_rc_clipped, lh_Nc_clipped, & - !$acc& lh_sample_point_weights, lh_rt_clipped, lh_rt_clipped, & - !$acc& lh_rv_clipped, lh_thl_clipped, THL_lh_out, & - !$acc& RT_lh_out, RCM_lh_out, NCLW_lh_out, ICE_lh_out, & - !$acc& NICE_lh_out, RVM_lh_out, THL_lh_out, RAIN_lh_out, & - !$acc& NRAIN_lh_out, SNOW_lh_out, NSNOW_lh_out, WM_lh_out, & - !$acc& OMEGA_lh_out ) & - !$acc& copyin( state, state%zm, state%phis, rho_ds_zt, invs_exner ) & - !$acc& copyout( state%t, state%s, state%omega, state_sc%q ) - !$acc& async(1) - - ! Set the seed to the random number generator based on a quantity that - ! will be reproducible for restarts. - lh_seed = int( 1.0e4_r8 * rtm(1,pver), kind = genrand_intg ) - - ! Let's generate some subcolumns!!!!! - call generate_silhs_sample_api( & - iter, pdf_dim, num_subcols, sequence_length, pverp-top_lev+1, ngrdcol, & ! In - l_calc_weights_all_levs_itime, & ! In - pdf_params_chnk(lchnk), delta_zm, Lscale, & ! In - lh_seed, hm_metadata, & ! In - rho_ds_zt, & ! In - mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In - precip_fracs, silhs_config_flags, & ! In - vert_decorr_coef, & ! In - stats_metadata, & ! In - stats_lh_zt, stats_lh_sfc, & ! InOut - X_nl_all_levs, X_mixt_comp_all_levs, & ! Out - lh_sample_point_weights) ! Out - - ! Extract clipped variables from subcolumns - call clip_transform_silhs_output_api( gr, pverp-top_lev+1, ngrdcol, num_subcols, & ! In - pdf_dim, hydromet_dim, hm_metadata, & ! In - X_mixt_comp_all_levs, & ! In - X_nl_all_levs, & ! In - pdf_params_chnk(lchnk), & ! In - l_use_Ncn_to_Nc, & ! In - lh_rt_clipped, lh_thl_clipped, & ! Out - lh_rc_clipped, lh_rv_clipped, & ! Out - lh_Nc_clipped ) ! Out - !$acc wait - - if ( l_est_kessler_microphys ) then - call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(err_info%err_header_global//NEW_LINE('a')// & + 'CAM subcol_gen_SILHS: Fatal error calling setup_pdf_parameters_api') end if - !------------------------------------------------------------------------- - ! Convert from CLUBB vertical grid to CAM grid - !------------------------------------------------------------------------ - ! This kernel is executed in stream 1: - !$acc parallel loop collapse(3) default(present) async(1) - do k = top_lev, pverp - do j = 1, num_subcols - do i = 1, ngrdcol - RT_lh_out( num_subcols*(i-1)+j,k ) = lh_rt_clipped(i,j,pverp-k+1) - RCM_lh_out( num_subcols*(i-1)+j,k ) = lh_rc_clipped(i,j,pverp-k+1) - NCLW_lh_out( num_subcols*(i-1)+j,k ) = lh_Nc_clipped(i,j,pverp-k+1) - RVM_lh_out( num_subcols*(i-1)+j,k ) = lh_rv_clipped(i,j,pverp-k+1) - THL_lh_out( num_subcols*(i-1)+j,k ) = lh_thl_clipped(i,j,pverp-k+1) - end do - end do - end do - - ! This kernel is executed in stream 2: - !$acc parallel loop collapse(3) default(present) async(2) - do k = top_lev, pverp - do j = 1, num_subcols - do i = 1, ngrdcol - ICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) - NICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ni) - RAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rr) - NRAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Nr) - SNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rs) - NSNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ns) - WM_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_w) - end do - end do - end do + ! In order for Lscale to be used properly, it needs to be passed out of + ! advance_clubb_core, saved to the pbuf, and then pulled out of the + ! pbuf for use here. The profile of Lscale is passed into subroutine + ! generate_silhs_sample_api for use in calculating the vertical + ! correlation coefficient. Rather than output Lscale directly, its + ! value can be calculated from other fields that are already output to + ! pbuf. The equation relating Lscale to eddy diffusivity is: + ! + ! Kh = c_K * Lscale * sqrt( TKE ). + ! + ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted + ! from CLUBB's tunable parameters. The equation for Lscale is: + ! + ! Lscale = Kh / ( c_K * sqrt( TKE ) ). + ! + ! Since Kh and TKE are output on momentum (interface) grid levels, the + ! resulting calculation of Lscale is also found on momentum levels. It + ! needs to be interpolated back to thermodynamic (midpoint) grid levels + ! for further use. + + do k = 1, nzm_clubb + do i = 1, ngrdcol + Lscale_zm(i,k) = khzm(i,k) / ( c_K * sqrt( max( tke(i,k), em_min ) ) ) + end do + end do + + ! Interpolate to thermodynamic grid levels + Lscale = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, Lscale_zm ) + + do k = 1, nzt_clubb + do i = 1, ngrdcol + Lscale(i,k) = max( Lscale(i,k), 0.01_r8 ) + end do + end do - ! This kernel is executed in stream 2 because WM_lh_out comes from stream 2: - !$acc parallel loop collapse(3) default(present) async(2) - do k = top_lev, pverp - do j = 1, num_subcols - do i = 1, ngrdcol - OMEGA_lh_out( num_subcols*(i-1)+j,k ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k) & - * rho_ds_zt(i,pverp-k+1) * gravit - end do - end do - end do + !$acc data create( X_mixt_comp_all_levs, X_nl_all_levs, lh_rc_clipped, lh_Nc_clipped, & + !$acc& lh_sample_point_weights, lh_rt_clipped, lh_rt_clipped, & + !$acc& lh_rv_clipped, lh_thl_clipped, THL_lh_out, & + !$acc& RT_lh_out, RCM_lh_out, NCLW_lh_out, ICE_lh_out, & + !$acc& NICE_lh_out, RVM_lh_out, THL_lh_out, RAIN_lh_out, & + !$acc& NRAIN_lh_out, SNOW_lh_out, NSNOW_lh_out, WM_lh_out, & + !$acc& OMEGA_lh_out ) & + !$acc& copyin( state, state%zm, state%phis, rho_ds_zt, invs_exner ) & + !$acc& copyout( state%t, state%s, state%omega, state_sc%q ) + !$acc& - if ( l_est_kessler_microphys ) then - do k = top_lev, pverp - do j = 1, num_subcols - do i = 1, ngrdcol - AKm_out(i,k) = AKm(i,pverp-k+1) - lh_AKm_out(i,k) = lh_AKm(i,pverp-k+1) - end do - end do - end do + ! Set the seed to the random number generator based on a quantity that + ! will be reproducible for restarts. + lh_seed = int( 1.0e4_r8 * tke(1,nzm_clubb), kind = genrand_intg ) + + ! Let's generate some subcolumns!!!!! + call generate_silhs_sample_api( & + iter, pdf_dim, num_subcols, sequence_length, nzt_clubb, ngrdcol, & ! In + l_calc_weights_all_levs_itime, & ! In + gr, pdf_params_chnk(lchnk), gr%dzt, Lscale, & ! In + lh_seed, hm_metadata, & ! In + mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In + corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In + precip_fracs, silhs_config_flags, & ! In + vert_decorr_coef, & ! In + stats_metadata, & ! In + stats_lh_zt, stats_lh_sfc, err_info, & ! InOut + X_nl_all_levs, X_mixt_comp_all_levs, & ! Out + lh_sample_point_weights) ! Out + + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(err_info%err_header_global//NEW_LINE('a')// & + 'CAM subcol_gen_SILHS: Fatal error calling generate_silhs_sample_api') end if - ! Pack up weights - ! Using grid level 2 always won't work if weights vary with height. - call subcol_pack(lchnk, lh_sample_point_weights(:,:,2), weights ) - call subcol_set_weight(lchnk, weights) + ! Extract clipped variables from subcolumns + call clip_transform_silhs_output_api( nzt_clubb, ngrdcol, num_subcols, & ! In + pdf_dim, hydromet_dim, hm_metadata, & ! In + X_mixt_comp_all_levs, & ! In + X_nl_all_levs, & ! In + pdf_params_chnk(lchnk), & ! In + l_use_Ncn_to_Nc, & ! In + lh_rt_clipped, lh_thl_clipped, & ! Out + lh_rc_clipped, lh_rv_clipped, & ! Out + lh_Nc_clipped ) ! Out - ! Constrain the sample distribution of cloud water and ice to the same mean - ! as the grid to prevent negative condensate errors - if(subcol_SILHS_constrainmn) then - - do i = 1, ngrdcol - - stncol = num_subcols*(i-1) + ! Cleaning up err_info + call cleanup_err_info_api(err_info) + + if ( l_est_kessler_microphys ) then + call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') + end if + + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb + do j = 1, num_subcols + do i = 1, ngrdcol + k_cam = top_lev - 1 + k + RT_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_rt_clipped(i,j,k) + RCM_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_rc_clipped(i,j,k) + NCLW_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_Nc_clipped(i,j,k) + RVM_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_rv_clipped(i,j,k) + THL_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_thl_clipped(i,j,k) + + ICE_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_ri) + NICE_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_Ni) + RAIN_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_rr) + NRAIN_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_Nr) + SNOW_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_rs) + NSNOW_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_Ns) + WM_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_w) + + OMEGA_lh_out( num_subcols*(i-1)+j,k_cam ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k_cam) & + * rho_ds_zt(i,k) * gravit + end do + end do + end do + + if ( l_est_kessler_microphys ) then + + do k = 1, nzt_clubb + do j = 1, num_subcols + do i = 1, ngrdcol + k_cam = top_lev - 1 + k + AKm_out(i,k_cam) = AKm(i,k) + lh_AKm_out(i,k_cam) = lh_AKm(i,k) + end do + end do + end do + + end if + + ! Pack up weights + ! Using grid level nzt_clubb-1 (level above surface) won't always work if weights vary with height. + call subcol_pack(lchnk, lh_sample_point_weights(:,:,nzt_clubb-1), weights ) + call subcol_set_weight(lchnk, weights) + + ! Constrain the sample distribution of cloud water and ice to the same mean + ! as the grid to prevent negative condensate errors + if(subcol_SILHS_constrainmn) then + + do i = 1, ngrdcol + + stncol = num_subcols*(i-1) + + call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) + if ( ixrain > 0 ) & + call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixrain) ) + if ( ixsnow > 0 ) & + call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixsnow) ) + call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) + call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) + call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumice) ) + if ( ixnumrain > 0 ) & + call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumrain) ) + if ( ixnumsnow > 0 ) & + call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumsnow) ) + call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumliq) ) + do k = top_lev, pver + ! Look for exceptionally large values of condensate + if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then + ! Clip the large values + where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) + ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 + NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 + end where + ! Recalculate the weighted subcolumn mean + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & + weights(stncol+1:stncol+num_subcols), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixcldice)-tmp_mean + ! Add the difference to each subcolumn + ICE_lh_out(stncol+1:stncol+num_subcols,k) = & + ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + ! Recalculate the weight subcolumn mean for ice num conc + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & + weights(stncol+1:stncol+num_subcols), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixnumice)-tmp_mean + ! Add the difference to each subcolumn + if(diff_mean.gt.0.0_r8) then + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + else ! just use the grid mean in each subcolumn + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + state%q(i,k,ixnumice) + end if + ! Test adjusted means for debugging + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & + weights(stncol+1:stncol+num_subcols), & + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixcldice)-tmp_mean + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & + weights(stncol+1:stncol+num_subcols), & + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixnumice)-tmp_mean + endif + end do ! k = top_lev, pver + end do + endif ! subcol_silhs_constrainm + + + !--------------------------------------------------- + ! Updating state variables + !--------------------------------------------------- + ! Code to update the state variables for interactive runs + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + + state_sc%t(num_subcols*(i-1)+j,k) = THL_lh_out(num_subcols*(i-1)+j,k) * invs_exner(i,k) & + + Lv * RCM_lh_out(num_subcols*(i-1)+j,k) / Cp - call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) - if ( ixrain > 0 ) & - call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixrain) ) - if ( ixsnow > 0 ) & - call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixsnow) ) - call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) - call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) - call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumice) ) - if ( ixnumrain > 0 ) & - call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumrain) ) - if ( ixnumsnow > 0 ) & - call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumsnow) ) - call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumliq) ) - do k = top_lev, pver - ! Look for exceptionally large values of condensate - if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then - ! Clip the large values - where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) - ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 - NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 - end where - ! Recalculate the weighted subcolumn mean - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixcldice)-tmp_mean - ! Add the difference to each subcolumn - ICE_lh_out(stncol+1:stncol+num_subcols,k) = & - ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - ! Recalculate the weight subcolumn mean for ice num conc - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixnumice)-tmp_mean - ! Add the difference to each subcolumn - if(diff_mean.gt.0.0_r8) then - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - else ! just use the grid mean in each subcolumn - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - state%q(i,k,ixnumice) - end if - ! Test adjusted means for debugging - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixcldice)-tmp_mean - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixnumice)-tmp_mean - endif - end do ! k = top_lev, pver - end do - endif ! subcol_silhs_constrainm - - - !--------------------------------------------------- - ! Updating state variables - !--------------------------------------------------- - ! Code to update the state variables for interactive runs - ! This kernel is executed in stream 3, but waits for stream 1 - ! because THL_lh_out and RCM_lh_out come from stream 1: - !$acc parallel loop collapse(3) default(present) wait(1) async(3) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - - state_sc%t(num_subcols*(i-1)+j,k) = THL_lh_out(num_subcols*(i-1)+j,k) * invs_exner(i,k) & - + Lv * RCM_lh_out(num_subcols*(i-1)+j,k) / Cp - - state_sc%s(num_subcols*(i-1)+j,k) = cpair * state_sc%t(num_subcols*(i-1)+j,k) & - + gravit * state%zm(i,k) + state%phis(i) - end do - end do - end do - - ! This kernel is executed in stream 4, but waits for stream 1 and 2 - ! because RVM_lh_out is from stream 1 and OMEGA_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(1,2) async(4) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - ! Vertical Velocity is not part of the energy conservation checks, but - ! we need to be careful here, because the SILHS output VV is noisy. - state_sc%omega(num_subcols*(i-1)+j,k) = OMEGA_lh_out(num_subcols*(i-1)+j,k) - state_sc%q(num_subcols*(i-1)+j,k,ixq) = RVM_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do + state_sc%s(num_subcols*(i-1)+j,k) = cpair * state_sc%t(num_subcols*(i-1)+j,k) & + + gravit * state%zm(i,k) + state%phis(i) + end do + end do + end do + + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + ! Vertical Velocity is not part of the energy conservation checks, but + ! we need to be careful here, because the SILHS output VV is noisy. + state_sc%omega(num_subcols*(i-1)+j,k) = OMEGA_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixq) = RVM_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp - if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp - - ! This kernel is executed in stream 5, but waits for stream 1 and 2 - ! because RCM_lh_out is from stream 1 and ICE_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(1,2) async(5) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = RCM_lh_out(num_subcols*(i-1)+j,k) - state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = ICE_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - - if (ixrain > 0) then - ! This kernel is executed in stream 6, but waits for stream 2 - ! because RAIN_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(6) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixrain) = RAIN_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - end if - - if (ixsnow > 0) then - ! This kernel is executed in stream 7, but waits for stream 2 - ! because SNOW_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(7) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = SNOW_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - end if - - else - - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = state%q(i,k,ixcldliq) - state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = state%q(i,k,ixcldice) - if (ixrain > 0) then - state_sc%q(num_subcols*(i-1)+j,k,ixrain) = state%q(i,k,ixrain) - end if - if (ixsnow > 0) then - state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = state%q(i,k,ixsnow) - end if - end do - end do - end do + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = RCM_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = ICE_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do - endif + if (ixrain > 0) then + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = RAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if - if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp - - ! This kernel is executed in stream 8, but waits for stream 1 and 2 - ! because NCLW_lh_out is from stream 1 and NICE_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(1,2) async(8) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = NICE_lh_out(num_subcols*(i-1)+j,k) - state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = NCLW_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - - if (ixnumrain > 0) then - ! This kernel is executed in stream 9, but waits for stream 2 - ! because NRAIN_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(9) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = NRAIN_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - end if + if (ixsnow > 0) then + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = SNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + else - if (ixnumsnow > 0) then - ! This kernel is executed in stream 10, but waits for stream 2 - ! because NSNOW_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(10) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = NSNOW_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - end if + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = state%q(i,k,ixcldliq) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = state%q(i,k,ixcldice) + if (ixrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = state%q(i,k,ixrain) + end if + if (ixsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = state%q(i,k,ixsnow) + end if + end do + end do + end do + + endif + + if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp - else + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = NICE_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = NCLW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = state%q(i,k,ixnumliq) - state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = state%q(i,k,ixnumice) - if (ixnumrain > 0) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = state%q(i,k,ixnumrain) - end if - if (ixnumsnow > 0) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = state%q(i,k,ixnumsnow) - end if - end do - end do - end do - - endif + if (ixnumrain > 0) then + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = NRAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + if (ixnumsnow > 0) then + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = NSNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if - ! This kernel is executed in stream 8, because state_sc%q(:,:,ixnumliq) and - ! state_sc%q(:,:,ixnumice) are from stream 8 - !$acc parallel loop collapse(3) default(present) async(8) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - ! Change liq and ice (and rain and snow) num conc zeros to min values (1e-12) - if (state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) .lt. min_num_conc) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = min_num_conc - end if - - if (state_sc%q(num_subcols*(i-1)+j,k,ixnumice) .lt. min_num_conc) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = min_num_conc - end if - end do - end do - end do - - if (ixnumrain > 0) then - ! This kernel is executed in stream 9, because state_sc%q(:,:,ixnumrain) is - ! from stream 9 - !$acc parallel loop collapse(3) default(present) async(9) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - if(state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) .lt. min_num_conc) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = min_num_conc - end if - end do - end do - end do - endif + else + + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = state%q(i,k,ixnumliq) + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = state%q(i,k,ixnumice) + if (ixnumrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = state%q(i,k,ixnumrain) + end if + if (ixnumsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = state%q(i,k,ixnumsnow) + end if + end do + end do + end do - if (ixnumsnow > 0) then - ! This kernel is executed in stream 10, because state_sc%q(:,:,ixnumsnow) is - ! from stream 10 - !$acc parallel loop collapse(3) default(present) async(10) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - if(state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) .lt. min_num_conc) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = min_num_conc + endif + + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + ! Change liq and ice (and rain and snow) num conc zeros to min values (1e-12) + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = min_num_conc + end if + + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumice) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = min_num_conc + end if + end do + end do + end do + + if (ixnumrain > 0) then + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = min_num_conc end if - end do - end do - end do - endif + end do + end do + end do + endif + + if (ixnumsnow > 0) then + !$acc parallel loop collapse(3) default(present) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = min_num_conc + end if + end do + end do + end do + endif - if ( l_outfld_subcol ) then - - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - do j = 1, num_subcols + if ( l_outfld_subcol ) then + + do k = 1, nzt_clubb + do i = 1, ngrdcol + do j = 1, num_subcols + + k_cam = top_lev - 1 + k + + ! Calc effective cloud fraction for testing + if ( ( lh_rc_clipped(i,j,k) .gt. qsmall ) & + .or. ( X_nl_all_levs(i,j,k,iiPDF_ri) .gt. qsmall ) ) then + eff_cldfrac(i,k_cam) = eff_cldfrac(i,k_cam) + lh_sample_point_weights(i,j,k) + else + eff_cldfrac(i,k_cam) = 0.0_r8 + endif - ! Calc effective cloud fraction for testing - if ( ( lh_rc_clipped(i,j,pverp-k+1) .gt. qsmall ) & - .or. ( X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) .gt. qsmall ) ) then - eff_cldfrac(i,k) = eff_cldfrac(i,k) + lh_sample_point_weights(i,j,pverp-k+1) - else - eff_cldfrac(i,k) = 0.0_r8 - endif - - end do - - eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) - - end do - end do - - ! Pack precip_frac for output - do k = 2, pverp-top_lev+1 - do i = 1, ngrdcol - precip_frac_out(i,pver-k+2) = precip_fracs%precip_frac(i,k) - end do - end do - - call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) - call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) - call outfld( 'SILHS_RTM', rtm, pcols, lchnk ) - call outfld( 'SILHS_THLM', thlm, pcols, lchnk ) - call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) - call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) - call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) - call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) - if ( l_est_kessler_microphys ) then - call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) - call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) - end if - call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) - call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) - if ( subcol_SILHS_constrainmn ) then - call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) - call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) - if ( ixsnow > 0 ) then - call outfld( 'SILHS_MSC_CLDLIQ', meansc_liq, pcols, lchnk ) - call outfld( 'SILHS_STDSC_CLDLIQ', stdsc_liq, pcols, lchnk ) - call outfld( 'SILHS_MSC_Q', meansc_vap, pcols, lchnk ) - call outfld( 'SILHS_STDSC_Q', stdsc_vap, pcols, lchnk ) - endif ! ixsnow > 0 - endif ! subcol_SILHS_constrainmn - call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) - end if - - !$acc end data - !$acc wait + end do + + eff_cldfrac(i,k_cam) = eff_cldfrac(i,k_cam)/real(num_subcols, kind=r8) + + end do + end do + + ! Pack precip_frac for output + do k = 1, nzt_clubb + do i = 1, ngrdcol + k_cam = top_lev - 1 + k + precip_frac_out(i,k_cam) = precip_fracs%precip_frac(i,k) + end do + end do + + call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) + call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) + call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) + call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) + call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) + call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) + + if ( l_est_kessler_microphys ) then + call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) + call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) + end if + + call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) + + if ( subcol_SILHS_constrainmn ) then + call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) + call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) + if ( ixsnow > 0 ) then + call outfld( 'SILHS_MSC_CLDLIQ', meansc_liq, pcols, lchnk ) + call outfld( 'SILHS_STDSC_CLDLIQ', stdsc_liq, pcols, lchnk ) + call outfld( 'SILHS_MSC_Q', meansc_vap, pcols, lchnk ) + call outfld( 'SILHS_STDSC_Q', stdsc_vap, pcols, lchnk ) + endif ! ixsnow > 0 + endif ! subcol_SILHS_constrainmn + + call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) + call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) + end if + + !$acc end data #endif #endif - end subroutine subcol_gen_SILHS + end subroutine subcol_gen_SILHS - subroutine subcol_ptend_avg_SILHS(ptend_sc, ngrdcol, lchnk, ptend) - use physics_buffer, only: physics_buffer_desc - use subcol_utils, only: subcol_ptend_get_firstsubcol, subcol_ptend_avg_shr, & - subcol_get_weight, subcol_get_filter, & - is_filter_set, is_weight_set + subroutine subcol_ptend_avg_SILHS(ptend_sc, ngrdcol, lchnk, ptend) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_ptend_get_firstsubcol, subcol_ptend_avg_shr, & + subcol_get_weight, subcol_get_filter, & + is_filter_set, is_weight_set - !----------------------------------- - ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) - !----------------------------------- + !----------------------------------- + ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) + !----------------------------------- - type(physics_ptend), intent(in) :: ptend_sc ! intent in - integer, intent(in) :: ngrdcol ! # grid cols - integer, intent(in) :: lchnk ! chunk index - type(physics_ptend), intent(inout) :: ptend - ! Because we can't get a state passed in here, we might have to use values from the - ! subcolumn generation. This would make any conservation checks invalid if this - ! function is called after another parameterization... hmm. + type(physics_ptend), intent(in) :: ptend_sc ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + type(physics_ptend), intent(inout) :: ptend + ! Because we can't get a state passed in here, we might have to use values from the + ! subcolumn generation. This would make any conservation checks invalid if this + ! function is called after another parameterization... hmm. - call subcol_ptend_avg_shr(ptend_sc, ngrdcol, lchnk, ptend, is_filter_set(), is_weight_set()) + call subcol_ptend_avg_shr(ptend_sc, ngrdcol, lchnk, ptend, is_filter_set(), is_weight_set()) - end subroutine subcol_ptend_avg_SILHS + end subroutine subcol_ptend_avg_SILHS - subroutine subcol_SILHS_var_covar_driver & - ( ztodt, state_sc, ptend_sc, & - pbuf ) + subroutine subcol_SILHS_var_covar_driver & + ( ztodt, state_sc, ptend_sc, & + pbuf ) - ! This subroutine calculates microphysical effects on five variances and - ! covariances: rtp2, thlp2, wprtp, wpthlp, and rtpthlp. - ! - ! This code is experimental!! + ! This subroutine calculates microphysical effects on five variances and + ! covariances: rtp2, thlp2, wprtp, wpthlp, and rtpthlp. + ! + ! This code is experimental!! - use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field + use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field #ifdef CLUBB_SGS #ifdef SILHS - use subcol_utils, only: subcol_get_weight - use subcol_pack_mod, only: subcol_unpack, subcol_get_nsubcol - use clubb_api_module, only: T_in_K2thlm_api, & - init_pdf_params_api, & - copy_multi_pdf_params_to_single,& - pdf_parameter - use silhs_api_module, only: lh_microphys_var_covar_driver_api + use subcol_utils, only: subcol_get_weight + use subcol_pack_mod, only: subcol_unpack, subcol_get_nsubcol + use clubb_api_module, only: T_in_K2thlm_api, & + init_pdf_params_api, & + copy_multi_pdf_params_to_single,& + pdf_parameter + use silhs_api_module, only: lh_microphys_var_covar_driver_api #endif #endif - implicit none + implicit none - ! Parameters - ! This fill value is set to catch errors; it should not be read. - real(r8), parameter :: fillvalue = -999._r8 + ! Parameters + ! This fill value is set to catch errors; it should not be read. + real(r8), parameter :: fillvalue = -999._r8 - ! Input Variables - real(r8), intent(in) :: ztodt ! model time increment - type(physics_state), intent(in) :: state_sc ! state for sub-columns - type(physics_ptend), intent(in) :: ptend_sc ! ptend for sub-columns + ! Input Variables + real(r8), intent(in) :: ztodt ! model time increment + type(physics_state), intent(in) :: state_sc ! state for sub-columns + type(physics_ptend), intent(in) :: ptend_sc ! ptend for sub-columns - ! Pointers - type(physics_buffer_desc), pointer :: pbuf(:) + ! Pointers + type(physics_buffer_desc), pointer :: pbuf(:) #ifdef CLUBB_SGS #ifdef SILHS - ! Local Variables - integer :: lchnk, ngrdcol, igrdcol, isubcol, ns, k - integer, dimension(pcols) :: nsubcol - real(r8), dimension(pcols*psubcols) :: weights_packed - real(r8), dimension(pcols,psubcols) :: weights - real(r8), dimension(pcols,psubcols,pverp) :: rc_all, rv_all, rt_all, w_all, thl_all - real(r8), dimension(pcols,psubcols,pver ) :: s_all, t_all, zm_all, omega_all, pmid_all - real(r8), dimension(pcols,psubcols) :: phis_all - real(r8), dimension(pcols,psubcols,pver ) :: stend, ttend - real(r8), dimension(pcols,psubcols,pverp) :: thltend, qctend, qvtend - - real(r8), dimension(pcols,psubcols,pver) :: dz_g, pdel_all, rho - real(r8), dimension(pcols,psubcols,pverp) :: zi_all - - real(r8), dimension(pcols,psubcols,pver ) :: exner - - ! Inputs to lh_microphys_var_covar_driver - real(r8), dimension(pcols,psubcols,pverp) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & - qctend_clubb, qvtend_clubb, thltend_clubb - real(r8), dimension(pcols,psubcols,pverp-top_lev+1) :: height_depndt_weights - - ! Outputs from lh_microphys_var_covar_driver - real(r8), dimension(:,:), pointer :: rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, & - wpthlp_mc_zt, rtpthlp_mc_zt - - ! pbuf indices - integer :: & - rtp2_mc_zt_idx, & - thlp2_mc_zt_idx, & - wprtp_mc_zt_idx, & - wpthlp_mc_zt_idx, & - rtpthlp_mc_zt_idx - - type(pdf_parameter) :: pdf_params_single_col - - !----- Begin Code ----- - - call init_pdf_params_api( pverp+1-top_lev, 1, pdf_params_single_col ) - - ! Don't do anything if this option isn't enabled. - if ( .not. subcol_SILHS_var_covar_src ) return - - lchnk = state_sc%lchnk - ngrdcol = state_sc%ngrdcol - - ! Obtain indices - rtp2_mc_zt_idx = pbuf_get_index('rtp2_mc_zt') - thlp2_mc_zt_idx = pbuf_get_index('thlp2_mc_zt') - wprtp_mc_zt_idx = pbuf_get_index('wprtp_mc_zt') - wpthlp_mc_zt_idx = pbuf_get_index('wpthlp_mc_zt') - rtpthlp_mc_zt_idx = pbuf_get_index('rtpthlp_mc_zt') - - ! Obtain pbuf fields for output - call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt) - call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt) - call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) - call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) - call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) - - ! Unpack needed tendencies from subcolumn ptends - call subcol_unpack(lchnk, ptend_sc%s(:,:), stend, fillvalue) - call subcol_unpack(lchnk, ptend_sc%q(:,:,ixcldliq), qctend(:,:,1:pver), fillvalue) - call subcol_unpack(lchnk, ptend_sc%q(:,:,ixq), qvtend(:,:,1:pver), fillvalue) - - ! Unpack sample point values from subcolumn states - call subcol_unpack(lchnk, state_sc%q(:,:,ixcldliq), rc_all(:,:,1:pver), fillvalue) - call subcol_unpack(lchnk, state_sc%q(:,:,ixq), rv_all(:,:,1:pver), fillvalue) - call subcol_unpack(lchnk, state_sc%omega(:,:), omega_all (:,:,:), fillvalue) - call subcol_unpack(lchnk, state_sc%s(:,:), s_all, fillvalue) - call subcol_unpack(lchnk, state_sc%zm, zm_all, fillvalue) - call subcol_unpack(lchnk, state_sc%phis, phis_all, fillvalue) - call subcol_unpack(lchnk, state_sc%zi, zi_all, fillvalue) - call subcol_unpack(lchnk, state_sc%pdel, pdel_all, fillvalue) - call subcol_unpack(lchnk, state_sc%pmid, pmid_all, fillvalue) - - ! Initialize fields to fillvalue. - rt_all = fillvalue - thl_all = fillvalue - w_all = fillvalue - qctend = fillvalue - qvtend = fillvalue - thltend = fillvalue - - ! How many subcolumns in each column? - call subcol_get_nsubcol(lchnk, nsubcol) - - do igrdcol = 1, ngrdcol - do isubcol = 1, nsubcol(igrdcol) - - rt_all(igrdcol,isubcol,top_lev:pver) = rc_all(igrdcol,isubcol,top_lev:pver) & - + rv_all(igrdcol,isubcol,top_lev:pver) - - ! Compute dry static density on CLUBB vertical grid - do k = top_lev, pver - dz_g(igrdcol,isubcol,k) = zi_all(igrdcol,isubcol,k) - zi_all(igrdcol,isubcol,k+1) ! thickness - rho(igrdcol,isubcol,k) = (rga)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) - end do - - ! Compute w from omega - w_all(igrdcol,isubcol,top_lev:pver) = -omega_all(igrdcol,isubcol,top_lev:pver) & - / ( rho(igrdcol,isubcol,top_lev:pver) * gravit ) - - ! Convert stend and s_all to ttend and t_all - ! Note 1: With subcolumns, cpair is truly a constant (I think). - ! Note 2: For tendencies, the extra terns zm and phis should - ! not be included in the calculation. - ttend(igrdcol,isubcol,top_lev:pver) = stend(igrdcol,isubcol,top_lev:pver) / cpair - - do k = top_lev, pver - t_all(igrdcol,isubcol,k) = ( s_all(igrdcol,isubcol,k) & - - gravit * zm_all(igrdcol,isubcol,k) & - - phis_all(igrdcol,isubcol) ) / cpair - end do ! k = 1, pver - - ! This formula is taken from earlier in this file. - exner(igrdcol,isubcol,top_lev:pver) & - = ( pmid_all(igrdcol,isubcol,top_lev:pver) / p0_clubb )**(rair/cpair) - - ! Note: all tendencies or all means should be used in the call to - ! T_in_K2thlm_api (with the exception of exner) - do k = top_lev, pver - thltend(igrdcol,isubcol,k) & - = T_in_K2thlm_api( ttend(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & - qctend(igrdcol,isubcol,k) ) - thl_all(igrdcol,isubcol,k) & - = T_in_K2thlm_api( t_all(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & - rc_all(igrdcol,isubcol,k) ) - end do ! k = 1, pver - - ! Add ghost points - rt_all (igrdcol,isubcol,pverp) = rt_all (igrdcol,isubcol,pver) - thl_all(igrdcol,isubcol,pverp) = thl_all(igrdcol,isubcol,pver) - w_all (igrdcol,isubcol,pverp) = w_all (igrdcol,isubcol,pver) - qctend (igrdcol,isubcol,pverp) = qctend (igrdcol,isubcol,pver) - qvtend (igrdcol,isubcol,pverp) = qvtend (igrdcol,isubcol,pver) - thltend(igrdcol,isubcol,pverp) = thltend(igrdcol,isubcol,pver) - - ! Flip inputs to CLUBB's grid. Note the dimension ordering change. - rt_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pverp) ) - thl_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pverp) ) - w_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pverp) ) - qctend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pverp) ) - qvtend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pverp) ) - thltend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pverp) ) - - end do ! isubcol = 1, nsubcol(igrdcol) - end do ! igrdcol = 1, ngrdcol - - ! Obtain weights - call subcol_get_weight(lchnk, weights_packed) - call subcol_unpack(lchnk, weights_packed, weights, fillvalue) - - ! Call lh_microphys_var_covar_driver for each column - do igrdcol=1, ngrdcol - ns = nsubcol(igrdcol) - - ! This code assumes that the weights are height independent. - ! It will have to change once the weights vary with altitude! - ! I'm not sure whether the grid will need to be flipped. - do k = 1, pverp-top_lev+1 - height_depndt_weights(igrdcol,1:ns,k) = weights(igrdcol,1:ns) - end do - - ! Copy the igrdcol column from the multicolumn pdf_params_chnk to the single column - ! version of pdf_params_single_col since lh_microphys_var_covar_driver_api only - ! works over 1 column currently - call copy_multi_pdf_params_to_single( pdf_params_chnk(lchnk), igrdcol, & - pdf_params_single_col ) - - ! Make the call!!!!! - call lh_microphys_var_covar_driver_api & - ( pverp-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:pverp-top_lev+1), & - pdf_params_single_col, & - rt_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thl_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & - w_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), qctend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & - qvtend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thltend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & - silhs_config_flags%l_lh_instant_var_covar_src, & - rtp2_mc_zt(igrdcol,1:pverp-top_lev+1), thlp2_mc_zt(igrdcol,1:pverp-top_lev+1), & - wprtp_mc_zt(igrdcol,1:pverp-top_lev+1), wpthlp_mc_zt(igrdcol,1:pverp-top_lev+1), & - rtpthlp_mc_zt(igrdcol,1:pverp-top_lev+1) ) - - ! The *_mc_zt microphysics tendencies are passed out of SILHS and back - ! to CLUBB without being used at all in the rest of the host model code. - ! The arrays aren't flipped for the *_mc_zt microphysics tendencies, and - ! they don't need to be. - - ! CLUBB used pverp vertical levels, but SILHS only uses - ! pverp - top_lev + 1 vertical levels. - ! Fill the upper levels with 0s when necessary. - if ( pverp > pverp-top_lev+1 ) then - rtp2_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - thlp2_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - wprtp_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - wpthlp_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - rtpthlp_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - endif ! pverp > pverp-top_lev+1 - - end do ! igrdcol = 1, ngrdcol -#endif -#endif - - return - end subroutine subcol_SILHS_var_covar_driver -#ifdef SILHS - real(r8) function meansc(arr_in, w_in, ns) result(val) - real(r8), intent(in) :: ns ! Length of Array - real(r8), dimension(int(ns)), intent(in) :: arr_in ! Input array - real(r8), dimension(int(ns)), intent(in) :: w_in ! Weights - real(r8) :: acc ! accumulator - integer :: i - acc = 0 - val = 0 - do i=1,ns - acc = acc + arr_in(i)*w_in(i) - end do - val = acc/ns - end function - - real(r8) function stdsc(arr_in, w_in, mn_in, ns) result(val) - real(r8), intent(in) :: ns ! Number of elements (subcolumns) - real(r8), dimension(int(ns)), intent(in) :: arr_in, w_in !Input array and weights - real(r8), intent(in) :: mn_in ! The mean of arr_in - real(r8) :: accvar, var - integer :: i - accvar = 0 - do i=1,ns - accvar = accvar + ((arr_in(i)-mn_in)**2)*w_in(i) - end do - var = accvar/ns - val = sqrt(var) - end function - - subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) - - use clubb_api_module, only : T_in_K2thlm_api - - integer, intent(in) :: nz ! Num vert levels - real(r8), dimension(nz), intent(in) :: ABST_prof ! Abs Temp prof - real(r8), dimension(nz), intent(in) :: ex_prof ! Profile of Exner func - real(r8), dimension(nz), intent(in) :: rcm_prof ! Profile of Cld Wat MR - real(r8), dimension(nz), intent(out) :: THL_prof ! LWPT prof - integer :: i - - do i=1,nz - THL_prof(i) = T_in_K2thlm_api(ABST_prof(i), ex_prof(i), rcm_prof(i)) - end do + ! Local Variables + integer :: lchnk, ngrdcol, igrdcol, isubcol, ns, k + integer, dimension(pcols) :: nsubcol + real(r8), dimension(pcols*psubcols) :: weights_packed + real(r8), dimension(pcols,psubcols) :: weights + real(r8), dimension(pcols,psubcols,pver ) :: rc_all, rv_all, rt_all, w_all, thl_all + real(r8), dimension(pcols,psubcols,pver ) :: s_all, t_all, zm_all, omega_all, pmid_all + real(r8), dimension(pcols,psubcols) :: phis_all + real(r8), dimension(pcols,psubcols,pver ) :: stend, ttend + real(r8), dimension(pcols,psubcols,pver ) :: thltend, qctend, qvtend + + real(r8), dimension(pcols,psubcols,pver) :: dz_g, pdel_all, rho + real(r8), dimension(pcols,psubcols,pverp) :: zi_all + + real(r8), dimension(pcols,psubcols,pver ) :: exner + + ! Inputs to lh_microphys_var_covar_driver + real(r8), dimension(pcols,psubcols,pver) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & + qctend_clubb, qvtend_clubb, thltend_clubb + real(r8), dimension(pcols,psubcols,nzt_clubb) :: height_depndt_weights + + ! Outputs from lh_microphys_var_covar_driver + real(r8), dimension(:,:), pointer :: rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, & + wpthlp_mc_zt, rtpthlp_mc_zt + + ! pbuf indices + integer :: & + rtp2_mc_zt_idx, & + thlp2_mc_zt_idx, & + wprtp_mc_zt_idx, & + wpthlp_mc_zt_idx, & + rtpthlp_mc_zt_idx - end subroutine - - subroutine subcol_constrainmn( num_subcols, samples, weights, grid_mean, mean_sc, std_sc ) - - ! Input/Output Variables - integer, intent(in) :: num_subcols - real(r8), dimension(num_subcols, pverp), intent(inout) :: samples - real(r8), dimension(num_subcols), intent(in) :: weights - real(r8), dimension(pverp), intent(in) :: grid_mean - real(r8), dimension(pver), intent(out), optional :: mean_sc, std_sc - - ! Local Variables - real(r8) :: meansc_loc, adj_rat - integer :: k - !------------------------------------------------------------------ - !----- Begin Code ----- - do k=1, pver - meansc_loc = meansc( samples(:,k), weights(:), real(num_subcols, r8) ) - - if (present(mean_sc)) & - mean_sc(k) = meansc_loc - if (present(std_sc)) & - std_sc(k) = stdsc( samples(:,k), weights(:), meansc_loc, & - real(num_subcols, r8) ) - - if ( meansc_loc > 0.0_r8 ) then - adj_rat = grid_mean(k)/meansc_loc - else - ! If the mean is zero, then zero out all subcolumns to avoid - ! negative samples - adj_rat = 0.0_r8 - end if - samples(:,k) = samples(:,k) * adj_rat - end do - end subroutine subcol_constrainmn + type(pdf_parameter) :: pdf_params_single_col - ! =============================================================================== ! - ! ! - ! =============================================================================== ! - function clubb_flip_grid ( profile ) result( profile_flipped ) + !----- Begin Code ----- + + call init_pdf_params_api( nzt_clubb, 1, pdf_params_single_col ) + + ! Don't do anything if this option isn't enabled. + if ( .not. subcol_SILHS_var_covar_src ) return + + lchnk = state_sc%lchnk + ngrdcol = state_sc%ngrdcol + + ! Obtain indices + rtp2_mc_zt_idx = pbuf_get_index('rtp2_mc_zt') + thlp2_mc_zt_idx = pbuf_get_index('thlp2_mc_zt') + wprtp_mc_zt_idx = pbuf_get_index('wprtp_mc_zt') + wpthlp_mc_zt_idx = pbuf_get_index('wpthlp_mc_zt') + rtpthlp_mc_zt_idx = pbuf_get_index('rtpthlp_mc_zt') + + ! Obtain pbuf fields for output + call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt) + call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt) + call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) + call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) + call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) + + ! Unpack needed tendencies from subcolumn ptends + call subcol_unpack(lchnk, ptend_sc%s(:,:), stend, fillvalue) + call subcol_unpack(lchnk, ptend_sc%q(:,:,ixcldliq), qctend(:,:,1:pver), fillvalue) + call subcol_unpack(lchnk, ptend_sc%q(:,:,ixq), qvtend(:,:,1:pver), fillvalue) + + ! Unpack sample point values from subcolumn states + call subcol_unpack(lchnk, state_sc%q(:,:,ixcldliq), rc_all(:,:,1:pver), fillvalue) + call subcol_unpack(lchnk, state_sc%q(:,:,ixq), rv_all(:,:,1:pver), fillvalue) + call subcol_unpack(lchnk, state_sc%omega(:,:), omega_all (:,:,:), fillvalue) + call subcol_unpack(lchnk, state_sc%s(:,:), s_all, fillvalue) + call subcol_unpack(lchnk, state_sc%zm, zm_all, fillvalue) + call subcol_unpack(lchnk, state_sc%phis, phis_all, fillvalue) + call subcol_unpack(lchnk, state_sc%zi, zi_all, fillvalue) + call subcol_unpack(lchnk, state_sc%pdel, pdel_all, fillvalue) + call subcol_unpack(lchnk, state_sc%pmid, pmid_all, fillvalue) + + ! Initialize fields to fillvalue. + rt_all = fillvalue + thl_all = fillvalue + w_all = fillvalue + qctend = fillvalue + qvtend = fillvalue + thltend = fillvalue + + ! How many subcolumns in each column? + call subcol_get_nsubcol(lchnk, nsubcol) + + do igrdcol = 1, ngrdcol + do isubcol = 1, nsubcol(igrdcol) + + rt_all(igrdcol,isubcol,top_lev:pver) = rc_all(igrdcol,isubcol,top_lev:pver) & + + rv_all(igrdcol,isubcol,top_lev:pver) + + ! Compute dry static density on CLUBB vertical grid + do k = top_lev, pver + dz_g(igrdcol,isubcol,k) = zi_all(igrdcol,isubcol,k) - zi_all(igrdcol,isubcol,k+1) ! thickness + rho(igrdcol,isubcol,k) = (rga)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) + end do - ! Description: - ! Swaps the elements in profile so they are in reverse order. CAM and - ! CLUBB's grids are flipped with respect to each other. - ! - ! Usage: - ! clubb_var = clubb_flip_grid( cam_var ) - ! cam_var = clubb_flip_grid( clubb_var ) + ! Compute w from omega + w_all(igrdcol,isubcol,top_lev:pver) = -omega_all(igrdcol,isubcol,top_lev:pver) & + / ( rho(igrdcol,isubcol,top_lev:pver) * gravit ) - implicit none + ! Convert stend and s_all to ttend and t_all + ! Note 1: With subcolumns, cpair is truly a constant (I think). + ! Note 2: For tendencies, the extra terns zm and phis should + ! not be included in the calculation. + ttend(igrdcol,isubcol,top_lev:pver) = stend(igrdcol,isubcol,top_lev:pver) / cpair - ! Input Variable - real(r8), dimension(pverp), intent(in) :: profile + do k = top_lev, pver + t_all(igrdcol,isubcol,k) = ( s_all(igrdcol,isubcol,k) & + - gravit * zm_all(igrdcol,isubcol,k) & + - phis_all(igrdcol,isubcol) ) / cpair + end do ! k = 1, pver - ! Output Variable - real(r8), dimension(pverp) :: profile_flipped + ! This formula is taken from earlier in this file. + exner(igrdcol,isubcol,top_lev:pver) & + = ( pmid_all(igrdcol,isubcol,top_lev:pver) / p0_clubb )**(rair/cpair) - ! Local Variable - integer :: k + ! Note: all tendencies or all means should be used in the call to + ! T_in_K2thlm_api (with the exception of exner) + do k = top_lev, pver + thltend(igrdcol,isubcol,k) & + = T_in_K2thlm_api( ttend(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & + qctend(igrdcol,isubcol,k) ) + thl_all(igrdcol,isubcol,k) & + = T_in_K2thlm_api( t_all(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & + rc_all(igrdcol,isubcol,k) ) + end do ! k = 1, pver + + rt_all_clubb(igrdcol,isubcol,1:pver) = rt_all(igrdcol,isubcol,1:pver) + thl_all_clubb(igrdcol,isubcol,1:pver) = thl_all(igrdcol,isubcol,1:pver) + w_all_clubb(igrdcol,isubcol,1:pver) = w_all(igrdcol,isubcol,1:pver) + qctend_clubb(igrdcol,isubcol,1:pver) = qctend(igrdcol,isubcol,1:pver) + qvtend_clubb(igrdcol,isubcol,1:pver) = qvtend(igrdcol,isubcol,1:pver) + thltend_clubb(igrdcol,isubcol,1:pver) = thltend(igrdcol,isubcol,1:pver) + + end do ! isubcol = 1, nsubcol(igrdcol) + end do ! igrdcol = 1, ngrdcol + + ! Obtain weights + call subcol_get_weight(lchnk, weights_packed) + call subcol_unpack(lchnk, weights_packed, weights, fillvalue) + + ! Call lh_microphys_var_covar_driver for each column + do igrdcol=1, ngrdcol + ns = nsubcol(igrdcol) + + ! This code assumes that the weights are height independent. + ! It will have to change once the weights vary with altitude! + do k = 1, nzt_clubb + height_depndt_weights(igrdcol,1:ns,k) = weights(igrdcol,1:ns) + end do - do k=1, pverp - profile_flipped(k) = profile(pverp-k+1) - end do ! k=1, pverp + ! Copy the igrdcol column from the multicolumn pdf_params_chnk to the single column + ! version of pdf_params_single_col since lh_microphys_var_covar_driver_api only + ! works over 1 column currently + call copy_multi_pdf_params_to_single( pdf_params_chnk(lchnk), igrdcol, & + pdf_params_single_col ) + + ! Make the call!!!!! + call lh_microphys_var_covar_driver_api & + ( nzt_clubb, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:nzt_clubb), & + pdf_params_single_col, & + rt_all_clubb(igrdcol,1:ns,top_lev:pver), thl_all_clubb(igrdcol,1:ns,top_lev:pver), & + w_all_clubb(igrdcol,1:ns,top_lev:pver), qctend_clubb(igrdcol,1:ns,top_lev:pver), & + qvtend_clubb(igrdcol,1:ns,top_lev:pver), thltend_clubb(igrdcol,1:ns,top_lev:pver), & + silhs_config_flags%l_lh_instant_var_covar_src, & + rtp2_mc_zt(igrdcol,:), thlp2_mc_zt(igrdcol,:), & + wprtp_mc_zt(igrdcol,:), wpthlp_mc_zt(igrdcol,:), & + rtpthlp_mc_zt(igrdcol,:) ) + + ! The *_mc_zt microphysics tendencies are passed out of SILHS and back + ! to CLUBB without being used at all in the rest of the host model code. + + end do ! igrdcol = 1, ngrdcol - return - end function clubb_flip_grid - ! =============================================================================== ! - ! ! - ! =============================================================================== ! #endif - !============================================================================ - subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) - - ! The William F. Buckley Jr. Conservative Hole Filler. - - ! Description: - ! Stops holes from forming in a hydrometeor mixing ratio by reducing the - ! microphysics tendency of that hydrometeor mixing ratio which would - ! otherwise cause that hydrometeor mixing ratio to have a negative value - ! once the microphysics tendency is applied. This code is used to prevent - ! holes in water mass, not number concentration. - ! - ! This subroutine is called after microphysics has completed and after - ! microphysics fields from subcolumns have been averaged back to grid - ! columns, but before the grid-column microphysics tendencies have been - ! applied in physics_update. This code is meant for use with the SILHS - ! subcolumn approach. This code needs to be applied to grid columns, not - ! subcolumns. - ! - ! This code adjusts the tendencies (ptend) before they are used to update - ! the grid mean fields (state variables). - ! - ! The column-integrated total water needs to be conserved during - ! microphysics. The conserved amount includes the amount of water that - ! precipitated to the ground from sedimentation during microphysics. - ! The conservation equation for each grid column is: - ! - ! SUM(k=top_lev:pver) ( rv_start(k) + rc_start(k) + rr_start(k) - ! + ri_start(k) + rs_start(k) ) * pdel(k) / g - ! = SUM(k=top_lev:pver) ( rv(k) + rc(k) + rr(k) + ri(k) + rs(k) ) - ! * pdel(k) / g - ! + prect * dt * 1000; - ! - ! where rv_start, rc_start, rr_start, ri_start, and rs_start are water - ! vapor, cloud water, rain water, cloud ice, and snow mixing ratios before - ! microphysics is called; rv, rc, rr, ri, and rs are water vapor, cloud - ! water, rain water, cloud ice, and snow mixing ratios after being updated - ! by microphysics; pdel is the pressure difference between vertical levels, - ! g is gravity, and prect * dt * 1000 is the total amount of water (from - ! all precipitating hydrometeors) that sedimented to the ground during - ! microphysics (dt is the timestep used for microphysics). The units of - ! column-integrated total water are kg (water) / m^2. - ! - ! All the updated hydrometeor fields are related to the hydrometeor fields - ! at the start by: - ! - ! rv(k) = rv_start(k) + rv_tend(k) * dt; - ! rc(k) = rc_start(k) + rc_tend(k) * dt; - ! rr(k) = rr_start(k) + rr_tend(k) * dt; - ! ri(k) = ri_start(k) + ri_tend(k) * dt; and - ! rs(k) = rs_start(k) + rs_tend(k) * dt; - ! - ! where rv_tend, rc_tend, rr_tend, ri_tend, and rs_tend are water vapor, - ! cloud water, rain water, cloud ice, and snow mixing ratio tendencies - ! from microphysics, which includes the sum of microphysics process rates - ! and sedimentation. When these equations are applied to the equation - ! for column-integrated total water, that equation becomes: - ! - ! SUM(k=top_lev:pver) ( rv_tend(k) + rc_tend(k) + rr_tend(k) - ! + ri_tend(k) + rs_tend(k) ) * dt * pdel(k) / g - ! + prect * dt * 1000 = 0. - ! - ! As stated above, the hydrometeor tendencies are the sum of tendencies - ! from microphysics process rates and tendencies from sedimentation: - ! - ! rv_tend(k) = rv_mc_tend(k); - ! rc_tend(k) = rc_mc_tend(k) + rc_sed_tend(k); - ! rr_tend(k) = rr_mc_tend(k) + rr_sed_tend(k); - ! ri_tend(k) = ri_mc_tend(k) + ri_sed_tend(k); and - ! rs_tend(k) = rs_mc_tend(k) + rs_sed_tend(k); - ! - ! where rv_mc_tend, rc_mc_tend, rr_mc_tend, ri_mc_tend, and rs_mc_tend are - ! the tendencies of water vapor, cloud water, rain water, cloud ice, and - ! snow from microphysics process rates, and rc_sed_tend, rr_sed_tend, - ! ri_sed_tend, and rs_sed_tend are the tendencies of cloud water, - ! rain water, cloud ice, and snow from sedimentation. When these equations - ! are applied to the equation for column-integrated total water, that - ! equation becomes: - ! - ! SUM(k=top_lev:pver) ( rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) - ! + ri_mc_tend(k) + rs_mc_tend(k) ) - ! * dt * pdel(k) / g - ! + SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) + ri_sed_tend(k) - ! + rs_sed_tend(k) ) * dt * pdel(k) / g - ! + prect * dt * 1000 = 0. - ! - ! At any vertical level, the tendencies from microphysics process rates - ! (mc_tend variables) must balance: - ! - ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) - ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. - ! - ! The column-integrated total water equation can be applied to - ! sedimentation: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) + ri_sed_tend(k) - ! + rs_sed_tend(k) ) * dt * pdel(k) / g - ! + prect * dt * 1000 = 0. - ! - ! The total precipitation rate, prect, can be split into liquid - ! precipitation rate, precl, and frozen precipitation rate, preci: - ! - ! prect = precl + preci. - ! - ! The microphysics code outputs prect and preci, so precl can be calculated - ! by precl = prect - preci. The column-integrated total water equation can - ! be split into: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + precl * dt * 1000 = 0; and - ! - ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + preci * dt * 1000 = 0. - ! - ! Overall, the conservation methods used in this subroutine are: - ! - ! 1) When adjusting the tendencies from microphysics process rates, - ! conserve: - ! - ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) - ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. - ! - ! 2) When adjusting the tendencies from microphysics process rates, adjust - ! dry static energy appropriately. The change in dry static energy - ! is necessary because of phase changes. This "puts back" the extra dry - ! static energy that was "taken out" when an excessive phase-changing - ! process rate was produced by microphysics. - ! - ! 3) When adjusting the hydrometeor tendency from sedimentation of a - ! liquid hydrometeor (cloud water or rain water), conserve: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + precl * dt * 1000 = 0. - ! - ! 4) When adjusting the hydrometeor tendency from sedimentation of a - ! frozen hydrometeor (cloud ice or snow), conserve: - ! - ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + preci * dt * 1000 = 0. - ! - ! The conservative hole filler works as follows. The total microphysics - ! tendency for each hydrometeor is provided in ptend. This is the sum of - ! the microphysics process rate tendency and sedimentation tendency for - ! each hydrometeor. The sedimentation tendency is provided in pbuf. The - ! sedimentation tendency is subtracted off the total microphysics tendency - ! to produce the microphysics process rate tendency for each hydrometeor. - ! The microphysics process rate tendency is adjusted when necessary so that - ! holes in the hydrometeor are not produced by microphysics process rates. - ! When a hydrometeor's negative microphysics process rate tendency needs to - ! be made smaller in magnitude to avoid a hole, all hydrometeor tendencies - ! that are positive at that grid level are also decreased proportionately - ! to maintain a balance. Dry static energy tendency is also adjusted - ! appropriately when necessary. After this, the vertical integral of each - ! hydrometeor species is greater than or equal to 0. - ! - ! The sedimentation tendency is then added back onto the new microphysics - ! process rate tendency to produce a new total microphysics tendency for - ! each hydrometeor. Since the sedimentation tendency was based on the old - ! value of hydrometeor, before the hole-filling adjustment, it is possible - ! that the new total microphysics tendency may produce holes. When this - ! happens, sedimentation hole filling fills holes in the vertical profile - ! of each hydrometeor. Holes are filled using mass from other vertical - ! levels for the same hydrometeor (or from a same-phase hydrometeor when - ! necessary). Since the vertical integral of sedimentation tendency - ! (including surface precipitation rate) is 0, the vertical integral of the - ! hydrometeor must be greater than or equal to 0, which means that all - ! holes can be filled. The result is that all holes in any hydrometeor - ! mixing ratio are filled completely and conservatively. The value of - ! ptend is updated appropriately so that it can be applied later in - ! physics_update. - - !---------------------------------------------------------------------- - - use physics_buffer, only: & - physics_buffer_desc, & - pbuf_get_field - - use ppgrid, only: & - pcols - - use constituents, only: & - qmin - - use ref_pres, only: & - top_lev => trop_cloud_top_lev - - implicit none - - ! Input Variables - type(physics_state), intent(in) :: state ! Physics state variables - real(r8), intent(in) :: dt ! Time step duration - - ! Input/Output Variables - type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies - type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer - - ! Local Variables - real(r8), dimension(pcols,pver) :: & - rv_start, & ! Water vapor mixing ratio at start of microphysics [kg/kg] - rc_start, & ! Cloud water mixing ratio at start of microphysics [kg/kg] - rr_start, & ! Rain water mixing ratio at start of microphysics [kg/kg] - ri_start, & ! Cloud ice mixing ratio at start of microphysics [kg/kg] - rs_start ! Snow mixing ratio at start of microphysics [kg/kg] - - real(r8), dimension(pcols,pver) :: & - rv_tend, & ! Water vapor mixing ratio tendency [kg/kg/s] - rc_tend, & ! Cloud water mixing ratio tendency [kg/kg/s] - rr_tend, & ! Rain water mixing ratio tendency [kg/kg/s] - ri_tend, & ! Cloud ice mixing ratio tendency [kg/kg/s] - rs_tend, & ! Snow mixing ratio tendency [kg/kg/s] - stend ! Dry static energy tendency [J/kg/s] - - real(r8), dimension(:), pointer :: & - prect, & ! Total microphysics precipitation rate (surface) [m/s] - preci, & ! Ice-phase microphysics precipitation rate (surface) [m/s] - prec_str, & ! Total surface precipitation rate from stratoform [m/s] - snow_str ! Snow surface precipitation rate from stratoform [m/s] - - real(r8), dimension(:,:), pointer :: & - rc_sed_tend, & ! Mean cloud water sedimentation tendency [kg/kg/s] - rr_sed_tend, & ! Mean rain water sedimentation tendency [kg/kg/s] - ri_sed_tend, & ! Mean cloud ice sedimentation tendency [kg/kg/s] - rs_sed_tend, & ! Mean snow sedimentation tendency [kg/kg/s] - vtrmc, & ! Mean cloud water sedimentation velocity [m/s] - umr, & ! Mean rain water sedimentation velocity [m/s] - vtrmi, & ! Mean cloud ice sedimentation velocity [m/s] - ums, & ! Mean snow sedimentation velocity [m/s] - rc_sed_evap, & ! Mean evap of cloud water during sedimentation [kg/kg/s] - ri_sed_subl ! Mean subl of cloud ice during sedimentation [kg/kg/s] - - real(r8), dimension(pcols,pver) :: & - rv_mc_tend, & ! Water vapor mixing ratio microphysics tendency [kg/kg/s] - rc_mc_tend, & ! Cloud water mixing ratio microphysics tendency [kg/kg/s] - rr_mc_tend, & ! Rain water mixing ratio microphysics tendency [kg/kg/s] - ri_mc_tend, & ! Cloud ice mixing ratio microphysics tendency [kg/kg/s] - rs_mc_tend ! Snow mixing ratio microphysics tendency [kg/kg/s] - - real(r8) :: & - rv_curr, & ! Current water vapor mixing ratio [kg/kg] - rc_curr, & ! Current cloud water mixing ratio [kg/kg] - rr_curr, & ! Current rain water mixing ratio [kg/kg] - ri_curr, & ! Current cloud ice mixing ratio [kg/kg] - rs_curr ! Current snow mixing ratio [kg/kg] - - logical :: & - l_pos_rv_mc_tend, & ! Flag for positive water vapor mixing ratio mc tend. - l_pos_rc_mc_tend, & ! Flag for positive cloud water mixing ratio mc tend. - l_pos_rr_mc_tend, & ! Flag for positive rain water mixing ratio mc tend. - l_pos_ri_mc_tend, & ! Flag for positive cloud ice mixing ratio mc tend. - l_pos_rs_mc_tend ! Flag for positive snow mixing ratio mc tend. - - real(r8) :: & - mc_tend_max_mag, & ! Max. allowable mag. of (neg.) mc tend [kg/kg/s] - mc_tend_correction, & ! Amnt. correction necessary to mc tend [kg/kg/s] - total_mc_positive, & ! Total of all positive mc tendencies [kg/kg/s] - mc_correction_ratio ! Ratio: mc_tend_correction/total_mc_positive [-] - - real(r8), dimension(pcols) :: & - precl ! Liquid-phase precipitation rate (surface) [m/s] - - ! Budgeting terms for hole filling. - ! These variables are for use in stats output. - real(r8), dimension(pcols,pver) :: & - rv_hf_tend, & ! Water vapor mixing ratio hole-filling tendency [kg/kg/s] - rc_hf_tend, & ! Cloud water mixing ratio hole-filling tendency [kg/kg/s] - rr_hf_tend, & ! Rain water mixing ratio hole-filling tendency [kg/kg/s] - ri_hf_tend, & ! Cloud ice mixing ratio hole-filling tendency [kg/kg/s] - rs_hf_tend, & ! Snow mixing ratio hole-filling tendency [kg/kg/s] - s_hf_tend ! Dry static energy hole-filling tendency [J/kg/s] - - integer :: ncol ! Number of grid columns - - integer :: icol, k ! Loop indices - - ! Flag to perform hole filling after the original sedimentation tendency - ! is added back on to the new microphysics process tendency. This calls - ! the sedimentation hole filler. - logical, parameter :: & - l_sed_hole_fill = .true. - - logical, parameter :: & - l_check_conservation = .true. ! Flag to perform water conservation check - - ! Vertically-integrated grand total water (rv+rc+rr+ri+rs) [kg/m^2] - real(r8), dimension(pcols) :: & - grand_total_water_column_start, & ! Column integral at start - grand_total_water_column_finish ! Column integral at finish - - ! Vertically-integrated total water energy [J/m^2] - real(r8), dimension(pcols) :: & - total_energy_column_start, & ! Column integral at start - total_energy_column_finish ! Column integral at finish - - real(r8), dimension(pcols) :: & - tot_water_rel_err, & ! Relative error: vert-integrated grand total water - tot_energy_rel_err ! Relative error: vert-integrated total energy - - real(r8), parameter :: & - err_thresh = 1.0e-14_r8 ! Threshold of relative error - - - ! Get the number of grid columns. - ncol = state%ncol - - ! Get fields from the pbuf. - call pbuf_get_field(pbuf, prec_pcw_idx, prect) - call pbuf_get_field(pbuf, snow_pcw_idx, preci) - call pbuf_get_field(pbuf, prec_str_idx, prec_str) - call pbuf_get_field(pbuf, snow_str_idx, snow_str) - call pbuf_get_field(pbuf, qcsedten_idx, rc_sed_tend) - call pbuf_get_field(pbuf, qrsedten_idx, rr_sed_tend) - call pbuf_get_field(pbuf, qisedten_idx, ri_sed_tend) - call pbuf_get_field(pbuf, qssedten_idx, rs_sed_tend) - call pbuf_get_field(pbuf, vtrmc_idx, vtrmc) - call pbuf_get_field(pbuf, umr_idx, umr) - call pbuf_get_field(pbuf, vtrmi_idx, vtrmi) - call pbuf_get_field(pbuf, ums_idx, ums) - call pbuf_get_field(pbuf, qcsevap_idx, rc_sed_evap) - call pbuf_get_field(pbuf, qisevap_idx, ri_sed_subl) - - ! Calculate liquid precipitation rate (precl) from the total precipitation - ! rate (prect) and the frozen preciptation rate (preci). This should never - ! be negative, but just to be safe, threshold at 0. - precl(:ncol) = max( prect(:ncol) - preci(:ncol), 0.0_r8 ) - - ! Perform total water and total energy conservation checks. - if ( l_check_conservation ) then - - ! Calculate total water in each column. - ! This calculation is the vertically-integrated grand total water (where - ! grand total water is the sum of water vapor, cloud water, rain water, - ! cloud ice, and snow, as well as the amount of water that precipitated - ! to the surface) in each grid column after microphysics, but at the - ! start of hole filling. - do icol = 1, ncol - grand_total_water_column_start(icol) = 0.0_r8 - do k = top_lev, pver - grand_total_water_column_start(icol) & - = grand_total_water_column_start(icol) & - + ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt & - + state%q(icol,k,ixcldliq) & - + ptend%q(icol,k,ixcldliq) * dt & - + state%q(icol,k,ixcldice) & - + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) * rga - if ( ixrain > 0 ) then - grand_total_water_column_start(icol) & - = grand_total_water_column_start(icol) & - + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) * rga - endif - if ( ixsnow > 0 ) then - grand_total_water_column_start(icol) & - = grand_total_water_column_start(icol) & - + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) * rga - endif - end do ! k = top_lev, pver - grand_total_water_column_start(icol) & - = grand_total_water_column_start(icol) & - + prect(icol) * dt * 1000.0_r8 - end do ! icol = 1, ncol - - ! Calculate total energy in each column. - ! This calculation is the vertically-integrated total energy in each - ! grid column after microphysics, but at the start of hole filling. - ! Since the microphysics and hole filling code does not directly change - ! kinetic energy, 0.5 * ( u^2 + v^2 ), it can be skipped as part of the - ! energy conservation check. - do icol = 1, ncol - total_energy_column_start(icol) = 0.0_r8 - do k = top_lev, pver - total_energy_column_start(icol) & - = total_energy_column_start(icol) & - + ( state%s(icol,k) + ptend%s(icol,k) * dt & - + ( latvap + latice ) & - * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & - + latice * ( state%q(icol,k,ixcldliq) & - + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) * rga - if ( ixrain > 0 ) then - total_energy_column_start(icol) & - = total_energy_column_start(icol) & - + latice * ( state%q(icol,k,ixrain) & - + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) * rga - endif - end do ! k = top_lev, pver - total_energy_column_start(icol) & - = total_energy_column_start(icol) & - + latice * precl(icol) * dt * 1000.0_r8 - end do ! icol = 1, ncol - - endif ! l_check_conservation - - ! The fields within state haven't been updated yet, since this is before - ! the call to physics_update. - rv_start = state%q(:,:,1) - rc_start = state%q(:,:,ixcldliq) - if ( ixrain > 0 ) then - rr_start = state%q(:,:,ixrain) - endif - ri_start = state%q(:,:,ixcldice) - if ( ixsnow > 0 ) then - rs_start = state%q(:,:,ixsnow) - endif - - ! Unpack the current total tendencies for hydrometeor mixing ratio fields. - rv_tend = ptend%q(:,:,1) - rc_tend = ptend%q(:,:,ixcldliq) - if ( ixrain > 0 ) then - rr_tend = ptend%q(:,:,ixrain) - endif - ri_tend = ptend%q(:,:,ixcldice) - if ( ixsnow > 0 ) then - rs_tend = ptend%q(:,:,ixsnow) - endif - - ! Unpack the current tendency for dry static energy. - stend = ptend%s - - ! The total hydrometeor tendencies are the sum of microphysics process - ! rates and sedimentation rates. Calculate the microphysics process - ! tendencies by subtracting the sedimentation tendencies from the overall - ! tendencies. - ! The sedimentation tendencies for cloud water (rc_sed_tend) and cloud ice - ! (ri_sed_tend) include the evaporation of cloud water during sedimentation - ! and the sublimation of cloud ice during sedimentation, respectively. The - ! true sedimentation of cloud water is the sum of rc_sed_tend and - ! rc_sed_evap, and the true sedimentation of cloud ice is the sum of - ! ri_sed_tend and ri_sed_subl. Subtract off only the true sedimentation - ! rates, as evaporation and sublimation need to be included in the - ! microphysics process rates. - rv_mc_tend(:ncol,:) = rv_tend(:ncol,:) - rc_mc_tend(:ncol,:) = rc_tend(:ncol,:) - ( rc_sed_tend(:ncol,:) + rc_sed_evap(:ncol,:) ) - if ( ixrain > 0 ) then - rr_mc_tend(:ncol,:) = rr_tend(:ncol,:) - rr_sed_tend(:ncol,:) - endif - ri_mc_tend(:ncol,:) = ri_tend(:ncol,:) - ( ri_sed_tend(:ncol,:) + ri_sed_subl(:ncol,:) ) - if ( ixsnow > 0 ) then - rs_mc_tend(:ncol,:) = rs_tend(:ncol,:) - rs_sed_tend(:ncol,:) - endif +#endif - ! This section adjusts microphysics process rate tendencies so that the - ! resulting values of all hydrometeor mixing ratios are greater than or - ! equal to qmin after this section is complete. Once sedimentation is - ! added back on after this section, some of the hydrometeor mixing ratios - ! may become less than qmin again. - ! - ! This section, which again is concerned only with adjusting microphysics - ! process rates, makes use of the following two principles: - ! - ! 1) When adjusting the tendencies from microphysics process rates, - ! conserve: - ! - ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) - ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. - ! - ! 2) When adjusting the tendencies from microphysics process rates, adjust - ! dry static energy appropriately. The change in dry static energy - ! is necessary because of phase changes. This "puts back" the extra dry - ! static energy that was "taken out" when an excessive phase-changing - ! process rate was produced by microphysics. - - ! Loop over all columns, performing any tendency adjustments one column - ! at a time. - do icol = 1, ncol - - ! Loop over all vertical levels, performing any microphysics process - ! tendency adjustments one level at a time. - do k = top_lev, pver - - ! Find which hydrometeors have positive microphysics process - ! tendencies at this level. - if ( rv_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_rv_mc_tend = .true. - else - l_pos_rv_mc_tend = .false. - endif - if ( rc_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_rc_mc_tend = .true. - else - l_pos_rc_mc_tend = .false. - endif - if ( ixrain > 0 ) then - if ( rr_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_rr_mc_tend = .true. - else - l_pos_rr_mc_tend = .false. - endif - endif - if ( ri_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_ri_mc_tend = .true. - else - l_pos_ri_mc_tend = .false. - endif - if ( ixsnow > 0 ) then - if ( rs_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_rs_mc_tend = .true. - else - l_pos_rs_mc_tend = .false. - endif - endif + return + end subroutine subcol_SILHS_var_covar_driver +#ifdef SILHS + real(r8) function meansc(arr_in, w_in, ns) result(val) + real(r8), intent(in) :: ns ! Length of Array + real(r8), dimension(int(ns)), intent(in) :: arr_in ! Input array + real(r8), dimension(int(ns)), intent(in) :: w_in ! Weights + real(r8) :: acc ! accumulator + integer :: i + acc = 0 + val = 0 + do i=1,ns + acc = acc + arr_in(i)*w_in(i) + end do + val = acc/ns + end function + + real(r8) function stdsc(arr_in, w_in, mn_in, ns) result(val) + real(r8), intent(in) :: ns ! Number of elements (subcolumns) + real(r8), dimension(int(ns)), intent(in) :: arr_in, w_in !Input array and weights + real(r8), intent(in) :: mn_in ! The mean of arr_in + real(r8) :: accvar, var + integer :: i + accvar = 0 + do i=1,ns + accvar = accvar + ((arr_in(i)-mn_in)**2)*w_in(i) + end do + var = accvar/ns + val = sqrt(var) + end function - !!! Check for holes in water vapor mixing ratio - if ( .not. l_pos_rv_mc_tend ) then - - ! Calculate the water vapor mixing ratio as it would be with the - ! current microphysics process tendency. - rv_curr = rv_start(icol,k) + rv_mc_tend(icol,k) * dt - - if ( rv_curr < qmin(1) ) then - - ! Microphysics processes are causing a hole in water vapor - ! mixing ratio. - - ! Calculate the maximum allowable magnitude of (negative) water - ! vapor microphysics process tendency. - mc_tend_max_mag = ( qmin(1) - rv_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the water vapor mixing ratio microphysics process - ! tendency. This number is positive. - mc_tend_correction = mc_tend_max_mag - rv_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rc_mc_tend ) then - total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) - endif - if ( l_pos_ri_mc_tend ) then - total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative water vapor mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of water vapor). - if ( l_pos_rc_mc_tend ) then - ! Changing cloud water to water vapor cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - latvap * mc_correction_ratio * rc_mc_tend(icol,k) - ! Update cloud water mixing ratio microphysics tendency. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - ! Changing rain water to water vapor cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - latvap * mc_correction_ratio * rr_mc_tend(icol,k) - ! Update rain water mixing ratio microphysics tendency. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_ri_mc_tend ) then - ! Changing cloud ice to water vapor cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - ( latvap + latice ) & - * mc_correction_ratio * ri_mc_tend(icol,k) - ! Update cloud ice mixing ratio microphysics tendency. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - ! Changing snow to water vapor cools and reduces dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - - ( latvap + latice ) & - * mc_correction_ratio * rs_mc_tend(icol,k) - ! Update snow mixing ratio microphysics tendency. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new water vapor mixing ratio microphysics - ! process tendency. This should be equal to the maximum - ! magnitude (negative) amount allowed, mc_tend_max_mag. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! rv_curr < qmin(1) - - endif ! .not. l_pos_rv_mc_tend - - !!! Check for holes in cloud water mixing ratio - if ( .not. l_pos_rc_mc_tend ) then - - ! Calculate the cloud water mixing ratio as it would be with the - ! current microphysics process tendency. - rc_curr = rc_start(icol,k) + rc_mc_tend(icol,k) * dt - - if ( rc_curr < qmin(ixcldliq) ) then - - ! Microphysics processes are causing a hole in cloud water - ! mixing ratio. - - ! Calculate the maximum allowable magnitude of (negative) cloud - ! water microphysics process tendency. - mc_tend_max_mag = ( qmin(ixcldliq) - rc_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the cloud water mixing ratio microphysics process - ! tendency. This number is positive. - mc_tend_correction = mc_tend_max_mag - rc_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rv_mc_tend ) then - total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) - endif - if ( l_pos_ri_mc_tend ) then - total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative cloud water mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of cloud water). - if ( l_pos_rv_mc_tend ) then - ! Changing water vapor to cloud water heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + latvap * mc_correction_ratio * rv_mc_tend(icol,k) - ! Update water vapor mixing ratio microphysics tendency. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - ! Changing rain water to cloud water does not change - ! dry static energy. - ! Update rain water mixing ratio microphysics tendency. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_ri_mc_tend ) then - ! Changing cloud ice to cloud water cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - latice * mc_correction_ratio * ri_mc_tend(icol,k) - ! Update cloud ice mixing ratio microphysics tendency. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - ! Changing snow to cloud water cools and reduces dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - - latice * mc_correction_ratio * rs_mc_tend(icol,k) - ! Update snow mixing ratio microphysics tendency. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new cloud water mixing ratio microphysics - ! process tendency. This should be equal to the maximum - ! magnitude (negative) amount allowed, mc_tend_max_mag. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! rc_curr < qmin(ixcldliq) - - endif ! .not. l_pos_rc_mc_tend - - !!! Check for holes in rain water mixing ratio - if ( ixrain > 0 .and. ( .not. l_pos_rr_mc_tend ) ) then - - ! Calculate the rain water mixing ratio as it would be with the - ! current microphysics process tendency. - rr_curr = rr_start(icol,k) + rr_mc_tend(icol,k) * dt - - if ( rr_curr < qmin(ixrain) ) then - - ! Microphysics processes are causing a hole in rain water - ! mixing ratio. - - ! Calculate the maximum allowable magnitude of (negative) rain - ! water microphysics process tendency. - mc_tend_max_mag = ( qmin(ixrain) - rr_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the rain water mixing ratio microphysics process - ! tendency. This number is positive. - mc_tend_correction = mc_tend_max_mag - rr_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rv_mc_tend ) then - total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) - endif - if ( l_pos_rc_mc_tend ) then - total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) - endif - if ( l_pos_ri_mc_tend ) then - total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative rain water mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of rain water). - if ( l_pos_rv_mc_tend ) then - ! Changing water vapor to rain water heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + latvap * mc_correction_ratio * rv_mc_tend(icol,k) - ! Update water vapor mixing ratio microphysics tendency. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_rc_mc_tend ) then - ! Changing cloud water to rain water does not change - ! dry static energy. - ! Update cloud water mixing ratio microphysics tendency. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_ri_mc_tend ) then - ! Changing cloud ice to rain water cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - latice * mc_correction_ratio * ri_mc_tend(icol,k) - ! Update cloud ice mixing ratio microphysics tendency. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - ! Changing snow to rain water cools and reduces dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - - latice * mc_correction_ratio * rs_mc_tend(icol,k) - ! Update snow mixing ratio microphysics tendency. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new rain water mixing ratio microphysics - ! process tendency. This should be equal to the maximum - ! magnitude (negative) amount allowed, mc_tend_max_mag. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! rr_curr < qmin(ixrain) - - endif ! ixrain > 0 .and. ( .not. l_pos_rr_mc_tend ) - - !!! Check for holes in cloud ice mixing ratio - if ( .not. l_pos_ri_mc_tend ) then - - ! Calculate the cloud ice mixing ratio as it would be with the - ! current microphysics process tendency. - ri_curr = ri_start(icol,k) + ri_mc_tend(icol,k) * dt - - if ( ri_curr < qmin(ixcldice) ) then - - ! Microphysics processes are causing a hole in cloud ice - ! mixing ratio. - - ! Calculate the maximum allowable magnitude of (negative) cloud - ! ice microphysics process tendency. - mc_tend_max_mag = ( qmin(ixcldice) - ri_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the cloud ice mixing ratio microphysics process - ! tendency. This number is positive. - mc_tend_correction = mc_tend_max_mag - ri_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rv_mc_tend ) then - total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) - endif - if ( l_pos_rc_mc_tend ) then - total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative cloud ice mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of cloud ice). - if ( l_pos_rv_mc_tend ) then - ! Changing water vapor to cloud ice heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + ( latvap + latice ) & - * mc_correction_ratio * rv_mc_tend(icol,k) - ! Update water vapor mixing ratio microphysics tendency. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_rc_mc_tend ) then - ! Changing cloud water to cloud ice heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + latice * mc_correction_ratio * rc_mc_tend(icol,k) - ! Update cloud water mixing ratio microphysics tendency. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - ! Changing rain water to cloud ice heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + latice * mc_correction_ratio * rr_mc_tend(icol,k) - ! Update rain water mixing ratio microphysics tendency. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - ! Changing snow to cloud ice does not change dry static - ! energy. - ! Update snow mixing ratio microphysics tendency. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new cloud ice mixing ratio microphysics - ! process tendency. This should be equal to the maximum - ! magnitude (negative) amount allowed, mc_tend_max_mag. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! ri_curr < qmin(ixcldice) - - endif ! .not. l_pos_ri_mc_tend - - !!! Check for holes in snow mixing ratio - if ( ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) ) then - - ! Calculate the snow mixing ratio as it would be with the - ! current microphysics process tendency. - rs_curr = rs_start(icol,k) + rs_mc_tend(icol,k) * dt - - if ( rs_curr < qmin(ixsnow) ) then - - ! Microphysics processes are causing a hole in snow mixing - ! ratio. - - ! Calculate the maximum allowable magnitude of (negative) snow - ! microphysics process tendency. - mc_tend_max_mag = ( qmin(ixsnow) - rs_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the snow mixing ratio microphysics process tendency. - ! This number is positive. - mc_tend_correction = mc_tend_max_mag - rs_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rv_mc_tend ) then - total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) - endif - if ( l_pos_rc_mc_tend ) then - total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) - endif - if ( l_pos_ri_mc_tend ) then - total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative snow mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of snow). - if ( l_pos_rv_mc_tend ) then - ! Changing water vapor to snow heats and increases dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - + ( latvap + latice ) & - * mc_correction_ratio * rv_mc_tend(icol,k) - ! Update water vapor mixing ratio microphysics tendency. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_rc_mc_tend ) then - ! Changing cloud water to snow heats and increases dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - + latice * mc_correction_ratio * rc_mc_tend(icol,k) - ! Update cloud water mixing ratio microphysics tendency. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - ! Changing rain water to snow heats and increases dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - + latice * mc_correction_ratio * rr_mc_tend(icol,k) - ! Update rain water mixing ratio microphysics tendency. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_ri_mc_tend ) then - ! Changing cloud ice to snow does not change dry static - ! energy. - ! Update cloud ice mixing ratio microphysics tendency. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new snow mixing ratio microphysics process - ! tendency. This should be equal to the maximum magnitude - ! (negative) amount allowed, mc_tend_max_mag. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! rs_curr < qmin(ixsnow) - - endif ! ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) - - end do ! k = top_lev, pver - - end do ! icol = 1, ncol - - ! Calculate the new overall tendencies by adding the sedimentation - ! tendencies back onto the new microphysics process tendencies. - ! For cloud water and cloud ice, the sedimentation tendencies that are - ! added back on are the true sedimentation tendencies. For cloud water, - ! this is the sum of rc_sed_tend and rc_sed_evap, and for cloud ice, this - ! is the sum of ri_sed_tend and ri_sed_subl. - rv_tend(:ncol,:) = rv_mc_tend(:ncol,:) - rc_tend(:ncol,:) = rc_mc_tend(:ncol,:) + ( rc_sed_tend(:ncol,:) + rc_sed_evap(:ncol,:) ) - if ( ixrain > 0 ) then - rr_tend(:ncol,:) = rr_mc_tend(:ncol,:) + rr_sed_tend(:ncol,:) - endif - ri_tend(:ncol,:) = ri_mc_tend(:ncol,:) + ( ri_sed_tend(:ncol,:) + ri_sed_subl(:ncol,:) ) - if ( ixsnow > 0 ) then - rs_tend(:ncol,:) = rs_mc_tend(:ncol,:) + rs_sed_tend(:ncol,:) - endif + subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) - ! Now that the original sedimentation tendency has been added to the - ! new microphysics process tendency, the new total microphysics tendency - ! can still cause holes to form. After the microphysics process rates were - ! adjusted, the values of the hydrometeor fields were greater than or equal - ! to 0 at all grid levels, which means their vertical integrals were also - ! greater than or equal to 0. Sedimentation by itself has a vertical - ! integral of 0 (including the amount that sedimented to the surface). - ! This means that after the microphysics process rates have been adjusted - ! and sedimentation has been added back on, the resulting hydrometeor - ! fields all still have vertical integrals that are greater than or equal - ! to 0. Holes that develop at any particular grid level can be filled. - ! These holes can be filled conservatively using the sedimentation hole - ! filler. - if ( l_sed_hole_fill ) then - - ! This section makes use of the following principle: - ! - ! 3) When adjusting the hydrometeor tendency from sedimentation of a - ! liquid hydrometeor (cloud water or rain water), conserve: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + precl * dt * 1000 = 0. - - ! Call the sedimentation hole filler for rain water mixing ratio. - ! This can update rr_tend and precl. - if ( ixrain > 0 ) then - call fill_holes_sedimentation( dt, ncol, rr_start, state%pdel, & - umr, state%zi, qmin(ixrain), & - rr_tend, precl ) - endif ! ixrain > 0 - - ! Call the sedimentation hole filler for cloud water mixing ratio. - ! This can update rc_tend and precl. - call fill_holes_sedimentation( dt, ncol, rc_start, state%pdel, & - vtrmc, state%zi, qmin(ixcldliq), & - rc_tend, precl ) - - ! Occasionally, a situation can occur where filling a hole in rain can - ! deplete all the surface liquid-phase precipitation (precl), resulting - ! in not enough water mass in the vertical profile of cloud water to - ! fill a hole in cloud water. When this happens, there must be liquid - ! water found in the vertical profile of rain, so pull the water from - ! rain to fill any remaining holes in cloud water. - if ( ixrain > 0 ) then - call fill_holes_same_phase_vert( dt, ncol, rc_start, rr_start, & - state%pdel, qmin(ixcldliq), & - qmin(ixrain), & - rc_tend, rr_tend ) - endif ! ixrain > 0 - - ! This section makes use of the following principle: - ! - ! 4) When adjusting the hydrometeor tendency from sedimentation of a - ! frozen hydrometeor (cloud ice or snow), conserve: - ! - ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + preci * dt * 1000 = 0. - - ! Call the sedimentation hole filler for snow mixing ratio. - ! This can update rs_tend and preci. - if ( ixsnow > 0 ) then - call fill_holes_sedimentation( dt, ncol, rs_start, state%pdel, & - ums, state%zi, qmin(ixsnow), & - rs_tend, preci ) - endif ! ixsnow > 0 - - ! Call the sedimentation hole filler for cloud ice mixing ratio. - ! This can update ri_tend and preci. - call fill_holes_sedimentation( dt, ncol, ri_start, state%pdel, & - vtrmi, state%zi, qmin(ixcldice), & - ri_tend, preci ) - - ! Occasionally, a situation can occur where filling a hole in snow can - ! deplete all the surface ice-phase precipitation (preci), resulting - ! in not enough water mass in the vertical profile of cloud ice to - ! fill a hole in cloud ice. When this happens, there must be ice-phase - ! water found in the vertical profile of snow, so pull the water from - ! snow to fill any remaining holes in cloud ice. - if ( ixsnow > 0 ) then - call fill_holes_same_phase_vert( dt, ncol, ri_start, rs_start, & - state%pdel, qmin(ixcldice), & - qmin(ixsnow), & - ri_tend, rs_tend ) - endif ! ixsnow > 0 - - ! Update the total precipitation rate (prect) from the updated liquid - ! precipitation rate (precl) and the updated frozen preciptation rate - ! (preci). - prect(:ncol) = precl(:ncol) + preci(:ncol) - - ! The MG code sets prec_str equal to prect (prec_pcw) and snow_str equal - ! to preci (snow_pcw). The prec_str and snow_str variables are used - ! in the calculations for energy and water conservation. Since prect - ! and preci are adjusted here, when necessary, prec_str and snow_str - ! also need to be adjusted. - prec_str(:ncol) = prect(:ncol) - snow_str(:ncol) = preci(:ncol) - - endif ! l_sed_hole_fill - - ! The updated total microphysics tendencies after hole filling have not - ! been used to update ptend yet, so record the budget terms for hole - ! filling first. - rv_hf_tend = rv_tend - ptend%q(:,:,1) - rc_hf_tend = rc_tend - ptend%q(:,:,ixcldliq) - if ( ixrain > 0 ) then - rr_hf_tend = rr_tend - ptend%q(:,:,ixrain) - endif ! ixrain > 0 - ri_hf_tend = ri_tend - ptend%q(:,:,ixcldice) - if ( ixsnow > 0 ) then - rs_hf_tend = rs_tend - ptend%q(:,:,ixsnow) - endif ! ixsnow > 0 - - ! The updated dry static energy tendency after hole filling has not been - ! used to update ptend yet, so record the budget term for hole filling - ! first. - s_hf_tend = stend - ptend%s - - ! Pack the current total tendencies for hydrometeor mixing ratio fields. - ptend%q(:,:,1) = rv_tend - ptend%q(:,:,ixcldliq) = rc_tend - if ( ixrain > 0 ) then - ptend%q(:,:,ixrain) = rr_tend - endif - ptend%q(:,:,ixcldice) = ri_tend - if ( ixsnow > 0 ) then - ptend%q(:,:,ixsnow) = rs_tend - endif + use clubb_api_module, only : T_in_K2thlm_api - ! Pack the current tendency for dry static energy. - ptend%s = stend - - ! Output stats for hole filling tendencies. - call outfld( 'QVHFTEN', rv_hf_tend, pcols, state%lchnk ) - call outfld( 'QCHFTEN', rc_hf_tend, pcols, state%lchnk ) - call outfld( 'QRHFTEN', rr_hf_tend, pcols, state%lchnk ) - call outfld( 'QIHFTEN', ri_hf_tend, pcols, state%lchnk ) - call outfld( 'QSHFTEN', rs_hf_tend, pcols, state%lchnk ) - call outfld( 'THFTEN', s_hf_tend / cpair, pcols, state%lchnk ) - - ! Perform total water and total energy conservation checks. - if ( l_check_conservation ) then - - ! Calculate total water in each grid column. - ! This calculation is the vertically-integrated grand total water - ! in each grid column updated for all microphysics and hole filling. - ! This includes the amount that precipitated to the surface. - do icol = 1, ncol - grand_total_water_column_finish(icol) = 0.0_r8 - do k = top_lev, pver - grand_total_water_column_finish(icol) & - = grand_total_water_column_finish(icol) & - + ( state%q(icol,k,1) & - + ptend%q(icol,k,1) * dt & - + state%q(icol,k,ixcldliq) & - + ptend%q(icol,k,ixcldliq) * dt & - + state%q(icol,k,ixcldice) & - + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) * rga - if ( ixrain > 0 ) then - grand_total_water_column_finish(icol) & - = grand_total_water_column_finish(icol) & - + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) * rga - endif - if ( ixsnow > 0 ) then - grand_total_water_column_finish(icol) & - = grand_total_water_column_finish(icol) & - + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) * rga - endif - end do ! k = top_lev, pver - grand_total_water_column_finish(icol) & - = grand_total_water_column_finish(icol) & - + prect(icol) * dt * 1000.0_r8 - end do ! icol = 1, ncol - - ! Calculate total energy in each column. - ! This calculation is the vertically-integrated total energy in each - ! grid column updated for all microphysics and hole filling. This - ! includes the amount that precipitated to the surface. Since, the - ! microphysics code does not directly change kinetic energy, - ! 0.5 * ( u^2 + v^2 ), it can be skipped as part of the energy - ! conservation check. - do icol = 1, ncol - total_energy_column_finish(icol) = 0.0_r8 - do k = top_lev, pver - total_energy_column_finish(icol) & - = total_energy_column_finish(icol) & - + ( state%s(icol,k) + ptend%s(icol,k) * dt & - + ( latvap + latice ) & - * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & - + latice * ( state%q(icol,k,ixcldliq) & - + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) * rga - if ( ixrain > 0 ) then - total_energy_column_finish(icol) & - = total_energy_column_finish(icol) & - + latice * ( state%q(icol,k,ixrain) & - + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) * rga - endif - end do ! k = top_lev, pver - total_energy_column_finish(icol) & - = total_energy_column_finish(icol) & - + latice * precl(icol) * dt * 1000.0_r8 - end do ! icol = 1, ncol - - ! Calculate the total relative error in each grid column. - do icol = 1, ncol - - tot_water_rel_err(icol) & - = abs( ( grand_total_water_column_finish(icol) & - - grand_total_water_column_start(icol) ) ) & - / min( grand_total_water_column_finish(icol), & - grand_total_water_column_start(icol) ) - - tot_energy_rel_err(icol) & - = abs( ( total_energy_column_finish(icol) & - - total_energy_column_start(icol) ) ) & - / min( total_energy_column_finish(icol), & - total_energy_column_start(icol) ) - - end do ! icol = 1, ncol - - ! Print an error message if any total water relative error is found to - ! be greater than the threshold. - if ( any( tot_water_rel_err(:ncol) >= err_thresh ) ) then - write(iulog,*) "Water conservation error reported in hole filling" - do icol = 1, ncol - if ( tot_water_rel_err(icol) >= err_thresh ) then - write(iulog,*) "Column = ", icol, & - "Relative error = ", tot_water_rel_err(icol), & - "Column-integrated grand total water at start = ", & - grand_total_water_column_start(icol), & - "Column-integrated grand total water at finish = ", & - grand_total_water_column_finish(icol) - endif ! tot_water_rel_err(icol) >= err_thresh - end do ! icol = 1, ncol - endif ! any( tot_water_rel_err >= err_thresh ) - - ! Print an error message if any total energy relative error is found to - ! be greater than the threshold. - if ( any( tot_energy_rel_err(:ncol) >= err_thresh ) ) then - write(iulog,*) "Energy conservation error reported in hole filling" - do icol = 1, ncol - if ( tot_energy_rel_err(icol) >= err_thresh ) then - write(iulog,*) "Column = ", icol, & - "Relative error = ", tot_energy_rel_err(icol), & - "Column-integrated total energy at start = ", & - total_energy_column_start(icol), & - "Column-integrated total energy at finish = ", & - total_energy_column_finish(icol) - endif ! tot_energy_rel_err(icol) >= err_thresh - end do ! icol = 1, ncol - endif ! any( tot_energy_rel_err >= err_thresh ) - - endif ! l_check_conservation - - - return - - end subroutine subcol_SILHS_fill_holes_conserv - - !============================================================================ - subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & - fallspeed_m_per_s, zi, qmin_hm, & - hm_tend, prec ) - - ! Description: - ! After hydrometeor tendencies from microphysics processes were adjusted - ! so that holes don't form in a hydrometeor field from microphysics - ! processes, the sedimentation tendency was added back on to produce an - ! updated total microphysics tendency. The first-order "up-gravity" - ! sedimentation method that was originally used is positive definite. - ! However, since the microphysics process tendencies were altered so that - ! holes don't form, it is possible that adding the old sedimentation - ! tendencies back onto the new microphysics process tendencies could - ! produce new total microphysics tendencies that cause holes to form. - ! - ! In this subroutine, holes in a hydrometeor field are checked for after - ! the updated microphysics tendency is applied. If any are found, they are - ! filled from positive hydrometeor mass found at grid levels below where - ! the hole is found. The levels that are used to fill are within range - ! based on fallspeed of the hydrometeor. If the level that contains the - ! hole is within proximity to the surface, then the water that sedimented - ! to the surface can be used to fill the hole, as well. - ! - ! If there isn't enough total hydrometeor mass within the fall range to - ! fill the hole, then positive hydrometeor mass from levels below the fall - ! range is to be added to the total available mass to fill the hole. Mass - ! is added one level at a time until enough mass is found to fill the hole - ! or until the surface is reached and the surface precipitation is added to - ! the total available fill mass. - ! - ! After this, if there still isn't enough available mass to fill the hole, - ! then positive hydrometeor mass is added from all levels above the hole to - ! the total mass that is available to fill the hole. + integer, intent(in) :: nz ! Num vert levels + real(r8), dimension(nz), intent(in) :: ABST_prof ! Abs Temp prof + real(r8), dimension(nz), intent(in) :: ex_prof ! Profile of Exner func + real(r8), dimension(nz), intent(in) :: rcm_prof ! Profile of Cld Wat MR + real(r8), dimension(nz), intent(out) :: THL_prof ! LWPT prof + integer :: i - !---------------------------------------------------------------------- + do i=1,nz + THL_prof(i) = T_in_K2thlm_api(ABST_prof(i), ex_prof(i), rcm_prof(i)) + end do + + end subroutine - use ppgrid, only: & - pcols + subroutine subcol_constrainmn( num_subcols, samples, weights, grid_mean, mean_sc, std_sc ) - use ref_pres, only: & - top_lev => trop_cloud_top_lev + ! Input/Output Variables + integer, intent(in) :: num_subcols + real(r8), dimension(num_subcols, pver), intent(inout) :: samples + real(r8), dimension(num_subcols), intent(in) :: weights + real(r8), dimension(pver), intent(in) :: grid_mean + real(r8), dimension(pver), intent(out), optional :: mean_sc, std_sc - implicit none + ! Local Variables + real(r8) :: meansc_loc, adj_rat + integer :: k + !------------------------------------------------------------------ + !----- Begin Code ----- + do k=1, pver + meansc_loc = meansc( samples(:,k), weights(:), real(num_subcols, r8) ) + + if (present(mean_sc)) & + mean_sc(k) = meansc_loc + if (present(std_sc)) & + std_sc(k) = stdsc( samples(:,k), weights(:), meansc_loc, & + real(num_subcols, r8) ) + + if ( meansc_loc > 0.0_r8 ) then + adj_rat = grid_mean(k)/meansc_loc + else + ! If the mean is zero, then zero out all subcolumns to avoid + ! negative samples + adj_rat = 0.0_r8 + end if + samples(:,k) = samples(:,k) * adj_rat + end do + end subroutine subcol_constrainmn - ! Input Variables - real(r8), intent(in) :: dt ! Time step duration +#endif + !============================================================================ + subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) + + ! The William F. Buckley Jr. Conservative Hole Filler. + + ! Description: + ! Stops holes from forming in a hydrometeor mixing ratio by reducing the + ! microphysics tendency of that hydrometeor mixing ratio which would + ! otherwise cause that hydrometeor mixing ratio to have a negative value + ! once the microphysics tendency is applied. This code is used to prevent + ! holes in water mass, not number concentration. + ! + ! This subroutine is called after microphysics has completed and after + ! microphysics fields from subcolumns have been averaged back to grid + ! columns, but before the grid-column microphysics tendencies have been + ! applied in physics_update. This code is meant for use with the SILHS + ! subcolumn approach. This code needs to be applied to grid columns, not + ! subcolumns. + ! + ! This code adjusts the tendencies (ptend) before they are used to update + ! the grid mean fields (state variables). + ! + ! The column-integrated total water needs to be conserved during + ! microphysics. The conserved amount includes the amount of water that + ! precipitated to the ground from sedimentation during microphysics. + ! The conservation equation for each grid column is: + ! + ! SUM(k=top_lev:pver) ( rv_start(k) + rc_start(k) + rr_start(k) + ! + ri_start(k) + rs_start(k) ) * pdel(k) / g + ! = SUM(k=top_lev:pver) ( rv(k) + rc(k) + rr(k) + ri(k) + rs(k) ) + ! * pdel(k) / g + ! + prect * dt * 1000; + ! + ! where rv_start, rc_start, rr_start, ri_start, and rs_start are water + ! vapor, cloud water, rain water, cloud ice, and snow mixing ratios before + ! microphysics is called; rv, rc, rr, ri, and rs are water vapor, cloud + ! water, rain water, cloud ice, and snow mixing ratios after being updated + ! by microphysics; pdel is the pressure difference between vertical levels, + ! g is gravity, and prect * dt * 1000 is the total amount of water (from + ! all precipitating hydrometeors) that sedimented to the ground during + ! microphysics (dt is the timestep used for microphysics). The units of + ! column-integrated total water are kg (water) / m^2. + ! + ! All the updated hydrometeor fields are related to the hydrometeor fields + ! at the start by: + ! + ! rv(k) = rv_start(k) + rv_tend(k) * dt; + ! rc(k) = rc_start(k) + rc_tend(k) * dt; + ! rr(k) = rr_start(k) + rr_tend(k) * dt; + ! ri(k) = ri_start(k) + ri_tend(k) * dt; and + ! rs(k) = rs_start(k) + rs_tend(k) * dt; + ! + ! where rv_tend, rc_tend, rr_tend, ri_tend, and rs_tend are water vapor, + ! cloud water, rain water, cloud ice, and snow mixing ratio tendencies + ! from microphysics, which includes the sum of microphysics process rates + ! and sedimentation. When these equations are applied to the equation + ! for column-integrated total water, that equation becomes: + ! + ! SUM(k=top_lev:pver) ( rv_tend(k) + rc_tend(k) + rr_tend(k) + ! + ri_tend(k) + rs_tend(k) ) * dt * pdel(k) / g + ! + prect * dt * 1000 = 0. + ! + ! As stated above, the hydrometeor tendencies are the sum of tendencies + ! from microphysics process rates and tendencies from sedimentation: + ! + ! rv_tend(k) = rv_mc_tend(k); + ! rc_tend(k) = rc_mc_tend(k) + rc_sed_tend(k); + ! rr_tend(k) = rr_mc_tend(k) + rr_sed_tend(k); + ! ri_tend(k) = ri_mc_tend(k) + ri_sed_tend(k); and + ! rs_tend(k) = rs_mc_tend(k) + rs_sed_tend(k); + ! + ! where rv_mc_tend, rc_mc_tend, rr_mc_tend, ri_mc_tend, and rs_mc_tend are + ! the tendencies of water vapor, cloud water, rain water, cloud ice, and + ! snow from microphysics process rates, and rc_sed_tend, rr_sed_tend, + ! ri_sed_tend, and rs_sed_tend are the tendencies of cloud water, + ! rain water, cloud ice, and snow from sedimentation. When these equations + ! are applied to the equation for column-integrated total water, that + ! equation becomes: + ! + ! SUM(k=top_lev:pver) ( rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) + ! + ri_mc_tend(k) + rs_mc_tend(k) ) + ! * dt * pdel(k) / g + ! + SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) + ri_sed_tend(k) + ! + rs_sed_tend(k) ) * dt * pdel(k) / g + ! + prect * dt * 1000 = 0. + ! + ! At any vertical level, the tendencies from microphysics process rates + ! (mc_tend variables) must balance: + ! + ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) + ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. + ! + ! The column-integrated total water equation can be applied to + ! sedimentation: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) + ri_sed_tend(k) + ! + rs_sed_tend(k) ) * dt * pdel(k) / g + ! + prect * dt * 1000 = 0. + ! + ! The total precipitation rate, prect, can be split into liquid + ! precipitation rate, precl, and frozen precipitation rate, preci: + ! + ! prect = precl + preci. + ! + ! The microphysics code outputs prect and preci, so precl can be calculated + ! by precl = prect - preci. The column-integrated total water equation can + ! be split into: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + precl * dt * 1000 = 0; and + ! + ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + preci * dt * 1000 = 0. + ! + ! Overall, the conservation methods used in this subroutine are: + ! + ! 1) When adjusting the tendencies from microphysics process rates, + ! conserve: + ! + ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) + ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. + ! + ! 2) When adjusting the tendencies from microphysics process rates, adjust + ! dry static energy appropriately. The change in dry static energy + ! is necessary because of phase changes. This "puts back" the extra dry + ! static energy that was "taken out" when an excessive phase-changing + ! process rate was produced by microphysics. + ! + ! 3) When adjusting the hydrometeor tendency from sedimentation of a + ! liquid hydrometeor (cloud water or rain water), conserve: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + precl * dt * 1000 = 0. + ! + ! 4) When adjusting the hydrometeor tendency from sedimentation of a + ! frozen hydrometeor (cloud ice or snow), conserve: + ! + ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + preci * dt * 1000 = 0. + ! + ! The conservative hole filler works as follows. The total microphysics + ! tendency for each hydrometeor is provided in ptend. This is the sum of + ! the microphysics process rate tendency and sedimentation tendency for + ! each hydrometeor. The sedimentation tendency is provided in pbuf. The + ! sedimentation tendency is subtracted off the total microphysics tendency + ! to produce the microphysics process rate tendency for each hydrometeor. + ! The microphysics process rate tendency is adjusted when necessary so that + ! holes in the hydrometeor are not produced by microphysics process rates. + ! When a hydrometeor's negative microphysics process rate tendency needs to + ! be made smaller in magnitude to avoid a hole, all hydrometeor tendencies + ! that are positive at that grid level are also decreased proportionately + ! to maintain a balance. Dry static energy tendency is also adjusted + ! appropriately when necessary. After this, the vertical integral of each + ! hydrometeor species is greater than or equal to 0. + ! + ! The sedimentation tendency is then added back onto the new microphysics + ! process rate tendency to produce a new total microphysics tendency for + ! each hydrometeor. Since the sedimentation tendency was based on the old + ! value of hydrometeor, before the hole-filling adjustment, it is possible + ! that the new total microphysics tendency may produce holes. When this + ! happens, sedimentation hole filling fills holes in the vertical profile + ! of each hydrometeor. Holes are filled using mass from other vertical + ! levels for the same hydrometeor (or from a same-phase hydrometeor when + ! necessary). Since the vertical integral of sedimentation tendency + ! (including surface precipitation rate) is 0, the vertical integral of the + ! hydrometeor must be greater than or equal to 0, which means that all + ! holes can be filled. The result is that all holes in any hydrometeor + ! mixing ratio are filled completely and conservatively. The value of + ! ptend is updated appropriately so that it can be applied later in + ! physics_update. + + !---------------------------------------------------------------------- + + use physics_buffer, only: & + physics_buffer_desc, & + pbuf_get_field + + use ppgrid, only: & + pcols + + use constituents, only: & + qmin + + use ref_pres, only: & + top_lev => trop_cloud_top_lev + + implicit none + + ! Input Variables + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: dt ! Time step duration + + ! Input/Output Variables + type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer + + ! Local Variables + real(r8), dimension(pcols,pver) :: & + rv_start, & ! Water vapor mixing ratio at start of microphysics [kg/kg] + rc_start, & ! Cloud water mixing ratio at start of microphysics [kg/kg] + rr_start, & ! Rain water mixing ratio at start of microphysics [kg/kg] + ri_start, & ! Cloud ice mixing ratio at start of microphysics [kg/kg] + rs_start ! Snow mixing ratio at start of microphysics [kg/kg] + + real(r8), dimension(pcols,pver) :: & + rv_tend, & ! Water vapor mixing ratio tendency [kg/kg/s] + rc_tend, & ! Cloud water mixing ratio tendency [kg/kg/s] + rr_tend, & ! Rain water mixing ratio tendency [kg/kg/s] + ri_tend, & ! Cloud ice mixing ratio tendency [kg/kg/s] + rs_tend, & ! Snow mixing ratio tendency [kg/kg/s] + stend ! Dry static energy tendency [J/kg/s] + + real(r8), dimension(:), pointer :: & + prect, & ! Total microphysics precipitation rate (surface) [m/s] + preci, & ! Ice-phase microphysics precipitation rate (surface) [m/s] + prec_str, & ! Total surface precipitation rate from stratoform [m/s] + snow_str ! Snow surface precipitation rate from stratoform [m/s] + + real(r8), dimension(:,:), pointer :: & + rc_sed_tend, & ! Mean cloud water sedimentation tendency [kg/kg/s] + rr_sed_tend, & ! Mean rain water sedimentation tendency [kg/kg/s] + ri_sed_tend, & ! Mean cloud ice sedimentation tendency [kg/kg/s] + rs_sed_tend, & ! Mean snow sedimentation tendency [kg/kg/s] + vtrmc, & ! Mean cloud water sedimentation velocity [m/s] + umr, & ! Mean rain water sedimentation velocity [m/s] + vtrmi, & ! Mean cloud ice sedimentation velocity [m/s] + ums, & ! Mean snow sedimentation velocity [m/s] + rc_sed_evap, & ! Mean evap of cloud water during sedimentation [kg/kg/s] + ri_sed_subl ! Mean subl of cloud ice during sedimentation [kg/kg/s] + + real(r8), dimension(pcols,pver) :: & + rv_mc_tend, & ! Water vapor mixing ratio microphysics tendency [kg/kg/s] + rc_mc_tend, & ! Cloud water mixing ratio microphysics tendency [kg/kg/s] + rr_mc_tend, & ! Rain water mixing ratio microphysics tendency [kg/kg/s] + ri_mc_tend, & ! Cloud ice mixing ratio microphysics tendency [kg/kg/s] + rs_mc_tend ! Snow mixing ratio microphysics tendency [kg/kg/s] + + real(r8) :: & + rv_curr, & ! Current water vapor mixing ratio [kg/kg] + rc_curr, & ! Current cloud water mixing ratio [kg/kg] + rr_curr, & ! Current rain water mixing ratio [kg/kg] + ri_curr, & ! Current cloud ice mixing ratio [kg/kg] + rs_curr ! Current snow mixing ratio [kg/kg] + + logical :: & + l_pos_rv_mc_tend, & ! Flag for positive water vapor mixing ratio mc tend. + l_pos_rc_mc_tend, & ! Flag for positive cloud water mixing ratio mc tend. + l_pos_rr_mc_tend, & ! Flag for positive rain water mixing ratio mc tend. + l_pos_ri_mc_tend, & ! Flag for positive cloud ice mixing ratio mc tend. + l_pos_rs_mc_tend ! Flag for positive snow mixing ratio mc tend. + + real(r8) :: & + mc_tend_max_mag, & ! Max. allowable mag. of (neg.) mc tend [kg/kg/s] + mc_tend_correction, & ! Amnt. correction necessary to mc tend [kg/kg/s] + total_mc_positive, & ! Total of all positive mc tendencies [kg/kg/s] + mc_correction_ratio ! Ratio: mc_tend_correction/total_mc_positive [-] + + real(r8), dimension(pcols) :: & + precl ! Liquid-phase precipitation rate (surface) [m/s] + + ! Budgeting terms for hole filling. + ! These variables are for use in stats output. + real(r8), dimension(pcols,pver) :: & + rv_hf_tend, & ! Water vapor mixing ratio hole-filling tendency [kg/kg/s] + rc_hf_tend, & ! Cloud water mixing ratio hole-filling tendency [kg/kg/s] + rr_hf_tend, & ! Rain water mixing ratio hole-filling tendency [kg/kg/s] + ri_hf_tend, & ! Cloud ice mixing ratio hole-filling tendency [kg/kg/s] + rs_hf_tend, & ! Snow mixing ratio hole-filling tendency [kg/kg/s] + s_hf_tend ! Dry static energy hole-filling tendency [J/kg/s] + + integer :: ncol ! Number of grid columns + + integer :: icol, k ! Loop indices + + ! Flag to perform hole filling after the original sedimentation tendency + ! is added back on to the new microphysics process tendency. This calls + ! the sedimentation hole filler. + logical, parameter :: & + l_sed_hole_fill = .true. + + logical, parameter :: & + l_check_conservation = .true. ! Flag to perform water conservation check + + ! Vertically-integrated grand total water (rv+rc+rr+ri+rs) [kg/m^2] + real(r8), dimension(pcols) :: & + grand_total_water_column_start, & ! Column integral at start + grand_total_water_column_finish ! Column integral at finish + + ! Vertically-integrated total water energy [J/m^2] + real(r8), dimension(pcols) :: & + total_energy_column_start, & ! Column integral at start + total_energy_column_finish ! Column integral at finish + + real(r8), dimension(pcols) :: & + tot_water_rel_err, & ! Relative error: vert-integrated grand total water + tot_energy_rel_err ! Relative error: vert-integrated total energy + + real(r8), parameter :: & + err_thresh = 1.0e-14_r8 ! Threshold of relative error + + + ! Get the number of grid columns. + ncol = state%ncol + + ! Get fields from the pbuf. + call pbuf_get_field(pbuf, prec_pcw_idx, prect) + call pbuf_get_field(pbuf, snow_pcw_idx, preci) + call pbuf_get_field(pbuf, prec_str_idx, prec_str) + call pbuf_get_field(pbuf, snow_str_idx, snow_str) + call pbuf_get_field(pbuf, qcsedten_idx, rc_sed_tend) + call pbuf_get_field(pbuf, qrsedten_idx, rr_sed_tend) + call pbuf_get_field(pbuf, qisedten_idx, ri_sed_tend) + call pbuf_get_field(pbuf, qssedten_idx, rs_sed_tend) + call pbuf_get_field(pbuf, vtrmc_idx, vtrmc) + call pbuf_get_field(pbuf, umr_idx, umr) + call pbuf_get_field(pbuf, vtrmi_idx, vtrmi) + call pbuf_get_field(pbuf, ums_idx, ums) + call pbuf_get_field(pbuf, qcsevap_idx, rc_sed_evap) + call pbuf_get_field(pbuf, qisevap_idx, ri_sed_subl) + + ! Calculate liquid precipitation rate (precl) from the total precipitation + ! rate (prect) and the frozen preciptation rate (preci). This should never + ! be negative, but just to be safe, threshold at 0. + precl(:ncol) = max( prect(:ncol) - preci(:ncol), 0.0_r8 ) + + ! Perform total water and total energy conservation checks. + if ( l_check_conservation ) then + + ! Calculate total water in each column. + ! This calculation is the vertically-integrated grand total water (where + ! grand total water is the sum of water vapor, cloud water, rain water, + ! cloud ice, and snow, as well as the amount of water that precipitated + ! to the surface) in each grid column after microphysics, but at the + ! start of hole filling. + do icol = 1, ncol + grand_total_water_column_start(icol) = 0.0_r8 + do k = top_lev, pver + grand_total_water_column_start(icol) & + = grand_total_water_column_start(icol) & + + ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt & + + state%q(icol,k,ixcldliq) & + + ptend%q(icol,k,ixcldliq) * dt & + + state%q(icol,k,ixcldice) & + + ptend%q(icol,k,ixcldice) * dt ) & + * state%pdel(icol,k) * rga + if ( ixrain > 0 ) then + grand_total_water_column_start(icol) & + = grand_total_water_column_start(icol) & + + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & + * state%pdel(icol,k) * rga + endif + if ( ixsnow > 0 ) then + grand_total_water_column_start(icol) & + = grand_total_water_column_start(icol) & + + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & + * state%pdel(icol,k) * rga + endif + end do ! k = top_lev, pver + grand_total_water_column_start(icol) & + = grand_total_water_column_start(icol) & + + prect(icol) * dt * 1000.0_r8 + end do ! icol = 1, ncol + + ! Calculate total energy in each column. + ! This calculation is the vertically-integrated total energy in each + ! grid column after microphysics, but at the start of hole filling. + ! Since the microphysics and hole filling code does not directly change + ! kinetic energy, 0.5 * ( u^2 + v^2 ), it can be skipped as part of the + ! energy conservation check. + do icol = 1, ncol + total_energy_column_start(icol) = 0.0_r8 + do k = top_lev, pver + total_energy_column_start(icol) & + = total_energy_column_start(icol) & + + ( state%s(icol,k) + ptend%s(icol,k) * dt & + + ( latvap + latice ) & + * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + + latice * ( state%q(icol,k,ixcldliq) & + + ptend%q(icol,k,ixcldliq) * dt ) ) & + * state%pdel(icol,k) * rga + if ( ixrain > 0 ) then + total_energy_column_start(icol) & + = total_energy_column_start(icol) & + + latice * ( state%q(icol,k,ixrain) & + + ptend%q(icol,k,ixrain) * dt ) & + * state%pdel(icol,k) * rga + endif + end do ! k = top_lev, pver + total_energy_column_start(icol) & + = total_energy_column_start(icol) & + + latice * precl(icol) * dt * 1000.0_r8 + end do ! icol = 1, ncol + + endif ! l_check_conservation + + ! The fields within state haven't been updated yet, since this is before + ! the call to physics_update. + rv_start = state%q(:,:,1) + rc_start = state%q(:,:,ixcldliq) + if ( ixrain > 0 ) then + rr_start = state%q(:,:,ixrain) + endif + ri_start = state%q(:,:,ixcldice) + if ( ixsnow > 0 ) then + rs_start = state%q(:,:,ixsnow) + endif + + ! Unpack the current total tendencies for hydrometeor mixing ratio fields. + rv_tend = ptend%q(:,:,1) + rc_tend = ptend%q(:,:,ixcldliq) + if ( ixrain > 0 ) then + rr_tend = ptend%q(:,:,ixrain) + endif + ri_tend = ptend%q(:,:,ixcldice) + if ( ixsnow > 0 ) then + rs_tend = ptend%q(:,:,ixsnow) + endif + + ! Unpack the current tendency for dry static energy. + stend = ptend%s + + ! The total hydrometeor tendencies are the sum of microphysics process + ! rates and sedimentation rates. Calculate the microphysics process + ! tendencies by subtracting the sedimentation tendencies from the overall + ! tendencies. + ! The sedimentation tendencies for cloud water (rc_sed_tend) and cloud ice + ! (ri_sed_tend) include the evaporation of cloud water during sedimentation + ! and the sublimation of cloud ice during sedimentation, respectively. The + ! true sedimentation of cloud water is the sum of rc_sed_tend and + ! rc_sed_evap, and the true sedimentation of cloud ice is the sum of + ! ri_sed_tend and ri_sed_subl. Subtract off only the true sedimentation + ! rates, as evaporation and sublimation need to be included in the + ! microphysics process rates. + rv_mc_tend(:ncol,:) = rv_tend(:ncol,:) + rc_mc_tend(:ncol,:) = rc_tend(:ncol,:) - ( rc_sed_tend(:ncol,:) + rc_sed_evap(:ncol,:) ) + if ( ixrain > 0 ) then + rr_mc_tend(:ncol,:) = rr_tend(:ncol,:) - rr_sed_tend(:ncol,:) + endif + ri_mc_tend(:ncol,:) = ri_tend(:ncol,:) - ( ri_sed_tend(:ncol,:) + ri_sed_subl(:ncol,:) ) + if ( ixsnow > 0 ) then + rs_mc_tend(:ncol,:) = rs_tend(:ncol,:) - rs_sed_tend(:ncol,:) + endif + + ! This section adjusts microphysics process rate tendencies so that the + ! resulting values of all hydrometeor mixing ratios are greater than or + ! equal to qmin after this section is complete. Once sedimentation is + ! added back on after this section, some of the hydrometeor mixing ratios + ! may become less than qmin again. + ! + ! This section, which again is concerned only with adjusting microphysics + ! process rates, makes use of the following two principles: + ! + ! 1) When adjusting the tendencies from microphysics process rates, + ! conserve: + ! + ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) + ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. + ! + ! 2) When adjusting the tendencies from microphysics process rates, adjust + ! dry static energy appropriately. The change in dry static energy + ! is necessary because of phase changes. This "puts back" the extra dry + ! static energy that was "taken out" when an excessive phase-changing + ! process rate was produced by microphysics. + + ! Loop over all columns, performing any tendency adjustments one column + ! at a time. + do icol = 1, ncol + + ! Loop over all vertical levels, performing any microphysics process + ! tendency adjustments one level at a time. + do k = top_lev, pver + + ! Find which hydrometeors have positive microphysics process + ! tendencies at this level. + if ( rv_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_rv_mc_tend = .true. + else + l_pos_rv_mc_tend = .false. + endif + if ( rc_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_rc_mc_tend = .true. + else + l_pos_rc_mc_tend = .false. + endif + if ( ixrain > 0 ) then + if ( rr_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_rr_mc_tend = .true. + else + l_pos_rr_mc_tend = .false. + endif + endif + if ( ri_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_ri_mc_tend = .true. + else + l_pos_ri_mc_tend = .false. + endif + if ( ixsnow > 0 ) then + if ( rs_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_rs_mc_tend = .true. + else + l_pos_rs_mc_tend = .false. + endif + endif + + !!! Check for holes in water vapor mixing ratio + if ( .not. l_pos_rv_mc_tend ) then + + ! Calculate the water vapor mixing ratio as it would be with the + ! current microphysics process tendency. + rv_curr = rv_start(icol,k) + rv_mc_tend(icol,k) * dt + + if ( rv_curr < qmin(1) ) then + + ! Microphysics processes are causing a hole in water vapor + ! mixing ratio. + + ! Calculate the maximum allowable magnitude of (negative) water + ! vapor microphysics process tendency. + mc_tend_max_mag = ( qmin(1) - rv_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the water vapor mixing ratio microphysics process + ! tendency. This number is positive. + mc_tend_correction = mc_tend_max_mag - rv_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rc_mc_tend ) then + total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) + endif + if ( l_pos_ri_mc_tend ) then + total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative water vapor mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of water vapor). + if ( l_pos_rc_mc_tend ) then + ! Changing cloud water to water vapor cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - latvap * mc_correction_ratio * rc_mc_tend(icol,k) + ! Update cloud water mixing ratio microphysics tendency. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + ! Changing rain water to water vapor cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - latvap * mc_correction_ratio * rr_mc_tend(icol,k) + ! Update rain water mixing ratio microphysics tendency. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_ri_mc_tend ) then + ! Changing cloud ice to water vapor cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - ( latvap + latice ) & + * mc_correction_ratio * ri_mc_tend(icol,k) + ! Update cloud ice mixing ratio microphysics tendency. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + ! Changing snow to water vapor cools and reduces dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + - ( latvap + latice ) & + * mc_correction_ratio * rs_mc_tend(icol,k) + ! Update snow mixing ratio microphysics tendency. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new water vapor mixing ratio microphysics + ! process tendency. This should be equal to the maximum + ! magnitude (negative) amount allowed, mc_tend_max_mag. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! rv_curr < qmin(1) + + endif ! .not. l_pos_rv_mc_tend + + !!! Check for holes in cloud water mixing ratio + if ( .not. l_pos_rc_mc_tend ) then + + ! Calculate the cloud water mixing ratio as it would be with the + ! current microphysics process tendency. + rc_curr = rc_start(icol,k) + rc_mc_tend(icol,k) * dt + + if ( rc_curr < qmin(ixcldliq) ) then + + ! Microphysics processes are causing a hole in cloud water + ! mixing ratio. + + ! Calculate the maximum allowable magnitude of (negative) cloud + ! water microphysics process tendency. + mc_tend_max_mag = ( qmin(ixcldliq) - rc_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the cloud water mixing ratio microphysics process + ! tendency. This number is positive. + mc_tend_correction = mc_tend_max_mag - rc_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rv_mc_tend ) then + total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) + endif + if ( l_pos_ri_mc_tend ) then + total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative cloud water mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of cloud water). + if ( l_pos_rv_mc_tend ) then + ! Changing water vapor to cloud water heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + latvap * mc_correction_ratio * rv_mc_tend(icol,k) + ! Update water vapor mixing ratio microphysics tendency. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + ! Changing rain water to cloud water does not change + ! dry static energy. + ! Update rain water mixing ratio microphysics tendency. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_ri_mc_tend ) then + ! Changing cloud ice to cloud water cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - latice * mc_correction_ratio * ri_mc_tend(icol,k) + ! Update cloud ice mixing ratio microphysics tendency. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + ! Changing snow to cloud water cools and reduces dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + - latice * mc_correction_ratio * rs_mc_tend(icol,k) + ! Update snow mixing ratio microphysics tendency. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new cloud water mixing ratio microphysics + ! process tendency. This should be equal to the maximum + ! magnitude (negative) amount allowed, mc_tend_max_mag. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! rc_curr < qmin(ixcldliq) + + endif ! .not. l_pos_rc_mc_tend + + !!! Check for holes in rain water mixing ratio + if ( ixrain > 0 .and. ( .not. l_pos_rr_mc_tend ) ) then + + ! Calculate the rain water mixing ratio as it would be with the + ! current microphysics process tendency. + rr_curr = rr_start(icol,k) + rr_mc_tend(icol,k) * dt + + if ( rr_curr < qmin(ixrain) ) then + + ! Microphysics processes are causing a hole in rain water + ! mixing ratio. + + ! Calculate the maximum allowable magnitude of (negative) rain + ! water microphysics process tendency. + mc_tend_max_mag = ( qmin(ixrain) - rr_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the rain water mixing ratio microphysics process + ! tendency. This number is positive. + mc_tend_correction = mc_tend_max_mag - rr_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rv_mc_tend ) then + total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) + endif + if ( l_pos_rc_mc_tend ) then + total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) + endif + if ( l_pos_ri_mc_tend ) then + total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative rain water mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of rain water). + if ( l_pos_rv_mc_tend ) then + ! Changing water vapor to rain water heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + latvap * mc_correction_ratio * rv_mc_tend(icol,k) + ! Update water vapor mixing ratio microphysics tendency. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_rc_mc_tend ) then + ! Changing cloud water to rain water does not change + ! dry static energy. + ! Update cloud water mixing ratio microphysics tendency. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_ri_mc_tend ) then + ! Changing cloud ice to rain water cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - latice * mc_correction_ratio * ri_mc_tend(icol,k) + ! Update cloud ice mixing ratio microphysics tendency. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + ! Changing snow to rain water cools and reduces dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + - latice * mc_correction_ratio * rs_mc_tend(icol,k) + ! Update snow mixing ratio microphysics tendency. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new rain water mixing ratio microphysics + ! process tendency. This should be equal to the maximum + ! magnitude (negative) amount allowed, mc_tend_max_mag. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! rr_curr < qmin(ixrain) + + endif ! ixrain > 0 .and. ( .not. l_pos_rr_mc_tend ) + + !!! Check for holes in cloud ice mixing ratio + if ( .not. l_pos_ri_mc_tend ) then + + ! Calculate the cloud ice mixing ratio as it would be with the + ! current microphysics process tendency. + ri_curr = ri_start(icol,k) + ri_mc_tend(icol,k) * dt + + if ( ri_curr < qmin(ixcldice) ) then + + ! Microphysics processes are causing a hole in cloud ice + ! mixing ratio. + + ! Calculate the maximum allowable magnitude of (negative) cloud + ! ice microphysics process tendency. + mc_tend_max_mag = ( qmin(ixcldice) - ri_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the cloud ice mixing ratio microphysics process + ! tendency. This number is positive. + mc_tend_correction = mc_tend_max_mag - ri_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rv_mc_tend ) then + total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) + endif + if ( l_pos_rc_mc_tend ) then + total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative cloud ice mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of cloud ice). + if ( l_pos_rv_mc_tend ) then + ! Changing water vapor to cloud ice heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + ( latvap + latice ) & + * mc_correction_ratio * rv_mc_tend(icol,k) + ! Update water vapor mixing ratio microphysics tendency. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_rc_mc_tend ) then + ! Changing cloud water to cloud ice heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + latice * mc_correction_ratio * rc_mc_tend(icol,k) + ! Update cloud water mixing ratio microphysics tendency. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + ! Changing rain water to cloud ice heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + latice * mc_correction_ratio * rr_mc_tend(icol,k) + ! Update rain water mixing ratio microphysics tendency. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + ! Changing snow to cloud ice does not change dry static + ! energy. + ! Update snow mixing ratio microphysics tendency. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new cloud ice mixing ratio microphysics + ! process tendency. This should be equal to the maximum + ! magnitude (negative) amount allowed, mc_tend_max_mag. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! ri_curr < qmin(ixcldice) + + endif ! .not. l_pos_ri_mc_tend + + !!! Check for holes in snow mixing ratio + if ( ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) ) then + + ! Calculate the snow mixing ratio as it would be with the + ! current microphysics process tendency. + rs_curr = rs_start(icol,k) + rs_mc_tend(icol,k) * dt + + if ( rs_curr < qmin(ixsnow) ) then + + ! Microphysics processes are causing a hole in snow mixing + ! ratio. + + ! Calculate the maximum allowable magnitude of (negative) snow + ! microphysics process tendency. + mc_tend_max_mag = ( qmin(ixsnow) - rs_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the snow mixing ratio microphysics process tendency. + ! This number is positive. + mc_tend_correction = mc_tend_max_mag - rs_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rv_mc_tend ) then + total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) + endif + if ( l_pos_rc_mc_tend ) then + total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) + endif + if ( l_pos_ri_mc_tend ) then + total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative snow mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of snow). + if ( l_pos_rv_mc_tend ) then + ! Changing water vapor to snow heats and increases dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + + ( latvap + latice ) & + * mc_correction_ratio * rv_mc_tend(icol,k) + ! Update water vapor mixing ratio microphysics tendency. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_rc_mc_tend ) then + ! Changing cloud water to snow heats and increases dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + + latice * mc_correction_ratio * rc_mc_tend(icol,k) + ! Update cloud water mixing ratio microphysics tendency. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + ! Changing rain water to snow heats and increases dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + + latice * mc_correction_ratio * rr_mc_tend(icol,k) + ! Update rain water mixing ratio microphysics tendency. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_ri_mc_tend ) then + ! Changing cloud ice to snow does not change dry static + ! energy. + ! Update cloud ice mixing ratio microphysics tendency. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new snow mixing ratio microphysics process + ! tendency. This should be equal to the maximum magnitude + ! (negative) amount allowed, mc_tend_max_mag. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! rs_curr < qmin(ixsnow) + + endif ! ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) + + end do ! k = top_lev, pver + + end do ! icol = 1, ncol + + ! Calculate the new overall tendencies by adding the sedimentation + ! tendencies back onto the new microphysics process tendencies. + ! For cloud water and cloud ice, the sedimentation tendencies that are + ! added back on are the true sedimentation tendencies. For cloud water, + ! this is the sum of rc_sed_tend and rc_sed_evap, and for cloud ice, this + ! is the sum of ri_sed_tend and ri_sed_subl. + rv_tend(:ncol,:) = rv_mc_tend(:ncol,:) + rc_tend(:ncol,:) = rc_mc_tend(:ncol,:) + ( rc_sed_tend(:ncol,:) + rc_sed_evap(:ncol,:) ) + if ( ixrain > 0 ) then + rr_tend(:ncol,:) = rr_mc_tend(:ncol,:) + rr_sed_tend(:ncol,:) + endif + ri_tend(:ncol,:) = ri_mc_tend(:ncol,:) + ( ri_sed_tend(:ncol,:) + ri_sed_subl(:ncol,:) ) + if ( ixsnow > 0 ) then + rs_tend(:ncol,:) = rs_mc_tend(:ncol,:) + rs_sed_tend(:ncol,:) + endif + + ! Now that the original sedimentation tendency has been added to the + ! new microphysics process tendency, the new total microphysics tendency + ! can still cause holes to form. After the microphysics process rates were + ! adjusted, the values of the hydrometeor fields were greater than or equal + ! to 0 at all grid levels, which means their vertical integrals were also + ! greater than or equal to 0. Sedimentation by itself has a vertical + ! integral of 0 (including the amount that sedimented to the surface). + ! This means that after the microphysics process rates have been adjusted + ! and sedimentation has been added back on, the resulting hydrometeor + ! fields all still have vertical integrals that are greater than or equal + ! to 0. Holes that develop at any particular grid level can be filled. + ! These holes can be filled conservatively using the sedimentation hole + ! filler. + if ( l_sed_hole_fill ) then + + ! This section makes use of the following principle: + ! + ! 3) When adjusting the hydrometeor tendency from sedimentation of a + ! liquid hydrometeor (cloud water or rain water), conserve: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + precl * dt * 1000 = 0. + + ! Call the sedimentation hole filler for rain water mixing ratio. + ! This can update rr_tend and precl. + if ( ixrain > 0 ) then + call fill_holes_sedimentation( dt, ncol, rr_start, state%pdel, & + umr, state%zi, qmin(ixrain), & + rr_tend, precl ) + endif ! ixrain > 0 + + ! Call the sedimentation hole filler for cloud water mixing ratio. + ! This can update rc_tend and precl. + call fill_holes_sedimentation( dt, ncol, rc_start, state%pdel, & + vtrmc, state%zi, qmin(ixcldliq), & + rc_tend, precl ) + + ! Occasionally, a situation can occur where filling a hole in rain can + ! deplete all the surface liquid-phase precipitation (precl), resulting + ! in not enough water mass in the vertical profile of cloud water to + ! fill a hole in cloud water. When this happens, there must be liquid + ! water found in the vertical profile of rain, so pull the water from + ! rain to fill any remaining holes in cloud water. + if ( ixrain > 0 ) then + call fill_holes_same_phase_vert( dt, ncol, rc_start, rr_start, & + state%pdel, qmin(ixcldliq), & + qmin(ixrain), & + rc_tend, rr_tend ) + endif ! ixrain > 0 + + ! This section makes use of the following principle: + ! + ! 4) When adjusting the hydrometeor tendency from sedimentation of a + ! frozen hydrometeor (cloud ice or snow), conserve: + ! + ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + preci * dt * 1000 = 0. + + ! Call the sedimentation hole filler for snow mixing ratio. + ! This can update rs_tend and preci. + if ( ixsnow > 0 ) then + call fill_holes_sedimentation( dt, ncol, rs_start, state%pdel, & + ums, state%zi, qmin(ixsnow), & + rs_tend, preci ) + endif ! ixsnow > 0 + + ! Call the sedimentation hole filler for cloud ice mixing ratio. + ! This can update ri_tend and preci. + call fill_holes_sedimentation( dt, ncol, ri_start, state%pdel, & + vtrmi, state%zi, qmin(ixcldice), & + ri_tend, preci ) + + ! Occasionally, a situation can occur where filling a hole in snow can + ! deplete all the surface ice-phase precipitation (preci), resulting + ! in not enough water mass in the vertical profile of cloud ice to + ! fill a hole in cloud ice. When this happens, there must be ice-phase + ! water found in the vertical profile of snow, so pull the water from + ! snow to fill any remaining holes in cloud ice. + if ( ixsnow > 0 ) then + call fill_holes_same_phase_vert( dt, ncol, ri_start, rs_start, & + state%pdel, qmin(ixcldice), & + qmin(ixsnow), & + ri_tend, rs_tend ) + endif ! ixsnow > 0 + + ! Update the total precipitation rate (prect) from the updated liquid + ! precipitation rate (precl) and the updated frozen preciptation rate + ! (preci). + prect(:ncol) = precl(:ncol) + preci(:ncol) + + ! The MG code sets prec_str equal to prect (prec_pcw) and snow_str equal + ! to preci (snow_pcw). The prec_str and snow_str variables are used + ! in the calculations for energy and water conservation. Since prect + ! and preci are adjusted here, when necessary, prec_str and snow_str + ! also need to be adjusted. + prec_str(:ncol) = prect(:ncol) + snow_str(:ncol) = preci(:ncol) + + endif ! l_sed_hole_fill + + ! The updated total microphysics tendencies after hole filling have not + ! been used to update ptend yet, so record the budget terms for hole + ! filling first. + rv_hf_tend = rv_tend - ptend%q(:,:,1) + rc_hf_tend = rc_tend - ptend%q(:,:,ixcldliq) + if ( ixrain > 0 ) then + rr_hf_tend = rr_tend - ptend%q(:,:,ixrain) + endif ! ixrain > 0 + ri_hf_tend = ri_tend - ptend%q(:,:,ixcldice) + if ( ixsnow > 0 ) then + rs_hf_tend = rs_tend - ptend%q(:,:,ixsnow) + endif ! ixsnow > 0 + + ! The updated dry static energy tendency after hole filling has not been + ! used to update ptend yet, so record the budget term for hole filling + ! first. + s_hf_tend = stend - ptend%s + + ! Pack the current total tendencies for hydrometeor mixing ratio fields. + ptend%q(:,:,1) = rv_tend + ptend%q(:,:,ixcldliq) = rc_tend + if ( ixrain > 0 ) then + ptend%q(:,:,ixrain) = rr_tend + endif + ptend%q(:,:,ixcldice) = ri_tend + if ( ixsnow > 0 ) then + ptend%q(:,:,ixsnow) = rs_tend + endif + + ! Pack the current tendency for dry static energy. + ptend%s = stend + + ! Output stats for hole filling tendencies. + call outfld( 'QVHFTEN', rv_hf_tend, pcols, state%lchnk ) + call outfld( 'QCHFTEN', rc_hf_tend, pcols, state%lchnk ) + call outfld( 'QRHFTEN', rr_hf_tend, pcols, state%lchnk ) + call outfld( 'QIHFTEN', ri_hf_tend, pcols, state%lchnk ) + call outfld( 'QSHFTEN', rs_hf_tend, pcols, state%lchnk ) + call outfld( 'THFTEN', s_hf_tend / cpair, pcols, state%lchnk ) + + ! Perform total water and total energy conservation checks. + if ( l_check_conservation ) then + + ! Calculate total water in each grid column. + ! This calculation is the vertically-integrated grand total water + ! in each grid column updated for all microphysics and hole filling. + ! This includes the amount that precipitated to the surface. + do icol = 1, ncol + grand_total_water_column_finish(icol) = 0.0_r8 + do k = top_lev, pver + grand_total_water_column_finish(icol) & + = grand_total_water_column_finish(icol) & + + ( state%q(icol,k,1) & + + ptend%q(icol,k,1) * dt & + + state%q(icol,k,ixcldliq) & + + ptend%q(icol,k,ixcldliq) * dt & + + state%q(icol,k,ixcldice) & + + ptend%q(icol,k,ixcldice) * dt ) & + * state%pdel(icol,k) * rga + if ( ixrain > 0 ) then + grand_total_water_column_finish(icol) & + = grand_total_water_column_finish(icol) & + + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & + * state%pdel(icol,k) * rga + endif + if ( ixsnow > 0 ) then + grand_total_water_column_finish(icol) & + = grand_total_water_column_finish(icol) & + + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & + * state%pdel(icol,k) * rga + endif + end do ! k = top_lev, pver + grand_total_water_column_finish(icol) & + = grand_total_water_column_finish(icol) & + + prect(icol) * dt * 1000.0_r8 + end do ! icol = 1, ncol + + ! Calculate total energy in each column. + ! This calculation is the vertically-integrated total energy in each + ! grid column updated for all microphysics and hole filling. This + ! includes the amount that precipitated to the surface. Since, the + ! microphysics code does not directly change kinetic energy, + ! 0.5 * ( u^2 + v^2 ), it can be skipped as part of the energy + ! conservation check. + do icol = 1, ncol + total_energy_column_finish(icol) = 0.0_r8 + do k = top_lev, pver + total_energy_column_finish(icol) & + = total_energy_column_finish(icol) & + + ( state%s(icol,k) + ptend%s(icol,k) * dt & + + ( latvap + latice ) & + * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + + latice * ( state%q(icol,k,ixcldliq) & + + ptend%q(icol,k,ixcldliq) * dt ) ) & + * state%pdel(icol,k) * rga + if ( ixrain > 0 ) then + total_energy_column_finish(icol) & + = total_energy_column_finish(icol) & + + latice * ( state%q(icol,k,ixrain) & + + ptend%q(icol,k,ixrain) * dt ) & + * state%pdel(icol,k) * rga + endif + end do ! k = top_lev, pver + total_energy_column_finish(icol) & + = total_energy_column_finish(icol) & + + latice * precl(icol) * dt * 1000.0_r8 + end do ! icol = 1, ncol + + ! Calculate the total relative error in each grid column. + do icol = 1, ncol + + tot_water_rel_err(icol) & + = abs( ( grand_total_water_column_finish(icol) & + - grand_total_water_column_start(icol) ) ) & + / min( grand_total_water_column_finish(icol), & + grand_total_water_column_start(icol) ) + + tot_energy_rel_err(icol) & + = abs( ( total_energy_column_finish(icol) & + - total_energy_column_start(icol) ) ) & + / min( total_energy_column_finish(icol), & + total_energy_column_start(icol) ) + + end do ! icol = 1, ncol + + ! Print an error message if any total water relative error is found to + ! be greater than the threshold. + if ( any( tot_water_rel_err(:ncol) >= err_thresh ) ) then + write(iulog,*) "Water conservation error reported in hole filling" + do icol = 1, ncol + if ( tot_water_rel_err(icol) >= err_thresh ) then + write(iulog,*) "Column = ", icol, & + "Relative error = ", tot_water_rel_err(icol), & + "Column-integrated grand total water at start = ", & + grand_total_water_column_start(icol), & + "Column-integrated grand total water at finish = ", & + grand_total_water_column_finish(icol) + endif ! tot_water_rel_err(icol) >= err_thresh + end do ! icol = 1, ncol + endif ! any( tot_water_rel_err >= err_thresh ) + + ! Print an error message if any total energy relative error is found to + ! be greater than the threshold. + if ( any( tot_energy_rel_err(:ncol) >= err_thresh ) ) then + write(iulog,*) "Energy conservation error reported in hole filling" + do icol = 1, ncol + if ( tot_energy_rel_err(icol) >= err_thresh ) then + write(iulog,*) "Column = ", icol, & + "Relative error = ", tot_energy_rel_err(icol), & + "Column-integrated total energy at start = ", & + total_energy_column_start(icol), & + "Column-integrated total energy at finish = ", & + total_energy_column_finish(icol) + endif ! tot_energy_rel_err(icol) >= err_thresh + end do ! icol = 1, ncol + endif ! any( tot_energy_rel_err >= err_thresh ) + + endif ! l_check_conservation + + + return + + end subroutine subcol_SILHS_fill_holes_conserv + + !============================================================================ + subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & + fallspeed_m_per_s, zi, qmin_hm, & + hm_tend, prec ) + + ! Description: + ! After hydrometeor tendencies from microphysics processes were adjusted + ! so that holes don't form in a hydrometeor field from microphysics + ! processes, the sedimentation tendency was added back on to produce an + ! updated total microphysics tendency. The first-order "up-gravity" + ! sedimentation method that was originally used is positive definite. + ! However, since the microphysics process tendencies were altered so that + ! holes don't form, it is possible that adding the old sedimentation + ! tendencies back onto the new microphysics process tendencies could + ! produce new total microphysics tendencies that cause holes to form. + ! + ! In this subroutine, holes in a hydrometeor field are checked for after + ! the updated microphysics tendency is applied. If any are found, they are + ! filled from positive hydrometeor mass found at grid levels below where + ! the hole is found. The levels that are used to fill are within range + ! based on fallspeed of the hydrometeor. If the level that contains the + ! hole is within proximity to the surface, then the water that sedimented + ! to the surface can be used to fill the hole, as well. + ! + ! If there isn't enough total hydrometeor mass within the fall range to + ! fill the hole, then positive hydrometeor mass from levels below the fall + ! range is to be added to the total available mass to fill the hole. Mass + ! is added one level at a time until enough mass is found to fill the hole + ! or until the surface is reached and the surface precipitation is added to + ! the total available fill mass. + ! + ! After this, if there still isn't enough available mass to fill the hole, + ! then positive hydrometeor mass is added from all levels above the hole to + ! the total mass that is available to fill the hole. + + !---------------------------------------------------------------------- + + use ppgrid, only: & + pcols + + use ref_pres, only: & + top_lev => trop_cloud_top_lev + + implicit none + + ! Input Variables + real(r8), intent(in) :: dt ! Time step duration + + integer, intent(in) :: ncol ! Number of grid columns + + real(r8), dimension(pcols,pver), intent(in) :: & + hm_start, & ! Hydrometeor mixing ratio at start of microphysics [kg/kg] + pdel ! Pressure difference between grid levels [Pa] + + real(r8), dimension(pcols,pver), intent(in) :: & + fallspeed_m_per_s ! Hydrometeor mixing ratio fall speed [m/s] + + real(r8), dimension(pcols,pverp), intent(in) :: & + zi ! Height of momentum (interface) grid levels [m] + + real(r8), intent(in) :: & + qmin_hm ! Minimum threshold value of hydrometeor mixing ratio [kg/kg] + + ! Input/Output Variables + real(r8), dimension(pcols,pver), intent(inout) :: & + hm_tend ! Hydrometeor mixing ratio tendency [kg/kg/s] + + real(r8), dimension(pcols), intent(inout) :: & + prec ! Precipitation rate (surface) [m/s] + + ! Local Variables + real(r8), dimension(pver) :: & + hm_update, & ! Hydrometeor mixing ratio; start of sed. hole fill [kg/kg] + hm_curr ! Current value of hydrometeor mixing ratio [kg/kg] + + real(r8) :: & + total_hole, & ! Total mass of hole in hydrometeor [kg/m^2] + total_fill_mass, & ! Total mass available to fill hole [kg/m^2] + hole_fillmass_ratio, & ! Ratio: total_hole / total_fill_mass [-] + fallspeed_Pa_per_s, & ! Hydrometeor mixing ratio fall speed [Pa/s] + total_fall_Pa, & ! Pressure "distance" hydrometeor fell [Pa] + sum_pdel ! Sum of pdel over levels [Pa] + + logical, dimension(pver) :: & + l_pos_hm ! Flag for a hydrometeor having a positive (>= qmin_hm) value + + ! Flag for whether surface precipitation mass needs to be included in + ! the total_fill_mass for hole filling. + logical :: l_reached_surface + + ! Flag for whether hydrometeor mass from levels above the hole needs to be + ! included in the total_fill_mass for hole filling. + logical :: l_fill_from_above + + integer :: icol ! Grid column index + + integer :: k, idx ! Vertical grid level indices + + ! Index of the lowest vertical grid level that needs to be included in the + ! total_fill_mass for hole filling. + integer :: lowest_level_idx + + + ! Loop over all columns, performing any adjustments one column at a time. + do icol = 1, ncol + + ! Calculate the updated value of the hydrometeor field based on the + ! updated microphysics tendency. Since the original sedimentation + ! tendency has been added to the updated microphysics process tendency + ! to produce the updated total microphysics tendency (hm_tend), the + ! updated value of the hydrometeor field (hm_update) could be negative. + hm_update = hm_start(icol,:) + hm_tend(icol,:) * dt + hm_curr = hm_update + + ! Check for any holes in the vertical profile + if ( any( hm_curr(top_lev:pver) < qmin_hm ) ) then - integer, intent(in) :: ncol ! Number of grid columns + ! At least one hole is found in this hydrometeor species in this + ! grid column. The holes must be filled conservatively. - real(r8), dimension(pcols,pver), intent(in) :: & - hm_start, & ! Hydrometeor mixing ratio at start of microphysics [kg/kg] - pdel ! Pressure difference between grid levels [Pa] + ! Check which levels have values of the hydrometeor that are at or + ! above the minimum threshold value. + do k = top_lev, pver + if ( hm_curr(k) >= qmin_hm ) then + l_pos_hm(k) = .true. + else ! hm_curr < qmin_hm + l_pos_hm(k) = .false. + endif ! hm_curr >= qmin_hm + end do ! k = top_lev, pver - real(r8), dimension(pcols,pver), intent(in) :: & - fallspeed_m_per_s ! Hydrometeor mixing ratio fall speed [m/s] + do k = pver, top_lev, -1 + + if ( .not. l_pos_hm(k) ) then + + ! A hole is found in the hydrometeor at this grid level. + + ! Calculate the total hydrometeor mass of the hole that needs + ! to be filled. + ! The value of the hydrometeor mixing ratio is negative, but + ! the value of total_hole is positive. + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga + + ! Calculate the total hydrometeor mass available from below + ! to fill the hole. + if ( k == pver ) then + + ! A hole is found at the lowermost level. + ! The only place the hydrometeor could have sedimented + ! to is the surface, so fill from only the surface. + l_reached_surface = .true. + + ! Calculate the available amount of hydrometeor mass to + ! fill the hole. + total_fill_mass = prec(icol) * dt * 1000.0_r8 + + else ! top_lev <= k < pver + + ! Calculate the hydrometeor fallspeed in Pa/s. + ! In MG2, the equation for this is given by: + ! + ! fallspeed([Pa/s]) = g * rho * fallspeed([m/s]). + ! + ! The value of rho is typically calculated from the + ! hydrostatic approximation: + ! + ! rho = - ( 1 / g ) * dp/dz. + ! + ! The equation for fallspeed in Pa/s becomes: + ! + ! fallspeed([Pa/s]) = - dp/dz * fallspeed([m/s]). + fallspeed_Pa_per_s & + = fallspeed_m_per_s(icol,k) & + * pdel(icol,k) / ( zi(icol,k) - zi(icol,k+1) ) + + ! Calculate the fall "distance" in Pa. + total_fall_Pa = fallspeed_Pa_per_s * dt + + ! Find the index of the vertical level that the hydrometeor + ! sedimented to in one timestep. It must sediment at least + ! one level. + sum_pdel = 0.0_r8 + idx = k + 1 + do + ! Update the total pressure difference between the + ! level of origin and the current level. + sum_pdel = sum_pdel + pdel(icol,idx) + if ( sum_pdel >= total_fall_Pa ) then + ! The total pressure difference between the level of + ! origin and the current level exceeds the total + ! hydrometeor fall "distance" (in Pa). + lowest_level_idx = idx + l_reached_surface = .false. + exit + else ! sum_pdel < total_fall_Pa + ! The total hydrometeor fall "distance" (in Pa) + ! exceeds the total pressure difference between the + ! level of origin and the current level. + if ( idx == pver ) then + ! The lowest level of the model has been reached. + ! The hydrometeor sedimented to the surface. + lowest_level_idx = pver + l_reached_surface = .true. + exit + else ! idx < pver + ! Increment idx and keep going. + idx = idx + 1 + endif ! idx == pver + endif ! sum_pdel >= total_fall_Pa + end do + + ! Calculate the available amount of hydrometeor mass to + ! fill the hole. + total_fill_mass = 0.0_r8 + if ( l_reached_surface ) then + ! The hydrometeor sedimented to the surface, so + ! automatically loop down to pver and include the + ! surface mass. + do idx = k+1, pver, 1 + if ( l_pos_hm(idx) ) then + total_fill_mass & + = total_fill_mass & + + ( hm_curr(idx) - qmin_hm ) & + * pdel(icol,idx) * rga + endif ! l_pos_hm(idx) + end do ! idx = k+1, pver, 1 + ! Contribution to total fill mass from the surface. + total_fill_mass & + = total_fill_mass + prec(icol) * dt * 1000.0_r8 + else ! .not. l_reached_surface + ! The hydrometeor sedimented to lowest_level_idx. + idx = k + 1 + do + if ( l_pos_hm(idx) ) then + total_fill_mass & + = total_fill_mass & + + ( hm_curr(idx) - qmin_hm ) & + * pdel(icol,idx) * rga + endif ! l_pos_hm(idx) + if ( idx >= lowest_level_idx ) then + ! Check if enough mass has been gathered in + ! total_fill_mass to fill the hole. + if ( total_fill_mass >= total_hole ) then + ! There has been enough total_fill_mass + ! gathered to completely fill the hole. + lowest_level_idx = idx + exit + else ! total_fill_mass < total_hole + ! Even though lowest_level_idx has been reached, + ! more total_fill_mass needs to be added in + ! order to completely fill the hole, so keep + ! going. + if ( idx == pver ) then + ! The lowest vertical level has already been + ! reached, so go to the surface. + lowest_level_idx = pver + l_reached_surface = .true. + ! Contribution to total fill mass from the + ! surface. + total_fill_mass & + = total_fill_mass & + + prec(icol) * dt * 1000.0_r8 + exit + else ! idx < pver + ! Haven't reached pver yet, so increment + ! and keep going. + idx = idx + 1 + endif ! idx == pver + endif ! total_fill_mass >= total_hole + else ! idx < lowest_level_idx + ! Haven't reached lowest_level_idx yet, so + ! increment and keep going. + idx = idx + 1 + endif ! idx >= lowest_level_idx + end do + endif ! l_reached_surface + + endif ! k == pver + + ! If mass has been added all the way down to the surface and + ! there's still not enough mass to fill the hole, then fill the + ! hole pulling mass from above. + if ( total_fill_mass >= total_hole ) then + l_fill_from_above = .false. + else ! total_fill_mass < total_hole + l_fill_from_above = .true. + do idx = top_lev, k-1, 1 + if ( l_pos_hm(idx) ) then + total_fill_mass & + = total_fill_mass & + + ( hm_curr(idx) - qmin_hm ) & + * pdel(icol,idx) * rga + endif ! l_pos_hm(idx) + end do ! idx = top_lev, k-1, 1 + endif ! total_fill_mass >= total_hole + + ! Calculate the ratio of total hole to total fill mass. This + ! should not exceed 1 except as a result of numerical round-off + ! errors. Use thresholding to be safe. + hole_fillmass_ratio & + = min( total_hole / max( total_fill_mass, 1.0e-30_r8 ), & + 1.0_r8 ) + + if ( k < pver ) then + ! Modify (reduce) the amount of the hydrometeor at levels + ! that were used to fill the hole. + do idx = k+1, lowest_level_idx + if ( l_pos_hm(idx) ) then + ! Since pdel at a grid level does not change and + ! gravit is constant, the only variable that needs to + ! be modified proportionately is hm_curr. + hm_curr(idx) & + = qmin_hm & + + ( hm_curr(idx) - qmin_hm ) & + * ( 1.0_r8 - hole_fillmass_ratio ) + endif ! l_pos_hm(idx) + end do ! idx = k+1, lowest_level_idx + endif ! k < pver + + if ( l_reached_surface ) then + ! Modify (reduce) the amount of surface precipitation in + ! order to fill the hole. Since dt and 1000 are constants, + ! the only variable that needs to be modified + ! proportionately is prec. + prec(icol) = prec(icol) * ( 1.0_r8 - hole_fillmass_ratio ) + endif ! l_reached_surface + + if ( l_fill_from_above ) then + ! Modify (reduce) the amount of the hydrometeor at levels + ! that were used to fill the hole. + do idx = top_lev, k-1 + if ( l_pos_hm(idx) ) then + ! Since pdel at a grid level does not change and + ! gravit is constant, the only variable that needs to + ! be modified proportionately is hm_curr. + hm_curr(idx) & + = qmin_hm & + + ( hm_curr(idx) - qmin_hm ) & + * ( 1.0_r8 - hole_fillmass_ratio ) + endif ! l_pos_hm(idx) + end do ! idx = top_lev, k-1 + endif ! l_fill_from_above + + ! Update the value of the hydrometeor at the level where the + ! hole was found. Mathematically, as long as the available + ! mass was able to fill the entire hole, the new value of the + ! hydrometeor mixing ratio (hm_curr) should be qmin_hm. + hm_curr(k) & + = hm_curr(k) & + + hole_fillmass_ratio * total_fill_mass & + * gravit / pdel(icol,k) + + endif ! .not. l_pos_hm(k) + + end do ! k = pver, top_lev, -1 + + endif ! any( hm_curr(top_lev:pver) < qmin_hm ) + + ! Update the value of total microphysics tendency after hole filling. + hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt + + end do ! icol = 1, ncol + + + return + + end subroutine fill_holes_sedimentation + + !============================================================================ + subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & + pdel, qmin_hm, qmin_hm_filler, & + hm_tend, hm_tend_filler ) + + ! Description: + ! Fills remaining holes in a hydrometeor with mass from the the vertical + ! profile of another hydrometeor of the same phase. Remaining holes in + ! cloud water are filled with rain water and remaining holes in snow are + ! filled with cloud ice. + ! + ! This subroutine, combined with subroutine fill_holes_sedimentation, fill + ! holes making use of the following principles: + ! + ! 3) When adjusting the hydrometeor tendency from sedimentation of a + ! liquid hydrometeor (cloud water or rain water), conserve: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + precl * dt * 1000 = 0. + ! + ! 4) When adjusting the hydrometeor tendency from sedimentation of a + ! frozen hydrometeor (cloud ice or snow), conserve: + ! + ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + preci * dt * 1000 = 0. + ! + ! These two equations (one for liquid-phase hydrometeors and one for + ! ice-phase hydrometeors) could be further split into one equation for + ! each hydrometeor if there was prec output for each hydrometeor. However, + ! there's only prec output for ice-phase precipitation rate and total + ! precipitation rate (liquid preciptation rate is total rate minus + ! ice-phase rate). + ! + ! Since only liquid-phase precipitation rate (precl) and ice-phase + ! precipitation rate (preci) are available, and there are two hydrometeors + ! in each category, one hydrometeor from each category must fill before + ! the other hydrometeor from its category and get priority access to precl + ! or preci. Since a vast majority of liquid precipitation comes from rain + ! rather than sedimenting cloud water, rain is filled before cloud water + ! and gets priority access to precl. Likewise, since a vast majority of + ! frozen precipitation comes from snow rather than sedimenting cloud ice, + ! snow is filled before cloud ice and gets priority access to preci. + ! + ! The order of sedimentation hole filling is as follows. First, a level + ! with a hole in it is identified. The fall distance for the hydrometeor + ! that originated at a level is calculated. Total mass to fill the hole is + ! calculated from all levels within the fall range that have positive + ! values of the hydrometeor. The amount that precipitated to the surface + ! is also included if the hydrometeor fell that far. If that isn't enough + ! mass to fill the hole, then levels that are lower in the profile are + ! included (if the hydrometeor has a positive value) until enough mass is + ! found to fill the hole or until the surface is reached. If there isn't + ! enough mass found in all levels below the hole, including the amount that + ! precipitated to the ground, to fill the hole, then the hydrometeor mass + ! from all levels above the hole (again, where a positive value of the + ! hydrometeor is found) are included in the total available mass to fill + ! the hole. + ! + ! Occasionally, a situation can occur where both hydrometeors in a category + ! contributed to surface precipitation rate, and filling a hole in rain + ! (or snow) can deplete all the surface precl (or preci), resulting in not + ! enough water mass in the vertical profile (including the surface) of + ! cloud water (or cloud ice) to fill a hole in cloud water (or cloud ice). + ! When this happens, there must still be liquid water (or frozen water) + ! found in the vertical profile of rain (or snow), so pull the water from + ! rain (or snow) to fill any remaining holes in cloud water (or cloud ice). + + !---------------------------------------------------------------------- + + use ppgrid, only: & + pcols + + use ref_pres, only: & + top_lev => trop_cloud_top_lev + + implicit none + + ! Input Variables + real(r8), intent(in) :: dt ! Time step duration + + integer, intent(in) :: ncol ! Number of grid columns + + real(r8), dimension(pcols,pver), intent(in) :: & + hm_start, & ! Hydrometeor mixing ratio (microphys start) [kg/kg] + hm_start_filler, & ! Filler hydromet mix ratio (microphys start) [kg/kg] + pdel ! Pressure difference between grid levels [Pa] + + real(r8), intent(in) :: & + qmin_hm, & ! Minimum threshold hydrometeor mixing ratio [kg/kg] + qmin_hm_filler ! Min threshold filler hydromet mixing ratio [kg/kg] + + ! Input/Output Variables + real(r8), dimension(pcols,pver), intent(inout) :: & + hm_tend, & ! Hydrometeor mixing ratio tendency [kg/kg/s] + hm_tend_filler ! Filler hydrometeor mixing ratio tendency [kg/kg/s] + + ! Local Variables + real(r8), dimension(pver) :: & + hm_update, & ! Hydrometeor mixing ratio; start [kg/kg] + hm_update_filler, & ! Filler Hydrometeor mixing ratio; start [kg/kg] + hm_curr, & ! Current hydrometeor mixing ratio [kg/kg] + hm_curr_filler ! Current filler hydrometeor mixing ratio [kg/kg] + + real(r8) :: & + total_hole, & ! Total mass of hole in hydrometeor [kg/m^2] + total_fill_mass, & ! Total mass available to fill hole [kg/m^2] + hole_fillmass_ratio ! Ratio: total_hole / total_fill_mass [-] + + logical, dimension(pver) :: & + l_pos_hm, & ! Flag: hydrometeor has positive (>= qmin_hm) value + l_pos_hm_filler ! Flag: filler hydrometeor has positive value + + integer :: icol ! Grid column index + + integer :: k, idx ! Vertical grid level indices + + + ! Loop over all columns, performing any adjustments one column at a time. + do icol = 1, ncol + + ! Calculate the updated value of the hydrometeor field based on the + ! updated microphysics tendency. + hm_update = hm_start(icol,:) + hm_tend(icol,:) * dt + hm_curr = hm_update + + ! Calculate the updated value of the filler hydrometeor field based on + ! the updated microphysics tendency. + hm_update_filler = hm_start_filler(icol,:) + hm_tend_filler(icol,:) * dt + hm_curr_filler = hm_update_filler + + ! Check for any holes in the vertical profile + if ( any( hm_curr(top_lev:pver) < qmin_hm ) ) then + + ! At least one hole is found in this hydrometeor species in this + ! grid column. The holes must be filled conservatively. + + ! Check which levels have values of the hydrometeor that are at or + ! above the minimum threshold value. + do k = top_lev, pver + ! Check for the hydrometeor that might need to be filled. + if ( hm_curr(k) >= qmin_hm ) then + l_pos_hm(k) = .true. + else ! hm_curr < qmin_hm + l_pos_hm(k) = .false. + endif ! hm_curr >= qmin_hm + ! Check for the filler hydrometeor, as some levels might have + ! numerical round-off level, small negative values. + if ( hm_curr_filler(k) >= qmin_hm_filler ) then + l_pos_hm_filler(k) = .true. + else ! hm_curr_filler < qmin_hm_filler + l_pos_hm_filler(k) = .false. + endif ! hm_curr_filler >= qmin_hm_filler + end do ! k = top_lev, pver - real(r8), dimension(pcols,pverp), intent(in) :: & - zi ! Height of momentum (interface) grid levels [m] + do k = top_lev, pver - real(r8), intent(in) :: & - qmin_hm ! Minimum threshold value of hydrometeor mixing ratio [kg/kg] + if ( .not. l_pos_hm(k) ) then - ! Input/Output Variables - real(r8), dimension(pcols,pver), intent(inout) :: & - hm_tend ! Hydrometeor mixing ratio tendency [kg/kg/s] + ! A hole is found in the hydrometeor at this grid level. - real(r8), dimension(pcols), intent(inout) :: & - prec ! Precipitation rate (surface) [m/s] + ! Calculate the total hydrometeor mass of the hole that needs + ! to be filled. + ! The value of the hydrometeor mixing ratio is negative, but + ! the value of total_hole is positive. + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga - ! Local Variables - real(r8), dimension(pver) :: & - hm_update, & ! Hydrometeor mixing ratio; start of sed. hole fill [kg/kg] - hm_curr ! Current value of hydrometeor mixing ratio [kg/kg] - - real(r8) :: & - total_hole, & ! Total mass of hole in hydrometeor [kg/m^2] - total_fill_mass, & ! Total mass available to fill hole [kg/m^2] - hole_fillmass_ratio, & ! Ratio: total_hole / total_fill_mass [-] - fallspeed_Pa_per_s, & ! Hydrometeor mixing ratio fall speed [Pa/s] - total_fall_Pa, & ! Pressure "distance" hydrometeor fell [Pa] - sum_pdel ! Sum of pdel over levels [Pa] - - logical, dimension(pver) :: & - l_pos_hm ! Flag for a hydrometeor having a positive (>= qmin_hm) value - - ! Flag for whether surface precipitation mass needs to be included in - ! the total_fill_mass for hole filling. - logical :: l_reached_surface - - ! Flag for whether hydrometeor mass from levels above the hole needs to be - ! included in the total_fill_mass for hole filling. - logical :: l_fill_from_above - - integer :: icol ! Grid column index - - integer :: k, idx ! Vertical grid level indices - - ! Index of the lowest vertical grid level that needs to be included in the - ! total_fill_mass for hole filling. - integer :: lowest_level_idx - - - ! Loop over all columns, performing any adjustments one column at a time. - do icol = 1, ncol - - ! Calculate the updated value of the hydrometeor field based on the - ! updated microphysics tendency. Since the original sedimentation - ! tendency has been added to the updated microphysics process tendency - ! to produce the updated total microphysics tendency (hm_tend), the - ! updated value of the hydrometeor field (hm_update) could be negative. - hm_update = hm_start(icol,:) + hm_tend(icol,:) * dt - hm_curr = hm_update - - ! Check for any holes in the vertical profile - if ( any( hm_curr(top_lev:pver) < qmin_hm ) ) then - - ! At least one hole is found in this hydrometeor species in this - ! grid column. The holes must be filled conservatively. - - ! Check which levels have values of the hydrometeor that are at or - ! above the minimum threshold value. - do k = top_lev, pver - if ( hm_curr(k) >= qmin_hm ) then - l_pos_hm(k) = .true. - else ! hm_curr < qmin_hm - l_pos_hm(k) = .false. - endif ! hm_curr >= qmin_hm - end do ! k = top_lev, pver - - do k = pver, top_lev, -1 - - if ( .not. l_pos_hm(k) ) then - - ! A hole is found in the hydrometeor at this grid level. - - ! Calculate the total hydrometeor mass of the hole that needs - ! to be filled. - ! The value of the hydrometeor mixing ratio is negative, but - ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga - - ! Calculate the total hydrometeor mass available from below - ! to fill the hole. - if ( k == pver ) then - - ! A hole is found at the lowermost level. - ! The only place the hydrometeor could have sedimented - ! to is the surface, so fill from only the surface. - l_reached_surface = .true. - - ! Calculate the available amount of hydrometeor mass to - ! fill the hole. - total_fill_mass = prec(icol) * dt * 1000.0_r8 - - else ! top_lev <= k < pver - - ! Calculate the hydrometeor fallspeed in Pa/s. - ! In MG2, the equation for this is given by: - ! - ! fallspeed([Pa/s]) = g * rho * fallspeed([m/s]). - ! - ! The value of rho is typically calculated from the - ! hydrostatic approximation: - ! - ! rho = - ( 1 / g ) * dp/dz. - ! - ! The equation for fallspeed in Pa/s becomes: - ! - ! fallspeed([Pa/s]) = - dp/dz * fallspeed([m/s]). - fallspeed_Pa_per_s & - = fallspeed_m_per_s(icol,k) & - * pdel(icol,k) / ( zi(icol,k) - zi(icol,k+1) ) - - ! Calculate the fall "distance" in Pa. - total_fall_Pa = fallspeed_Pa_per_s * dt - - ! Find the index of the vertical level that the hydrometeor - ! sedimented to in one timestep. It must sediment at least - ! one level. - sum_pdel = 0.0_r8 - idx = k + 1 - do - ! Update the total pressure difference between the - ! level of origin and the current level. - sum_pdel = sum_pdel + pdel(icol,idx) - if ( sum_pdel >= total_fall_Pa ) then - ! The total pressure difference between the level of - ! origin and the current level exceeds the total - ! hydrometeor fall "distance" (in Pa). - lowest_level_idx = idx - l_reached_surface = .false. - exit - else ! sum_pdel < total_fall_Pa - ! The total hydrometeor fall "distance" (in Pa) - ! exceeds the total pressure difference between the - ! level of origin and the current level. - if ( idx == pver ) then - ! The lowest level of the model has been reached. - ! The hydrometeor sedimented to the surface. - lowest_level_idx = pver - l_reached_surface = .true. - exit - else ! idx < pver - ! Increment idx and keep going. - idx = idx + 1 - endif ! idx == pver - endif ! sum_pdel >= total_fall_Pa - end do - - ! Calculate the available amount of hydrometeor mass to - ! fill the hole. - total_fill_mass = 0.0_r8 - if ( l_reached_surface ) then - ! The hydrometeor sedimented to the surface, so - ! automatically loop down to pver and include the - ! surface mass. - do idx = k+1, pver, 1 - if ( l_pos_hm(idx) ) then - total_fill_mass & - = total_fill_mass & - + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) * rga - endif ! l_pos_hm(idx) - end do ! idx = k+1, pver, 1 - ! Contribution to total fill mass from the surface. + ! Calculate the total hydrometeor mass available from the + ! filler hydrometeor to fill the hole. + total_fill_mass = 0.0_r8 + do idx = top_lev, pver, 1 + if ( l_pos_hm_filler(idx) ) then total_fill_mass & - = total_fill_mass + prec(icol) * dt * 1000.0_r8 - else ! .not. l_reached_surface - ! The hydrometeor sedimented to lowest_level_idx. - idx = k + 1 - do - if ( l_pos_hm(idx) ) then - total_fill_mass & - = total_fill_mass & - + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) * rga - endif ! l_pos_hm(idx) - if ( idx >= lowest_level_idx ) then - ! Check if enough mass has been gathered in - ! total_fill_mass to fill the hole. - if ( total_fill_mass >= total_hole ) then - ! There has been enough total_fill_mass - ! gathered to completely fill the hole. - lowest_level_idx = idx - exit - else ! total_fill_mass < total_hole - ! Even though lowest_level_idx has been reached, - ! more total_fill_mass needs to be added in - ! order to completely fill the hole, so keep - ! going. - if ( idx == pver ) then - ! The lowest vertical level has already been - ! reached, so go to the surface. - lowest_level_idx = pver - l_reached_surface = .true. - ! Contribution to total fill mass from the - ! surface. - total_fill_mass & - = total_fill_mass & - + prec(icol) * dt * 1000.0_r8 - exit - else ! idx < pver - ! Haven't reached pver yet, so increment - ! and keep going. - idx = idx + 1 - endif ! idx == pver - endif ! total_fill_mass >= total_hole - else ! idx < lowest_level_idx - ! Haven't reached lowest_level_idx yet, so - ! increment and keep going. - idx = idx + 1 - endif ! idx >= lowest_level_idx - end do - endif ! l_reached_surface - - endif ! k == pver - - ! If mass has been added all the way down to the surface and - ! there's still not enough mass to fill the hole, then fill the - ! hole pulling mass from above. - if ( total_fill_mass >= total_hole ) then - l_fill_from_above = .false. - else ! total_fill_mass < total_hole - l_fill_from_above = .true. - do idx = top_lev, k-1, 1 - if ( l_pos_hm(idx) ) then - total_fill_mass & - = total_fill_mass & - + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) * rga - endif ! l_pos_hm(idx) - end do ! idx = top_lev, k-1, 1 - endif ! total_fill_mass >= total_hole - - ! Calculate the ratio of total hole to total fill mass. This - ! should not exceed 1 except as a result of numerical round-off - ! errors. Use thresholding to be safe. - hole_fillmass_ratio & - = min( total_hole / max( total_fill_mass, 1.0e-30_r8 ), & - 1.0_r8 ) - - if ( k < pver ) then - ! Modify (reduce) the amount of the hydrometeor at levels - ! that were used to fill the hole. - do idx = k+1, lowest_level_idx - if ( l_pos_hm(idx) ) then - ! Since pdel at a grid level does not change and - ! gravit is constant, the only variable that needs to - ! be modified proportionately is hm_curr. - hm_curr(idx) & - = qmin_hm & - + ( hm_curr(idx) - qmin_hm ) & - * ( 1.0_r8 - hole_fillmass_ratio ) - endif ! l_pos_hm(idx) - end do ! idx = k+1, lowest_level_idx - endif ! k < pver - - if ( l_reached_surface ) then - ! Modify (reduce) the amount of surface precipitation in - ! order to fill the hole. Since dt and 1000 are constants, - ! the only variable that needs to be modified - ! proportionately is prec. - prec(icol) = prec(icol) * ( 1.0_r8 - hole_fillmass_ratio ) - endif ! l_reached_surface - - if ( l_fill_from_above ) then - ! Modify (reduce) the amount of the hydrometeor at levels - ! that were used to fill the hole. - do idx = top_lev, k-1 - if ( l_pos_hm(idx) ) then - ! Since pdel at a grid level does not change and - ! gravit is constant, the only variable that needs to - ! be modified proportionately is hm_curr. - hm_curr(idx) & - = qmin_hm & - + ( hm_curr(idx) - qmin_hm ) & - * ( 1.0_r8 - hole_fillmass_ratio ) - endif ! l_pos_hm(idx) - end do ! idx = top_lev, k-1 - endif ! l_fill_from_above - - ! Update the value of the hydrometeor at the level where the - ! hole was found. Mathematically, as long as the available - ! mass was able to fill the entire hole, the new value of the - ! hydrometeor mixing ratio (hm_curr) should be qmin_hm. - hm_curr(k) & - = hm_curr(k) & - + hole_fillmass_ratio * total_fill_mass & - * gravit / pdel(icol,k) - - endif ! .not. l_pos_hm(k) - - end do ! k = pver, top_lev, -1 - - endif ! any( hm_curr(top_lev:pver) < qmin_hm ) - - ! Update the value of total microphysics tendency after hole filling. - hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt - - end do ! icol = 1, ncol - - - return - - end subroutine fill_holes_sedimentation - - !============================================================================ - subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & - pdel, qmin_hm, qmin_hm_filler, & - hm_tend, hm_tend_filler ) - - ! Description: - ! Fills remaining holes in a hydrometeor with mass from the the vertical - ! profile of another hydrometeor of the same phase. Remaining holes in - ! cloud water are filled with rain water and remaining holes in snow are - ! filled with cloud ice. - ! - ! This subroutine, combined with subroutine fill_holes_sedimentation, fill - ! holes making use of the following principles: - ! - ! 3) When adjusting the hydrometeor tendency from sedimentation of a - ! liquid hydrometeor (cloud water or rain water), conserve: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + precl * dt * 1000 = 0. - ! - ! 4) When adjusting the hydrometeor tendency from sedimentation of a - ! frozen hydrometeor (cloud ice or snow), conserve: - ! - ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + preci * dt * 1000 = 0. - ! - ! These two equations (one for liquid-phase hydrometeors and one for - ! ice-phase hydrometeors) could be further split into one equation for - ! each hydrometeor if there was prec output for each hydrometeor. However, - ! there's only prec output for ice-phase precipitation rate and total - ! precipitation rate (liquid preciptation rate is total rate minus - ! ice-phase rate). - ! - ! Since only liquid-phase precipitation rate (precl) and ice-phase - ! precipitation rate (preci) are available, and there are two hydrometeors - ! in each category, one hydrometeor from each category must fill before - ! the other hydrometeor from its category and get priority access to precl - ! or preci. Since a vast majority of liquid precipitation comes from rain - ! rather than sedimenting cloud water, rain is filled before cloud water - ! and gets priority access to precl. Likewise, since a vast majority of - ! frozen precipitation comes from snow rather than sedimenting cloud ice, - ! snow is filled before cloud ice and gets priority access to preci. - ! - ! The order of sedimentation hole filling is as follows. First, a level - ! with a hole in it is identified. The fall distance for the hydrometeor - ! that originated at a level is calculated. Total mass to fill the hole is - ! calculated from all levels within the fall range that have positive - ! values of the hydrometeor. The amount that precipitated to the surface - ! is also included if the hydrometeor fell that far. If that isn't enough - ! mass to fill the hole, then levels that are lower in the profile are - ! included (if the hydrometeor has a positive value) until enough mass is - ! found to fill the hole or until the surface is reached. If there isn't - ! enough mass found in all levels below the hole, including the amount that - ! precipitated to the ground, to fill the hole, then the hydrometeor mass - ! from all levels above the hole (again, where a positive value of the - ! hydrometeor is found) are included in the total available mass to fill - ! the hole. - ! - ! Occasionally, a situation can occur where both hydrometeors in a category - ! contributed to surface precipitation rate, and filling a hole in rain - ! (or snow) can deplete all the surface precl (or preci), resulting in not - ! enough water mass in the vertical profile (including the surface) of - ! cloud water (or cloud ice) to fill a hole in cloud water (or cloud ice). - ! When this happens, there must still be liquid water (or frozen water) - ! found in the vertical profile of rain (or snow), so pull the water from - ! rain (or snow) to fill any remaining holes in cloud water (or cloud ice). + = total_fill_mass & + + ( hm_curr_filler(idx) - qmin_hm_filler ) & + * pdel(icol,idx) * rga + endif ! l_pos_hm_filler(idx) + end do ! idx = top_lev, pver, 1 + + ! Calculate the ratio of total hole to total fill mass. This + ! should not exceed 1 except as a result of numerical round-off + ! errors. Use thresholding to be safe. + hole_fillmass_ratio & + = min( total_hole / max( total_fill_mass, 1.0e-30_r8 ), & + 1.0_r8 ) + + ! Modify (reduce) the amount of the filler hydrometeor. + do idx = top_lev, pver + if ( l_pos_hm_filler(idx) ) then + ! Since pdel at a grid level does not change and gravit + ! is constant, the only variable that needs to be + ! modified proportionately is hm_curr_filler. + hm_curr_filler(idx) & + = qmin_hm_filler & + + ( hm_curr_filler(idx) - qmin_hm_filler ) & + * ( 1.0_r8 - hole_fillmass_ratio ) + endif ! l_pos_hm_filler(idx) + end do ! idx = top_lev, pver + + ! Update the value of the hydrometeor at the level where the + ! hole was found. Mathematically, as long as the available + ! mass was able to fill the entire hole, the new value of the + ! hydrometeor mixing ratio (hm_curr) should be qmin_hm. + hm_curr(k) & + = hm_curr(k) & + + hole_fillmass_ratio * total_fill_mass & + * gravit / pdel(icol,k) + + endif ! .not. l_pos_hm(k) - !---------------------------------------------------------------------- + end do ! k = top_lev, pver - use ppgrid, only: & - pcols + endif ! any( hm_curr(top_lev:pver) < qmin_hm ) - use ref_pres, only: & - top_lev => trop_cloud_top_lev + ! Update the value of total microphysics tendency after hole filling. + hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt - implicit none + ! Update the value of total microphysics tendency after hole filling for + ! the filler hydrometeor. + hm_tend_filler(icol,:) & + = hm_tend_filler(icol,:) + ( hm_curr_filler - hm_update_filler ) / dt - ! Input Variables - real(r8), intent(in) :: dt ! Time step duration + end do ! icol = 1, ncol - integer, intent(in) :: ncol ! Number of grid columns - real(r8), dimension(pcols,pver), intent(in) :: & - hm_start, & ! Hydrometeor mixing ratio (microphys start) [kg/kg] - hm_start_filler, & ! Filler hydromet mix ratio (microphys start) [kg/kg] - pdel ! Pressure difference between grid levels [Pa] + return - real(r8), intent(in) :: & - qmin_hm, & ! Minimum threshold hydrometeor mixing ratio [kg/kg] - qmin_hm_filler ! Min threshold filler hydromet mixing ratio [kg/kg] + end subroutine fill_holes_same_phase_vert - ! Input/Output Variables - real(r8), dimension(pcols,pver), intent(inout) :: & - hm_tend, & ! Hydrometeor mixing ratio tendency [kg/kg/s] - hm_tend_filler ! Filler hydrometeor mixing ratio tendency [kg/kg/s] + !============================================================================ + subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) - ! Local Variables - real(r8), dimension(pver) :: & - hm_update, & ! Hydrometeor mixing ratio; start [kg/kg] - hm_update_filler, & ! Filler Hydrometeor mixing ratio; start [kg/kg] - hm_curr, & ! Current hydrometeor mixing ratio [kg/kg] - hm_curr_filler ! Current filler hydrometeor mixing ratio [kg/kg] - - real(r8) :: & - total_hole, & ! Total mass of hole in hydrometeor [kg/m^2] - total_fill_mass, & ! Total mass available to fill hole [kg/m^2] - hole_fillmass_ratio ! Ratio: total_hole / total_fill_mass [-] - - logical, dimension(pver) :: & - l_pos_hm, & ! Flag: hydrometeor has positive (>= qmin_hm) value - l_pos_hm_filler ! Flag: filler hydrometeor has positive value - - integer :: icol ! Grid column index - - integer :: k, idx ! Vertical grid level indices - - - ! Loop over all columns, performing any adjustments one column at a time. - do icol = 1, ncol - - ! Calculate the updated value of the hydrometeor field based on the - ! updated microphysics tendency. - hm_update = hm_start(icol,:) + hm_tend(icol,:) * dt - hm_curr = hm_update - - ! Calculate the updated value of the filler hydrometeor field based on - ! the updated microphysics tendency. - hm_update_filler = hm_start_filler(icol,:) + hm_tend_filler(icol,:) * dt - hm_curr_filler = hm_update_filler - - ! Check for any holes in the vertical profile - if ( any( hm_curr(top_lev:pver) < qmin_hm ) ) then - - ! At least one hole is found in this hydrometeor species in this - ! grid column. The holes must be filled conservatively. - - ! Check which levels have values of the hydrometeor that are at or - ! above the minimum threshold value. - do k = top_lev, pver - ! Check for the hydrometeor that might need to be filled. - if ( hm_curr(k) >= qmin_hm ) then - l_pos_hm(k) = .true. - else ! hm_curr < qmin_hm - l_pos_hm(k) = .false. - endif ! hm_curr >= qmin_hm - ! Check for the filler hydrometeor, as some levels might have - ! numerical round-off level, small negative values. - if ( hm_curr_filler(k) >= qmin_hm_filler ) then - l_pos_hm_filler(k) = .true. - else ! hm_curr_filler < qmin_hm_filler - l_pos_hm_filler(k) = .false. - endif ! hm_curr_filler >= qmin_hm_filler - end do ! k = top_lev, pver - - do k = top_lev, pver - - if ( .not. l_pos_hm(k) ) then - - ! A hole is found in the hydrometeor at this grid level. - - ! Calculate the total hydrometeor mass of the hole that needs - ! to be filled. - ! The value of the hydrometeor mixing ratio is negative, but - ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga - - ! Calculate the total hydrometeor mass available from the - ! filler hydrometeor to fill the hole. - total_fill_mass = 0.0_r8 - do idx = top_lev, pver, 1 - if ( l_pos_hm_filler(idx) ) then - total_fill_mass & - = total_fill_mass & - + ( hm_curr_filler(idx) - qmin_hm_filler ) & - * pdel(icol,idx) * rga - endif ! l_pos_hm_filler(idx) - end do ! idx = top_lev, pver, 1 - - ! Calculate the ratio of total hole to total fill mass. This - ! should not exceed 1 except as a result of numerical round-off - ! errors. Use thresholding to be safe. - hole_fillmass_ratio & - = min( total_hole / max( total_fill_mass, 1.0e-30_r8 ), & - 1.0_r8 ) - - ! Modify (reduce) the amount of the filler hydrometeor. - do idx = top_lev, pver - if ( l_pos_hm_filler(idx) ) then - ! Since pdel at a grid level does not change and gravit - ! is constant, the only variable that needs to be - ! modified proportionately is hm_curr_filler. - hm_curr_filler(idx) & - = qmin_hm_filler & - + ( hm_curr_filler(idx) - qmin_hm_filler ) & - * ( 1.0_r8 - hole_fillmass_ratio ) - endif ! l_pos_hm_filler(idx) - end do ! idx = top_lev, pver + ! Description: + ! Limits the values of mean hydrometeor concentrations so that the mean + ! drop size for the hydrometeor type remains reasonable and does not become + ! too large. - ! Update the value of the hydrometeor at the level where the - ! hole was found. Mathematically, as long as the available - ! mass was able to fill the entire hole, the new value of the - ! hydrometeor mixing ratio (hm_curr) should be qmin_hm. - hm_curr(k) & - = hm_curr(k) & - + hole_fillmass_ratio * total_fill_mass & - * gravit / pdel(icol,k) + !---------------------------------------------------------------------- - endif ! .not. l_pos_hm(k) + use shr_const_mod, only: & + shr_const_pi, & + shr_const_rhofw - end do ! k = top_lev, pver + use constituents, only: & + qmin - endif ! any( hm_curr(top_lev:pver) < qmin_hm ) + use ref_pres, only: & + top_lev => trop_cloud_top_lev - ! Update the value of total microphysics tendency after hole filling. - hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt + implicit none - ! Update the value of total microphysics tendency after hole filling for - ! the filler hydrometeor. - hm_tend_filler(icol,:) & - = hm_tend_filler(icol,:) + ( hm_curr_filler - hm_update_filler ) / dt + ! Input Variables + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: dt ! Time step duration - end do ! icol = 1, ncol + ! Input/Output Variable + type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies + ! Local Variables + real( r8 ) :: & + rcm_update, & ! New value of mean cloud water mixing ratio [kg/kg] + rrm_update, & ! New value of mean rain water mixing ratio [kg/kg] + rim_update, & ! New value of mean ice mixing ratio [kg/kg] + rsm_update ! New value of mean snow mixing ratio [kg/kg] - return + real( r8 ) :: & + Nc_tend_min, & ! Minimum value of cloud droplet conc. tendency [num/kg/s] + Nr_tend_min, & ! Minimum value of rain drop conc. tendency [num/kg/s] + Ni_tend_min, & ! Minimum value of ice conc. tendency [num/kg/s] + Ns_tend_min ! Minimum value of snow conc. tendency [num/kg/s] - end subroutine fill_holes_same_phase_vert + real( r8 ), parameter :: & + four_thirds = 4.0_r8/3.0_r8, & ! 4/3 + rho_ice = 917.0_r8, & ! Density of ice [kg/m^3] + rho_lw = shr_const_rhofw, & ! Density of liquid water [kg/m^3] + pi = shr_const_pi ! Pi - !============================================================================ - subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) + real( r8 ), parameter :: & + mvr_cloud_max = 1.6E-5_r8, & ! Max. avg. mean vol. rad. cloud [m] + mvr_rain_max = 5.0E-3_r8, & ! Max. avg. mean vol. rad. rain [m] + mvr_ice_max = 1.3E-4_r8, & ! Max. avg. mean vol. rad. ice [m] + mvr_snow_max = 1.0E-2_r8 ! Max. avg. mean vol. rad. snow [m] - ! Description: - ! Limits the values of mean hydrometeor concentrations so that the mean - ! drop size for the hydrometeor type remains reasonable and does not become - ! too large. + ! Calculate the coefficient for the minimum mean cloud droplet + ! concentration, where |_min = Ncm_min_coef * and has units of + ! 1/kg. + real( r8 ), parameter :: & + Ncm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_lw * mvr_cloud_max**3 ) - !---------------------------------------------------------------------- + ! Calculate the coefficient for the minimum mean rain drop concentration, + ! where |_min = Nrm_min_coef * and has units of 1/kg. + real( r8 ), parameter :: & + Nrm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_lw * mvr_rain_max**3 ) - use shr_const_mod, only: & - shr_const_pi, & - shr_const_rhofw + ! Calculate the coefficient for the minimum mean ice crystal concentration, + ! where |_min = Nim_min_coef * and has units of 1/kg. + real( r8 ), parameter :: & + Nim_min_coef = 1.0_r8 / ( four_thirds * pi * rho_ice * mvr_ice_max**3 ) - use constituents, only: & - qmin + ! Calculate the coefficient for the minimum mean snow flake concentration, + ! where |_min = Nsm_min_coef * and has units of 1/kg. + real( r8 ), parameter :: & + Nsm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_ice * mvr_snow_max**3 ) - use ref_pres, only: & - top_lev => trop_cloud_top_lev + integer :: ncol ! Number of grid columns - implicit none + integer :: icol ! Column loop index - ! Input Variables - type(physics_state), intent(in) :: state ! Physics state variables - real(r8), intent(in) :: dt ! Time step duration + integer :: k ! Vertical level loop index - ! Input/Output Variable - type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies - ! Local Variables - real( r8 ) :: & - rcm_update, & ! New value of mean cloud water mixing ratio [kg/kg] - rrm_update, & ! New value of mean rain water mixing ratio [kg/kg] - rim_update, & ! New value of mean ice mixing ratio [kg/kg] - rsm_update ! New value of mean snow mixing ratio [kg/kg] - - real( r8 ) :: & - Nc_tend_min, & ! Minimum value of cloud droplet conc. tendency [num/kg/s] - Nr_tend_min, & ! Minimum value of rain drop conc. tendency [num/kg/s] - Ni_tend_min, & ! Minimum value of ice conc. tendency [num/kg/s] - Ns_tend_min ! Minimum value of snow conc. tendency [num/kg/s] - - real( r8 ), parameter :: & - four_thirds = 4.0_r8/3.0_r8, & ! 4/3 - rho_ice = 917.0_r8, & ! Density of ice [kg/m^3] - rho_lw = shr_const_rhofw, & ! Density of liquid water [kg/m^3] - pi = shr_const_pi ! Pi - - real( r8 ), parameter :: & - mvr_cloud_max = 1.6E-5_r8, & ! Max. avg. mean vol. rad. cloud [m] - mvr_rain_max = 5.0E-3_r8, & ! Max. avg. mean vol. rad. rain [m] - mvr_ice_max = 1.3E-4_r8, & ! Max. avg. mean vol. rad. ice [m] - mvr_snow_max = 1.0E-2_r8 ! Max. avg. mean vol. rad. snow [m] - - ! Calculate the coefficient for the minimum mean cloud droplet - ! concentration, where |_min = Ncm_min_coef * and has units of - ! 1/kg. - real( r8 ), parameter :: & - Ncm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_lw * mvr_cloud_max**3 ) - - ! Calculate the coefficient for the minimum mean rain drop concentration, - ! where |_min = Nrm_min_coef * and has units of 1/kg. - real( r8 ), parameter :: & - Nrm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_lw * mvr_rain_max**3 ) - - ! Calculate the coefficient for the minimum mean ice crystal concentration, - ! where |_min = Nim_min_coef * and has units of 1/kg. - real( r8 ), parameter :: & - Nim_min_coef = 1.0_r8 / ( four_thirds * pi * rho_ice * mvr_ice_max**3 ) - - ! Calculate the coefficient for the minimum mean snow flake concentration, - ! where |_min = Nsm_min_coef * and has units of 1/kg. - real( r8 ), parameter :: & - Nsm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_ice * mvr_snow_max**3 ) - - integer :: ncol ! Number of grid columns - - integer :: icol ! Column loop index - - integer :: k ! Vertical level loop index - - - ! Get the number of grid columns. - ncol = state%ncol + ! Get the number of grid columns. + ncol = state%ncol - ! Loop over all grid columns. - do icol = 1, ncol + ! Loop over all grid columns. + do icol = 1, ncol - ! Loop over all vertical levels from top_lev to pver. - do k = top_lev, pver + ! Loop over all vertical levels from top_lev to pver. + do k = top_lev, pver - ! Cloud droplet concentration - if ( ixcldliq > 0 .and. ixnumliq > 0 ) then + ! Cloud droplet concentration + if ( ixcldliq > 0 .and. ixnumliq > 0 ) then - ! Calculate the value of cloud water mixing ratio after the - ! update. - rcm_update & - = max( state%q(icol,k,ixcldliq) + ptend%q(icol,k,ixcldliq) * dt, & - qmin(ixcldliq) ) + ! Calculate the value of cloud water mixing ratio after the + ! update. + rcm_update & + = max( state%q(icol,k,ixcldliq) + ptend%q(icol,k,ixcldliq) * dt, & + qmin(ixcldliq) ) - ! Calculate the limiting cloud droplet concentration tendency so - ! that cloud maintains a reasonable (not too big) mean volume - ! radius. - Nc_tend_min & - = ( Ncm_min_coef * rcm_update - state%q(icol,k,ixnumliq) ) / dt + ! Calculate the limiting cloud droplet concentration tendency so + ! that cloud maintains a reasonable (not too big) mean volume + ! radius. + Nc_tend_min & + = ( Ncm_min_coef * rcm_update - state%q(icol,k,ixnumliq) ) / dt - ! The cloud droplet concentration tendency needs to be the greater - ! of the current Nc_tend and Nc_tend_min. - ptend%q(icol,k,ixnumliq) & - = max( ptend%q(icol,k,ixnumliq), Nc_tend_min ) + ! The cloud droplet concentration tendency needs to be the greater + ! of the current Nc_tend and Nc_tend_min. + ptend%q(icol,k,ixnumliq) & + = max( ptend%q(icol,k,ixnumliq), Nc_tend_min ) - endif ! ixcldliq > 0 .and. ixnumliq > 0 + endif ! ixcldliq > 0 .and. ixnumliq > 0 - ! Rain drop concentration - if ( ixrain > 0 .and. ixnumrain > 0 ) then + ! Rain drop concentration + if ( ixrain > 0 .and. ixnumrain > 0 ) then - ! Calculate the value of rain water mixing ratio after the update. - rrm_update & - = max( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt, & - qmin(ixrain) ) + ! Calculate the value of rain water mixing ratio after the update. + rrm_update & + = max( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt, & + qmin(ixrain) ) - ! Calculate the limiting rain drop concentration tendency so that - ! rain maintains a reasonable (not too big) mean volume radius. - Nr_tend_min & - = ( Nrm_min_coef * rrm_update - state%q(icol,k,ixnumrain) ) / dt + ! Calculate the limiting rain drop concentration tendency so that + ! rain maintains a reasonable (not too big) mean volume radius. + Nr_tend_min & + = ( Nrm_min_coef * rrm_update - state%q(icol,k,ixnumrain) ) / dt - ! The rain drop concentration tendency needs to be the greater of - ! the current Nr_tend and Nr_tend_min. - ptend%q(icol,k,ixnumrain) & - = max( ptend%q(icol,k,ixnumrain), Nr_tend_min ) + ! The rain drop concentration tendency needs to be the greater of + ! the current Nr_tend and Nr_tend_min. + ptend%q(icol,k,ixnumrain) & + = max( ptend%q(icol,k,ixnumrain), Nr_tend_min ) - endif ! ixrain > 0 .and. ixnumrain > 0 + endif ! ixrain > 0 .and. ixnumrain > 0 - ! Ice crystal concentration - if ( ixcldice > 0 .and. ixnumice > 0 ) then + ! Ice crystal concentration + if ( ixcldice > 0 .and. ixnumice > 0 ) then - ! Calculate the value of ice mixing ratio after the update. - rim_update & - = max( state%q(icol,k,ixcldice) + ptend%q(icol,k,ixcldice) * dt, & - qmin(ixcldice) ) + ! Calculate the value of ice mixing ratio after the update. + rim_update & + = max( state%q(icol,k,ixcldice) + ptend%q(icol,k,ixcldice) * dt, & + qmin(ixcldice) ) - ! Calculate the limiting ice crystal concentration tendency so - ! that ice maintains a reasonable (not too big) mean volume - ! radius. - Ni_tend_min & - = ( Nim_min_coef * rim_update - state%q(icol,k,ixnumice) ) / dt + ! Calculate the limiting ice crystal concentration tendency so + ! that ice maintains a reasonable (not too big) mean volume + ! radius. + Ni_tend_min & + = ( Nim_min_coef * rim_update - state%q(icol,k,ixnumice) ) / dt - ! The ice crystal concentration tendency needs to be the greater - ! of the current Ni_tend and Ni_tend_min. - ptend%q(icol,k,ixnumice) & - = max( ptend%q(icol,k,ixnumice), Ni_tend_min ) + ! The ice crystal concentration tendency needs to be the greater + ! of the current Ni_tend and Ni_tend_min. + ptend%q(icol,k,ixnumice) & + = max( ptend%q(icol,k,ixnumice), Ni_tend_min ) - endif ! ixcldice > 0 .and. ixnumice > 0 + endif ! ixcldice > 0 .and. ixnumice > 0 - ! Snow flake concentration - if ( ixsnow > 0 .and. ixnumsnow > 0 ) then + ! Snow flake concentration + if ( ixsnow > 0 .and. ixnumsnow > 0 ) then - ! Calculate the value of snow mixing ratio after the update. - rsm_update & - = max( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt, & - qmin(ixsnow) ) + ! Calculate the value of snow mixing ratio after the update. + rsm_update & + = max( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt, & + qmin(ixsnow) ) - ! Calculate the limiting snow flake concentration tendency so that - ! snow maintains a reasonable (not too big) mean volume radius. - Ns_tend_min & - = ( Nsm_min_coef * rsm_update - state%q(icol,k,ixnumsnow) ) / dt + ! Calculate the limiting snow flake concentration tendency so that + ! snow maintains a reasonable (not too big) mean volume radius. + Ns_tend_min & + = ( Nsm_min_coef * rsm_update - state%q(icol,k,ixnumsnow) ) / dt - ! The snow flake concentration tendency needs to be the greater of - ! the current Ns_tend and Ns_tend_min. - ptend%q(icol,k,ixnumsnow) & - = max( ptend%q(icol,k,ixnumsnow), Ns_tend_min ) + ! The snow flake concentration tendency needs to be the greater of + ! the current Ns_tend and Ns_tend_min. + ptend%q(icol,k,ixnumsnow) & + = max( ptend%q(icol,k,ixnumsnow), Ns_tend_min ) - endif ! ixsnow > 0 .and. ixnumsnow > 0 + endif ! ixsnow > 0 .and. ixnumsnow > 0 - end do ! k = top_lev, pver + end do ! k = top_lev, pver - end do ! icol = 1, ncol + end do ! icol = 1, ncol - return + return - end subroutine subcol_SILHS_hydromet_conc_tend_lim + end subroutine subcol_SILHS_hydromet_conc_tend_lim - !============================================================================ + !============================================================================ - ! Getunit and Freeunit are depreciated in Fortran going forward, so this is a - ! small function to get an unused stream identifier to send to setup_corr_varnce_array_api - ! or any other silhs/clubb functions that require a unit number argument - ! This comes directly from the Fortran wiki - integer function newunit(unit) - integer, intent(out), optional :: unit - - integer, parameter :: LUN_MIN=10, LUN_MAX=1000 - logical :: opened - integer :: lun - - newunit=-1 - do lun=LUN_MIN,LUN_MAX - inquire(unit=lun,opened=opened) - if (.not. opened) then - newunit=lun - exit - end if - end do - if (present(unit)) unit=newunit - end function newunit + ! Getunit and Freeunit are depreciated in Fortran going forward, so this is a + ! small function to get an unused stream identifier to send to setup_corr_varnce_array_api + ! or any other silhs/clubb functions that require a unit number argument + ! This comes directly from the Fortran wiki + integer function newunit(unit) + integer, intent(out), optional :: unit + integer, parameter :: LUN_MIN=10, LUN_MAX=1000 + logical :: opened + integer :: lun + + newunit=-1 + do lun=LUN_MIN,LUN_MAX + inquire(unit=lun,opened=opened) + if (.not. opened) then + newunit=lun + exit + end if + end do + if (present(unit)) unit=newunit + end function newunit + end module subcol_SILHS diff --git a/src/physics/clubb b/src/physics/clubb index 15e802092f..bfd33d6dd7 160000 --- a/src/physics/clubb +++ b/src/physics/clubb @@ -1 +1 @@ -Subproject commit 15e802092f65b3a20e5d67cb32d40f8a2771ca9b +Subproject commit bfd33d6dd7575f1ea1aa509e0d53d27b4d4a66c5