diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml index f24b9a19..e4190b79 100644 --- a/.github/workflows/test.yaml +++ b/.github/workflows/test.yaml @@ -1,6 +1,12 @@ name: build -on: [pull_request,workflow_dispatch] +on: + push: + branches: + - main + - development + workflow_dispatch: + pull_request: jobs: test_musica_api: diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 00000000..aa99bf1b --- /dev/null +++ b/.gitmodules @@ -0,0 +1,6 @@ +[submodule "mmm-physics"] + path = schemes/mmm/mmm_physics + url = https://github.com/NCAR/MMM-physics.git + fxtag = 20240626-MPASv8.2 + fxrequired = AlwaysRequired + fxDONOTUSEurl = https://github.com/NCAR/MMM-physics.git diff --git a/doc/NamesNotInDictionary.txt b/doc/NamesNotInDictionary.txt index fd11ee07..ef98dec9 100644 --- a/doc/NamesNotInDictionary.txt +++ b/doc/NamesNotInDictionary.txt @@ -1,15 +1,36 @@ ####################### Date/time of when script was run: -2025-02-13 20:35:20.393146 +2025-06-16 17:08:09.244285 ####################### Non-dictionary standard names found in the following metadata files: -------------------------- +atmospheric_physics/schemes/sima_diagnostics/sima_tend_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + - stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation + - stratiform_rain_flux_at_surface_due_to_sedimentation + - tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/zm_evap_tendency_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_deep_convection - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_deep_convection - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water @@ -18,6 +39,8 @@ atmospheric_physics/schemes/sima_diagnostics/zm_evap_tendency_diagnostics.meta atmospheric_physics/schemes/sima_diagnostics/check_energy_gmean_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - flag_for_energy_global_means_output - global_mean_heating_rate_correction_for_energy_conservation - global_mean_vertically_integrated_total_energy_using_dycore_energy_formula_at_end_of_physics_timestep @@ -25,14 +48,58 @@ atmospheric_physics/schemes/sima_diagnostics/check_energy_gmean_diagnostics.meta -------------------------- +atmospheric_physics/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + - deep_convective_cloud_area_fraction + - shallow_convective_cloud_area_fraction + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/zm_tendency_diagnostics.meta + - ccpp_constituent_properties + - ccpp_constituent_tendencies + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/sima_diagnostics/convect_shallow_diagnostics.meta + + - atmosphere_convective_mass_flux_due_to_all_convection + - atmosphere_convective_mass_flux_due_to_shallow_convection + - ccpp_constituent_properties - ccpp_constituent_tendencies + - ccpp_error_code + - ccpp_error_message + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_all_convection + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - frozen_precipitation_flux_at_interface_due_to_shallow_convection + - in_cloud_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - liquid_water_static_energy_flux_due_to_shallow_convection + - lwe_precipitation_rate_at_surface_due_to_shallow_convection + - number_of_ccpp_constituents + - precipitation_flux_at_interface_due_to_shallow_convection + - pressure_at_cloud_base_for_all_convection + - pressure_at_cloud_top_for_all_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_shallow_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_shallow_convection + - tendency_of_frozen_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection_excluding_subcloud_evaporation + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + - total_water_flux_due_to_shallow_convection + - vertical_index_at_cloud_base_for_all_convection + - vertical_index_at_cloud_top_for_all_convection -------------------------- atmospheric_physics/schemes/sima_diagnostics/check_energy_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - cumulative_total_energy_boundary_flux_using_physics_energy_formula - cumulative_total_water_boundary_flux - ratio_of_specific_heat_of_air_used_in_physics_energy_formula_to_specific_heat_of_air_used_in_dycore_energy_formula @@ -46,20 +113,72 @@ atmospheric_physics/schemes/sima_diagnostics/sima_state_diagnostics.meta - air_pressure_at_interface - air_pressure_of_dry_air_at_interface + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - geopotential_height_wrt_surface_at_interface - ln_air_pressure_at_interface - ln_air_pressure_of_dry_air_at_interface - surface_air_pressure -------------------------- +atmospheric_physics/schemes/sima_diagnostics/rk_stratiform_diagnostics.meta + + - accretion_of_cloud_ice_by_snow + - accretion_of_cloud_liquid_water_by_rain + - accretion_of_cloud_liquid_water_by_snow + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - cloud_area_fraction_from_relative_humidity_method + - lwe_snow_precipitation_rate_at_surface_due_to_microphysics + - mass_fraction_of_ice_content_within_stratiform_cloud + - net_condensation_rate_due_to_microphysics + - precipitation_production_due_to_microphysics + - rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - rate_of_evaporation_of_falling_snow_due_to_microphysics + - rate_of_evaporation_of_precipitation_due_to_microphysics + - relative_importance_of_cloud_ice_autoconversion + - relative_importance_of_cloud_liquid_water_autoconversion + - relative_importance_of_rain_accreting_cloud_liquid_water + - relative_importance_of_snow_accreting_cloud_ice + - relative_importance_of_snow_accreting_cloud_liquid_water + - stratiform_rain_and_snow_flux_at_interface + - stratiform_snow_flux_at_interface + - tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt + +-------------------------- + +atmospheric_physics/schemes/sima_diagnostics/rayleigh_friction_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/zm_convr_tendency_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water -------------------------- atmospheric_physics/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - net_sensible_heat_flux_through_top_and_bottom_of_atmosphere_column - vertically_integrated_total_energy_using_dycore_energy_formula - vertically_integrated_total_energy_using_dycore_energy_formula_at_end_of_physics_timestep @@ -67,8 +186,17 @@ atmospheric_physics/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta -------------------------- +atmospheric_physics/schemes/sima_diagnostics/kessler_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/tropopause_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - tropopause_air_pressure - tropopause_air_pressure_from_climatological_method - tropopause_air_pressure_from_cold_point_method @@ -95,12 +223,29 @@ atmospheric_physics/schemes/sima_diagnostics/tropopause_diagnostics.meta -------------------------- +atmospheric_physics/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + - stratiform_cloud_area_fraction + +-------------------------- + +atmospheric_physics/schemes/sima_diagnostics/zm_momtran_tendency_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/zm_diagnostics.meta - atmosphere_convective_mass_flux_due_to_deep_convection - atmosphere_downdraft_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns - - detrainment_of_cloud_liquid_due_to_deep_convection + - ccpp_error_code + - ccpp_error_message + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_deep_convection - frozen_precipitation_flux_at_interface_due_to_deep_convection - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns - in_cloud_eastward_wind_in_downdraft_due_to_deep_convection @@ -124,9 +269,12 @@ atmospheric_physics/schemes/sima_diagnostics/zm_diagnostics.meta atmospheric_physics/schemes/tj2016/tj2016_precip.meta + - ccpp_error_code + - ccpp_error_message - gas_constant_of_water_vapor - lwe_large_scale_precipitation_rate_at_surface - ratio_of_water_vapor_to_dry_air_molecular_weights + - scheme_name - sum_of_sigma_pressure_hybrid_coordinate_a_coefficient_and_sigma_pressure_hybrid_coordinate_b_coefficient -------------------------- @@ -134,12 +282,15 @@ atmospheric_physics/schemes/tj2016/tj2016_precip.meta atmospheric_physics/schemes/tj2016/tj2016_sfc_pbl_hs.meta - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message - eddy_heat_diffusivity - eddy_momentum_diffusivity - gas_constant_of_water_vapor - ln_air_pressure_at_interface - pi_constant - ratio_of_water_vapor_to_dry_air_molecular_weights + - scheme_name - sum_of_sigma_pressure_hybrid_coordinate_a_coefficient_and_sigma_pressure_hybrid_coordinate_b_coefficient - surface_air_pressure - surface_eastward_wind_stress @@ -152,12 +303,176 @@ atmospheric_physics/schemes/tj2016/tj2016_sfc_pbl_hs.meta -------------------------- +atmospheric_physics/schemes/cloud_fraction/convective_cloud_cover.meta + + - atmosphere_convective_mass_flux_due_to_all_convection + - atmosphere_convective_mass_flux_due_to_shallow_convection + - ccpp_error_code + - ccpp_error_message + - deep_convective_cloud_area_fraction + - flag_for_cloud_area_fraction_to_use_shallow_convection_calculated_cloud_area_fraction + - shallow_convective_cloud_area_fraction + - shallow_convective_cloud_area_fraction_from_shallow_convection + - tunable_parameter_for_deep_convection_1_for_cloud_fraction + - tunable_parameter_for_deep_convection_2_for_cloud_fraction + - tunable_parameter_for_shallow_convection_1_for_cloud_fraction + - tunable_parameter_for_shallow_convection_2_for_cloud_fraction + - vertical_layer_index_of_cloud_fraction_top + +-------------------------- + +atmospheric_physics/schemes/cloud_fraction/compute_cloud_fraction.meta + + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - cloud_area_fraction_from_relative_humidity_method + - control_for_ice_cloud_fraction + - deep_convective_cloud_area_fraction + - do_ice_cloud_fraction_for_cloud_fraction + - do_no_stratification_based_cloud_fraction + - do_relative_humidity_perturbation_for_cloud_fraction + - do_vavrus_freeze_dry_adjustment_for_cloud_fraction + - freezing_point_of_water + - lwe_surface_snow_depth_over_land + - ocean_area_fraction + - ratio_of_dry_air_gas_constant_to_specific_heat_of_dry_air_at_constant_pressure + - reference_temperature_lapse_rate + - relative_humidity_threshold_for_cloud_formation + - shallow_convective_cloud_area_fraction + - stratiform_cloud_area_fraction + - stratiform_cloud_ice_area_fraction + - stratiform_cloud_liquid_area_fraction + - surface_air_pressure + - tunable_parameter_for_adjustment_to_minimum_relative_humidity_for_low_stable_clouds_for_land_without_snow_cover_for_cloud_fraction + - tunable_parameter_for_bottom_pressure_bound_for_mid_level_liquid_stratus_for_cloud_fraction + - tunable_parameter_for_critical_relative_humidity_for_ice_clouds_for_cloud_fraction_using_wilson_and_ballard_scheme + - tunable_parameter_for_minimum_relative_humidity_for_high_stable_clouds_for_cloud_fraction + - tunable_parameter_for_minimum_relative_humidity_for_low_stable_clouds_for_cloud_fraction + - tunable_parameter_for_top_pressure_bound_for_mid_level_clouds_for_cloud_fraction + - vertical_layer_index_of_cloud_fraction_top + +-------------------------- + atmospheric_physics/schemes/cloud_fraction/cloud_fraction_fice.meta + - ccpp_error_code + - ccpp_error_message - freezing_point_of_water - mass_fraction_of_ice_content_within_stratiform_cloud - mass_fraction_of_snow_content_within_stratiform_cloud - - vertical_layer_index_of_troposphere_cloud_top + - vertical_layer_index_of_cloud_fraction_top + +-------------------------- + +atmospheric_physics/schemes/cloud_fraction/set_cloud_fraction_top.meta + + - ccpp_error_code + - ccpp_error_message + - vertical_layer_index_of_cloud_fraction_top + - vertical_layer_index_of_troposphere_cloud_physics_top + +-------------------------- + +atmospheric_physics/schemes/hack_shallow/convect_shallow_sum_to_deep.meta + + - atmosphere_convective_mass_flux_due_to_all_convection + - atmosphere_convective_mass_flux_due_to_deep_convection + - atmosphere_convective_mass_flux_due_to_shallow_convection + - ccpp_error_code + - ccpp_error_message + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_all_convection + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_deep_convection + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - pressure_at_cloud_base_for_all_convection + - pressure_at_cloud_top_for_all_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_convection_excluding_subcloud_evaporation + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_deep_convection_excluding_subcloud_evaporation + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection_excluding_subcloud_evaporation + - vertical_index_at_cloud_base_for_all_convection + - vertical_index_at_cloud_base_for_shallow_convection + - vertical_index_at_cloud_top_for_all_convection + - vertical_index_at_cloud_top_for_shallow_convection + - vertical_index_at_top_of_deep_convection_for_convective_columns + - vertical_index_of_deep_convection_launch_level_for_convective_columns + - vertically_integrated_cloud_liquid_water_tendency_due_to_all_convection_to_be_applied_later_in_time_loop + - vertically_integrated_cloud_liquid_water_tendency_due_to_shallow_convection_to_be_applied_later_in_time_loop + +-------------------------- + +atmospheric_physics/schemes/hack_shallow/hack_convect_shallow.meta + + - atmosphere_convective_mass_flux_due_to_shallow_convection + - ccpp_constituent_properties + - ccpp_constituent_tendencies + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - characteristic_adjustment_time_for_shallow_convection + - convective_water_vapor_wrt_moist_air_and_condensed_water_perturbation_due_to_pbl_eddies + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - flag_for_cloud_area_fraction_to_use_shallow_convection_calculated_cloud_area_fraction + - in_cloud_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - liquid_water_static_energy_flux_due_to_shallow_convection + - lwe_precipitation_rate_at_surface_due_to_shallow_convection + - net_liquid_and_lwe_ice_fluxes_through_top_and_bottom_of_atmosphere_column + - number_of_ccpp_constituents + - rain_water_autoconversion_coefficient_for_shallow_convection + - reference_pressure_at_interface + - scheme_name + - shallow_convective_cloud_area_fraction_from_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection_excluding_subcloud_evaporation + - total_water_flux_due_to_shallow_convection + - vertical_index_at_cloud_base_for_shallow_convection + - vertical_index_at_cloud_top_for_shallow_convection + - vertical_layer_index_of_cloud_fraction_top + - vertically_integrated_cloud_liquid_water_tendency_due_to_shallow_convection_to_be_applied_later_in_time_loop + +-------------------------- + +atmospheric_physics/schemes/hack_shallow/set_shallow_conv_fluxes_to_general.meta + + - lwe_precipitation_rate_at_surface_due_to_convection + - lwe_precipitation_rate_at_surface_due_to_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_convection_excluding_subcloud_evaporation + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection_excluding_subcloud_evaporation + +-------------------------- + +atmospheric_physics/schemes/hack_shallow/set_general_conv_fluxes_to_shallow.meta + + - frozen_precipitation_flux_at_interface_due_to_convection + - frozen_precipitation_flux_at_interface_due_to_shallow_convection + - lwe_frozen_precipitation_rate_at_surface_due_to_convection + - lwe_frozen_precipitation_rate_at_surface_due_to_shallow_convection + - lwe_precipitation_rate_at_surface_due_to_convection + - lwe_precipitation_rate_at_surface_due_to_shallow_convection + - net_lwe_ice_fluxes_through_top_and_bottom_of_atmosphere_column + - precipitation_flux_at_interface_due_to_convection + - precipitation_flux_at_interface_due_to_shallow_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_shallow_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_shallow_convection + - tendency_of_frozen_precipitation_wrt_moist_air_and_condensed_water_due_to_convection + - tendency_of_frozen_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection + +-------------------------- + +atmospheric_physics/schemes/kessler/kessler_update.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/kessler/kessler.meta + + - ccpp_error_code + - ccpp_error_message + - scheme_name -------------------------- @@ -165,12 +480,42 @@ atmospheric_physics/schemes/dry_adiabatic_adjust/dadadj.meta - air_pressure_at_interface - binary_indicator_for_dry_adiabatic_adjusted_grid_cell + - ccpp_error_code + - ccpp_error_message - number_of_iterations_for_dry_adiabatic_adjustment_algorithm_convergence - number_of_vertical_levels_from_model_top_where_dry_adiabatic_adjustment_occurs + - scheme_name - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water -------------------------- +atmospheric_physics/schemes/thermo_water_update/thermo_water_update.meta + + - ccpp_constituents + - specific_heat_of_air_used_in_dycore + - total_energy_formula_for_dycore + +-------------------------- + +atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_options.meta + + - cape_threshold_for_zhang_mcfarlane_deep_convection_scheme + - cloud_condensate_to_precipitation_autoconversion_coefficient_over_land_for_zhang_mcfarlane_deep_convection_scheme + - cloud_condensate_to_precipitation_autoconversion_coefficient_over_ocean_for_zhang_mcfarlane_deep_convection_scheme + - deep_convective_adjustment_timescale_for_zhang_mcfarlane_deep_convection_scheme + - entrainment_rate_for_cape_for_zhang_mcfarlane_deep_convection_scheme + - flag_for_no_deep_convection_in_pbl + - flag_for_well_mixed_pbl_parcel_property_for_zhang_mcfarlane_deep_convection_scheme + - fraction_of_pbl_depth_mixed_for_initial_zhang_mcfarlane_parcel_properties + - momentum_transport_parameter_for_vertical_pressure_gradient_force_for_downdraft_for_zhang_mcfarlane_deep_convection_scheme + - momentum_transport_parameter_for_vertical_pressure_gradient_force_for_updraft_for_zhang_mcfarlane_deep_convection_scheme + - number_of_negative_buoyancy_layers_allowed_before_convection_top_for_zhang_mcfarlane_deep_convection_scheme + - parcel_temperature_perturbation_for_zhang_mcfarlane_deep_convection_scheme + - tunable_evaporation_efficiency_over_land_for_zhang_mcfarlane_deep_convection_scheme + - tunable_evaporation_efficiency_over_ocean_for_zhang_mcfarlane_deep_convection_scheme + +-------------------------- + atmospheric_physics/schemes/zhang_mcfarlane/set_deep_conv_fluxes_to_general.meta - lwe_precipitation_rate_at_surface_due_to_convection @@ -187,6 +532,8 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_momtran.meta - atmosphere_downdraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - ccpp_error_code + - ccpp_error_message - current_timestep_number - flag_for_momentum_transport_by_zhang_mcfarlane_deep_convection_scheme - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns @@ -200,6 +547,7 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_momtran.meta - momentum_transport_parameter_for_vertical_pressure_gradient_force_for_updraft_for_zhang_mcfarlane_deep_convection_scheme - pressure_thickness_for_deep_convection_for_convective_columns - pressure_thickness_for_subcloud_layer_for_deep_convection_for_convective_columns + - scheme_name - tendency_of_eastward_wind_due_to_zhang_mcfarlane_deep_convective_downdraft_pressure_gradient_term - tendency_of_eastward_wind_due_to_zhang_mcfarlane_deep_convective_updraft_pressure_gradient_term - tendency_of_northward_wind_due_to_zhang_mcfarlane_deep_convective_downdraft_pressure_gradient_term @@ -211,6 +559,8 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_momtran.meta atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_evap.meta + - ccpp_error_code + - ccpp_error_message - cloud_area_fraction - freezing_point_of_water - frozen_precipitation_flux_at_interface_due_to_convection @@ -219,6 +569,7 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_evap.meta - lwe_precipitation_rate_at_surface_due_to_convection - mass_fraction_of_snow_content_within_stratiform_cloud - precipitation_flux_at_interface_due_to_convection + - scheme_name - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_convection - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_convection - tendency_of_frozen_precipitation_wrt_moist_air_and_condensed_water_due_to_convection @@ -240,18 +591,22 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_convr.meta - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns - cape_threshold_for_zhang_mcfarlane_deep_convection_scheme + - ccpp_error_code + - ccpp_error_message - cloud_condensate_to_precipitation_autoconversion_coefficient_over_land_for_zhang_mcfarlane_deep_convection_scheme - cloud_condensate_to_precipitation_autoconversion_coefficient_over_ocean_for_zhang_mcfarlane_deep_convection_scheme - convective_temperature_perturbation_due_to_pbl_eddies - deep_convective_adjustment_timescale_for_zhang_mcfarlane_deep_convection_scheme - detrainment_mass_flux_due_to_deep_convection - - detrainment_of_cloud_ice_due_to_deep_convection - - detrainment_of_cloud_liquid_due_to_deep_convection + - detrainment_of_cloud_ice_wrt_moist_air_and_condensed_water_due_to_deep_convection + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_deep_convection - entrainment_rate_for_cape_for_zhang_mcfarlane_deep_convection_scheme - flag_for_no_deep_convection_in_pbl - flag_for_well_mixed_pbl_parcel_property_for_zhang_mcfarlane_deep_convection_scheme + - fraction_of_pbl_depth_mixed_for_initial_zhang_mcfarlane_parcel_properties - freezing_point_of_water - gas_constant_of_water_vapor + - geopotential_height_wrt_surface_at_interface - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns - in_cloud_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_deep_convection - index_of_last_column_of_gathered_deep_convection_arrays @@ -265,6 +620,7 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_convr.meta - pressure_thickness_for_subcloud_layer_for_deep_convection_for_convective_columns - ratio_of_water_vapor_to_dry_air_molecular_weights - reference_pressure_at_interface + - scheme_name - specific_heat_of_liquid_water_at_constant_pressure - specific_heat_of_water_vapor_at_constant_pressure - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_deep_convection_excluding_subcloud_evaporation @@ -275,7 +631,7 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_convr.meta - vertical_index_at_top_of_deep_convection_for_convective_columns - vertical_index_of_deep_convection_launch_level_for_convective_columns - vertically_integrated_cloud_ice_tendency_due_to_all_convection_to_be_applied_later_in_time_loop - - vertically_integrated_cloud_liquid_tendency_due_to_all_convection_to_be_applied_later_in_time_loop + - vertically_integrated_cloud_liquid_water_tendency_due_to_all_convection_to_be_applied_later_in_time_loop - zhang_mcfarlane_convective_available_potential_energy -------------------------- @@ -308,44 +664,246 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_convtran.meta - atmosphere_downdraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - ccpp_constituent_properties - ccpp_constituent_tendencies + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message - current_timestep_number - flag_for_tracer_transport_by_zhang_mcfarlane_deep_scheme - fraction_of_water_insoluble_convectively_transported_species - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns - index_of_first_column_of_gathered_deep_convection_arrays - index_of_last_column_of_gathered_deep_convection_arrays + - number_of_ccpp_constituents - pressure_thickness_for_deep_convection_for_convective_columns - pressure_thickness_for_subcloud_layer_for_deep_convection_for_convective_columns + - scheme_name - vertical_index_at_top_of_deep_convection_for_convective_columns - vertical_index_of_deep_convection_launch_level_for_convective_columns -------------------------- +atmospheric_physics/schemes/utilities/to_be_ccppized_temporary.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + atmospheric_physics/schemes/utilities/geopotential_temp.meta - air_pressure_at_interface + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - geopotential_height_wrt_surface_at_interface - ln_air_pressure_at_interface + - number_of_ccpp_constituents + +-------------------------- + +atmospheric_physics/schemes/utilities/state_converters.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/utilities/qneg.meta + + - ccpp_constituent_minimum_values + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - number_of_ccpp_constituents + - scheme_name -------------------------- atmospheric_physics/schemes/utilities/physics_tendency_updaters.meta - ccpp_constituent_tendencies + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/utilities/static_energy.meta + + - ccpp_error_code + - ccpp_error_message -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_save_teout.meta +atmospheric_physics/schemes/rasch_kristjansson/rk_stratiform.meta + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep + - deep_convective_cloud_area_fraction + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_all_convection + - freezing_point_of_water + - latent_heat_of_fusion_of_water_at_0c + - lwe_large_scale_precipitation_rate_at_surface + - lwe_snow_and_cloud_ice_precipitation_rate_at_surface_due_to_microphysics + - lwe_snow_precipitation_rate_at_surface_due_to_microphysics + - lwe_stratiform_precipitation_rate_at_surface + - lwe_surface_snow_depth_over_land + - mass_fraction_of_ice_content_within_stratiform_cloud + - net_condensation_rate_due_to_microphysics + - ocean_area_fraction + - rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - rate_of_evaporation_of_precipitation_due_to_microphysics + - ratio_of_dry_air_gas_constant_to_specific_heat_of_dry_air_at_constant_pressure + - reference_temperature_lapse_rate + - relative_humidity_divided_by_cloud_area_fraction_perturbation + - relative_humidity_threshold_for_cloud_formation + - sea_ice_area_fraction + - shallow_convective_cloud_area_fraction + - smoothed_land_area_fraction + - stratiform_cloud_water_surface_flux_due_to_sedimentation + - stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation + - stratiform_rain_flux_at_surface_due_to_sedimentation + - surface_air_pressure + - tendency_of_air_temperature_not_due_to_microphysics + - tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion + - tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics + - vertical_layer_index_of_cloud_fraction_top + - vertically_integrated_cloud_liquid_water_tendency_due_to_all_convection_to_be_applied_later_in_time_loop + - water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep + +-------------------------- + +atmospheric_physics/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta + + - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - freezing_point_of_water + - latent_heat_of_fusion_of_water_at_0c + - lwe_surface_snow_depth_over_land + - magnitude_of_vertical_pressure_velocity_of_cloud_ice_due_to_sedimentation + - magnitude_of_vertical_pressure_velocity_of_cloud_liquid_water_due_to_sedimentation + - ocean_area_fraction + - sea_ice_area_fraction + - smoothed_land_area_fraction + - stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation + - stratiform_rain_flux_at_surface_due_to_sedimentation + - tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + - tunable_parameter_for_autoconversion_of_cold_ice_for_rk_microphysics + - tunable_parameter_for_ice_fall_velocity_for_rk_microphysics + +-------------------------- + +atmospheric_physics/schemes/rasch_kristjansson/prognostic_cloud_water.meta + + - accretion_of_cloud_ice_by_snow + - accretion_of_cloud_liquid_water_by_rain + - accretion_of_cloud_liquid_water_by_snow + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - density_of_dry_air_at_stp + - flag_for_relative_humidity_threshold_for_cloud_formation_in_polar_stratosphere_for_rk_microphysics + - freezing_point_of_water + - gas_constant_of_water_vapor + - geopotential_height_wrt_surface_at_interface + - latent_heat_of_fusion_of_water_at_0c + - latitude_degrees_north + - lwe_snow_precipitation_rate_at_surface_due_to_microphysics + - lwe_stratiform_precipitation_rate_at_surface + - lwe_surface_snow_depth_over_land + - mass_fraction_of_ice_content_within_stratiform_cloud + - mass_fraction_of_snow_content_within_stratiform_cloud + - net_condensation_rate_due_to_microphysics + - pi_constant + - precipitation_production_due_to_microphysics + - rate_of_evaporation_of_falling_snow_due_to_microphysics + - rate_of_evaporation_of_precipitation_due_to_microphysics + - ratio_of_water_vapor_to_dry_air_molecular_weights + - relative_humidity_divided_by_cloud_area_fraction_perturbation + - relative_humidity_threshold_for_cloud_formation + - relative_humidity_threshold_for_cloud_formation_in_polar_stratosphere_for_rk_microphysics + - relative_importance_of_cloud_ice_autoconversion + - relative_importance_of_cloud_liquid_water_autoconversion + - relative_importance_of_rain_accreting_cloud_liquid_water + - relative_importance_of_snow_accreting_cloud_ice + - relative_importance_of_snow_accreting_cloud_liquid_water + - sea_ice_area_fraction + - smoothed_land_area_fraction + - snow_production_due_to_microphysics + - stratiform_rain_and_snow_flux_at_interface + - stratiform_snow_flux_at_interface + - tendency_of_air_temperature_not_due_to_microphysics + - tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_snow_autoconversion + - tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics + - tropopause_vertical_layer_index + - tunable_parameter_for_autoconversion_of_cold_ice_for_rk_microphysics + - tunable_parameter_for_autoconversion_of_warm_ice_for_rk_microphysics + - tunable_parameter_for_cloud_water_autoconversion_for_rk_microphysics + - tunable_parameter_for_precipitation_evaporation_for_rk_microphysics + - vertical_layer_index_of_troposphere_cloud_physics_top + +-------------------------- + +atmospheric_physics/schemes/conservation_adjust/dme_adjust/dme_adjust.meta + + - air_pressure_at_interface + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - is_moist_basis_dycore + - ln_air_pressure_at_interface + - number_of_ccpp_constituents + - surface_air_pressure + - total_ice_water_mixing_ratio_wrt_moist_air_and_condensed_water_before_physics + - total_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_before_physics + - water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_before_physics + +-------------------------- + +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_save_teout.meta + + - ccpp_error_code + - ccpp_error_message - vertically_integrated_total_energy_using_dycore_energy_formula - vertically_integrated_total_energy_using_dycore_energy_formula_at_end_of_physics_timestep -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_chng.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_chng.meta - air_pressure_of_dry_air_at_interface - air_temperature_at_start_of_physics_timestep + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message - cumulative_total_energy_boundary_flux_using_physics_energy_formula - cumulative_total_water_boundary_flux - flag_for_energy_conservation_warning @@ -356,7 +914,9 @@ atmospheric_physics/schemes/check_energy/check_energy_chng.meta - net_sensible_heat_flux_through_top_and_bottom_of_atmosphere_column - net_water_vapor_fluxes_through_top_and_bottom_of_atmosphere_column - number_of_atmosphere_columns_with_significant_energy_or_water_imbalances + - number_of_ccpp_constituents - ratio_of_specific_heat_of_air_used_in_physics_energy_formula_to_specific_heat_of_air_used_in_dycore_energy_formula + - scheme_name - specific_heat_of_air_used_in_dycore - total_energy_formula_for_dycore - total_energy_formula_for_physics @@ -370,40 +930,52 @@ atmospheric_physics/schemes/check_energy/check_energy_chng.meta -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_zero_fluxes.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_zero_fluxes.meta + - ccpp_error_code + - ccpp_error_message - net_liquid_and_lwe_ice_fluxes_through_top_and_bottom_of_atmosphere_column - net_lwe_ice_fluxes_through_top_and_bottom_of_atmosphere_column - net_sensible_heat_flux_through_top_and_bottom_of_atmosphere_column - net_water_vapor_fluxes_through_top_and_bottom_of_atmosphere_column + - scheme_name -------------------------- -atmospheric_physics/schemes/check_energy/dycore_energy_consistency_adjust.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/dycore_energy_consistency_adjust.meta + - ccpp_error_code + - ccpp_error_message - flag_for_dycore_energy_consistency_adjustment - ratio_of_specific_heat_of_air_used_in_physics_energy_formula_to_specific_heat_of_air_used_in_dycore_energy_formula -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_scaling.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_scaling.meta + - ccpp_error_code + - ccpp_error_message - ratio_of_specific_heat_of_air_used_in_physics_energy_formula_to_specific_heat_of_air_used_in_dycore_energy_formula - specific_heat_of_air_used_in_dycore -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_fix.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_fix.meta - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message - global_mean_heating_rate_correction_for_energy_conservation - net_sensible_heat_flux_through_top_and_bottom_of_atmosphere_column + - scheme_name -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_gmean/check_energy_gmean.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message - global_mean_air_pressure_at_top_of_atmosphere_model - global_mean_heating_rate_correction_for_energy_conservation - global_mean_surface_air_pressure @@ -418,10 +990,14 @@ atmospheric_physics/schemes/check_energy/check_energy_gmean/check_energy_gmean.m atmospheric_physics/schemes/tropopause_find/tropopause_find.meta - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message - fill_value_for_diagnostic_output - fractional_calendar_days_on_end_of_current_timestep + - geopotential_height_wrt_surface_at_interface - pi_constant - ratio_of_dry_air_gas_constant_to_specific_heat_of_dry_air_at_constant_pressure + - scheme_name - tropopause_air_pressure - tropopause_air_pressure_from_chemical_method - tropopause_air_pressure_from_climatological_method @@ -454,21 +1030,54 @@ atmospheric_physics/schemes/tropopause_find/tropopause_find.meta -------------------------- +atmospheric_physics/schemes/held_suarez/held_suarez_1994.meta + + - ccpp_error_code + - ccpp_error_message + - scheme_name + +-------------------------- + +atmospheric_physics/schemes/rayleigh_friction/rayleigh_friction.meta + + - ccpp_error_code + - ccpp_error_message + - center_vertical_layer_for_rayleigh_friction + - model_top_decay_time_for_rayleigh_friction + - number_of_vertical_layers_for_rayleigh_friction + +-------------------------- + atmospheric_physics/schemes/musica/musica_ccpp.meta - blackbody_temperature_at_surface + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message - cloud_area_fraction - dynamic_constituents_for_musica_ccpp - earth_sun_distance - extraterrestrial_radiation_flux + - geopotential_height_wrt_surface_at_interface - photolysis_wavelength_grid_interfaces - solar_zenith_angle - surface_albedo_due_to_UV_and_VIS_direct -------------------------- +atmospheric_physics/test/test_schemes/file_io_test.meta + + - ccpp_error_code + - ccpp_error_message + - filename_of_rrtmgp_shortwave_coefficients + +-------------------------- + atmospheric_physics/test/test_schemes/initialize_constituents.meta + - ccpp_error_code + - ccpp_error_message - dynamic_constituents_for_initialize_constituents ####################### diff --git a/phys_utils/atmos_phys_rad_utils.F90 b/phys_utils/atmos_phys_rad_utils.F90 new file mode 100644 index 00000000..50d2e116 --- /dev/null +++ b/phys_utils/atmos_phys_rad_utils.F90 @@ -0,0 +1,33 @@ +module atmos_phys_rad_utils + ! Radiation utility functions + + implicit none + private + + public :: is_visible + +contains + + pure logical function is_visible(wavenumber) + ! Returns true if the provided wavenumber is above the visible threshold + use ccpp_kinds, only: kind_phys + + ! Wavenumber is in the visible if it is above the visible threshold + ! wavenumber, and in the infrared if it is below the threshold + ! This function doesn't distinquish between visible and UV. + + ! wavenumber in inverse cm (cm^-1) + real(kind_phys), intent(in) :: wavenumber + + ! Set threshold between visible and infrared to 0.7 micron, or 14286 cm^-1 + real(kind_phys), parameter :: visible_wavenumber_threshold = 14286._kind_phys ! cm^-1 + + if (wavenumber > visible_wavenumber_threshold) then + is_visible = .true. + else + is_visible = .false. + end if + + end function is_visible + +end module atmos_phys_rad_utils diff --git a/phys_utils/atmos_phys_string_utils.F90 b/phys_utils/atmos_phys_string_utils.F90 new file mode 100644 index 00000000..f7431f87 --- /dev/null +++ b/phys_utils/atmos_phys_string_utils.F90 @@ -0,0 +1,60 @@ +module atmos_phys_string_utils + ! String utils + + implicit none + private + + public :: to_lower + public :: to_upper + +contains + + pure function to_lower(input_string) result(lowercase_string) + ! Return 'input_string' in all lower case + character(len=*), intent(in) :: input_string + character(len=len(input_string)) :: lowercase_string + ! Local variables + + integer :: i ! Index + integer :: aseq ! ascii collating sequence + integer :: upper_to_lower ! integer to convert case + character(len=1) :: ctmp ! Character temporary + !----------------------------------------------------------------------- + upper_to_lower = iachar("a") - iachar("A") + + do i = 1, len(input_string) + ctmp = input_string(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) & + ctmp = achar(aseq + upper_to_lower) + lowercase_string(i:i) = ctmp + end do + + end function to_lower + +!--------------------------------------------------------------------------- +!--------------------------------------------------------------------------- + + pure function to_upper(input_string) result(uppercase_string) + ! Return 'input_string' in all upper case + character(len=*), intent(in) :: input_string + character(len=len(input_string)) :: uppercase_string + + integer :: i ! Index + integer :: aseq ! ascii collating sequence + integer :: lower_to_upper ! integer to convert case + character(len=1) :: ctmp ! Character temporary + !----------------------------------------------------------------------- + lower_to_upper = iachar("A") - iachar("a") + + do i = 1, len(input_string) + ctmp = input_string(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("a") .and. aseq <= iachar("z") ) & + ctmp = achar(aseq + lower_to_upper) + uppercase_string(i:i) = ctmp + end do + + end function to_upper + +end module atmos_phys_string_utils diff --git a/phys_utils/ccpp_io_reader.F90 b/phys_utils/ccpp_io_reader.F90 new file mode 100644 index 00000000..6f206736 --- /dev/null +++ b/phys_utils/ccpp_io_reader.F90 @@ -0,0 +1,258 @@ +module ccpp_io_reader + implicit none + private + + public :: abstract_netcdf_reader_t + public :: create_netcdf_reader_t + + type, abstract :: abstract_netcdf_reader_t + contains + procedure(open_file), deferred :: open_file + procedure(close_file), deferred :: close_file + procedure(get_var_int_0d), deferred :: get_var_int_0d + procedure(get_var_int_1d), deferred :: get_var_int_1d + procedure(get_var_int_2d), deferred :: get_var_int_2d + procedure(get_var_int_3d), deferred :: get_var_int_3d + procedure(get_var_int_4d), deferred :: get_var_int_4d + procedure(get_var_int_5d), deferred :: get_var_int_5d + procedure(get_var_real_0d), deferred :: get_var_real_0d + procedure(get_var_real_1d), deferred :: get_var_real_1d + procedure(get_var_real_2d), deferred :: get_var_real_2d + procedure(get_var_real_3d), deferred :: get_var_real_3d + procedure(get_var_real_4d), deferred :: get_var_real_4d + procedure(get_var_real_5d), deferred :: get_var_real_5d + procedure(get_var_char_0d), deferred :: get_var_char_0d + procedure(get_var_char_1d), deferred :: get_var_char_1d + procedure(get_var_char_2d), deferred :: get_var_char_2d + procedure(get_var_char_3d), deferred :: get_var_char_3d + procedure(get_var_char_4d), deferred :: get_var_char_4d + procedure(get_var_char_5d), deferred :: get_var_char_5d + + generic :: get_var => get_var_int_0d, get_var_int_1d, get_var_int_2d, get_var_int_3d, get_var_int_4d, get_var_int_5d, & + get_var_real_0d, get_var_real_1d, get_var_real_2d, get_var_real_3d, get_var_real_4d, get_var_real_5d, & + get_var_char_0d, get_var_char_1d, get_var_char_2d, get_var_char_3d, get_var_char_4d, get_var_char_5d + end type abstract_netcdf_reader_t + + interface + module function create_netcdf_reader_t() result(r) + class(abstract_netcdf_reader_t), allocatable :: r + end function create_netcdf_reader_t + + subroutine open_file(this, file_path, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(inout) :: this + character(len=*), intent(in) :: file_path + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errcode !Error code + end subroutine open_file + + subroutine close_file(this, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(inout) :: this + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errcode !Error code + end subroutine close_file + + ! ------------------------------------------------------------------ + ! Integer interfaces + ! ------------------------------------------------------------------ + + subroutine get_var_int_0d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_0d + + subroutine get_var_int_1d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:) !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_1d + + subroutine get_var_int_2d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:,:)!Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_2d + + subroutine get_var_int_3d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:,:,:) !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_3d + + subroutine get_var_int_4d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:,:,:,:) !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_4d + + subroutine get_var_int_5d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:,:,:,:,:) !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_5d + + ! ------------------------------------------------------------------ + ! Real interfaces + ! ------------------------------------------------------------------ + + subroutine get_var_real_0d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_0d + + subroutine get_var_real_1d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var(:) !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_1d + + subroutine get_var_real_2d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var(:,:)!Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_2d + + subroutine get_var_real_3d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var(:,:,:) !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_3d + + subroutine get_var_real_4d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var(:,:,:,:) !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_4d + + subroutine get_var_real_5d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var(:,:,:,:,:) !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_5d + + ! ------------------------------------------------------------------ + ! Character interfaces + ! ------------------------------------------------------------------ + + subroutine get_var_char_0d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var !Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_0d + + subroutine get_var_char_1d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var(:) !Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_1d + + subroutine get_var_char_2d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var(:,:)!Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_2d + + subroutine get_var_char_3d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var(:,:,:) !Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_3d + + subroutine get_var_char_4d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var(:,:,:,:) !Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_4d + + subroutine get_var_char_5d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var(:,:,:,:,:) !Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_5d + + end interface + +end module ccpp_io_reader diff --git a/schemes/cloud_fraction/compute_cloud_fraction.meta b/schemes/cloud_fraction/compute_cloud_fraction.meta index c314e2cf..590bf42e 100644 --- a/schemes/cloud_fraction/compute_cloud_fraction.meta +++ b/schemes/cloud_fraction/compute_cloud_fraction.meta @@ -225,13 +225,13 @@ dimensions = (horizontal_loop_extent) intent = in [ shallowcu ] - standard_name = shallow_convective_cloud_area_fraction_tbd + standard_name = shallow_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ deepcu ] - standard_name = deep_convective_cloud_area_fraction_tbd + standard_name = deep_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -273,7 +273,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ rhcloud ] - standard_name = cloud_area_fraction_from_relative_humidity_method_tbd + standard_name = cloud_area_fraction_from_relative_humidity_method units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -285,7 +285,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ rhu00 ] - standard_name = relative_humidity_threshold_for_prognostic_cloud_water_tbd + standard_name = relative_humidity_threshold_for_cloud_formation units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -303,7 +303,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ relhum ] - standard_name = relative_humidity_for_prognostic_cloud_water_tbd + standard_name = relative_humidity units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/cloud_fraction/convective_cloud_cover.meta b/schemes/cloud_fraction/convective_cloud_cover.meta index 7340b8f6..d368ecb5 100644 --- a/schemes/cloud_fraction/convective_cloud_cover.meta +++ b/schemes/cloud_fraction/convective_cloud_cover.meta @@ -82,7 +82,7 @@ dimensions = () intent = in [ shfrc ] - standard_name = shallow_convective_cloud_area_fraction + standard_name = shallow_convective_cloud_area_fraction_from_shallow_convection units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -100,13 +100,13 @@ dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = in [ shallowcu ] - standard_name = shallow_convective_cloud_area_fraction_tbd + standard_name = shallow_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ deepcu ] - standard_name = deep_convective_cloud_area_fraction_tbd + standard_name = deep_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/cloud_fraction/set_cloud_fraction_top.F90 b/schemes/cloud_fraction/set_cloud_fraction_top.F90 index a13bce30..9bed51a3 100644 --- a/schemes/cloud_fraction/set_cloud_fraction_top.F90 +++ b/schemes/cloud_fraction/set_cloud_fraction_top.F90 @@ -1,3 +1,6 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +! ! Stub scheme to set top of cloud physics to below top cloud level. ! Used for all macrophysical schemes except RK. module set_cloud_fraction_top diff --git a/schemes/conservation_adjust/check_energy/check_energy_chng.meta b/schemes/conservation_adjust/check_energy/check_energy_chng.meta index d673c9a1..b9bc0b9e 100644 --- a/schemes/conservation_adjust/check_energy/check_energy_chng.meta +++ b/schemes/conservation_adjust/check_energy/check_energy_chng.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = check_energy_chng type = scheme - dependencies = ../../../../data/cam_thermo.F90,../../../../data/cam_thermo_formula.F90 + dependencies = ../../../../../data/cam_thermo.F90,../../../../../data/cam_thermo_formula.F90 [ccpp-arg-table] diff --git a/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta b/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta index 9567f6ee..9cf4a5a0 100644 --- a/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta +++ b/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = check_energy_gmean type = scheme - dependencies = ../../../../../utils/gmean_mod.F90 + dependencies = ../../../../../../utils/gmean_mod.F90 [ccpp-arg-table] name = check_energy_gmean_run diff --git a/schemes/hack_shallow/hack_convect_shallow.meta b/schemes/hack_shallow/hack_convect_shallow.meta index ac0f88ea..3b90a151 100644 --- a/schemes/hack_shallow/hack_convect_shallow.meta +++ b/schemes/hack_shallow/hack_convect_shallow.meta @@ -79,7 +79,7 @@ dimensions = () intent = out [ shfrc ] - standard_name = shallow_convective_cloud_area_fraction + standard_name = shallow_convective_cloud_area_fraction_from_shallow_convection units = fraction type = real | kind = kind_phys dimensions = (horizontal_dimension, vertical_layer_dimension) diff --git a/schemes/mmm/CMakeLists.txt b/schemes/mmm/CMakeLists.txt new file mode 100644 index 00000000..e52c1192 --- /dev/null +++ b/schemes/mmm/CMakeLists.txt @@ -0,0 +1,29 @@ +cmake_minimum_required(VERSION 3.20) + +# `mmm_physics_compat` has not been integrated into the CMake build of any top level projects yet, +# and this CMakeLists.txt file is currently for unit testing purposes only. +# Making a change to this CMakeLists.txt file will not impact the build of a parent project at this time. +project(mmm_physics_compat + VERSION + 0.1.0 + DESCRIPTION + "MMM physics compatibility layer for CCPP" + LANGUAGES + Fortran +) + +add_library(mmm_physics_compat) +target_sources(mmm_physics_compat + PRIVATE + ../../test/unit-test/include/ccpp_kinds.F90 + ccpp_kind_types.F90 + mmm_physics_compat.F90 +) +target_compile_options(mmm_physics_compat + PRIVATE + $<$,$>:-fbacktrace -fcheck=all -std=f2018 -Wall -Wextra -Wpedantic> +) +target_include_directories(mmm_physics_compat + INTERFACE + ${CMAKE_CURRENT_BINARY_DIR} +) diff --git a/schemes/mmm/bl_gwdo_compat.F90 b/schemes/mmm/bl_gwdo_compat.F90 new file mode 100644 index 00000000..0a5d7a9b --- /dev/null +++ b/schemes/mmm/bl_gwdo_compat.F90 @@ -0,0 +1,197 @@ +!> This module contains interstitial schemes that are specific to YSU orographic gravity wave drag scheme, +!> which is part of MMM physics. +module bl_gwdo_compat + implicit none + + private + public :: bl_gwdo_compat_pre_init + public :: bl_gwdo_compat_pre_run + public :: bl_gwdo_compat_run + public :: bl_gwdo_diagnostics_init + public :: bl_gwdo_diagnostics_run +contains + !> \section arg_table_bl_gwdo_compat_pre_init Argument Table + !! \htmlinclude bl_gwdo_compat_pre_init.html + pure subroutine bl_gwdo_compat_pre_init( & + omega, rearth, & + dxmeter, sina, cosa, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(in) :: omega(:), rearth + real(kind_phys), intent(out) :: dxmeter(:), sina(:), cosa(:) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! These variables do not change with time. Set them just once at model initialization for better performance. + + ! The "bl_gwdo" physics scheme needs grid sizes in meters. This is trivial for models with regular grids like WRF, + ! but not so straightforward for models with unstructured grids like CAM-SIMA. Here, the square root of cell area is used. + dxmeter(:) = sqrt(omega(:) * (rearth ** 2)) + + ! The "bl_gwdo" physics scheme was originally designed to be used with regional models like WRF, where the positive X and + ! Y directions may not always point to the east and north, respectively. This is no longer the case for global models like + ! CAM-SIMA. + + ! The angle of rotation from east to X is zero. + sina(:) = 0.0_kind_phys + cosa(:) = 1.0_kind_phys + end subroutine bl_gwdo_compat_pre_init + + !> \section arg_table_bl_gwdo_compat_pre_run Argument Table + !! \htmlinclude bl_gwdo_compat_pre_run.html + pure subroutine bl_gwdo_compat_pre_run( & + u, v, & + uproj, vproj, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(in) :: u(:, :), v(:, :) + real(kind_phys), intent(out) :: uproj(:, :), vproj(:, :) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! The "bl_gwdo" physics scheme was originally designed to be used with regional models like WRF, where the positive X and + ! Y directions may not always point to the east and north, respectively. This is no longer the case for global models like + ! CAM-SIMA. + + ! X and Y winds are just eastward and northward winds, respectively. + uproj(:, :) = u(:, :) + vproj(:, :) = v(:, :) + end subroutine bl_gwdo_compat_pre_run + + !> \section arg_table_bl_gwdo_compat_run Argument Table + !! \htmlinclude bl_gwdo_compat_run.html + subroutine bl_gwdo_compat_run( & + sina, cosa, & + rublten, rvblten, & + dtaux3d, dtauy3d, & + dusfcg, dvsfcg, & + uproj, vproj, & + t1, q1, & + prsi, prsl, prslk, zl, & + var, oc1, & + oa2d1, oa2d2, & + oa2d3, oa2d4, & + ol2d1, ol2d2, & + ol2d3, ol2d4, & + g_, cp_, rd_, rv_, fv_, pi_, & + dxmeter, deltim, & + its, ite, kte, kme, & + errmsg, errflg) + use bl_gwdo, only: bl_gwdo_run + use ccpp_kinds, only: kind_phys + + integer, intent(in) :: & + its, ite, kte, kme + real(kind_phys), intent(in) :: & + sina(:), cosa(:), & + uproj(:, :), vproj(:, :), & + t1(:, :), q1(:, :), & + prsi(:, :), prsl(:, :), prslk(:, :), zl(:, :), & + var(:), oc1(:), & + oa2d1(:), oa2d2(:), & + oa2d3(:), oa2d4(:), & + ol2d1(:), ol2d2(:), & + ol2d3(:), ol2d4(:), & + g_, cp_, rd_, rv_, fv_, pi_, & + dxmeter(:), deltim + real(kind_phys), intent(inout) :: & + rublten(:, :), rvblten(:, :) + real(kind_phys), intent(out) :: & + dtaux3d(:, :), dtauy3d(:, :), & + dusfcg(:), dvsfcg(:) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! All members of MMM physics expect vertical indexes to be in ascending order from bottom to top of atmosphere, + ! which is the exact opposite to CAM-SIMA. + ! + ! For all variables with a vertical dimension, they must be flipped upside down. + ! This can be achieved by the `associate` construct with array bounds remapping so that the actual array bounds + ! stays intact elsewhere. + associate ( & + rublten_r => rublten(:, size(rublten, 2):1:-1), & + rvblten_r => rvblten(:, size(rvblten, 2):1:-1), & + dtaux3d_r => dtaux3d(:, size(dtaux3d, 2):1:-1), & + dtauy3d_r => dtauy3d(:, size(dtauy3d, 2):1:-1), & + uproj_r => uproj(:, size(uproj, 2):1:-1), & + vproj_r => vproj(:, size(vproj, 2):1:-1), & + t1_r => t1(:, size(t1, 2):1:-1), & + q1_r => q1(:, size(q1, 2):1:-1), & + prsi_r => prsi(:, size(prsi, 2):1:-1), & + prsl_r => prsl(:, size(prsl, 2):1:-1), & + prslk_r => prslk(:, size(prslk, 2):1:-1), & + zl_r => zl(:, size(zl, 2):1:-1)) + call bl_gwdo_run( & + sina, cosa, & + rublten_r, rvblten_r, & + dtaux3d_r, dtauy3d_r, & + dusfcg, dvsfcg, & + uproj_r, vproj_r, & + t1_r, q1_r, & + prsi_r, prsl_r, prslk_r, zl_r, & + var, oc1, & + oa2d1, oa2d2, & + oa2d3, oa2d4, & + ol2d1, ol2d2, & + ol2d3, ol2d4, & + g_, cp_, rd_, rv_, fv_, pi_, & + dxmeter, deltim, & + its, ite, kte, kme, & + errmsg, errflg) + end associate + end subroutine bl_gwdo_compat_run + + !> \section arg_table_bl_gwdo_diagnostics_init Argument Table + !! \htmlinclude bl_gwdo_diagnostics_init.html + subroutine bl_gwdo_diagnostics_init( & + errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! The "bl_gwdo" physics scheme makes a distinction between X/Y winds and eastward/northward winds. See + ! the "bl_gwdo_compat_pre" interstitial scheme for details. However, here we just refer to its diagnostics as + ! eastward/northward to make them more familiar to CAM-SIMA users. + call history_add_field('bl_gwdo_dtaux3d', 'tendency_of_eastward_wind_due_to_orographic_gwd', 'lev', 'avg', 'm s-2') + call history_add_field('bl_gwdo_dtauy3d', 'tendency_of_northward_wind_due_to_orographic_gwd', 'lev', 'avg', 'm s-2') + call history_add_field('bl_gwdo_dusfcg', 'atmosphere_eastward_stress_due_to_orographic_gwd', horiz_only, 'avg', 'Pa') + call history_add_field('bl_gwdo_dvsfcg', 'atmosphere_northward_stress_due_to_orographic_gwd', horiz_only, 'avg', 'Pa') + end subroutine bl_gwdo_diagnostics_init + + !> \section arg_table_bl_gwdo_diagnostics_run Argument Table + !! \htmlinclude bl_gwdo_diagnostics_run.html + subroutine bl_gwdo_diagnostics_run( & + dtaux3d, dtauy3d, dusfcg, dvsfcg, & + errmsg, errflg) + use cam_history, only: history_out_field + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(in) :: dtaux3d(:, :), dtauy3d(:, :), dusfcg(:), dvsfcg(:) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + call history_out_field('bl_gwdo_dtaux3d', dtaux3d) + call history_out_field('bl_gwdo_dtauy3d', dtauy3d) + call history_out_field('bl_gwdo_dusfcg', dusfcg) + call history_out_field('bl_gwdo_dvsfcg', dvsfcg) + end subroutine bl_gwdo_diagnostics_run +end module bl_gwdo_compat diff --git a/schemes/mmm/bl_gwdo_compat.meta b/schemes/mmm/bl_gwdo_compat.meta new file mode 100644 index 00000000..f154a5f7 --- /dev/null +++ b/schemes/mmm/bl_gwdo_compat.meta @@ -0,0 +1,413 @@ +[ccpp-table-properties] + name = bl_gwdo_compat_pre + type = scheme + +[ccpp-arg-table] + name = bl_gwdo_compat_pre_init + type = scheme +[ omega ] + standard_name = cell_angular_area + units = sr + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = in +[ rearth ] + standard_name = radius_of_earth + units = m + type = real | kind = kind_phys + dimensions = () + intent = in +[ dxmeter ] + standard_name = characteristic_grid_lengthscale + units = m + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = out +[ sina ] + standard_name = sine_of_angle_of_rotation_from_east_to_x + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = out +[ cosa ] + standard_name = cosine_of_angle_of_rotation_from_east_to_x + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = bl_gwdo_compat_pre_run + type = scheme +[ u ] + standard_name = eastward_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ v ] + standard_name = northward_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ uproj ] + standard_name = x_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ vproj ] + standard_name = y_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +# ---------- + +[ccpp-table-properties] + name = bl_gwdo_compat + type = scheme + dependencies = ccpp_kind_types.F90, mmm_physics/bl_gwdo.F90 + +[ccpp-arg-table] + name = bl_gwdo_compat_run + type = scheme +[ sina ] + standard_name = sine_of_angle_of_rotation_from_east_to_x + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ cosa ] + standard_name = cosine_of_angle_of_rotation_from_east_to_x + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ rublten ] + standard_name = tendency_of_x_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ rvblten ] + standard_name = tendency_of_y_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ dtaux3d ] + standard_name = tendency_of_x_wind_due_to_orographic_gwd + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ dtauy3d ] + standard_name = tendency_of_y_wind_due_to_orographic_gwd + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ dusfcg ] + standard_name = atmosphere_x_stress_due_to_orographic_gwd + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ dvsfcg ] + standard_name = atmosphere_y_stress_due_to_orographic_gwd + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ uproj ] + standard_name = x_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ vproj ] + standard_name = y_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ t1 ] + standard_name = air_temperature + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ q1 ] + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in + advected = true +[ prsi ] + standard_name = air_pressure_at_interface + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = in +[ prsl ] + standard_name = air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ prslk ] + standard_name = dimensionless_exner_function + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ zl ] + standard_name = geopotential_height + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ var ] + standard_name = standard_deviation_of_subgrid_orography + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oc1 ] + standard_name = convexity_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oa2d1 ] + standard_name = eastward_asymmetry_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oa2d2 ] + standard_name = northward_asymmetry_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oa2d3 ] + standard_name = northeastward_asymmetry_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oa2d4 ] + standard_name = southeastward_asymmetry_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ol2d1 ] + standard_name = eastward_dimensionless_effective_length_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ol2d2 ] + standard_name = northward_dimensionless_effective_length_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ol2d3 ] + standard_name = northeastward_dimensionless_effective_length_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ol2d4 ] + standard_name = southeastward_dimensionless_effective_length_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ g_ ] + standard_name = standard_gravitational_acceleration + units = m s-2 + type = real | kind = kind_phys + dimensions = () + intent = in +[ cp_ ] + standard_name = specific_heat_of_dry_air_at_constant_pressure + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ rd_ ] + standard_name = gas_constant_of_dry_air + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ rv_ ] + standard_name = gas_constant_of_water_vapor + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ fv_ ] + standard_name = ratio_of_water_vapor_to_dry_air_gas_constants_minus_one + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ pi_ ] + standard_name = pi_constant + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ dxmeter ] + standard_name = characteristic_grid_lengthscale + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ deltim ] + standard_name = timestep_for_physics + units = s + type = real | kind = kind_phys + dimensions = () + intent = in +[ its ] + standard_name = horizontal_loop_begin + units = count + type = integer + dimensions = () + intent = in +[ ite ] + standard_name = horizontal_loop_end + units = count + type = integer + dimensions = () + intent = in +[ kte ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ kme ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +# ---------- + +[ccpp-table-properties] + name = bl_gwdo_diagnostics + type = scheme + +[ccpp-arg-table] + name = bl_gwdo_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = bl_gwdo_diagnostics_run + type = scheme +[ dtaux3d ] + standard_name = tendency_of_x_wind_due_to_orographic_gwd + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ dtauy3d ] + standard_name = tendency_of_y_wind_due_to_orographic_gwd + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ dusfcg ] + standard_name = atmosphere_x_stress_due_to_orographic_gwd + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ dvsfcg ] + standard_name = atmosphere_y_stress_due_to_orographic_gwd + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/mmm/ccpp_kind_types.F90 b/schemes/mmm/ccpp_kind_types.F90 new file mode 100644 index 00000000..555453cd --- /dev/null +++ b/schemes/mmm/ccpp_kind_types.F90 @@ -0,0 +1,11 @@ +!> The mere existence of this module is to satisfy the misdirected dependency of MMM physics, +!> which inexplicably depends on `ccpp_kind_types` instead of `ccpp_kinds`. +module ccpp_kind_types + use ccpp_kinds, only: kind_phys + + implicit none + + private + public :: kind_phys +contains +end module ccpp_kind_types diff --git a/schemes/mmm/mmm_physics b/schemes/mmm/mmm_physics new file mode 160000 index 00000000..0ea59b1c --- /dev/null +++ b/schemes/mmm/mmm_physics @@ -0,0 +1 @@ +Subproject commit 0ea59b1cd673006ee7a9a9958c533a6a0e354243 diff --git a/schemes/mmm/mmm_physics_compat.F90 b/schemes/mmm/mmm_physics_compat.F90 new file mode 100644 index 00000000..4ef5f048 --- /dev/null +++ b/schemes/mmm/mmm_physics_compat.F90 @@ -0,0 +1,88 @@ +!> This module contains interstitial schemes that are specific to MMM physics. +module mmm_physics_compat + implicit none + + private + public :: mmm_physics_accumulate_tendencies_timestep_init + public :: mmm_physics_accumulate_tendencies_run + public :: geopotential_height_wrt_sfc_to_msl_run +contains + !> \section arg_table_mmm_physics_accumulate_tendencies_timestep_init Argument Table + !! \htmlinclude mmm_physics_accumulate_tendencies_timestep_init.html + pure subroutine mmm_physics_accumulate_tendencies_timestep_init( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(out) :: dudt(:, :), dvdt(:, :) + real(kind_phys), intent(out) :: rublten(:, :), rvblten(:, :) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! Zero out tendencies at the beginning of each time step. + + ! Tendencies for feeding back to CAM-SIMA. + dudt(:, :) = 0.0_kind_phys + dvdt(:, :) = 0.0_kind_phys + + ! Tendencies generated by MMM physics. + rublten(:, :) = 0.0_kind_phys + rvblten(:, :) = 0.0_kind_phys + end subroutine mmm_physics_accumulate_tendencies_timestep_init + + !> \section arg_table_mmm_physics_accumulate_tendencies_run Argument Table + !! \htmlinclude mmm_physics_accumulate_tendencies_run.html + pure subroutine mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(inout) :: dudt(:, :), dvdt(:, :) + real(kind_phys), intent(inout) :: rublten(:, :), rvblten(:, :) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! Accumulate tendencies for feeding back to CAM-SIMA. + dudt(:, :) = dudt(:, :) + rublten(:, :) + dvdt(:, :) = dvdt(:, :) + rvblten(:, :) + + ! After the accumulation, zero out tendencies generated by MMM physics so that this subroutine is idempotent. + rublten(:, :) = 0.0_kind_phys + rvblten(:, :) = 0.0_kind_phys + end subroutine mmm_physics_accumulate_tendencies_run + + !> \section arg_table_geopotential_height_wrt_sfc_to_msl_run Argument Table + !! \htmlinclude geopotential_height_wrt_sfc_to_msl_run.html + pure subroutine geopotential_height_wrt_sfc_to_msl_run( & + ncol, & + gravit, phis, zmsfc, & + zmmsl, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + integer, intent(in) :: ncol + real(kind_phys), intent(in) :: gravit, phis(:), zmsfc(:, :) + real(kind_phys), intent(out) :: zmmsl(:, :) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: i + + errmsg = '' + errflg = 0 + + ! Convert geopotential height wrt surface to geopotential height wrt mean sea level, in accordance with + ! its normal definition. + do i = 1, ncol + zmmsl(i, :) = phis(i) / gravit + zmsfc(i, :) + end do + end subroutine geopotential_height_wrt_sfc_to_msl_run +end module mmm_physics_compat diff --git a/schemes/mmm/mmm_physics_compat.meta b/schemes/mmm/mmm_physics_compat.meta new file mode 100644 index 00000000..36669f15 --- /dev/null +++ b/schemes/mmm/mmm_physics_compat.meta @@ -0,0 +1,141 @@ +[ccpp-table-properties] + name = mmm_physics_accumulate_tendencies + type = scheme + +[ccpp-arg-table] + name = mmm_physics_accumulate_tendencies_timestep_init + type = scheme +[ dudt ] + standard_name = tendency_of_eastward_wind + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ dvdt ] + standard_name = tendency_of_northward_wind + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ rublten ] + standard_name = tendency_of_x_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ rvblten ] + standard_name = tendency_of_y_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = mmm_physics_accumulate_tendencies_run + type = scheme +[ dudt ] + standard_name = tendency_of_eastward_wind + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ dvdt ] + standard_name = tendency_of_northward_wind + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ rublten ] + standard_name = tendency_of_x_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ rvblten ] + standard_name = tendency_of_y_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +# ---------- + +[ccpp-table-properties] + name = geopotential_height_wrt_sfc_to_msl + type = scheme + +[ccpp-arg-table] + name = geopotential_height_wrt_sfc_to_msl_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ gravit ] + standard_name = standard_gravitational_acceleration + units = m s-2 + type = real | kind = kind_phys + dimensions = () + intent = in +[ phis ] + standard_name = surface_geopotential + units = m2 s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ zmsfc ] + standard_name = geopotential_height_wrt_surface + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ zmmsl ] + standard_name = geopotential_height + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/musica/aerosol/musica_ccpp_aerosol_model.F90 b/schemes/musica/aerosol/musica_ccpp_aerosol_model.F90 new file mode 100644 index 00000000..31c15ce9 --- /dev/null +++ b/schemes/musica/aerosol/musica_ccpp_aerosol_model.F90 @@ -0,0 +1,82 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_aerosol_model + + implicit none + private + + public :: aerosol_model_t + + !> Defines the configuration of any aerosol package (using + !! any aerosol representation) based on user specification. These values are + !! set during initialization and do not vary during the simulation. + !! + !! Each aerosol package (e.g., MAM, CARMA, etc) must extend the abstract + !! aerosol_model_t class to define the details of their configuration. Any + !! package must implement each of the deferred procedures of the abstract + !! aerosol_model_t class, may include additional private data members and + !! type-bound procedures, and may override functions of the abstract class. + !! + !! Please see the musica_ccpp_stub_aerosol_model module for an example of how the + !! aerosol_model_t class can be extended for a specific aerosol package. + type, abstract :: aerosol_model_t + contains + procedure(aerosol_model_create_state), deferred :: create_state + procedure(aerosol_model_optical_properties), deferred :: optical_properties + end type aerosol_model_t + + abstract interface + + !> Returns a new instance of the aerosol state for the aerosol model. + !! The aerosol state is used to store the time-and-space varying aerosol + !! properties for the aerosol model. + !! @param this The aerosol model instance. + !! @param number_of_columns The number of columns in the model grid. + !! @param number_of_levels The number of levels in the model grid. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @return The aerosol state instance. + function aerosol_model_create_state(this, number_of_columns, number_of_levels, & + error_message, error_code) result(aerosol_state) + use musica_ccpp_aerosol_state, only: aerosol_state_t + import :: aerosol_model_t + class(aerosol_model_t), intent(in) :: this + integer, intent(in) :: number_of_columns + integer, intent(in) :: number_of_levels + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + class(aerosol_state_t), pointer :: aerosol_state + end function aerosol_model_create_state + + !> Computes the optical properties of the aerosol for the given state and + !! wavelengths. + !! @param this The aerosol model instance. + !! @param state The aerosol state instance. + !! @param wavelengths The wavelengths at which to compute the optical properties. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @param extinction Parameterized specific extinction (m^2/kg) [column, level, wavelength]. + !! @param absorption Parameterized specific absorption (m^2/kg) [column, level, wavelength]. + !! @param scattering Single scattering albedo (unitless) [column, level, wavelength]. + !! @param asymmetry_factor Asymmetry factor (unitless) [column, level, wavelength]. + subroutine aerosol_model_optical_properties(this, state, wavelengths, & + error_message, error_code, extinction, absorption, scattering, & + asymmetry_factor) + use ccpp_kinds, only: rk => kind_phys + use musica_ccpp_aerosol_state, only: aerosol_state_t + use musica_ccpp_grid, only: grid_t + import :: aerosol_model_t + class(aerosol_model_t), intent(in) :: this + class(aerosol_state_t), intent(in) :: state + class(grid_t), intent(in) :: wavelengths + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + real(rk), optional, intent(out) :: extinction(:,:,:) + real(rk), optional, intent(out) :: absorption(:,:,:) + real(rk), optional, intent(out) :: scattering(:,:,:) + real(rk), optional, intent(out) :: asymmetry_factor(:,:,:) + end subroutine aerosol_model_optical_properties + + end interface + +end module musica_ccpp_aerosol_model \ No newline at end of file diff --git a/schemes/musica/aerosol/musica_ccpp_aerosol_state.F90 b/schemes/musica/aerosol/musica_ccpp_aerosol_state.F90 new file mode 100644 index 00000000..be9a6754 --- /dev/null +++ b/schemes/musica/aerosol/musica_ccpp_aerosol_state.F90 @@ -0,0 +1,15 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_aerosol_state + + implicit none + private + + public :: aerosol_state_t + + !> Defines the state of an aerosol system according to + !! the aerosol representation of a specific aerosol package. + type, abstract :: aerosol_state_t + end type aerosol_state_t + +end module musica_ccpp_aerosol_state \ No newline at end of file diff --git a/schemes/musica/aerosol_stub/README.md b/schemes/musica/aerosol_stub/README.md new file mode 100644 index 00000000..e70a329a --- /dev/null +++ b/schemes/musica/aerosol_stub/README.md @@ -0,0 +1,6 @@ +The stub aerosol model +====================== + +The files in this folder define a stub aerosol model, primarily for use during +development. Functions of the stub aerosol classes return values corresponding +to the absence of aerosols. \ No newline at end of file diff --git a/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_model.F90 b/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_model.F90 new file mode 100644 index 00000000..233b3399 --- /dev/null +++ b/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_model.F90 @@ -0,0 +1,159 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_stub_aerosol_model + + use musica_ccpp_aerosol_model, only: aerosol_model_t + + implicit none + private + + public :: stub_aerosol_model_t, stub_aerosol_model_parameters_t, & + STUB_AEROSOL_INVALID_DIMENSION, STUB_AEROSOL_INVALID_STATE_TYPE + + !> @brief stub_aerosol_model_parameters_t defines the parameters for the + !! stub aerosol model. (This model assumes no aerosols are present in + !! the atmosphere, and therefore has no parameters.) + type :: stub_aerosol_model_parameters_t + end type stub_aerosol_model_parameters_t + + !> @brief stub_aerosol_model_t defines the configuration of a simplified + !! aerosol package, which assumes no aerosols are present in the + !! atmosphere. + type, extends(aerosol_model_t) :: stub_aerosol_model_t + contains + procedure :: create_state => stub_aerosol_model_create_state + procedure :: optical_properties => stub_aerosol_model_optical_properties + end type stub_aerosol_model_t + + interface stub_aerosol_model_t + module procedure stub_aerosol_model_constructor + end interface stub_aerosol_model_t + + integer, parameter :: STUB_AEROSOL_INVALID_DIMENSION = 1 + integer, parameter :: STUB_AEROSOL_INVALID_STATE_TYPE = 2 + +contains + + !> @brief Constructor for stub_aerosol_model_t + !! @param parameters The parameters for the stub aerosol model. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @return The stub aerosol model instance. + function stub_aerosol_model_constructor(parameters, error_message, & + error_code) result(model) + type(stub_aerosol_model_t), pointer :: model + class(stub_aerosol_model_parameters_t), intent(in) :: parameters + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + error_message = '' + error_code = 0 + allocate(model, stat=error_code, errmsg=error_message) + if (error_code == 0) then + error_message = '' + end if + end function stub_aerosol_model_constructor + + !> @brief Create a new aerosol state for the stub aerosol model. + !! @param this The stub aerosol model instance. + !! @param number_of_columns The number of columns in the model grid. + !! @param number_of_levels The number of levels in the model grid. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @return The aerosol state instance. + function stub_aerosol_model_create_state(this, number_of_columns, & + number_of_levels, error_message, error_code) result(aerosol_state) + use musica_ccpp_aerosol_state, only: aerosol_state_t + use musica_ccpp_stub_aerosol_state, only: stub_aerosol_state_t + class(stub_aerosol_model_t), intent(in) :: this + integer, intent(in) :: number_of_columns + integer, intent(in) :: number_of_levels + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + class(aerosol_state_t), pointer :: aerosol_state + error_message = '' + error_code = 0 + ! Create a new aerosol state for the stub aerosol model + aerosol_state => stub_aerosol_state_t(number_of_columns, number_of_levels, & + error_message, error_code) + end function stub_aerosol_model_create_state + + !> @brief Compute the optical properties of the aerosol for the stub aerosol model. + !! @param this The stub aerosol model instance. + !! @param state The aerosol state instance. + !! @param wavelengths The wavelengths at which to compute the optical properties. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @param extinction Parameterized specific extinction (m^2/kg) [column, level, wavelength]. + !! @param absorption Parameterized specific absorption (m^2/kg) [column, level, wavelength]. + !! @param scattering Single scattering albedo (unitless) [column, level, wavelength]. + !! @param asymmetry_factor Asymmetry factor (unitless) [column, level, wavelength]. + subroutine stub_aerosol_model_optical_properties(this, state, wavelengths, & + error_message, error_code, extinction, absorption, scattering, & + asymmetry_factor) + use ccpp_kinds, only: rk => kind_phys + use musica_ccpp_aerosol_state, only: aerosol_state_t + use musica_ccpp_grid, only: grid_t + use musica_ccpp_stub_aerosol_state, only: stub_aerosol_state_t + class(stub_aerosol_model_t), intent(in) :: this + class(aerosol_state_t), intent(in) :: state + class(grid_t), intent(in) :: wavelengths + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + real(rk), optional, intent(out) :: extinction(:,:,:) + real(rk), optional, intent(out) :: absorption(:,:,:) + real(rk), optional, intent(out) :: scattering(:,:,:) + real(rk), optional, intent(out) :: asymmetry_factor(:,:,:) + error_message = '' + error_code = 0 + select type(state) + class is (stub_aerosol_state_t) + ! Compute the optical properties of the aerosol + ! (This model assumes no aerosols are present in the atmosphere, + ! so the optical properties are set to zero.) + if (present(extinction)) then + if (size(extinction, 1) /= state%number_of_columns() .or. & + size(extinction, 2) /= state%number_of_levels() .or. & + size(extinction, 3) /= wavelengths%number_of_sections()) then + error_message = 'Invalid dimensions for extinction' + error_code = STUB_AEROSOL_INVALID_DIMENSION + return + end if + extinction = 0.0_rk + end if + if (present(absorption)) then + if (size(absorption, 1) /= state%number_of_columns() .or. & + size(absorption, 2) /= state%number_of_levels() .or. & + size(absorption, 3) /= wavelengths%number_of_sections()) then + error_message = 'Invalid dimensions for absorption' + error_code = STUB_AEROSOL_INVALID_DIMENSION + return + end if + absorption = 0.0_rk + end if + if (present(scattering)) then + if (size(scattering, 1) /= state%number_of_columns() .or. & + size(scattering, 2) /= state%number_of_levels() .or. & + size(scattering, 3) /= wavelengths%number_of_sections()) then + error_message = 'Invalid dimensions for scattering' + error_code = STUB_AEROSOL_INVALID_DIMENSION + return + end if + scattering = 0.0_rk + end if + if (present(asymmetry_factor)) then + if (size(asymmetry_factor, 1) /= state%number_of_columns() .or. & + size(asymmetry_factor, 2) /= state%number_of_levels() .or. & + size(asymmetry_factor, 3) /= wavelengths%number_of_sections()) then + error_message = 'Invalid dimensions for asymmetry factor' + error_code = STUB_AEROSOL_INVALID_DIMENSION + return + end if + asymmetry_factor = 0.0_rk + end if + class default + error_message = 'Invalid aerosol state type' + error_code = STUB_AEROSOL_INVALID_STATE_TYPE + end select + end subroutine stub_aerosol_model_optical_properties + +end module musica_ccpp_stub_aerosol_model \ No newline at end of file diff --git a/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_state.F90 b/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_state.F90 new file mode 100644 index 00000000..d719add8 --- /dev/null +++ b/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_state.F90 @@ -0,0 +1,66 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_stub_aerosol_state + + use musica_ccpp_aerosol_state, only: aerosol_state_t + + implicit none + private + + public :: stub_aerosol_state_t + + !> stub_aerosol_state_t defines the state of an aerosol system according to + !! the aerosol representation of the stub aerosol package. + type, extends(aerosol_state_t) :: stub_aerosol_state_t + integer :: number_of_columns_ = 0 !< The number of columns in the model grid + integer :: number_of_levels_ = 0 !< The number of levels in the model grid + contains + procedure :: number_of_columns => stub_aerosol_state_number_of_columns + procedure :: number_of_levels => stub_aerosol_state_number_of_levels + end type stub_aerosol_state_t + + interface stub_aerosol_state_t + module procedure stub_aerosol_state_constructor + end interface stub_aerosol_state_t + +contains + + !> @brief Constructor for stub_aerosol_state_t + !! @param number_of_columns The number of columns in the model grid. + !! @param number_of_levels The number of levels in the model grid. + !! @return The stub aerosol state instance. + function stub_aerosol_state_constructor(number_of_columns, number_of_levels, & + error_message, error_code) result(state) + type(stub_aerosol_state_t), pointer :: state + integer, intent(in) :: number_of_columns + integer, intent(in) :: number_of_levels + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + error_message = '' + error_code = 0 + allocate(state, stat=error_code, errmsg=error_message) + if (error_code /= 0) return + error_message = '' + state%number_of_columns_ = number_of_columns + state%number_of_levels_ = number_of_levels + end function stub_aerosol_state_constructor + + !> @brief Returns the number of columns in the model grid. + !! @param this The stub aerosol state instance. + !! @return The number of columns in the model grid. + function stub_aerosol_state_number_of_columns(this) result(number_of_columns) + class(stub_aerosol_state_t), intent(in) :: this + integer :: number_of_columns + number_of_columns = this%number_of_columns_ + end function stub_aerosol_state_number_of_columns + + !> @brief Returns the number of levels in the model grid. + !! @param this The stub aerosol state instance. + !! @return The number of levels in the model grid. + function stub_aerosol_state_number_of_levels(this) result(number_of_levels) + class(stub_aerosol_state_t), intent(in) :: this + integer :: number_of_levels + number_of_levels = this%number_of_levels_ + end function stub_aerosol_state_number_of_levels + +end module musica_ccpp_stub_aerosol_state \ No newline at end of file diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index d51b51cc..1cfb694b 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -1,3 +1,5 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_micm ! Note: "micm_t" is included in an external pre-built MICM library that the host @@ -5,28 +7,47 @@ module musica_ccpp_micm use ccpp_kinds, only: kind_phys use musica_ccpp_util, only: has_error_occurred use musica_ccpp_namelist, only: filename_of_micm_configuration - use musica_micm, only: micm_t + use musica_micm, only: micm_t, solver_stats_t, Rosenbrock + use musica_state, only: conditions_t, state_t + use musica_util, only: mappings_t implicit none private + save - public :: micm_register, micm_init, micm_run, micm_final, micm, number_of_rate_parameters + public :: micm_register, micm_init, micm_run, micm_final - type(micm_t), pointer :: micm => null( ) - integer :: number_of_rate_parameters = 0 + !> MICM solver. The solver will be configured for a specific chemical mechanism. + !! It then can be used to create and solve MICM states for the mechanism and a + !! given number of grid cells. + type(micm_t), pointer :: micm => null( ) + !> For optimal performance, the grid cells assigned to any particular MPI rank + !! are solved in sets of a fixed size specified at build time. If the total number + !! of grid cells is not evenly divisible by the set size, an additional state + !! is created to handle the residual grid cells. + !! If the number of grid cells is less than the optimal set size, only the first + !! state is created and used. + type(state_t), pointer :: state_1 => null( ) ! state for the optimal set of grid cells + type(state_t), pointer :: state_2 => null( ) ! state for the residual grid cells + integer :: number_of_grid_cells = 0 + + type(mappings_t), public, protected :: species_ordering + type(mappings_t), public, protected :: rate_parameters_ordering + + integer, parameter :: SOLVER_TYPE_ROSENBROCK = 1 + integer, parameter :: SOLVER_TYPE_BACKWARD_EULER = 3 + integer, parameter :: ONE_GRID_CELL = 1 contains !> Registers MICM constituent properties with the CCPP - subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & - micm_species, errmsg, errcode) + subroutine micm_register(solver_type, constituent_props, micm_species, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_species, only: musica_species_t use musica_util, only: error_t use iso_c_binding, only: c_int - integer(c_int), intent(in) :: solver_type - integer(c_int), intent(in) :: number_of_grid_cells + character(len=*), intent(in) :: solver_type type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) type(musica_species_t), allocatable, intent(out) :: micm_species(:) character(len=512), intent(out) :: errmsg @@ -38,17 +59,29 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & character(len=:), allocatable :: species_name logical :: is_advected integer :: number_of_species - integer :: i, species_index + integer :: i, species_index, solver_type_int + type(state_t), pointer :: state if (associated( micm )) then deallocate( micm ) micm => null() end if - micm => micm_t(trim(filename_of_micm_configuration), solver_type, & - number_of_grid_cells, error) + if (trim(solver_type) == 'Rosenbrock') then + solver_type_int = SOLVER_TYPE_ROSENBROCK + else if (trim(solver_type) == 'Backward Euler') then + solver_type_int = SOLVER_TYPE_BACKWARD_EULER + else + errmsg = "[MUSICA Error] Invalid solver type. Supported types: 'Rosenbrock', 'Backward Euler'." // & + " Got: '" // trim(solver_type) // "'." + errcode = 1 + return + end if + micm => micm_t(trim(filename_of_micm_configuration), solver_type_int, error) + if (has_error_occurred(error, errmsg, errcode)) return + state => micm%get_state(ONE_GRID_CELL, error) if (has_error_occurred(error, errmsg, errcode)) return - number_of_species = micm%species_ordering%size() + number_of_species = state%species_ordering%size() allocate(constituent_props(number_of_species), stat=errcode) if (errcode /= 0) then errmsg = "[MUSICA Error] Failed to allocate memory for constituent properties." @@ -62,7 +95,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & end if do i = 1, number_of_species - associate( map => micm%species_ordering ) + associate( map => state%species_ordering ) species_name = map%name(i) species_index = map%index(i) @@ -85,7 +118,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & molar_mass = molar_mass, & advected = is_advected, & errcode = errcode, & - errmsg = errmsg) + errmsg = errmsg ) if (errcode /= 0) return ! Species are ordered to match the sequence of the MICM state array @@ -96,51 +129,116 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & index_musica_species = species_index ) end associate ! map end do - number_of_rate_parameters = micm%user_defined_reaction_rates%size() + species_ordering = state%species_ordering + rate_parameters_ordering = state%rate_parameters_ordering + deallocate( state ) end subroutine micm_register !> Initializes MICM - subroutine micm_init(errmsg, errcode) + subroutine micm_init(n_grid_cells, errmsg, errcode) + use musica_util, only: error_t + + integer, intent(in) :: n_grid_cells character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode + integer :: max_grid_cells, size_1, size_2 + type(error_t) :: error + errmsg = '' errcode = 0 + if (.not. associated( micm )) then + errmsg = "[MUSICA Error] MICM not registered. Call micm_register first." + errcode = 1 + return + end if + if (n_grid_cells <= 0) then + errmsg = "[MUSICA Error] Invalid number of grid cells." + errcode = 1 + return + end if + number_of_grid_cells = n_grid_cells + max_grid_cells = micm%get_maximum_number_of_grid_cells( ) + size_1 = min( number_of_grid_cells, max_grid_cells ) + size_2 = mod( number_of_grid_cells - size_1, max_grid_cells ) + state_1 => micm%get_state( size_1, error ) + if (has_error_occurred(error, errmsg, errcode)) return + if (size_2 > 0) then + state_2 => micm%get_state( size_2, error ) + if (has_error_occurred(error, errmsg, errcode)) return + end if + end subroutine micm_init !> Solves chemistry at the current time step subroutine micm_run(time_step, temperature, pressure, dry_air_density, & - user_defined_rate_parameters, constituents, errmsg, errcode) - use musica_micm, only: solver_stats_t - use musica_util, only: string_t, error_t - use iso_c_binding, only: c_double, c_loc - - real(kind_phys), intent(in) :: time_step ! s - real(kind_phys), target, intent(in) :: temperature(:,:) ! K - real(kind_phys), target, intent(in) :: pressure(:,:) ! Pa - real(kind_phys), target, intent(in) :: dry_air_density(:,:) ! kg m-3 - real(kind_phys), target, intent(in) :: user_defined_rate_parameters(:,:,:) ! various units - real(kind_phys), target, intent(inout) :: constituents(:,:,:) ! mol m-3 + rate_parameters, mixing_ratios, log_output_unit, errmsg, errcode) + use musica_ccpp_micm_util, only: update_micm_state, extract_mixing_ratios_from_state + use musica_micm, only: solver_stats_t + use musica_util, only: string_t, error_t + use iso_c_binding, only: c_double, c_loc + + real(kind_phys), intent(in) :: time_step ! s + real(kind_phys), target, intent(in) :: temperature(:,:) ! K + real(kind_phys), target, intent(in) :: pressure(:,:) ! Pa + real(kind_phys), target, intent(in) :: dry_air_density(:,:) ! kg m-3 + real(kind_phys), target, intent(in) :: rate_parameters(:,:,:) ! various units + real(kind_phys), target, intent(inout) :: mixing_ratios(:,:,:) ! kg kg-1 + integer, intent(in) :: log_output_unit ! file unit for logging output character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode ! local variables - type(string_t) :: solver_state - type(solver_stats_t) :: solver_stats - type(error_t) :: error - - call micm%solve(real(time_step, kind=c_double), & - c_loc(temperature), & - c_loc(pressure), & - c_loc(dry_air_density), & - c_loc(constituents), & - c_loc(user_defined_rate_parameters), & - solver_state, & - solver_stats, & - error) - if (has_error_occurred(error, errmsg, errcode)) return + integer :: max_cells, i_state, state_size, state_1_size, offset + type(state_t), pointer :: state + type(string_t) :: solver_state + type(solver_stats_t) :: solver_stats + type(error_t) :: error + + state_1_size = state_1%number_of_grid_cells + do i_state = 1, ceiling( real( number_of_grid_cells ) / state_1_size ) + + ! Determine which state to use for the current iteration + state_size = min( number_of_grid_cells - ( i_state - 1 ) * state_1_size, & + state_1_size ) + if ( state_size == state_1_size ) then + state => state_1 ! use the main state for the optimal number of grid cells + else + state => state_2 ! use the residual state for the remaining grid cells + if (.not. associated( state )) then + errmsg = "[MUSICA Error] Internal error. MICM residual state not initialized." + errcode = 1 + return + end if + if (state%number_of_grid_cells /= state_size) then + errmsg = "[MUSICA Error] Internal error. MICM residual state size mismatch." + errcode = 1 + return + end if + end if + offset = ( i_state - 1 ) * state_1_size ! number of grid cells already updated + + ! Update MICM state with the current conditions and mixing ratios + call update_micm_state( state, offset, temperature, pressure, dry_air_density, & + mixing_ratios, rate_parameters ) + + ! Solve the system + call micm%solve( time_step, state, solver_state, solver_stats, error ) + if (has_error_occurred(error, errmsg, errcode)) return + if (solver_state%get_char_array() /= "Converged") then + write(log_output_unit,*) & + "[MUSICA Warning] MICM solver failure: '" // & + trim(solver_state%get_char_array()) // "'. For grid cells ", & + (i_state - 1) * state_1_size + 1, " to ", i_state * state_1_size, & + " of ", number_of_grid_cells + end if + + ! Update the mixing ratios with the results + call extract_mixing_ratios_from_state( state, offset, mixing_ratios) + + end do end subroutine micm_run @@ -152,6 +250,14 @@ subroutine micm_final(errmsg, errcode) errmsg = '' errcode = 0 + if (associated( state_1 )) then + deallocate( state_1 ) + state_1 => null() + end if + if (associated( state_2 )) then + deallocate( state_2 ) + state_2 => null() + end if if (associated( micm )) then deallocate( micm ) micm => null() diff --git a/schemes/musica/micm/musica_ccpp_micm_util.F90 b/schemes/musica/micm/musica_ccpp_micm_util.F90 index 2e12de18..5322cb30 100644 --- a/schemes/musica/micm/musica_ccpp_micm_util.F90 +++ b/schemes/musica/micm/musica_ccpp_micm_util.F90 @@ -1,66 +1,120 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_micm_util - implicit none + use ccpp_kinds, only: kind_phys + + implicit none private - public :: convert_to_mol_per_cubic_meter, convert_to_mass_mixing_ratio + + public :: update_micm_state, extract_mixing_ratios_from_state contains - ! Convert CAM-SIMA unit to MICM unit (kg kg-1 -> mol m-3) - subroutine convert_to_mol_per_cubic_meter(dry_air_density, molar_mass_arr, constituents) - use ccpp_kinds, only: kind_phys - - real(kind_phys), intent(in) :: dry_air_density(:,:) ! kg m-3 - real(kind_phys), intent(in) :: molar_mass_arr(:) ! kg mol-1 - real(kind_phys), intent(inout) :: constituents(:,:,:) ! in: kg kg-1 | out: mol m-3 - - ! local variables - integer :: num_columns, num_layers, num_constituents - integer :: i_column, i_layer, i_elem - real(kind_phys) :: val - - num_columns = size(constituents, dim=1) - num_layers = size(constituents, dim=2) - num_constituents = size(constituents, dim=3) - - do i_elem = 1, num_constituents - do i_layer = 1, num_layers - do i_column = 1, num_columns - val = constituents(i_column, i_layer, i_elem) * dry_air_density(i_column, i_layer) & - / molar_mass_arr(i_elem) - constituents(i_column, i_layer, i_elem) = val - end do + !> Populate a MICM state object with conditions from CCPP variables + !! + !! The state object is populated with data from the first grid cell that has not + !! yet been added to a MICM state. Indices for chemical species are mapped from + !! the CCPP constituent ordering to the MICM species ordering. Mass mixing ratios + !! are converted to number density (mol m-3) using the dry air density and + !! molecular weights of the species. + subroutine update_micm_state(state, state_data_offset, temperature, pressure, & + dry_air_mass_density, mixing_ratios, rate_parameters) + + use musica_ccpp_species, only: micm_indices_constituent_props, micm_molar_mass_array + use musica_ccpp_util, only: MOLAR_MASS_DRY_AIR + use musica_state, only: state_t + + type(state_t), intent(inout) :: state + integer, intent(in) :: state_data_offset ! number of grid cells already updated + real(kind_phys), target, contiguous, intent(in) :: temperature(:,:) ! K (column, layer) + real(kind_phys), target, contiguous, intent(in) :: pressure(:,:) ! Pa (column, layer) + real(kind_phys), target, contiguous, intent(in) :: dry_air_mass_density(:,:) ! kg m-3 (column, layer) + real(kind_phys), target, contiguous, intent(in) :: mixing_ratios(:,:,:) ! kg kg-1 (column, layer, species) + real(kind_phys), target, contiguous, intent(in) :: rate_parameters(:,:,:) ! various units (column, layer, parameter) + + integer :: i_cell, i_var, state_offset, n_cells, n_cells_total + real(kind_phys), pointer :: temperature_1D(:), pressure_1D(:), air_density_1D(:), & + species_1D(:), params_1D(:) + + ! get grid cell dimensions + n_cells = state%number_of_grid_cells + n_cells_total = size(temperature, 1) * size(temperature, 2) + + ! Update environmental conditions + ! collapse 2D arrays to 1D + ! (column, layer) -> (column*layer) + temperature_1D(1:n_cells_total) => temperature(:,:) + pressure_1D(1:n_cells_total) => pressure(:,:) + air_density_1D(1:n_cells_total) => dry_air_mass_density(:,:) + do i_cell = 1, n_cells + state%conditions(i_cell)%temperature = temperature_1D(i_cell + state_data_offset) + state%conditions(i_cell)%pressure = pressure_1D(i_cell + state_data_offset) + state%conditions(i_cell)%air_density = air_density_1D(i_cell + state_data_offset) / MOLAR_MASS_DRY_AIR + end do + + ! Update species concentrations + associate(cell_stride => state%species_strides%grid_cell, & + var_stride => state%species_strides%variable) + do i_var = 1, state%number_of_species + species_1D(1:n_cells_total) => mixing_ratios(:,:,micm_indices_constituent_props(i_var)) + do i_cell = 1, n_cells + state%concentrations( 1 + ( i_cell - 1 ) * cell_stride + ( i_var - 1 ) * var_stride ) = & + species_1D(i_cell + state_data_offset) * state%conditions(i_cell)%air_density & + / micm_molar_mass_array(i_var) end do end do + end associate + + ! Update rate parameters + associate(cell_stride => state%rate_parameters_strides%grid_cell, & + var_stride => state%rate_parameters_strides%variable) + do i_var = 1, state%number_of_rate_parameters + params_1D(1:n_cells_total) => rate_parameters(:,:,i_var) + do i_cell = 1, n_cells + state%rate_parameters( 1 + ( i_cell - 1 ) * cell_stride + ( i_var - 1 ) * var_stride ) = & + params_1D(i_cell + state_data_offset) + end do + end do + end associate + + end subroutine update_micm_state - end subroutine convert_to_mol_per_cubic_meter + !> Extract mixing ratios from a MICM state object + !! + !! Species concentrations are mapped from the MICM species ordering to the + !! CCPP constituent ordering. The concentrations are converted to mass mixing + !! ratios (kg kg-1) using the dry air density and molecular weights of the + !! species. + subroutine extract_mixing_ratios_from_state(state, state_data_offset, mixing_ratios) - ! Convert MICM unit to CAM-SIMA unit (mol m-3 -> kg kg-1) - subroutine convert_to_mass_mixing_ratio(dry_air_density, molar_mass_arr, constituents) - use ccpp_kinds, only: kind_phys + use musica_ccpp_species, only: micm_indices_constituent_props, micm_molar_mass_array + use musica_state, only: state_t - real(kind_phys), intent(in) :: dry_air_density(:,:) ! kg m-3 - real(kind_phys), intent(in) :: molar_mass_arr(:) ! kg mol-1 - real(kind_phys), intent(inout) :: constituents(:,:,:) ! in: mol m-3 | out: kg kg-1 + type(state_t), intent(in) :: state + integer, intent(in) :: state_data_offset ! number of grid cells already updated + real(kind_phys), target, contiguous, intent(inout) :: mixing_ratios(:,:,:) ! kg kg-1 (column, layer, species) - integer :: num_columns, num_layers, num_constituents - integer :: i_column, i_layer, i_elem - real(kind_phys) :: val + integer :: i_cell, i_var, state_offset, n_cells, n_cells_total + real(kind_phys), pointer :: species_1D(:) - num_columns = size(constituents, dim=1) - num_layers = size(constituents, dim=2) - num_constituents = size(constituents, dim=3) + ! get grid cell dimensions + n_cells = state%number_of_grid_cells + n_cells_total = size(mixing_ratios, 1) * size(mixing_ratios, 2) - do i_elem = 1, num_constituents - do i_layer = 1, num_layers - do i_column = 1, num_columns - val = constituents(i_column, i_layer, i_elem) / dry_air_density(i_column, i_layer) & - * molar_mass_arr(i_elem) - constituents(i_column, i_layer, i_elem) = val - end do + ! Update species mass mixing ratios + associate(cell_stride => state%species_strides%grid_cell, & + var_stride => state%species_strides%variable) + do i_var = 1, state%number_of_species + species_1D(1:n_cells_total) => mixing_ratios(:,:,micm_indices_constituent_props(i_var)) + do i_cell = 1, n_cells + species_1D(i_cell + state_data_offset) = & + state%concentrations( 1 + ( i_cell - 1 ) * cell_stride + ( i_var - 1 ) * var_stride ) & + * micm_molar_mass_array(i_var) / state%conditions(i_cell)%air_density end do end do + end associate - end subroutine convert_to_mass_mixing_ratio + end subroutine extract_mixing_ratios_from_state -end module musica_ccpp_micm_util \ No newline at end of file +end module musica_ccpp_micm_util diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 27a8897a..5dc114bc 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -1,3 +1,6 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 + !> Top-level wrapper for MUSICA chemistry components module musica_ccpp use musica_ccpp_micm, only: micm_register, micm_init, micm_run, micm_final @@ -7,16 +10,21 @@ module musica_ccpp implicit none private + save public :: musica_ccpp_register, musica_ccpp_init, musica_ccpp_run, musica_ccpp_final + integer :: number_of_micm_rate_parameters = -1 + + logical, public, protected :: do_tuvx = .false. + contains !> \section arg_table_musica_ccpp_register Argument Table !! \htmlinclude musica_ccpp_register.html subroutine musica_ccpp_register(constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t - use musica_ccpp_namelist, only: micm_solver_type + use musica_ccpp_namelist, only: micm_solver_type, filename_of_tuvx_configuration use musica_ccpp_species, only: musica_species_t, register_musica_species use musica_ccpp_tuvx_load_species, only: check_tuvx_species_initialization @@ -28,23 +36,23 @@ subroutine musica_ccpp_register(constituent_props, errmsg, errcode) type(ccpp_constituent_properties_t), allocatable :: constituent_props_subset(:) type(musica_species_t), allocatable :: micm_species(:) type(musica_species_t), allocatable :: tuvx_species(:) - integer :: number_of_grid_cells - - ! Temporary fix until the number of grid cells is only needed to create a MICM state - ! instead of when the solver is created. - ! The number of grid cells is not known at this point, so we set it to 1 and recreate - ! the solver when the number of grid cells is known at the init stage. - number_of_grid_cells = 1 - call micm_register(micm_solver_type, number_of_grid_cells, constituent_props_subset, & - micm_species, errmsg, errcode) + + call micm_register(micm_solver_type, constituent_props_subset, micm_species, & + errmsg, errcode) if (errcode /= 0) return constituent_props = constituent_props_subset deallocate(constituent_props_subset) - call tuvx_register(micm_species, tuvx_species, constituent_props_subset, & - errmsg, errcode) - if (errcode /= 0) return - constituent_props = [ constituent_props, constituent_props_subset ] + if (trim(filename_of_tuvx_configuration) /= "none") then + do_tuvx = .true. + call tuvx_register(micm_species, tuvx_species, constituent_props_subset, & + errmsg, errcode) + if (errcode /= 0) return + constituent_props = [ constituent_props, constituent_props_subset ] + else + do_tuvx = .false. + allocate(tuvx_species(0)) + end if call register_musica_species(micm_species, tuvx_species) call check_tuvx_species_initialization(errmsg, errcode) @@ -57,12 +65,12 @@ end subroutine musica_ccpp_register subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & vertical_interface_dimension, & photolysis_wavelength_grid_interfaces, & - constituent_props_ptr, errmsg, errcode) + constituent_props_ptr, molar_mass_dry_air__g_mol, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t, ccpp_constituent_properties_t use ccpp_kinds, only: kind_phys - use musica_ccpp_micm, only: micm + use musica_ccpp_micm, only: rate_parameters_ordering use musica_ccpp_namelist, only: micm_solver_type - use musica_ccpp_util, only: has_error_occurred + use musica_ccpp_util, only: has_error_occurred, m_to_nm, set_constants use musica_ccpp_species, only: initialize_musica_species_indices, initialize_molar_mass_array, & check_initialization, musica_species_t @@ -71,6 +79,7 @@ subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & integer, intent(in) :: vertical_interface_dimension ! (count) real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! m type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props_ptr(:) + real(kind_phys), intent(in) :: molar_mass_dry_air__g_mol ! g mol-1 character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -78,24 +87,42 @@ subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & type(ccpp_constituent_properties_t), allocatable :: constituent_props(:) type(musica_species_t), allocatable :: micm_species(:) integer :: number_of_grid_cells + real(kind_phys), dimension(size(photolysis_wavelength_grid_interfaces)) & + :: photolysis_wavelength_grid_interfaces_nm ! nm - ! Temporary fix until the number of grid cells is only needed to create a MICM state - ! instead of when the solver is created. - ! Re-create the MICM solver with the correct number of grid cells number_of_grid_cells = horizontal_dimension * vertical_layer_dimension - call micm_register(micm_solver_type, number_of_grid_cells, constituent_props, & - micm_species, errmsg, errcode) - call micm_init(errmsg, errcode) - if (errcode /= 0) return - call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & - photolysis_wavelength_grid_interfaces, & - micm%user_defined_reaction_rates, errmsg, errcode) + + call set_constants(molar_mass_dry_air__g_mol * 1.0e-3_kind_phys) ! kg mol-1 + + call micm_init(number_of_grid_cells, errmsg, errcode) if (errcode /= 0) return + number_of_micm_rate_parameters = rate_parameters_ordering%size() + if (number_of_micm_rate_parameters < 0) then + errmsg = "MUSICA: Internal error: number_of_micm_rate_parameters < 0" + errcode = 1 + return + end if + + if (do_tuvx) then + if (size(photolysis_wavelength_grid_interfaces) < 2) then + errmsg = "MUSICA: Internal error: invalid photolysis_wavelength_grid_interfaces size." + errcode = 1 + return + end if + photolysis_wavelength_grid_interfaces_nm(:) = & + photolysis_wavelength_grid_interfaces(:) * m_to_nm + call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & + photolysis_wavelength_grid_interfaces_nm, & + rate_parameters_ordering, errmsg, errcode) + if (errcode /= 0) return + end if call initialize_musica_species_indices(constituent_props_ptr, errmsg, errcode) if (errcode /= 0) return + call initialize_molar_mass_array(constituent_props_ptr, errmsg, errcode) if (errcode /= 0) return + call check_initialization(errmsg, errcode) if (errcode /= 0) return @@ -105,23 +132,19 @@ end subroutine musica_ccpp_init !! \htmlinclude musica_ccpp_run.html !! !! The standard name for the variable 'surface_temperature' is - !! 'blackbody_temperature_at_surface' because this is what we have as - !! the standard name for 'cam_in%ts', whcih represents the same quantity. - subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, constituent_props, & - constituents, geopotential_height_wrt_surface_at_midpoint, & - geopotential_height_wrt_surface_at_interface, surface_geopotential, & - surface_temperature, surface_albedo, & - photolysis_wavelength_grid_interfaces, extraterrestrial_flux, & - standard_gravitational_acceleration, cloud_area_fraction, & - air_pressure_thickness, solar_zenith_angle, & - earth_sun_distance, errmsg, errcode) + !! 'blackbody_temperature_at_surface' as this is the standard name + !! used for 'cam_in%ts,' which represents the same quantity. + subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, constituent_props, & + constituents, geopotential_height_wrt_surface_at_midpoint, & + geopotential_height_wrt_surface_at_interface, surface_geopotential, & + surface_temperature, surface_albedo, extraterrestrial_flux, & + standard_gravitational_acceleration, cloud_area_fraction, & + air_pressure_thickness, solar_zenith_angle, earth_sun_distance, & + log_output_unit, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use ccpp_kinds, only: kind_phys - use musica_ccpp_micm, only: number_of_rate_parameters - use musica_ccpp_micm_util, only: convert_to_mol_per_cubic_meter, convert_to_mass_mixing_ratio - use musica_ccpp_species, only: number_of_micm_species, number_of_tuvx_species, & - micm_indices_constituent_props, tuvx_indices_constituent_props, micm_molar_mass_array, & - extract_subset_constituents, update_constituents + use musica_ccpp_species, only: number_of_tuvx_species, tuvx_indices_constituent_props, & + extract_subset_constituents real(kind_phys), intent(in) :: time_step ! s real(kind_phys), target, intent(in) :: temperature(:,:) ! K (column, layer) @@ -135,67 +158,50 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co real(kind_phys), intent(in) :: surface_geopotential(:) ! m2 s-2 (column) real(kind_phys), intent(in) :: surface_temperature(:) ! K (column) real(kind_phys), intent(in) :: surface_albedo(:) ! fraction (column) - real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm (wavelength interface) real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 (wavelength interface) real(kind_phys), intent(in) :: standard_gravitational_acceleration ! m s-2 real(kind_phys), intent(in) :: cloud_area_fraction(:,:) ! fraction (column, layer) real(kind_phys), intent(in) :: air_pressure_thickness(:,:) ! Pa (column, layer) real(kind_phys), intent(in) :: solar_zenith_angle(:) ! radians (column) real(kind_phys), intent(in) :: earth_sun_distance ! AU + integer, intent(in) :: log_output_unit ! file unit number for logging character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode ! local variables real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & - number_of_rate_parameters) :: rate_parameters ! various units + number_of_micm_rate_parameters) :: rate_parameters ! various units real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & - number_of_micm_species) :: constituents_micm_species ! kg kg-1 - real(kind_phys), dimension(size(constituents, dim=1), & - size(constituents, dim=2), & - number_of_tuvx_species) :: constituents_tuvx_species ! kg kg-1 + number_of_tuvx_species) :: constituents_tuvx_species ! kg kg-1 call extract_subset_constituents(tuvx_indices_constituent_props, constituents, & constituents_tuvx_species, errmsg, errcode) if (errcode /= 0) return ! Calculate photolysis rate constants using TUV-x - call tuvx_run(temperature, dry_air_density, & - constituents_tuvx_species, & - geopotential_height_wrt_surface_at_midpoint, & - geopotential_height_wrt_surface_at_interface, & - surface_geopotential, surface_temperature, & - surface_albedo, & - photolysis_wavelength_grid_interfaces, & - extraterrestrial_flux, & - standard_gravitational_acceleration, & - cloud_area_fraction, & - air_pressure_thickness, & - solar_zenith_angle, & - earth_sun_distance, & - rate_parameters, & - errmsg, errcode) - - call update_constituents(tuvx_indices_constituent_props, constituents_tuvx_species, & - constituents, errmsg, errcode) - if (errcode /= 0) return - call extract_subset_constituents(micm_indices_constituent_props, constituents, & - constituents_micm_species, errmsg, errcode) - if (errcode /= 0) return - - ! Convert CAM-SIMA unit to MICM unit (kg kg-1 -> mol m-3) - call convert_to_mol_per_cubic_meter(dry_air_density, micm_molar_mass_array, constituents_micm_species) + if (do_tuvx) then + call tuvx_run(temperature, dry_air_density, & + constituents_tuvx_species, & + geopotential_height_wrt_surface_at_midpoint, & + geopotential_height_wrt_surface_at_interface, & + surface_geopotential, surface_temperature, & + surface_albedo, & + extraterrestrial_flux, & + standard_gravitational_acceleration, & + cloud_area_fraction, & + air_pressure_thickness, & + solar_zenith_angle, & + earth_sun_distance, & + rate_parameters, & + errmsg, errcode) + if (errcode /= 0) return + end if ! Solve chemistry at the current time step call micm_run(time_step, temperature, pressure, dry_air_density, rate_parameters, & - constituents_micm_species, errmsg, errcode) - - ! Convert MICM unit back to CAM-SIMA unit (mol m-3 -> kg kg-1) - call convert_to_mass_mixing_ratio(dry_air_density, micm_molar_mass_array, constituents_micm_species) - - call update_constituents(micm_indices_constituent_props, constituents_micm_species, & - constituents, errmsg, errcode) + constituents, log_output_unit, errmsg, errcode) if (errcode /= 0) return end subroutine musica_ccpp_run @@ -208,8 +214,12 @@ subroutine musica_ccpp_final(errmsg, errcode) integer, intent(out) :: errcode call cleanup_musica_species() + call tuvx_final(errmsg, errcode) + if (errcode /= 0) return + call micm_final(errmsg, errcode) + if (errcode /= 0) return end subroutine musica_ccpp_final diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index bb251532..62d45a08 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -1,12 +1,12 @@ [ccpp-table-properties] name = musica_ccpp type = scheme - dependencies = musica_ccpp.F90,musica_ccpp_util.F90,musica_ccpp_species.F90 - dependencies = micm/musica_ccpp_micm.F90,micm/musica_ccpp_micm_util.F90 + dependencies = micm/musica_ccpp_micm_util.F90,micm/musica_ccpp_micm.F90 dependencies = tuvx/musica_ccpp_tuvx_aerosol_optics.F90,tuvx/musica_ccpp_tuvx_cloud_optics.F90,tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 dependencies = tuvx/musica_ccpp_tuvx_gas_species.F90,tuvx/musica_ccpp_tuvx_height_grid.F90,tuvx/musica_ccpp_tuvx_load_species.F90 dependencies = tuvx/musica_ccpp_tuvx_surface_albedo.F90,tuvx/musica_ccpp_tuvx_temperature.F90,tuvx/musica_ccpp_tuvx_wavelength_grid.F90 dependencies = tuvx/musica_ccpp_tuvx.F90 + dependencies = util/musica_ccpp_grid.F90,util/musica_ccpp_species.F90,util/musica_ccpp_util.F90 [ccpp-arg-table] name = musica_ccpp_register @@ -64,6 +64,12 @@ type = ccpp_constituent_prop_ptr_t dimensions = (number_of_ccpp_constituents) intent = in +[ molar_mass_dry_air__g_mol ] + standard_name = molecular_weight_of_dry_air + units = g mol-1 + type = real | kind = kind_phys + dimensions = () + intent = in [ errmsg ] standard_name = ccpp_error_message units = none @@ -146,12 +152,6 @@ units = fraction dimensions = (horizontal_loop_extent) intent = in -[ photolysis_wavelength_grid_interfaces ] - standard_name = photolysis_wavelength_grid_interfaces - type = real | kind = kind_phys - units = m - dimensions = (photolysis_wavelength_grid_interface_dimension) - intent = in [ extraterrestrial_flux ] standard_name = extraterrestrial_radiation_flux type = real | kind = kind_phys @@ -188,6 +188,12 @@ type = real | kind = kind_phys dimensions = () intent = in +[ log_output_unit ] + standard_name = log_output_unit + units = 1 + type = integer + dimensions = () + intent = in [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/schemes/musica/musica_ccpp_namelist.xml b/schemes/musica/musica_ccpp_namelist.xml index 88ac00e6..8325678c 100644 --- a/schemes/musica/musica_ccpp_namelist.xml +++ b/schemes/musica/musica_ccpp_namelist.xml @@ -77,16 +77,16 @@ --> - integer + char*512 musica_ccpp musica_ccpp micm_solver_type none - The type of MICM solver to use. + The type of MICM solver to use. Options are "Rosenbrock" and "Backward Euler". - 1 + Rosenbrock @@ -99,7 +99,7 @@ A configuration file for the MICM chemical solver. - ${CASEROOT} + ${RUNDIR}/musica_configurations/terminator/micm/config.json @@ -112,7 +112,7 @@ A configuration file for the TUV-x photolysis rate calculator - ${CASEROOT} + ${RUNDIR}/musica_configurations/terminator/tuvx/config.json @@ -125,7 +125,7 @@ A configuration file for the mapping of TUV-x photolysis rates to MICM custom rate parameters - ${CASEROOT} + ${RUNDIR}/musica_configurations/terminator/tuvx_micm_mapping.json \ No newline at end of file diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index eaac00dc..d8a2d652 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -1,3 +1,5 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx ! Note: "tuvx_t" is included in an external pre-built TUV-x library that the host @@ -10,6 +12,7 @@ module musica_ccpp_tuvx implicit none private + save public :: tuvx_register, tuvx_init, tuvx_run, tuvx_final @@ -29,7 +32,7 @@ module musica_ccpp_tuvx type(radiator_t), pointer :: aerosol_optics => null() type(index_mappings_t), pointer :: photolysis_rate_constants_mapping => null( ) integer, parameter :: DEFAULT_NUM_PHOTOLYSIS_RATE_CONSTANTS = 0 - integer :: number_of_photolysis_rate_constants = DEFAULT_NUM_PHOTOLYSIS_RATE_CONSTANTS + integer, protected :: number_of_photolysis_rate_constants = DEFAULT_NUM_PHOTOLYSIS_RATE_CONSTANTS contains @@ -129,8 +132,8 @@ end subroutine tuvx_register !> Initializes TUV-x subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & - wavelength_grid_interfaces, micm_rate_parameter_ordering, & - errmsg, errcode) + photolysis_wavelength_grid_interfaces_nm, & + micm_rate_parameter_ordering, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use musica_tuvx, only: grid_map_t, profile_map_t, radiator_map_t use musica_util, only: error_t, configuration_t, MUSICA_INDEX_MAPPINGS_MAP_ANY @@ -158,7 +161,7 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & integer, intent(in) :: vertical_layer_dimension ! (count) integer, intent(in) :: vertical_interface_dimension ! (count) - real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! m + real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces_nm(:) ! nm type(mappings_t), intent(in) :: micm_rate_parameter_ordering ! index mappings for MICM rate parameters character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -188,8 +191,8 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & return end if - wavelength_grid => create_wavelength_grid( wavelength_grid_interfaces, & - errmsg, errcode ) + wavelength_grid => create_wavelength_grid( & + photolysis_wavelength_grid_interfaces_nm, errmsg, errcode ) if (errcode /= 0) then call reset_tuvx_map_state( grids, null(), null() ) call cleanup_tuvx_resources() @@ -240,7 +243,7 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & end if extraterrestrial_flux_profile => create_extraterrestrial_flux_profile( & - wavelength_grid, wavelength_grid_interfaces, errmsg, errcode ) + wavelength_grid, photolysis_wavelength_grid_interfaces_nm, errmsg, errcode ) if (errcode /= 0) then call reset_tuvx_map_state( grids, profiles, null() ) call cleanup_tuvx_resources() @@ -507,7 +510,6 @@ subroutine tuvx_run(temperature, dry_air_density, & geopotential_height_wrt_surface_at_interface, & surface_geopotential, surface_temperature, & surface_albedo, & - photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, & standard_gravitational_acceleration, & cloud_area_fraction, & @@ -536,7 +538,6 @@ subroutine tuvx_run(temperature, dry_air_density, & real(kind_phys), intent(in) :: surface_geopotential(:) ! m2 s-2 (column) real(kind_phys), intent(in) :: surface_temperature(:) ! K (column) real(kind_phys), intent(in) :: surface_albedo(:) ! fraction (column) - real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm (wavelength interface) real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 (wavelength interface) real(kind_phys), intent(in) :: standard_gravitational_acceleration ! m s-2 real(kind_phys), intent(in) :: cloud_area_fraction(:,:) ! fraction (column, layer) @@ -561,8 +562,7 @@ subroutine tuvx_run(temperature, dry_air_density, & reciprocal_of_gravitational_acceleration = 1.0_kind_phys / standard_gravitational_acceleration - call set_extraterrestrial_flux_values( extraterrestrial_flux_profile, & - photolysis_wavelength_grid_interfaces, & + call set_extraterrestrial_flux_values( extraterrestrial_flux_profile, & extraterrestrial_flux, errmsg, errcode ) if (errcode /= 0) return @@ -639,6 +639,9 @@ end subroutine tuvx_run !> Finalizes TUV-x subroutine tuvx_final(errmsg, errcode) + use musica_ccpp_tuvx_extraterrestrial_flux, & + only: cleanup_photolysis_wavelength_grid_interfaces + character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -646,6 +649,7 @@ subroutine tuvx_final(errmsg, errcode) errcode = 0 call cleanup_tuvx_resources() + call cleanup_photolysis_wavelength_grid_interfaces() if (associated( tuvx )) then deallocate( tuvx ) diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_aerosol_optics.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_aerosol_optics.F90 index 94f0815a..137c341f 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_aerosol_optics.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_aerosol_optics.F90 @@ -1,4 +1,4 @@ -! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research ! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx_aerosol_optics implicit none diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_cloud_optics.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_cloud_optics.F90 index 8632176f..d005ed7a 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_cloud_optics.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_cloud_optics.F90 @@ -1,4 +1,4 @@ -! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research ! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx_cloud_optics implicit none diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 index 568954e9..8628be5b 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 @@ -1,52 +1,128 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx_extraterrestrial_flux use ccpp_kinds, only: kind_phys implicit none private - public :: create_extraterrestrial_flux_profile, set_extraterrestrial_flux_values + public :: create_extraterrestrial_flux_profile, set_extraterrestrial_flux_values, & + cleanup_photolysis_wavelength_grid_interfaces + + !> Wavelength grid interface object that stores interface array and size + type, private :: wavelength_grid_interfaces_t + real(kind_phys), allocatable :: interfaces(:) ! nm + integer :: size = 0 + contains + procedure :: deallocate_data => wavelength_grid_interfaces_t_deallocate_data + end type wavelength_grid_interfaces_t + + interface wavelength_grid_interfaces_t + procedure wavelength_grid_interfaces_t_constructor + end interface wavelength_grid_interfaces_t !> Label for extraterrestrial_flux in TUV-x character(len=*), parameter, public :: extraterrestrial_flux_label = "extraterrestrial flux" !> Unit for extraterrestrial_flux in TUV-x character(len=*), parameter, public :: extraterrestrial_flux_unit = "photon cm-2 s-1" !> Wavelength grid interface values - real(kind_phys), protected, allocatable :: wavelength_grid_interfaces_(:) ! nm - !> Default value of number of wavelength grid bins - integer, parameter :: DEFAULT_NUM_WAVELENGTH_BINS = 0 - !> Number of wavelength grid bins - integer, protected :: num_wavelength_bins_ = DEFAULT_NUM_WAVELENGTH_BINS + type(wavelength_grid_interfaces_t), protected, allocatable, public :: host_wavelength_grid_interfaces ! nm + type(wavelength_grid_interfaces_t), protected, allocatable, public :: tuvx_wavelength_grid_interfaces ! nm contains - !> Creates a TUV-x extraterrestrial flux profile from the host-model wavelength grid + !> Constructor for wavelength grid interface object + function wavelength_grid_interfaces_t_constructor(wavelength_grid_interfaces, size) & + result( this ) + + real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! nm + integer, intent(in) :: size + type(wavelength_grid_interfaces_t) :: this + + allocate( this%interfaces( size ) ) + this%interfaces(:) = wavelength_grid_interfaces(:) + this%size = size + + end function wavelength_grid_interfaces_t_constructor + + !> Deallocates memory for interface array + subroutine wavelength_grid_interfaces_t_deallocate_data(this) + class(wavelength_grid_interfaces_t), intent(inout) :: this + + if (allocated(this%interfaces)) then + deallocate(this%interfaces) + end if + + end subroutine wavelength_grid_interfaces_t_deallocate_data + + !> Deallocates memory for host and TUV-x photolysis wavelength grid interfaces + subroutine cleanup_photolysis_wavelength_grid_interfaces() + + if (allocated( host_wavelength_grid_interfaces )) then + call host_wavelength_grid_interfaces%deallocate_data() + deallocate( host_wavelength_grid_interfaces ) + end if + + if (allocated( tuvx_wavelength_grid_interfaces )) then + call tuvx_wavelength_grid_interfaces%deallocate_data() + deallocate( tuvx_wavelength_grid_interfaces ) + end if + + end subroutine cleanup_photolysis_wavelength_grid_interfaces + + !> Creates a TUV-x extraterrestrial flux profile based on the TUV-x wavelength grid + ! and initializes photolysis wavelength grid interfaces for the host and TUV-x function create_extraterrestrial_flux_profile(wavelength_grid, & - wavelength_grid_interfaces, errmsg, errcode) result( profile ) - use musica_util, only: error_t - use musica_ccpp_util, only: has_error_occurred - use musica_ccpp_tuvx_wavelength_grid, only: m_to_nm - use musica_tuvx_grid, only: grid_t - use musica_tuvx_profile, only: profile_t - - type(grid_t), intent(inout) :: wavelength_grid - real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! m - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errcode - type(profile_t), pointer :: profile + photolysis_wavelength_grid_interfaces, errmsg, errcode) result( profile ) + use musica_util, only: error_t + use musica_ccpp_util, only: has_error_occurred + use musica_tuvx_grid, only: grid_t + use musica_tuvx_profile, only: profile_t + + type(grid_t), intent(in) :: wavelength_grid + real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errcode + type(profile_t), pointer :: profile ! local variables - type(error_t) :: error + real(kind_phys), allocatable :: interfaces(:) ! nm + integer :: num_wavelength_grid_sections + type(error_t) :: error profile => profile_t( extraterrestrial_flux_label, extraterrestrial_flux_unit, & wavelength_grid, error ) if ( has_error_occurred( error, errmsg, errcode ) ) return - num_wavelength_bins_ = wavelength_grid%number_of_sections( error ) + num_wavelength_grid_sections = wavelength_grid%number_of_sections( error ) + if ( has_error_occurred( error, errmsg, errcode ) ) return + + allocate( interfaces( num_wavelength_grid_sections + 1), stat=errcode ) + if (errcode /= 0) then + errmsg = "[MUSICA Error] Failed to allocate memory for wavelength grid interfaces." + return + end if + + call wavelength_grid%get_edges( interfaces, error ) if ( has_error_occurred( error, errmsg, errcode ) ) return - allocate(wavelength_grid_interfaces_( size( wavelength_grid_interfaces ) )) + allocate( tuvx_wavelength_grid_interfaces, stat=errcode ) + if (errcode /= 0) then + errmsg = "[MUSICA Error] Failed to allocate memory for the TUV-x wavelength grid interfaces." + return + end if + tuvx_wavelength_grid_interfaces = wavelength_grid_interfaces_t_constructor( & + interfaces, num_wavelength_grid_sections + 1 ) + + allocate( host_wavelength_grid_interfaces, stat=errcode ) + if (errcode /= 0) then + errmsg = "[MUSICA Error] Failed to allocate memory for the host wavelength grid interfaces." + return + end if + host_wavelength_grid_interfaces = wavelength_grid_interfaces_t_constructor( & + photolysis_wavelength_grid_interfaces, size( photolysis_wavelength_grid_interfaces ) ) - wavelength_grid_interfaces_(:) = wavelength_grid_interfaces(:) * m_to_nm + deallocate( interfaces ) end function create_extraterrestrial_flux_profile @@ -54,11 +130,11 @@ end function create_extraterrestrial_flux_profile ! ! Extraterrestrial flux is read from data files and interpolated to the ! TUV-x wavelength grid. CAM extraterrestrial flux values are multiplied by the - ! width of the wavelength bins to get the TUV-x units of photon cm-2 s-1 + ! width of the wavelength bins to get the TUV-x units. + ! (photons cm-2 s-1 nm-1 -> photon cm-2 s-1) ! ! TUV-x only uses mid-point values for extraterrestrial flux - subroutine set_extraterrestrial_flux_values(profile, photolysis_wavelength_grid_interfaces, & - extraterrestrial_flux, errmsg, errcode) + subroutine set_extraterrestrial_flux_values(profile, extraterrestrial_flux, errmsg, errcode) use musica_ccpp_util, only: has_error_occurred use musica_tuvx_profile, only: profile_t use musica_util, only: error_t @@ -66,44 +142,51 @@ subroutine set_extraterrestrial_flux_values(profile, photolysis_wavelength_grid_ use ccpp_tuvx_utils, only: rebin type(profile_t), intent(inout) :: profile - real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm - real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 + real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 character(len=*), intent(out) :: errmsg integer, intent(out) :: errcode ! local variables - type(error_t) :: error - real(kind_phys) :: midpoints(num_wavelength_bins_) + real(kind_phys), allocatable :: flux_midpoints(:) ! photons cm-2 s-1 + type(error_t) :: error - if (.not. allocated(wavelength_grid_interfaces_)) then - errmsg = "[MUSICA Error] Failed to allocate the TUV-x wavelength grid interface array" + if (.not. allocated( host_wavelength_grid_interfaces )) then + errmsg = "[MUSICA Error] Failed to allocate the host model wavelength grid interfaces" errcode = 1 + call cleanup_photolysis_wavelength_grid_interfaces() return end if - if (num_wavelength_bins_ <= DEFAULT_NUM_WAVELENGTH_BINS) then - errmsg = "[MUSICA Error] Invalid size of TUV-x wavelength bins." + if (.not. allocated( tuvx_wavelength_grid_interfaces )) then + errmsg = "[MUSICA Error] Failed to allocate the TUV-x wavelength grid interfaces" errcode = 1 - deallocate( wavelength_grid_interfaces_ ) + call cleanup_photolysis_wavelength_grid_interfaces() return end if + allocate( flux_midpoints( tuvx_wavelength_grid_interfaces%size - 1 )) + ! Regrid normalized flux to TUV-x wavelength grid - call rebin( size(photolysis_wavelength_grid_interfaces) - 1, num_wavelength_bins_, & - photolysis_wavelength_grid_interfaces, wavelength_grid_interfaces_, & - extraterrestrial_flux, midpoints ) + ! This function fills the TUV-x flux_midpoints. + call rebin( host_wavelength_grid_interfaces%size - 1, & + tuvx_wavelength_grid_interfaces%size - 1, & + host_wavelength_grid_interfaces%interfaces, & + tuvx_wavelength_grid_interfaces%interfaces, & + extraterrestrial_flux, flux_midpoints ) ! Convert normalized flux to flux on TUV-x wavelength grid - midpoints = midpoints * ( wavelength_grid_interfaces_(2 : num_wavelength_bins_ + 1) & - - wavelength_grid_interfaces_(1 :num_wavelength_bins_) ) + ! This removes the "nm-1" of the extraterrestrial flux units. + flux_midpoints(:) = flux_midpoints(:) * & + ( tuvx_wavelength_grid_interfaces%interfaces(2 : tuvx_wavelength_grid_interfaces%size) - & + tuvx_wavelength_grid_interfaces%interfaces(1 : tuvx_wavelength_grid_interfaces%size - 1) ) - call profile%set_midpoint_values( midpoints, error) + call profile%set_midpoint_values( flux_midpoints, error) if ( has_error_occurred( error, errmsg, errcode ) ) then - deallocate( wavelength_grid_interfaces_ ) + call cleanup_photolysis_wavelength_grid_interfaces() return end if - deallocate( wavelength_grid_interfaces_ ) + deallocate( flux_midpoints ) end subroutine set_extraterrestrial_flux_values diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 index 74b73b17..7fd6c7c4 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 @@ -1,3 +1,5 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx_gas_species use ccpp_kinds, only: kind_phys @@ -8,9 +10,9 @@ module musica_ccpp_tuvx_gas_species set_gas_species_values !> Conversion factor from km to cm - real(kind_phys), parameter, public :: km_to_cm = 1.0e5 + real(kind_phys), parameter, public :: km_to_cm = 1.0e5_kind_phys !> Conversion factor from m3 to cm3 - real(kind_phys), parameter, public :: m_3_to_cm_3 = 1.0e6 + real(kind_phys), parameter, public :: m_3_to_cm_3 = 1.0e6_kind_phys contains diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 index 2fc38b97..4d0c071d 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 @@ -1,3 +1,5 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx_height_grid implicit none diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 index 916e5e97..ba4343f1 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 @@ -1,3 +1,5 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx_load_species use ccpp_kinds, only: kind_phys use musica_ccpp_species, only: MUSICA_INT_UNASSIGNED diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_surface_albedo.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_surface_albedo.F90 index a52894c3..d23e3c50 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_surface_albedo.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_surface_albedo.F90 @@ -1,8 +1,11 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx_surface_albedo implicit none private public :: create_surface_albedo_profile, set_surface_albedo_values + save !> Label for surface albedo in TUV-x character(len=*), parameter, public :: surface_albedo_label = "surface albedo" @@ -11,7 +14,7 @@ module musica_ccpp_tuvx_surface_albedo !> Default value of number of wavelength bins integer, parameter :: DEFAULT_NUM_WAVELENGTH_BINS = 0 !> Number of wavelength bins - integer, protected :: num_wavelength_bins_ = DEFAULT_NUM_WAVELENGTH_BINS + integer, protected :: num_wavelength_bins = DEFAULT_NUM_WAVELENGTH_BINS contains @@ -35,7 +38,7 @@ function create_surface_albedo_profile( wavelength_grid, errmsg, errcode ) & wavelength_grid, error ) if ( has_error_occurred( error, errmsg, errcode ) ) return - num_wavelength_bins_ = wavelength_grid%number_of_sections( error ) + num_wavelength_bins = wavelength_grid%number_of_sections( error ) if ( has_error_occurred( error, errmsg, errcode ) ) return end function create_surface_albedo_profile @@ -57,9 +60,9 @@ subroutine set_surface_albedo_values( profile, surface_albedo, & ! local variables type(error_t) :: error - real(kind_phys) :: surface_albedo_interfaces(num_wavelength_bins_ + 1) + real(kind_phys) :: surface_albedo_interfaces(num_wavelength_bins + 1) - if (num_wavelength_bins_ <= DEFAULT_NUM_WAVELENGTH_BINS) then + if (num_wavelength_bins <= DEFAULT_NUM_WAVELENGTH_BINS) then errmsg = "[MUSICA Error] Invalid size of TUV-x wavelength bins." errcode = 1 return @@ -72,4 +75,4 @@ subroutine set_surface_albedo_values( profile, surface_albedo, & end subroutine set_surface_albedo_values -end module musica_ccpp_tuvx_surface_albedo +end module musica_ccpp_tuvx_surface_albedo \ No newline at end of file diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_temperature.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_temperature.F90 index 7e9961b7..06c8b812 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_temperature.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_temperature.F90 @@ -1,3 +1,5 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx_temperature implicit none diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 index 20e34f5c..1613a21f 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 @@ -1,5 +1,6 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_tuvx_wavelength_grid - use ccpp_kinds, only: kind_phys implicit none @@ -21,38 +22,34 @@ module musica_ccpp_tuvx_wavelength_grid character(len=*), parameter, public :: wavelength_grid_label = "wavelength" !> Unit for wavelength grid in TUV-x character(len=*), parameter, public :: wavelength_grid_unit = "nm" - !> Conversion factor from meters to nanometers (CAM-SIMA -> TUV-x) - real(kind_phys), parameter, public :: m_to_nm = 1.0e9 contains !> Creates a TUV-x wavelength grid - function create_wavelength_grid( wavelength_grid_interfaces, errmsg, errcode ) & - result( wavelength_grid ) + function create_wavelength_grid( wavelength_grid_interfaces, & + errmsg, errcode ) result( wavelength_grid ) use ccpp_kinds, only: kind_phys use musica_ccpp_util, only: has_error_occurred use musica_tuvx_grid, only: grid_t use musica_util, only: error_t - real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! m + real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! nm character(len=*), intent(out) :: errmsg integer, intent(out) :: errcode type(grid_t), pointer :: wavelength_grid ! local variables - real(kind_phys) :: interfaces( size( wavelength_grid_interfaces ) ) ! nm reaL(kind_phys) :: midpoints( size( wavelength_grid_interfaces ) - 1 ) ! nm type(error_t) :: error - interfaces(:) = wavelength_grid_interfaces(:) * m_to_nm midpoints(:) = & - 0.5 * ( interfaces( 1: size( interfaces ) - 1 ) & - + interfaces( 2: size( interfaces ) ) ) + 0.5 * ( wavelength_grid_interfaces( 1: size( wavelength_grid_interfaces ) - 1 ) & + + wavelength_grid_interfaces( 2: size( wavelength_grid_interfaces ) ) ) wavelength_grid => grid_t( wavelength_grid_label, wavelength_grid_unit, & size( midpoints ), error ) if ( has_error_occurred( error, errmsg, errcode ) ) return - call wavelength_grid%set_edges( interfaces, error ) + call wavelength_grid%set_edges( wavelength_grid_interfaces, error ) if ( has_error_occurred( error, errmsg, errcode ) ) return call wavelength_grid%set_midpoints( midpoints, error ) if ( has_error_occurred( error, errmsg, errcode ) ) return diff --git a/schemes/musica/util/musica_ccpp_grid.F90 b/schemes/musica/util/musica_ccpp_grid.F90 new file mode 100644 index 00000000..e5cd6166 --- /dev/null +++ b/schemes/musica/util/musica_ccpp_grid.F90 @@ -0,0 +1,148 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_grid + + use ccpp_kinds, only: rk => kind_phys + + implicit none + private + + public :: grid_t, GRID_INVALID + + !> grid_t defines the dimensions for gridded data used in the model. + type :: grid_t + real(rk), allocatable :: interfaces_(:) !< Interfaces between grid sections + real(rk), allocatable :: centers_(:) !< Centers of grid sections + contains + procedure :: number_of_sections => grid_size + end type grid_t + + interface grid_t + module procedure grid_constructor_interfaces + module procedure grid_constructor_interfaces_centers + module procedure grid_constructor_evenly_spaced + end interface grid_t + + integer, parameter :: GRID_INVALID = 1 + +contains + + !> @brief Constructor for grid_t based on interfaces only + !> @param interfaces The interfaces between grid sections + !> @param error_message The error message if an error occurs + !> @param error_code The error code if an error occurs + !> @return The grid_t instance + function grid_constructor_interfaces(interfaces, error_message, error_code) & + result(grid) + type(grid_t) :: grid + real(rk), intent(in) :: interfaces(:) + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + integer :: i + error_code = 0 + error_message = '' + do i = 1, size(interfaces)-1 + if (interfaces(i) >= interfaces(i+1)) then + error_code = GRID_INVALID + error_message = 'Interfaces must be in increasing order' + return + end if + end do + grid%interfaces_ = interfaces + grid%centers_ = 0.5_rk * (grid%interfaces_(1:size(interfaces)-1) & + + grid%interfaces_(2:size(interfaces))) + end function grid_constructor_interfaces + + !> @brief Constructor for grid_t based on interfaces and centers + !> @param interfaces The interfaces between grid sections + !> @param centers The centers of grid sections + !> @param error_message The error message if an error occurs + !> @param error_code The error code if an error occurs + !> @return The grid_t instance + function grid_constructor_interfaces_centers(interfaces, centers, & + error_message, error_code) result(grid) + type(grid_t) :: grid + real(rk), intent(in) :: interfaces(:) + real(rk), intent(in) :: centers(:) + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + integer :: i + error_code = 0 + error_message = '' + if (size(interfaces) /= size(centers)+1) then + error_code = GRID_INVALID + error_message = 'Invalid dimensions for grid_t interfaces/centers' + end if + do i = 1, size(interfaces)-1 + if (interfaces(i) >= interfaces(i+1)) then + error_code = GRID_INVALID + error_message = 'Interfaces must be in increasing order' + return + end if + if (centers(i) < interfaces(i) .or. & + centers(i) > interfaces(i+1)) then + error_code = GRID_INVALID + error_message = 'Centers must be within grid interfaces' + return + end if + end do + grid%interfaces_ = interfaces + grid%centers_ = centers + end function grid_constructor_interfaces_centers + + !> @brief Constructor for grid_t based on evenly spaced centers + !> @param start The start of the grid + !> @param end The end of the grid + !> @param number_of_sections The number of sections in the grid + !> @param error_message The error message if an error occurs + !> @param error_code The error code if an error occurs + !> @return The grid_t instance + function grid_constructor_evenly_spaced(start, end, number_of_sections, & + error_message, error_code) result(grid) + type(grid_t) :: grid + real(rk), intent(in) :: start + real(rk), intent(in) :: end + integer, intent(in) :: number_of_sections + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + real(rk) :: delta + integer :: i + error_code = 0 + error_message = '' + if (number_of_sections < 1) then + error_code = GRID_INVALID + error_message = 'Number of sections must be at least 1' + return + end if + if (start >= end) then + error_code = GRID_INVALID + error_message = 'The start of the grid must be less than the end of the grid' + return + end if + delta = (end - start) / real(number_of_sections) + allocate(grid%interfaces_(number_of_sections+1), stat=error_code) + if (error_code /= 0) then + error_message = 'Failed to allocate memory for grid interfaces' + return + end if + allocate(grid%centers_(number_of_sections), stat=error_code) + if (error_code /= 0) then + error_message = 'Failed to allocate memory for grid centers' + return + end if + grid%interfaces_ = (/ (start + real(i-1) * delta, & + i=1, number_of_sections+1) /) + grid%centers_ = (/ (start + real(i-1) * delta + 0.5_rk * delta, & + i=1, number_of_sections) /) + end function grid_constructor_evenly_spaced + + !> @brief Get the number of sections in the grid + !> @param this The grid_t instance + !> @return The number of sections + function grid_size(this) result(number_of_sections) + class(grid_t), intent(in) :: this + integer :: number_of_sections + number_of_sections = size(this%interfaces_) - 1 + end function grid_size + +end module musica_ccpp_grid \ No newline at end of file diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/util/musica_ccpp_species.F90 similarity index 98% rename from schemes/musica/musica_ccpp_species.F90 rename to schemes/musica/util/musica_ccpp_species.F90 index 3f746a2f..1de229c4 100644 --- a/schemes/musica/musica_ccpp_species.F90 +++ b/schemes/musica/util/musica_ccpp_species.F90 @@ -1,3 +1,5 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_species use ccpp_kinds, only: kind_phys @@ -21,7 +23,7 @@ module musica_ccpp_species real(kind_phys) :: scale_height = 0.0_kind_phys ! km, TUV-x gas species optional contains ! Deallocates memory associated with this musica species object - procedure :: deallocate => musica_species_t_deallocate + procedure :: deallocate => musica_species_t_deallocate end type musica_species_t interface musica_species_t diff --git a/schemes/musica/musica_ccpp_util.F90 b/schemes/musica/util/musica_ccpp_util.F90 similarity index 66% rename from schemes/musica/musica_ccpp_util.F90 rename to schemes/musica/util/musica_ccpp_util.F90 index c87cce2f..84c43ef4 100644 --- a/schemes/musica/musica_ccpp_util.F90 +++ b/schemes/musica/util/musica_ccpp_util.F90 @@ -1,4 +1,4 @@ -! Copyright (C) 2024 National Center for Atmospheric Research, +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research ! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_util @@ -7,13 +7,26 @@ module musica_ccpp_util implicit none private - public :: has_error_occurred + public :: has_error_occurred, set_constants real(kind_phys), parameter, public :: PI = 3.14159265358979323846_kind_phys real(kind_phys), parameter, public :: DEGREE_TO_RADIAN = PI / 180.0_kind_phys + real(kind_phys), public, protected :: MOLAR_MASS_DRY_AIR = -HUGE(1.0_kind_phys) ! kg mol-1 + + !> Conversion factor for wavelength interfaces from meters (CAM-SIMA) to nanometers (TUV-x) + real(kind_phys), parameter, public :: m_to_nm = 1.0e9_kind_phys contains + !> @brief Set constants used for MUSICA components + !> @param[in] molar_mass_dry_air_in The molar mass of dry air (kg mol-1). + subroutine set_constants(molar_mass_dry_air_in) + + real(kind_phys), intent(in) :: molar_mass_dry_air_in + + MOLAR_MASS_DRY_AIR = molar_mass_dry_air_in + end subroutine set_constants + !> @brief Evaluate a MUSICA error for failure and convert to CCPP error data !> @param[in] error The error code to evaluate and convert. !> @param[out] error_message The CCPP error message. diff --git a/schemes/rasch_kristjansson/cloud_particle_sedimentation.F90 b/schemes/rasch_kristjansson/cloud_particle_sedimentation.F90 index 5732856a..3c7f4ff6 100644 --- a/schemes/rasch_kristjansson/cloud_particle_sedimentation.F90 +++ b/schemes/rasch_kristjansson/cloud_particle_sedimentation.F90 @@ -146,7 +146,7 @@ subroutine cloud_particle_sedimentation_run( & real(kind_phys), intent(out) :: wvtend(:,:) ! water vapor tendency [kg kg-1 s-1] -- to apply wv tendency real(kind_phys), intent(out) :: htend(:,:) ! heating rate [J kg-1 s-1] -- to apply s tendency real(kind_phys), intent(out) :: sfliq(:) ! surface flux of liquid (rain) [kg m-2 s-1] - real(kind_phys), intent(out) :: sfice(:) ! lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics [m s-1] + real(kind_phys), intent(out) :: sfice(:) ! stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation [m s-1] character(len=512), intent(out) :: errmsg ! error message integer, intent(out) :: errflg ! error flag @@ -361,7 +361,7 @@ subroutine cloud_particle_sedimentation_run( & sfliq(:ncol) = fxliq(:ncol, pverp)/(dtime*gravit) sfice(:ncol) = fxice(:ncol, pverp)/(dtime*gravit) - ! Convert lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics from kg m-2 s-1 to precip units m s-1 + ! Convert stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation from kg m-2 s-1 to precip units m s-1 sfice(:ncol) = sfice(:ncol)/1000._kind_phys end subroutine cloud_particle_sedimentation_run @@ -390,7 +390,6 @@ subroutine getflx(ncol, pver, pverp, & integer :: i, k real(kind_phys) :: psi(ncol, pverp) real(kind_phys) :: fdot(ncol, pverp) - real(kind_phys) :: xx(ncol) real(kind_phys) :: fxdot(ncol) real(kind_phys) :: fxdd(ncol) real(kind_phys) :: psistar(ncol) @@ -457,7 +456,6 @@ subroutine cfint2(ncol, pverp, & real(kind_phys) :: c2 real(kind_phys) :: c3 real(kind_phys) :: xx - real(kind_phys) :: xinf real(kind_phys) :: psi1, psi2, psi3, psim real(kind_phys) :: cfint real(kind_phys) :: cfnew @@ -551,7 +549,6 @@ subroutine cfdotmc(ncol, pver, pverp, x, f, fdot) real(kind_phys), intent(out) :: fdot(ncol, pverp) ! derivative at nodes integer :: i, k - real(kind_phys) :: a, b, c ! work var real(kind_phys) :: s(ncol, pverp) ! first divided differences at nodes real(kind_phys) :: sh(ncol, pverp) ! first divided differences between nodes real(kind_phys) :: d(ncol, pverp) ! second divided differences at nodes diff --git a/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta b/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta index 4b318031..cbe8705c 100644 --- a/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta +++ b/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta @@ -193,13 +193,13 @@ dimensions = (horizontal_loop_extent) intent = in [ pvliq ] - standard_name = vertical_velocity_of_cloud_liquid_water_due_to_sedimentation_tbd + standard_name = magnitude_of_vertical_pressure_velocity_of_cloud_liquid_water_due_to_sedimentation units = Pa s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = out [ pvice ] - standard_name = vertical_velocity_of_cloud_ice_due_to_sedimentation_tbd + standard_name = magnitude_of_vertical_pressure_velocity_of_cloud_ice_due_to_sedimentation units = Pa s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_interface_dimension) @@ -238,7 +238,7 @@ dimensions = (horizontal_loop_extent) intent = out [ sfice ] - standard_name = lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics + standard_name = stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation units = m s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent) diff --git a/schemes/rasch_kristjansson/prognostic_cloud_water.F90 b/schemes/rasch_kristjansson/prognostic_cloud_water.F90 index b2484d6b..d2f4d117 100644 --- a/schemes/rasch_kristjansson/prognostic_cloud_water.F90 +++ b/schemes/rasch_kristjansson/prognostic_cloud_water.F90 @@ -26,7 +26,6 @@ module prognostic_cloud_water real(kind_phys) :: rhonot ! air density at surface [g cm-3] real(kind_phys) :: rhos ! assumed snow density [g cm-3] real(kind_phys) :: rhow ! water density [g cm-3] - real(kind_phys) :: rhoi ! ice density [g cm-3] real(kind_phys) :: esi ! Collection efficiency for ice by snow [1] real(kind_phys) :: esw ! Collection efficiency for water by snow [1] real(kind_phys) :: t0 ! Approx. freezing temperature [K] @@ -120,10 +119,9 @@ subroutine prognostic_cloud_water_init( & rhonot = rhodair/1000.0_kind_phys ! convert from kg m-3 to g cm-3 - ! assumed densities of snow, water, ice [g cm-3] + ! assumed densities of snow, water [g cm-3] rhos = 0.1_kind_phys rhow = 1._kind_phys - rhoi = 1._kind_phys esi = 1._kind_phys esw = 0.1_kind_phys @@ -292,7 +290,7 @@ subroutine prognostic_cloud_water_run( & real(kind_phys), intent(out) :: qme(:,:) ! Rate of condensation-evaporation of condensate (net_condensation_rate_due_to_microphysics) [kg kg-1 s-1] real(kind_phys), intent(out) :: prodprec(:,:) ! Conversion rate of condensate to precip (precipitation_production_due_to_microphysics) [kg kg-1 s-1] real(kind_phys), intent(out) :: prodsnow(:,:) ! Snow production rate (ignored in RK?) [kg kg-1 s-1] - real(kind_phys), intent(out) :: evapprec(:,:) ! Falling precipitation evaporation rate (precipitation_evaporation_due_to_microphysics) [kg kg-1 s-1] -- & combined to apply q(wv) tendency + real(kind_phys), intent(out) :: evapprec(:,:) ! Falling precipitation evaporation rate (rate_of_evaporation_of_precipitation_due_to_microphysics) [kg kg-1 s-1] -- & combined to apply q(wv) tendency real(kind_phys), intent(out) :: evapsnow(:,:) ! Falling snow evaporation rate [kg kg-1 s-1] real(kind_phys), intent(out) :: evapheat(:,:) ! heating rate due to evaporation of precipitation [J kg-1 s-1] real(kind_phys), intent(out) :: prfzheat(:,:) ! heating rate due to freezing of precipitation [J kg-1 s-1] @@ -320,6 +318,7 @@ subroutine prognostic_cloud_water_run( & integer, intent(out) :: errflg ! error flag ! Local variables + real(kind_phys), parameter :: rhofw = 1000._kind_phys ! density of fresh water [kg m-3] integer :: i, k, l ! Iteration index [1] integer :: iter ! # of iterations for precipitation calculation [1] logical :: error_found ! Flag for error detection [flag] @@ -378,11 +377,9 @@ subroutine prognostic_cloud_water_run( & real(kind_phys) :: mincld ! Minimum cloud fraction [1] real(kind_phys) :: cpohl ! Ratio of specific heat to latent heat [K-1] real(kind_phys) :: hlocp ! Ratio of latent heat to specific heat [K] - real(kind_phys) :: clrh2o ! Ratio of latent heat to water vapor gas constant [K] real(kind_phys) :: dto2 ! Half timestep [s] ! Work variables - real(kind_phys) :: denom ! Denominator work variable [1] real(kind_phys) :: dqsdt ! Change in saturation specific humidity with temperature [kg kg-1 K-1] real(kind_phys) :: gamma(ncol) ! Temperature derivative of saturation specific humidity [kg kg-1 K-1] real(kind_phys) :: qtl(ncol) ! Saturation tendency [kg kg-1 s-1] @@ -400,7 +397,6 @@ subroutine prognostic_cloud_water_run( & errflg = 0 error_found = .false. - clrh2o = latvap/rh2o cpohl = cpair/latvap hlocp = latvap/cpair dto2 = 0.5_kind_phys * deltat @@ -845,8 +841,8 @@ subroutine prognostic_cloud_water_run( & ! ! If this conversion is removed in the future, the metadata needs to ! be updated. - precip(:ncol) = precip(:ncol)/1000._kind_phys - snowab(:ncol) = snowab(:ncol)/1000._kind_phys + precip(:ncol) = precip(:ncol)/rhofw + snowab(:ncol) = snowab(:ncol)/rhofw end subroutine prognostic_cloud_water_run ! Calculate the conversion of condensate to precipitate @@ -898,7 +894,6 @@ subroutine findmcnew( & integer :: ncols ! Number of active columns for microphysics (different from ncol!!) [count] integer :: ind(ncol) ! Active column indices [index] real(kind_phys) :: capn ! Local cloud particle number concentration [cm-3] - real(kind_phys) :: capnoice ! Cloud particle concentration excluding sea ice [cm-3] real(kind_phys) :: cldloc(ncol) ! Non-zero cloud fraction [1] real(kind_phys) :: cldpr(ncol) ! Cloud fraction for precipitation [1] real(kind_phys) :: totmr(ncol) ! In-cloud total water mixing ratio [kg kg-1] @@ -920,11 +915,7 @@ subroutine findmcnew( & real(kind_phys) :: rhocgs ! Air density in CGS units [g cm-3] real(kind_phys) :: r3l ! Cloud droplet volume radius [m] real(kind_phys) :: icrit ! Ice autoconversion threshold [kg kg-1] - real(kind_phys) :: wsi ! Sea ice weight factor [1] real(kind_phys) :: wt ! Ice fraction weight [1] - real(kind_phys) :: wland ! Land fraction weight [1] - real(kind_phys) :: wp ! Pressure dependence weight [1] - real(kind_phys) :: ftot ! Total fraction for conversion processes [1] real(kind_phys) :: con1 ! Work constant for radius calculation [m] real(kind_phys) :: con2 ! Work constant for density ratios [1] real(kind_phys) :: csacx ! Constant used for snow accreting liquid or ice [??] @@ -1119,8 +1110,6 @@ subroutine findmcnew( & fsacw(i) = 0._kind_phys fsaci(i) = 0._kind_phys endif - - ftot = fwaut(i)+fsaut(i)+fracw(i)+fsacw(i)+fsaci(i) end do end subroutine findmcnew diff --git a/schemes/rasch_kristjansson/prognostic_cloud_water.meta b/schemes/rasch_kristjansson/prognostic_cloud_water.meta index 6f59d935..c821416c 100644 --- a/schemes/rasch_kristjansson/prognostic_cloud_water.meta +++ b/schemes/rasch_kristjansson/prognostic_cloud_water.meta @@ -190,7 +190,7 @@ dimensions = (horizontal_loop_extent) intent = in [ ttend ] - standard_name = tendency_of_air_temperature_not_due_to_microphysics_tbd + standard_name = tendency_of_air_temperature_not_due_to_microphysics units = K s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -202,7 +202,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ qtend ] - standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics_tbd + standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -214,7 +214,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ ltend ] - standard_name = tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics_tbd + standard_name = tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -256,13 +256,13 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ rhdfda ] - standard_name = derivative_of_relative_humidity_wrt_cloud_fraction_tbd + standard_name = relative_humidity_divided_by_cloud_area_fraction_perturbation units = percent type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ rhu00 ] - standard_name = relative_humidity_threshold_for_prognostic_cloud_water_tbd + standard_name = relative_humidity_threshold_for_cloud_formation units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -304,31 +304,31 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ evapprec ] - standard_name = precipitation_evaporation_due_to_microphysics + standard_name = rate_of_evaporation_of_precipitation_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ evapsnow ] - standard_name = rate_of_evaporation_of_falling_snow_due_to_microphysics_tbd + standard_name = rate_of_evaporation_of_falling_snow_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ evapheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_evaporation_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ prfzheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_freezing_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ meltheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_phase_change_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -346,19 +346,19 @@ dimensions = (horizontal_loop_extent) intent = out [ ice2pr ] - standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_microphysics_tbd + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ liq2pr ] - standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_microphysics_tbd + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ liq2snow ] - standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_conversion_to_snow_tbd + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_snow_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -376,49 +376,49 @@ dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = out [ pracwo ] - standard_name = accretion_of_cloud_liquid_water_by_rain_tbd + standard_name = accretion_of_cloud_liquid_water_by_rain units = s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ psacwo ] - standard_name = accretion_of_cloud_liquid_water_by_snow_tbd + standard_name = accretion_of_cloud_liquid_water_by_snow units = s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ psacio ] - standard_name = accretion_of_cloud_ice_by_snow_tbd + standard_name = accretion_of_cloud_ice_by_snow units = s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fwaut ] - standard_name = relative_importance_of_liquid_autoconversion_tbd + standard_name = relative_importance_of_cloud_liquid_water_autoconversion units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fsaut ] - standard_name = relative_importance_of_ice_autoconversion_tbd + standard_name = relative_importance_of_cloud_ice_autoconversion units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fracw ] - standard_name = relative_importance_of_rain_accreting_liquid_tbd + standard_name = relative_importance_of_rain_accreting_cloud_liquid_water units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fsacw ] - standard_name = relative_importance_of_snow_accreting_liquid_tbd + standard_name = relative_importance_of_snow_accreting_cloud_liquid_water units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fsaci ] - standard_name = relative_importance_of_snow_accreting_ice_tbd + standard_name = relative_importance_of_snow_accreting_cloud_ice units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/rasch_kristjansson/rk_stratiform.F90 b/schemes/rasch_kristjansson/rk_stratiform.F90 index 64da34dd..ec2021e0 100644 --- a/schemes/rasch_kristjansson/rk_stratiform.F90 +++ b/schemes/rasch_kristjansson/rk_stratiform.F90 @@ -89,21 +89,23 @@ subroutine rk_stratiform_sedimentation_run( & ! Input arguments integer, intent(in) :: ncol real(kind_phys), intent(in) :: sfliq(:) ! stratiform_rain_flux_at_surface_due_to_sedimentation [kg m-2 s-1] - real(kind_phys), intent(in) :: snow_sed(:) ! sfice = lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics [m s-1] + real(kind_phys), intent(in) :: snow_sed(:) ! sfice = stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation [m s-1] ! Output arguments real(kind_phys), intent(out) :: prec_sed(:) ! stratiform_cloud_water_surface_flux_due_to_sedimentation [m s-1] real(kind_phys), intent(out) :: prec_str(:) ! lwe_large_scale_precipitation_rate_at_surface [m s-1] real(kind_phys), intent(out) :: snow_str(:) ! lwe_snow_and_cloud_ice_precipitation_rate_at_surface_due_to_microphysics [m s-1] - character(len=512), intent(out) :: errmsg ! error message - integer, intent(out) :: errflg ! error flag + character(len=512), intent(out) :: errmsg ! error message + integer, intent(out) :: errflg ! error flag + + real(kind_phys), parameter :: rhofw = 1000._kind_phys ! density of fresh water [kg m-3] errmsg = '' errflg = 0 ! Convert rain flux to precip units from mass units ! and create cloud water surface flux (rain + snow) - prec_sed(:ncol) = sfliq(:ncol)/1000._kind_phys + snow_sed(:ncol) + prec_sed(:ncol) = sfliq(:ncol)/rhofw + snow_sed(:ncol) ! Start accumulation of precipitation and snow flux [m s-1] prec_str(:ncol) = 0._kind_phys + prec_sed(:ncol) diff --git a/schemes/rasch_kristjansson/rk_stratiform.meta b/schemes/rasch_kristjansson/rk_stratiform.meta index f994c28b..f1ffe7f1 100644 --- a/schemes/rasch_kristjansson/rk_stratiform.meta +++ b/schemes/rasch_kristjansson/rk_stratiform.meta @@ -49,19 +49,19 @@ intent = in advected = true [ qcwat ] - standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = inout [ tcwat ] - standard_name = air_temperature_at_end_of_microphysics + standard_name = air_temperature_on_previous_timestep units = K type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = inout [ lcwat ] - standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -99,7 +99,7 @@ dimensions = (horizontal_loop_extent) intent = in [ snow_sed ] - standard_name = lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics + standard_name = stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation units = m s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent) @@ -290,13 +290,13 @@ dimensions = (horizontal_loop_extent) intent = in [ shallowcu ] - standard_name = shallow_convective_cloud_area_fraction_tbd + standard_name = shallow_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ deepcu ] - standard_name = deep_convective_cloud_area_fraction_tbd + standard_name = deep_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -332,19 +332,19 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ relhum ] - standard_name = relative_humidity_for_prognostic_cloud_water_tbd + standard_name = relative_humidity units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ rhu00 ] - standard_name = relative_humidity_threshold_for_prognostic_cloud_water_tbd + standard_name = relative_humidity_threshold_for_cloud_formation units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = inout [ rhdfda ] - standard_name = derivative_of_relative_humidity_wrt_cloud_fraction_tbd + standard_name = relative_humidity_divided_by_cloud_area_fraction_perturbation units = percent type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -412,37 +412,37 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ qcwat ] - standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ tcwat ] - standard_name = air_temperature_at_end_of_microphysics + standard_name = air_temperature_on_previous_timestep units = K type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ lcwat ] - standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ qtend ] - standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics_tbd + standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ ttend ] - standard_name = tendency_of_air_temperature_not_due_to_microphysics_tbd + standard_name = tendency_of_air_temperature_not_due_to_microphysics units = K s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ ltend ] - standard_name = tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics_tbd + standard_name = tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -510,7 +510,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ repartht ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_repartitioning_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -592,43 +592,43 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ evapheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_evaporation_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ prfzheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_freezing_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ meltheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_phase_change_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ repartht ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_repartitioning_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ evapprec ] - standard_name = precipitation_evaporation_due_to_microphysics + standard_name = rate_of_evaporation_of_precipitation_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ ice2pr ] - standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_microphysics_tbd + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ liq2pr ] - standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_microphysics_tbd + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -658,19 +658,19 @@ dimensions = (horizontal_loop_extent) intent = inout [ cmeheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_evaporation_within_stratiform_cloud_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ cmeice ] - standard_name = rate_of_condensation_evaporation_of_cloud_ice_within_stratiform_cloud_tbd + standard_name = rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ cmeliq ] - standard_name = rate_of_condensation_evaporation_of_cloud_liquid_water_within_stratiform_cloud_tbd + standard_name = rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -759,19 +759,19 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ qcwat ] - standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ tcwat ] - standard_name = air_temperature_at_end_of_microphysics + standard_name = air_temperature_on_previous_timestep units = K type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ lcwat ] - standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.F90 b/schemes/rrtmgp/objects/ccpp_fluxes.F90 new file mode 100644 index 00000000..062f55e3 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes.F90 @@ -0,0 +1,11 @@ +module ccpp_fluxes + ! CCPP wrapper for ty_fluxes_broadband DDT from RRTMGP + use mo_fluxes, only: ty_fluxes_broadband + + !> \section arg_table_ty_fluxes_broadband_ccpp Argument Table + !! \htmlinclude ty_fluxes_broadband_ccpp.html + type, public :: ty_fluxes_broadband_ccpp + type(ty_fluxes_broadband) :: fluxes + end type + +end module ccpp_fluxes diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.meta b/schemes/rrtmgp/objects/ccpp_fluxes.meta new file mode 100644 index 00000000..9ee8e981 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_fluxes_broadband_ccpp + type = ddt +# dependencies = /path/to/ext/rte-frontend/mo_fluxes.F90 + +[ccpp-arg-table] + name = ty_fluxes_broadband_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 b/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 new file mode 100644 index 00000000..67c2bddb --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 @@ -0,0 +1,11 @@ +module ccpp_fluxes_byband + ! CCPP wrapper for ty_fluxes_byband DDT from RRTMGP + use mo_fluxes_byband, only: ty_fluxes_byband + + !> \section arg_table_ty_fluxes_byband_ccpp Argument Table + !! \htmlinclude ty_fluxes_byband_ccpp.html + type, public :: ty_fluxes_byband_ccpp + type(ty_fluxes_byband) :: fluxes + end type + +end module ccpp_fluxes_byband diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta new file mode 100644 index 00000000..43b7ed45 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_fluxes_byband_ccpp + type = ddt +# dependencies = /path/to/ext/extensions/mo_fluxes_byband.F90 + +[ccpp-arg-table] + name = ty_fluxes_byband_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 b/schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 new file mode 100644 index 00000000..3b3dd96e --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 @@ -0,0 +1,11 @@ +module ccpp_gas_concentrations + ! CCPP wrapper for ty_gas_concs DDT from RRTMGP + use mo_gas_concentrations, only: ty_gas_concs + + !> \section arg_table_ty_gas_concs_ccpp Argument Table + !! \htmlinclude ty_gas_concs_ccpp.html + type, public :: ty_gas_concs_ccpp + type(ty_gas_concs) :: gas_concs + end type + +end module ccpp_gas_concentrations diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta new file mode 100644 index 00000000..209221c0 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_gas_concs_ccpp + type = ddt +# dependencies = /path/to/ext/gas-optics/mo_gas_concentrations.F90 + +[ccpp-arg-table] + name = ty_gas_concs_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 new file mode 100644 index 00000000..158da748 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 @@ -0,0 +1,11 @@ +module ccpp_gas_optics_rrtmgp + ! CCPP wrapper for ty_gas_optics_rrtmgp DDT from RRTMGP + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + + !> \section arg_table_ty_gas_optics_rrtmgp_ccpp Argument Table + !! \htmlinclude ty_gas_optics_rrtmgp_ccpp.html + type, public :: ty_gas_optics_rrtmgp_ccpp + type(ty_gas_optics_rrtmgp) :: gas_props + end type + +end module ccpp_gas_optics_rrtmgp diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta new file mode 100644 index 00000000..e1e0df46 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_gas_optics_rrtmgp_ccpp + type = ddt +# dependencies = /path/to/ext/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 + +[ccpp-arg-table] + name = ty_gas_optics_rrtmgp_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.F90 b/schemes/rrtmgp/objects/ccpp_optical_props.F90 new file mode 100644 index 00000000..2e28c582 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_optical_props.F90 @@ -0,0 +1,18 @@ +module ccpp_optical_props + ! CCPP wrapper for ty_optical_props_* DDTs from RRTMGP + use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_2str + + !> \section arg_table_ty_optical_props_1scl_ccpp Argument Table + !! \htmlinclude ty_optical_props_1scl_ccpp.html + type, public :: ty_optical_props_1scl_ccpp + type(ty_optical_props_1scl) :: optical_props + end type + + !> \section arg_table_ty_optical_props_2str_ccpp Argument Table + !! \htmlinclude ty_optical_props_2str_ccpp.html + type, public :: ty_optical_props_2str_ccpp + type(ty_optical_props_2str) :: optical_props + end type + +end module ccpp_optical_props diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.meta b/schemes/rrtmgp/objects/ccpp_optical_props.meta new file mode 100644 index 00000000..f14b163a --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_optical_props.meta @@ -0,0 +1,16 @@ +[ccpp-table-properties] + name = ty_optical_props_1scl_ccpp + type = ddt +# dependencies = /path/to/ext/rte-frontend/mo_optical_props.F90 + +[ccpp-arg-table] + name = ty_optical_props_1scl_ccpp + type = ddt + +[ccpp-table-properties] + name = ty_optical_props_2str_ccpp + type = ddt + +[ccpp-arg-table] + name = ty_optical_props_2str_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.F90 b/schemes/rrtmgp/objects/ccpp_source_functions.F90 new file mode 100644 index 00000000..56e65e3d --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_source_functions.F90 @@ -0,0 +1,11 @@ +module ccpp_source_functions + ! CCPP wrapper for ty_source_func_lw DDT from RRTMGP + use mo_source_functions, only: ty_source_func_lw + + !> \section arg_table_ty_source_func_lw_ccpp Argument Table + !! \htmlinclude ty_source_func_lw_ccpp.html + type, public :: ty_source_func_lw_ccpp + type(ty_source_func_lw) :: sources + end type + +end module ccpp_source_functions diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.meta b/schemes/rrtmgp/objects/ccpp_source_functions.meta new file mode 100644 index 00000000..03a0bbee --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_source_functions.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_source_func_lw_ccpp + type = ddt +# dependencies = /path/to/ext/rte-frontend/mo_source_functions.F90 + +[ccpp-arg-table] + name = ty_source_func_lw_ccpp + type = ddt diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 new file mode 100644 index 00000000..c2b69468 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -0,0 +1,627 @@ +module rrtmgp_inputs + + implicit none + private + + public :: rrtmgp_inputs_init + public :: rrtmgp_inputs_run + + contains +!> \section arg_table_rrtmgp_inputs_init Argument Table +!! \htmlinclude rrtmgp_inputs_init.html +!! + subroutine rrtmgp_inputs_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, nswbands, & + pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & + timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, is_root, & + nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & + idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, nlayp, & + nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp + + ! Inputs + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: nradgas ! Number of radiatively active gases + integer, intent(in) :: pverp ! Number of vertical interfaces + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative). + integer, intent(in) :: timestep_size ! Timestep size (s) + integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: iulog ! Logging unit + integer, intent(in) :: gasnamelength ! Length of all of the gas_list entries + real(kind_phys), intent(in) :: current_cal_day ! Current calendar day + real(kind_phys), dimension(:), intent(in) :: pref_edge ! Reference pressures (interfaces) (Pa) + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + logical, intent(in) :: is_first_step ! Flag for whether this is the first timestep (.true. = yes) + logical, intent(in) :: is_first_restart_step ! Flag for whether this is the first restart step (.true. = yes) + logical, intent(in) :: use_rad_dt_cosz ! Use adjusted radiation timestep for cosz calculation + logical, intent(in) :: is_root ! Flag for whether this is the root task + + ! Outputs + integer, intent(out) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(out) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(out) :: nlaycam ! Number of vertical layers in CAM. Is either equal to nlay + ! or is 1 less than nlay if "extra layer" is used in the radiation calculations + integer, intent(out) :: nlay ! Number of vertical layers in radiation calculation + integer, intent(out) :: nlayp ! Number of vertical interfaces in radiation calculations (nlay + 1) + ! Indices to specific bands for diagnostic output and COSP input + integer, intent(out) :: idx_sw_diag ! Index of band containing 500-nm wave + integer, intent(out) :: idx_nir_diag ! Index of band containing 1000-nm wave + integer, intent(out) :: idx_uv_diag ! Index of band containing 400-nm wave + integer, intent(out) :: idx_sw_cloudsim ! Index of band for shortwave cosp diagnostics + integer, intent(out) :: idx_lw_diag ! Index of band containing 1000-cm-1 wave (H2O window) + integer, intent(out) :: idx_lw_cloudsim ! Index of band for longwave cosp diagnostics + + integer, intent(out) :: nswgpts ! Number of shortwave g-points + integer, intent(out) :: nlwgpts ! Number of longwave g-points + integer, dimension(:,:), intent(out) :: band2gpt_sw ! Array for converting shortwave band limits to g-points + real(kind_phys), intent(out) :: nextsw_cday ! The next calendar day during which the shortwave radiation calculation will be performed + real(kind_phys), dimension(:), intent(out) :: sw_low_bounds ! Lower bounds of shortwave bands + real(kind_phys), dimension(:), intent(out) :: sw_high_bounds ! Upper bounds of shortwave bands + real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave radiative heating + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(inout) :: irad_always ! Number of time steps to execute radiation continuously + real(kind_phys), intent(inout) :: dt_avg ! averaging time interval for zenith angle + + ! Local variables + real(kind_phys), target :: wavenumber_low_shortwave(nswbands) + real(kind_phys), target :: wavenumber_high_shortwave(nswbands) + real(kind_phys), target :: wavenumber_low_longwave(nlwbands) + real(kind_phys), target :: wavenumber_high_longwave(nlwbands) + + ! Set error variables + errflg = 0 + errmsg = '' + + ! Number of layers in radiation calculation is capped by the number of + ! pressure interfaces below 1 Pa. When the entire model atmosphere is + ! below 1 Pa then an extra layer is added to the top of the model for + ! the purpose of the radiation calculation. + nlay = count( pref_edge(:) > 1._kind_phys ) ! pascals (0.01 mbar) + nlayp = nlay + 1 + + if (nlay == pverp) then + ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus + ! 1 extra layer between model top and 1 Pa. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + else if (nlay == (pverp-1)) then + ! Special case nlay == (pverp-1) -- topmost interface outside bounds (CAM MT config), treat as if it is ok. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + nlay = nlay+1 ! reassign the value so later code understands to treat this case like nlay==pverp + if (is_root) then + write(iulog,*) 'RADIATION_INIT: Special case of 1 model interface at p < 1Pa. Top layer will be INCLUDED in radiation calculation.' + write(iulog,*) 'RADIATION_INIT: nlay = ',nlay, ' same as pverp: ',nlay==pverp + end if + else + ! nlay < pverp. nlay layers are used in radiation calcs, and they are + ! all CAM layers. + ktopcam = pver - nlay + 1 + ktoprad = 1 + nlaycam = nlay + end if + + ! Set the sw/lw band boundaries in radconstants. Also sets + ! indicies of specific bands for diagnostic output and COSP input. + call set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & + idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & + wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & + wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + + call radiation_utils_init(nswbands, nlwbands, wavenumber_low_shortwave, wavenumber_high_shortwave, & + wavenumber_low_longwave, wavenumber_high_longwave, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Initialize the SW band boundaries + call get_sw_spectral_boundaries_ccpp(sw_low_bounds, sw_high_bounds, 'cm^-1', errmsg, errflg) + if (errflg /= 0) then + return + end if + + if (is_first_step) then + qrl = 0._kind_phys + end if + + ! Set the radiation timestep for cosz calculations if requested using + ! the adjusted iradsw value from radiation + if (use_rad_dt_cosz) then + dt_avg = iradsw*timestep_size + end if + + ! "irad_always" is number of time steps to execute radiation continuously from + ! start of initial OR restart run + if (irad_always > 0) then + irad_always = irad_always + nstep + end if + + ! Surface components to get radiation computed today + if (.not. is_first_restart_step) then + nextsw_cday = current_cal_day + end if + + end subroutine rrtmgp_inputs_init + +!> \section arg_table_rrtmgp_inputs_run Argument Table +!! \htmlinclude rrtmgp_inputs_run.html +!! + subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & + pmid, pint, t, nday, idxday, cldfprime, & + coszrs, kdist_sw, t_sfc, emis_sfc, t_rad, pmid_rad, & + pint_rad, t_day, pmid_day, pint_day, coszrs_day, & + alb_dir, alb_dif, lwup, stebol, ncol, ktopcam, ktoprad, & + nswbands, asdir, asdif, sw_low_bounds, sw_high_bounds, & + aldir, aldif, nlay, pverp, pver, cld, cldfsnow, & + cldfgrau, graupel_in_rad, gasnamelength, gaslist_lc, & + gas_concs_lw, aer_lw, atm_optics_lw, kdist_lw, & + sources_lw, aer_sw, atm_optics_sw, gas_concs_sw, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use atmos_phys_rad_utils, only: is_visible + ! Inputs + logical, intent(in) :: graupel_in_rad ! Flag to include graupel in radiation calculation + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: pverp ! Number of vertical interfaces + integer, intent(in) :: nlay ! Number of vertical layers used in radiation calculation + integer, intent(in) :: nswbands ! Number of shortwave bands + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: gasnamelength ! Length of gases in gas_list + integer, intent(in) :: nday ! Number of daylight columns + logical, intent(in) :: dosw ! Flag for performing the shortwave calculation + logical, intent(in) :: dolw ! Flag for performing the longwave calculation + logical, intent(in) :: snow_associated ! Flag for whether the cloud snow fraction argument should be used + logical, intent(in) :: graupel_associated ! Flag for whether the cloud graupel fraction argument should be used + integer, dimension(:), intent(in) :: idxday ! Indices of daylight columns + real(kind_phys), dimension(:,:), intent(in) :: pmid ! Air pressure at midpoint (Pa) + real(kind_phys), dimension(:,:), intent(in) :: pint ! Air pressure at interface (Pa) + real(kind_phys), dimension(:,:), intent(in) :: t ! Air temperature (K) + real(kind_phys), dimension(:,:), intent(in) :: cldfsnow ! Cloud fraction of just "snow clouds" + real(kind_phys), dimension(:,:), intent(in) :: cldfgrau ! Cloud fraction of just "graupel clouds" + real(kind_phys), dimension(:,:), intent(in) :: cld ! Cloud fraction (liq+ice) + real(kind_phys), dimension(:), intent(in) :: sw_low_bounds ! Lower bounds for shortwave bands + real(kind_phys), dimension(:), intent(in) :: sw_high_bounds ! Upper bounds for shortwave bands + real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine of solar senith angle (radians) + real(kind_phys), dimension(:), intent(in) :: lwup ! Longwave up flux (W m-2) + real(kind_phys), dimension(:), intent(in) :: asdir ! Shortwave direct albedo (fraction) + real(kind_phys), dimension(:), intent(in) :: asdif ! Shortwave diffuse albedo (fraction) + real(kind_phys), dimension(:), intent(in) :: aldir ! Longwave direct albedo (fraction) + real(kind_phys), dimension(:), intent(in) :: aldif ! Longwave diffuse albedo (fraction) + real(kind_phys), intent(in) :: stebol ! Stefan-Boltzmann constant (W m-2 K-4) + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + character(len=*), dimension(:), intent(in) :: gaslist_lc ! Radiatively active gases + ! Outputs + real(kind_phys), dimension(:,:), intent(out) :: t_rad ! Air temperature with radiation indexing (K) + real(kind_phys), dimension(:,:), intent(out) :: pmid_rad ! Midpoint pressure with radiation indexing (Pa) + real(kind_phys), dimension(:,:), intent(out) :: pint_rad ! Interface pressure with radiation indexing (Pa) + real(kind_phys), dimension(:,:), intent(out) :: t_day ! Air temperature of daylight columns (K) + real(kind_phys), dimension(:,:), intent(out) :: pint_day ! Interface pressure of daylight columns (Pa) + real(kind_phys), dimension(:,:), intent(out) :: pmid_day ! Midpoint pressure of daylight columns (Pa) + real(kind_phys), dimension(:,:), intent(out) :: emis_sfc ! Surface emissivity (fraction) + real(kind_phys), dimension(:,:), intent(out) :: alb_dir ! Surface albedo due to UV and VIS direct (fraction) + real(kind_phys), dimension(:,:), intent(out) :: alb_dif ! Surface albedo due to IR diffused (fraction) + real(kind_phys), dimension(:,:), intent(out) :: cldfprime ! modified cloud fraciton + + real(kind_phys), dimension(:), intent(out) :: t_sfc ! Surface temperature (K) + real(kind_phys), dimension(:), intent(out) :: coszrs_day ! Cosine of solar zenith angle for daylight columns (radians) + type(ty_gas_concs_ccpp), intent(out) :: gas_concs_lw ! Gas concentrations object for longwave radiation + type(ty_optical_props_1scl_ccpp), intent(out) :: atm_optics_lw ! Atmosphere optical properties object for longwave radiation + type(ty_optical_props_1scl_ccpp), intent(out) :: aer_lw ! Aerosol optical properties object for longwave radiation + type(ty_source_func_lw_ccpp), intent(out) :: sources_lw ! Longwave sources object for longwave radiation + type(ty_gas_concs_ccpp), intent(out) :: gas_concs_sw ! Gas concentrations object for shortwave radiation + type(ty_optical_props_2str_ccpp), intent(out) :: atm_optics_sw ! Atmosphere optical properties object for shortwave radiation + type(ty_optical_props_2str_ccpp), intent(out) :: aer_sw ! Aerosol optical properties object for shortwave radiation + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + real(kind_phys) :: tref_min + real(kind_phys) :: tref_max + integer :: idx, kdx, iband + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dosw .and. .not. dolw) then + return + end if + + ! RRTMGP set state + t_sfc = sqrt(sqrt(lwup(:)/stebol)) ! Surface temp set based on longwave up flux. + + ! Set surface emissivity to 1.0. + ! The land model *does* have its own surface emissivity, but is not spectrally resolved. + ! The LW upward flux is calculated with that land emissivity, and the "radiative temperature" + ! t_sfc is derived from that flux. We assume, therefore, that the emissivity is unity + ! to be consistent with t_sfc. + emis_sfc(:,:) = 1._kind_phys + + ! Level ordering is the same for both CAM and RRTMGP (top to bottom) + t_rad(:,ktoprad:) = t(:,ktopcam:) + pmid_rad(:,ktoprad:) = pmid(:,ktopcam:) + pint_rad(:,ktoprad:) = pint(:,ktopcam:) + + ! Add extra layer values if needed. + if (nlay == pverp) then + t_rad(:,1) = t(:,1) + ! The top reference pressure from the RRTMGP coefficients datasets is 1.005183574463 Pa + ! Set the top of the extra layer just below that. + pint_rad(:,1) = 1.01_kind_phys + + ! next interface down in LT will always be > 1Pa + ! but in MT we apply adjustment to have it be 1.02 Pa if it was too high + where (pint_rad(:,2) <= pint_rad(:,1)) pint_rad(:,2) = pint_rad(:,1)+0.01_kind_phys + + ! set the highest pmid (in the "extra layer") to the midpoint (guarantees > 1Pa) + pmid_rad(:,1) = pint_rad(:,1) + 0.5_kind_phys * (pint_rad(:,2) - pint_rad(:,1)) + + ! For case of CAM MT, also ensure pint_rad(:,2) > pint_rad(:,1) & pmid_rad(:,2) > max(pmid_rad(:,1), min_pressure) + where (pmid_rad(:,2) <= kdist_sw%gas_props%get_press_min()) pmid_rad(:,2) = pint_rad(:,2) + 0.01_kind_phys + else + ! nlay < pverp, thus the 1 Pa level is within a CAM layer. Assuming the top interface of + ! this layer is at a pressure < 1 Pa, we need to adjust the top of this layer so that it + ! is within the valid pressure range of RRTMGP (otherwise RRTMGP issues an error). Then + ! set the midpoint pressure halfway between the interfaces. + pint_rad(:,1) = 1.01_kind_phys + pmid_rad(:,1) = 0.5_kind_phys * (pint_rad(:,1) + pint_rad(:,2)) + end if + + ! Limit temperatures to be within the limits of RRTMGP validity. + tref_min = kdist_sw%gas_props%get_temp_min() + tref_max = kdist_sw%gas_props%get_temp_max() + t_rad = merge(t_rad, tref_min, t_rad > tref_min) + t_rad = merge(t_rad, tref_max, t_rad < tref_max) + + ! Construct arrays containing only daylight columns + do idx = 1, nday + t_day(idx,:) = t_rad(idxday(idx),:) + pmid_day(idx,:) = pmid_rad(idxday(idx),:) + pint_day(idx,:) = pint_rad(idxday(idx),:) + coszrs_day(idx) = coszrs(idxday(idx)) + end do + ! Assign albedos to the daylight columns (from E3SM implementation) + ! Albedos are imported from the surface models as broadband (visible, and near-IR), + ! and we need to map these to appropriate narrower bands used in RRTMGP. Bands + ! are categorized broadly as "visible/UV" or "infrared" based on wavenumber. + ! Loop over bands, and determine for each band whether it is broadly in the + ! visible or infrared part of the spectrum based on a dividing line of + ! 0.7 micron, or 14286 cm^-1 + do iband = 1,nswbands + if (is_visible(sw_low_bounds(iband)) .and. & + is_visible(sw_high_bounds(iband))) then + + ! Entire band is in the visible + do idx = 1, nday + alb_dir(iband,idx) = asdir(idxday(idx)) + alb_dif(iband,idx) = asdif(idxday(idx)) + end do + + else if (.not.is_visible(sw_low_bounds(iband)) .and. & + .not.is_visible(sw_high_bounds(iband))) then + ! Entire band is in the longwave (near-infrared) + do idx = 1, nday + alb_dir(iband,idx) = aldir(idxday(idx)) + alb_dif(iband,idx) = aldif(idxday(idx)) + end do + else + ! Band straddles the visible to near-infrared transition, so we take + ! the albedo to be the average of the visible and near-infrared + ! broadband albedos + do idx = 1, nday + alb_dir(iband,idx) = 0.5_kind_phys * (aldir(idxday(idx)) + asdir(idxday(idx))) + alb_dif(iband,idx) = 0.5_kind_phys * (aldif(idxday(idx)) + asdif(idxday(idx))) + end do + end if + end do + ! Strictly enforce albedo bounds + where (alb_dir < 0) + alb_dir = 0.0_kind_phys + end where + where (alb_dir > 1) + alb_dir = 1.0_kind_phys + end where + where (alb_dif < 0) + alb_dif = 0.0_kind_phys + end where + where (alb_dif > 1) + alb_dif = 1.0_kind_phys + end where + + ! modified cloud fraction + ! Compute modified cloud fraction, cldfprime. + ! 1. initialize as cld + ! 2. modify for snow. use max(cld, cldfsnow) + ! 3. modify for graupel if graupel_in_rad is true. + ! use max(cldfprime, cldfgrau) + if (snow_associated) then + do kdx = 1, pver + do idx = 1, ncol + cldfprime(idx,kdx) = max(cld(idx,kdx), cldfsnow(idx,kdx)) + end do + end do + else + cldfprime(:,:) = cld(:,:) + end if + + if (graupel_associated .and. graupel_in_rad) then + do kdx = 1, pver + do idx = 1, ncol + cldfprime(idx,kdx) = max(cldfprime(idx,kdx), cldfgrau(idx,kdx)) + end do + end do + end if + + ! If no daylight columns, can't create empty RRTMGP objects + if (dosw .and. nday > 0) then + ! Initialize object for gas concentrations. + errmsg = gas_concs_sw%gas_concs%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for combined gas + aerosol + cloud optics. + ! Allocates arrays for properties represented on g-points. + errmsg = atm_optics_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for SW aerosol optics. Allocates arrays + ! for properties represented by band. + errmsg = aer_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props%get_band_lims_wavenumber()) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + end if + + if (dolw) then + ! Initialize object for gas concentrations + errmsg = gas_concs_lw%gas_concs%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for combined gas + aerosol + cloud optics. + errmsg = atm_optics_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for LW aerosol optics. + errmsg = aer_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props%get_band_lims_wavenumber()) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for Planck sources. + errmsg = sources_lw%sources%alloc(ncol, nlay, kdist_lw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + end if + + end subroutine rrtmgp_inputs_run + +!========================================================================================= +! HELPER FUNCTIONS ! +!========================================================================================= + subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & + idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & + wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & + wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_kinds, only: kind_phys + ! Set the low and high limits of the wavenumber grid for sw and lw. + ! Values come from RRTMGP coefficients datasets, and are stored in the + ! kdist objects. + ! + ! Set band indices for bands containing specific wavelengths. + + ! Arguments + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands + + integer, intent(out) :: idx_sw_diag + integer, intent(out) :: idx_nir_diag + integer, intent(out) :: idx_uv_diag + integer, intent(out) :: idx_sw_cloudsim + integer, intent(out) :: idx_lw_diag + integer, intent(out) :: idx_lw_cloudsim + integer, intent(out) :: nswgpts + integer, intent(out) :: nlwgpts + integer, dimension(:,:), intent(out) :: band2gpt_sw + real(kind_phys), dimension(:), intent(out) :: wavenumber_low_shortwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_high_shortwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_low_longwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_high_longwave + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: istat + real(kind_phys), allocatable :: values(:,:) + character(len=256) :: alloc_errmsg + + character(len=*), parameter :: sub = 'set_wavenumber_bands' + !---------------------------------------------------------------------------- + + ! Initialize error variables + errflg = 0 + errmsg = '' + ! Check that number of sw/lw bands in gas optics files matches the parameters. + if (kdist_sw%gas_props%get_nband() /= nswbands) then + write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of sw bands in file, ', kdist_sw%gas_props%get_nband(), & + ", doesn't match parameter nswbands= ", nswbands + errflg = 1 + return + end if + if (kdist_lw%gas_props%get_nband() /= nlwbands) then + write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of lw bands in file, ', kdist_lw%gas_props%get_nband(), & + ", doesn't match parameter nlwbands= ", nlwbands + errflg = 1 + return + end if + + nswgpts = kdist_sw%gas_props%get_ngpt() + nlwgpts = kdist_lw%gas_props%get_ngpt() + + ! SW band bounds in cm^-1 + allocate( values(2,nswbands), stat=istat, errmsg=alloc_errmsg ) + if (istat/=0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nswbands); message - ', alloc_errmsg + errflg = 1 + return + end if + values = kdist_sw%gas_props%get_band_lims_wavenumber() + wavenumber_low_shortwave = values(1,:) + wavenumber_high_shortwave = values(2,:) + + ! First and last g-point for each SW band: + band2gpt_sw = kdist_sw%gas_props%get_band_lims_gpoint() + + ! Indices into specific bands + call get_band_index_by_value('sw', 500.0_kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 1000.0_kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_nir_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 400._kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_uv_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 0.67_kind_phys, 'micron', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_cloudsim, errmsg, errflg) + if (errflg /= 0) then + return + end if + + deallocate(values) + + ! LW band bounds in cm^-1 + allocate( values(2,nlwbands), stat=istat, errmsg=alloc_errmsg ) + if (istat/=0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nlwbands); message - ', alloc_errmsg + errflg = 1 + return + end if + values = kdist_lw%gas_props%get_band_lims_wavenumber() + wavenumber_low_longwave = values(1,:) + wavenumber_high_longwave = values(2,:) + + ! Indices into specific bands + call get_band_index_by_value('lw', 1000.0_kind_phys, 'cm^-1', nlwbands, & + wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('lw', 10.5_kind_phys, 'micron', nlwbands, & + wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_cloudsim, errmsg, errflg) + if (errflg /= 0) then + return + end if + + end subroutine set_wavenumber_bands + +!========================================================================================= + + subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_low, & + wavenumber_high, ans, errmsg, errflg) + use ccpp_kinds, only: kind_phys + + ! Find band index for requested wavelength/wavenumber. + + character(len=*), intent(in) :: swlw ! sw or lw bands + real(kind_phys), intent(in) :: targetvalue + character(len=*), intent(in) :: units ! units of targetvalue + integer, intent(in) :: nbnds + real(kind_phys), dimension(:), intent(in) :: wavenumber_low + real(kind_phys), dimension(:), intent(in) :: wavenumber_high + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(out) :: ans + + ! local + real(kind_phys) :: tgt + integer :: idx + + character(len=*), parameter :: sub = 'get_band_index_by_value' + !---------------------------------------------------------------------------- + + ! Initialize error variables + errflg = 0 + errmsg = '' + if (trim(swlw) /= 'sw' .and. trim(swlw) /= 'lw') then + write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: type of bands not recognized: ', swlw + errflg = 1 + return + end if + + ! band info is in cm^-1 but target value may be other units, + ! so convert targetvalue to cm^-1 + select case (units) + case ('inv_cm','cm^-1','cm-1') + tgt = targetvalue + case('m','meter','meters') + tgt = 1.0_kind_phys / (targetvalue * 1.e2_kind_phys) + case('nm','nanometer','nanometers') + tgt = 1.0_kind_phys / (targetvalue * 1.e-7_kind_phys) + case('um','micrometer','micrometers','micron','microns') + tgt = 1.0_kind_phys / (targetvalue * 1.e-4_kind_phys) + case('cm','centimeter','centimeters') + tgt = 1._kind_phys/targetvalue + case default + write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: units not recognized: ', units + errflg = 1 + return + end select + + ! now just loop through the array + ans = 0 + do idx = 1,nbnds + if ((tgt > wavenumber_low(idx)) .and. (tgt <= wavenumber_high(idx))) then + ans = idx + exit + end if + end do + + if (ans == 0) then + write(errmsg,'(f10.3,a,a)') targetvalue, ' ', trim(units) + errflg = 1 + end if + + end subroutine get_band_index_by_value + +end module rrtmgp_inputs diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 new file mode 100644 index 00000000..256085d7 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -0,0 +1,395 @@ +! PEVERWHEE - dependencies = interpolate_data +!> \file rrtmgp_lw_cloud_optics.F90 +!! + +!> This module contains two routines: The first initializes data and functions +!! needed to compute the longwave cloud radiative properties in RRTMGP. The second routine +!! is a ccpp scheme within the "radiation loop", where the shortwave optical properties +!! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL +!! cloud types visible to RRTMGP. +module rrtmgp_lw_cloud_optics + use ccpp_kinds, only: kind_phys + + implicit none + private + public :: rrtmgp_lw_cloud_optics_init + public :: rrtmgp_lw_cloud_optics_run + + real(kind_phys), allocatable :: abs_lw_liq(:,:,:) + real(kind_phys), allocatable :: abs_lw_ice(:,:) + real(kind_phys), allocatable :: g_mu(:) + real(kind_phys), allocatable :: g_d_eff(:) + real(kind_phys), allocatable :: g_lambda(:,:) + real(kind_phys) :: tiny + integer :: nmu + integer :: nlambda + integer :: n_g_d + + +contains + + ! ###################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_init() + ! ###################################################################################### +!> \section arg_table_rrtmgp_lw_cloud_optics_init Argument Table +!! \htmlinclude rrtmgp_lw_cloud_optics_init.html +!! + subroutine rrtmgp_lw_cloud_optics_init(nmu_in, nlambda_in, n_g_d_in, & + abs_lw_liq_in, abs_lw_ice_in, nlwbands, g_mu_in, g_lambda_in, & + g_d_eff_in, tiny_in, errmsg, errflg) + ! Inputs + integer, intent(in) :: nmu_in ! Number of mu samples on grid + integer, intent(in) :: nlambda_in ! Number of lambda scale samples on grid + integer, intent(in) :: n_g_d_in ! Number of radiative effective diameter samples on grid + integer, intent(in) :: nlwbands ! Number of longwave bands + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq_in ! Longwave mass specific absorption for in-cloud liquid water path + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice_in ! Longwave mass specific absorption for in-cloud ice water path + real(kind_phys), dimension(:,:), intent(in) :: g_lambda_in ! lambda scale samples on grid + real(kind_phys), dimension(:), intent(in) :: g_mu_in ! Mu samples on grid + real(kind_phys), dimension(:), intent(in) :: g_d_eff_in ! Radiative effective diameter samples on grid + real(kind_phys), intent(in) :: tiny_in ! Definition of what "tiny" means + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'rrtmgp_lw_cloud_optics_init' + + ! Set error variables + errmsg = '' + errflg = 0 + + ! Set module-level variables + nmu = nmu_in + nlambda = nlambda_in + n_g_d = n_g_d_in + tiny = tiny_in + ! Allocate module-level-variables + allocate(abs_lw_liq(nmu,nlambda,nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_liq, message: ', alloc_errmsg + return + end if + allocate(abs_lw_ice(n_g_d,nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_ice, message: ', alloc_errmsg + return + end if + allocate(g_mu(nmu), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_mu, message: ', alloc_errmsg + return + end if + allocate(g_lambda(nmu,nlambda), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_lambda, message: ', alloc_errmsg + return + end if + allocate(g_d_eff(n_g_d), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_d_eff, message: ', alloc_errmsg + return + end if + + abs_lw_liq = abs_lw_liq_in + abs_lw_ice = abs_lw_ice_in + g_mu = g_mu_in + g_lambda = g_lambda_in + g_d_eff = g_d_eff_in + + end subroutine rrtmgp_lw_cloud_optics_init + + ! ###################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_run() + ! ###################################################################################### +!> \section arg_table_rrtmgp_lw_cloud_optics_run Argument Table +!! \htmlinclude rrtmgp_lw_cloud_optics_run.html +!! + subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & + cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, & + dei, icswpth, des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, & + ktopcam, tauc, cldf, cld_lw_abs, snow_lw_abs, grau_lw_abs, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + ! Compute combined cloud optical properties + ! Create MCICA stochastic arrays for cloud LW optical properties + ! Initialize optical properties object (cloud_lw) and load with MCICA columns + + ! Inputs + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nlay ! Number of vertical layers in radiation + integer, intent(in) :: nlaycam ! Number of model layers in radiation + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: pver ! Total number of vertical layers + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + real(kind_phys), dimension(:,:), intent(in) :: cld ! Cloud fraction (liq + ice) + real(kind_phys), dimension(:,:), intent(in) :: cldfsnow ! Cloud fraction of just "snow clouds" + real(kind_phys), dimension(:,:), intent(in) :: cldfgrau ! Cloud fraction of just "graupel clouds" + real(kind_phys), dimension(:,:), intent(in) :: cldfprime ! Modified cloud fraction + real(kind_phys), dimension(:,:), intent(in) :: lamc ! Prognosed value of lambda for cloud + real(kind_phys), dimension(:,:), intent(in) :: pgam ! Prognosed value of mu for cloud + real(kind_phys), dimension(:,:), intent(in) :: iclwpth ! In-cloud liquid water path + real(kind_phys), dimension(:,:), intent(in) :: iciwpth ! In-cloud ice water path + real(kind_phys), dimension(:,:), intent(in) :: icswpth ! In-cloud snow water path + real(kind_phys), dimension(:,:), intent(in) :: icgrauwpth ! In-cloud graupel water path + real(kind_phys), dimension(:,:), intent(in) :: dei ! Mean effective radius for ice cloud + real(kind_phys), dimension(:,:), intent(in) :: des ! Mean effective radius for snow + real(kind_phys), dimension(:,:), intent(in) :: degrau ! Mean effective radius for graupel + logical, intent(in) :: do_snow ! Flag for whether cldfsnow is present + logical, intent(in) :: do_graupel ! Flag for whether cldfgrau is present + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + + ! Outputs + type(ty_optical_props_1scl_ccpp), intent(out) :: cloud_lw ! Longwave cloud optics object + real(kind_phys), dimension(:,:), intent(out) :: cldf ! Subset cloud fraction + real(kind_phys), dimension(:,:,:), intent(out) :: cld_lw_abs ! Cloud absorption optics depth (LW) + real(kind_phys), dimension(:,:,:), intent(out) :: snow_lw_abs ! Snow absorption optics depth (LW) + real(kind_phys), dimension(:,:,:), intent(out) :: grau_lw_abs ! Graupel absorption optics depth (LW) + real(kind_phys), dimension(:,:,:), intent(out) :: tauc ! Cloud optical depth + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: idx, kdx + + ! cloud radiative parameters are "in cloud" not "in cell" + real(kind_phys) :: liq_lw_abs(nlwbands, ncol, pver) ! liquid absorption optics depth (LW) + real(kind_phys) :: ice_lw_abs(nlwbands, ncol, pver) ! ice absorption optics depth (LW) + real(kind_phys) :: c_cld_lw_abs(nlwbands, ncol, pver) ! combined cloud absorption optics depth (LW) + + character(len=*), parameter :: sub = 'rrtmgp_lw_cloud_optics_run' + !-------------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + ! If not doing longwave, no need to proceed + if (.not. dolw) then + return + end if + + cldf = 0._kind_phys + tauc = 0._kind_phys + + ! Combine the cloud optical properties. + + ! gammadist liquid optics + call liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, g_mu, g_lambda, iclwpth, & + abs_lw_liq, liq_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + ! Mitchell ice optics + call interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & + n_g_d, g_d_eff, abs_lw_ice, ice_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + + cld_lw_abs(:,:,:) = liq_lw_abs(:,:,:) + ice_lw_abs(:,:,:) + + ! add in snow + if (do_snow) then + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icswpth, des, & + n_g_d, g_d_eff, abs_lw_ice, snow_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + do idx = 1, ncol + do kdx = 1, pver + if (cldfprime(idx,kdx) > 0._kind_phys) then + c_cld_lw_abs(:,idx,kdx) = ( cldfsnow(idx,kdx)*snow_lw_abs(:,idx,kdx) & + + cld(idx,kdx)*cld_lw_abs(:,idx,kdx) )/cldfprime(idx,kdx) + else + c_cld_lw_abs(:,idx,kdx) = 0._kind_phys + end if + end do + end do + else + c_cld_lw_abs(:,:,:) = cld_lw_abs(:,:,:) + end if + + ! add in graupel + if (do_graupel) then + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, & + g_d_eff, abs_lw_ice, grau_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + do idx = 1, ncol + do kdx = 1, pver + if (cldfprime(idx,kdx) > 0._kind_phys) then + c_cld_lw_abs(:,idx,kdx) = ( cldfgrau(idx,kdx)*grau_lw_abs(:,idx,kdx) & + + cld(idx,kdx)*c_cld_lw_abs(:,idx,kdx) )/cldfprime(idx,kdx) + else + c_cld_lw_abs(:,idx,kdx) = 0._kind_phys + end if + end do + end do + end if + + ! Extract just the layers of CAM where RRTMGP does calculations + + ! Subset "chunk" data so just the number of CAM layers in the + ! radiation calculation are used by MCICA to produce subcolumns + cldf = cldfprime(:, ktopcam:) + tauc = c_cld_lw_abs(:, :, ktopcam:) + + ! Enforce tauc >= 0. + tauc = merge(tauc, 0.0_kind_phys, tauc > 0.0_kind_phys) + + errmsg =cloud_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + end subroutine rrtmgp_lw_cloud_optics_run + +!============================================================================== + + subroutine liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, & + g_mu, g_lambda, iclwpth, abs_lw_liq, abs_od, errmsg, errflg) + ! Inputs + integer, intent(in) :: ncol + integer, intent(in) :: pver + integer, intent(in) :: nmu + integer, intent(in) :: nlambda + integer, intent(in) :: nlwbands + real(kind_phys), dimension(:,:), intent(in) :: lamc + real(kind_phys), dimension(:,:), intent(in) :: pgam + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq + real(kind_phys), dimension(:), intent(in) :: g_mu + real(kind_phys), dimension(:,:), intent(in) :: g_lambda + real(kind_phys), dimension(:,:), intent(in) :: iclwpth + ! Outputs + real(kind_phys), dimension(:,:,:), intent(out) :: abs_od + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer lwband, idx, kdx + + ! Set error variables + errflg = 0 + errmsg = '' + + abs_od = 0._kind_phys + + do kdx = 1,pver + do idx = 1,ncol + if(lamc(idx,kdx) > 0._kind_phys) then ! This seems to be the clue for no cloud from microphysics formulation + call gam_liquid_lw(nlwbands, nmu, nlambda, iclwpth(idx,kdx), lamc(idx,kdx), pgam(idx,kdx), abs_lw_liq, & + g_mu, g_lambda, abs_od(1:nlwbands,idx,kdx), errmsg, errflg) + else + abs_od(1:nlwbands,idx,kdx) = 0._kind_phys + endif + enddo + enddo + + end subroutine liquid_cloud_get_rad_props_lw + +!============================================================================== + + subroutine gam_liquid_lw(nlwbands, nmu, nlambda, clwptn, lamc, pgam, abs_lw_liq, g_mu, g_lambda, abs_od, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp, lininterp_finish + use radiation_utils, only: get_mu_lambda_weights_ccpp + ! Inputs + integer, intent(in) :: nlwbands + integer, intent(in) :: nmu + integer, intent(in) :: nlambda + real(kind_phys), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(kind_phys), intent(in) :: lamc ! prognosed value of lambda for cloud + real(kind_phys), intent(in) :: pgam ! prognosed value of mu for cloud + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq + real(kind_phys), dimension(:), intent(in) :: g_mu + real(kind_phys), dimension(:,:) , intent(in) :: g_lambda + ! Outputs + real(kind_phys), dimension(:), intent(out) :: abs_od + integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + + integer :: lwband ! sw band index + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + if (clwptn < tiny) then + abs_od = 0._kind_phys + return + endif + + call get_mu_lambda_weights_ccpp(nmu, nlambda, g_mu, g_lambda, lamc, pgam, mu_wgts, lambda_wgts, errmsg, errflg) + if (errflg /= 0) then + return + end if + + do lwband = 1, nlwbands + call lininterp(abs_lw_liq(:,:,lwband), nmu, nlambda, & + abs_od(lwband:lwband), 1, mu_wgts, lambda_wgts) + enddo + + abs_od = clwptn * abs_od + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + + end subroutine gam_liquid_lw + +!============================================================================== + + subroutine interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & + n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp, lininterp_init, & + lininterp_finish, extrap_method_bndry + + integer, intent(in) :: ncol + integer, intent(in) :: n_g_d + integer, intent(in) :: pver + integer, intent(in) :: nlwbands + real(kind_phys), dimension(:), intent(in) :: g_d_eff + real(kind_phys), dimension(:,:), intent(in) :: iciwpth + real(kind_phys), dimension(:,:), intent(in) :: dei + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice + real(kind_phys), dimension(:,:,:), intent(out) :: abs_od + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + type(interp_type) :: dei_wgts + + integer :: idx, kdx, lwband + real(kind_phys) :: absor(nlwbands) + + ! Set error variables + errflg = 0 + errmsg = '' + + do kdx = 1,pver + do idx = 1,ncol + ! if ice water path is too small, OD := 0 + if( iciwpth(idx,kdx) < tiny .or. dei(idx,kdx) == 0._kind_phys) then + abs_od (:,idx,kdx) = 0._kind_phys + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(idx:idx,kdx), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do lwband = 1, nlwbands + call lininterp(abs_lw_ice(:,lwband), n_g_d, & + absor(lwband:lwband), 1, dei_wgts) + enddo + abs_od(:,idx,kdx) = iciwpth(idx,kdx) * absor + where(abs_od(:,idx,kdx) > 50.0_kind_phys) abs_od(:,idx,kdx) = 50.0_kind_phys + call lininterp_finish(dei_wgts) + endif + enddo + enddo + + end subroutine interpolate_ice_optics_lw + +!============================================================================== + +end module rrtmgp_lw_cloud_optics diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 new file mode 100644 index 00000000..6812b895 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -0,0 +1,91 @@ +!> \file rrtmgp_lw_gas_optics.F90 +!! + +!> This module contains a run routine to compute gas optics during the radiation subcycle +module rrtmgp_lw_gas_optics + + implicit none + private + + public :: rrtmgp_lw_gas_optics_run + +contains + +!> \section arg_table_rrtmgp_lw_gas_optics_run Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_run.html +!! + subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, tsfg, & + gas_concs, lw_optical_props_clrsky, sources, t_lev, include_interface_temp, lw_gas_props, & + errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg + ! Inputs + logical, intent(in) :: dolw !< Flag for whether to perform longwave calculation + logical, intent(in) :: include_interface_temp !< Flag for whether to include interface temperature in calculation + integer, intent(in) :: iter_num !< Subcycle iteration number + integer, intent(in) :: ncol !< Total number of columns + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + real(kind_phys), dimension(:,:), intent(in) :: p_lay !< Air pressure at midpoints [Pa] + real(kind_phys), dimension(:,:), intent(in) :: p_lev !< Air pressure at interfaces [Pa] + real(kind_phys), dimension(:,:), intent(in) :: t_lay !< Air temperature at midpoints [K] + real(kind_phys), dimension(:), intent(in) :: tsfg !< Surface skin temperature [K] + real(kind_phys), dimension(:,:), intent(in) :: t_lev !< Air temperature at interfaces [K] + type(ty_gas_concs_ccpp), intent(in) :: gas_concs !< RRTMGP gas concentrations object + + ! Outputs + type(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clearsky optical properties + type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< RRTMGP gas optics object + type(ty_source_func_lw_ccpp), intent(inout) :: sources !< Longwave sources object + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: iCol, iCol2 + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dolw) then + return + end if + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) + + if (include_interface_temp) then + errmsg = lw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volume mixing-ratios + lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties + sources%sources, & ! OUT - RRTMGP DDT: source functions + tlev=t_lev(iCol:iCol2,:)) ! IN - Temperature @ layer-interfaces (K) (optional) + call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + else + errmsg = lw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties + sources%sources) ! OUT - RRTMGP DDT: source functions + call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + + end subroutine rrtmgp_lw_gas_optics_run + +end module rrtmgp_lw_gas_optics diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 new file mode 100644 index 00000000..46097c67 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 @@ -0,0 +1,102 @@ +!> \file rrtmgp_lw_gas_optics_data.F90 +!! + +!> This module contains an init routine to initialize the gas optics object +!> with data read in from file on the host side +module rrtmgp_lw_gas_optics_data + + implicit none + private + public :: rrtmgp_lw_gas_optics_data_init + + +contains +!> \section arg_table_rrtmgp_lw_gas_optics_data_init Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_data_init.html +!! + subroutine rrtmgp_lw_gas_optics_data_init(kdist, available_gases, gas_names, & + key_species, band2gpt, band_lims_wavenum, press_ref, press_ref_trop, & + temp_ref, temp_ref_p, temp_ref_t, vmr_ref, kmajor, kminor_lower, & + kminor_upper, gas_minor, identifier_minor, minor_gases_lower, & + minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, scale_by_complement_lower, & + scale_by_complement_upper, kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower, rayl_upper, optimal_angle_fit, & + errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_tools, only: check_error_msg + use mo_rte_kind, only: wl + + ! Inputs + class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object + character(len=*), dimension(:), intent(in) :: gas_names ! Names of absorbing gases + character(len=*), dimension(:), intent(in) :: gas_minor ! Name of absorbing minor gas + character(len=*), dimension(:), intent(in) :: identifier_minor ! Unique string identifying minor gas + character(len=*), dimension(:), intent(in) :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=*), dimension(:), intent(in) :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=*), dimension(:), intent(in) :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=*), dimension(:), intent(in) :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), intent(in) :: key_species ! Key species pair for each band + integer, dimension(:,:), intent(in) :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), intent(in) :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), intent(in) :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), intent(in) :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), intent(in) :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical(wl), dimension(:), intent(in) :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), intent(in) :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), intent(in) :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), intent(in) :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), intent(in) :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:,:), intent(in) :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point + real(kind_phys), dimension(:,:,:), intent(in) :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), intent(in) :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), intent(in) :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), intent(in) :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), intent(in) :: totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:), intent(in) :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), intent(in) :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), intent(in) :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), intent(in) :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), intent(in) :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), intent(in) :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + + ! Outputs + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object + character(len=*), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errflg ! CCPP error code + + ! Initialize error variables + errmsg = '' + errflg = 0 + + ! Initialize the gas optics object with data. + errmsg = kdist%gas_props%load( & + available_gases%gas_concs, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower, rayl_upper, & + optimal_angle_fit) + + if (len_trim(errmsg) > 0) then + errflg = 1 + end if + call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) + + end subroutine rrtmgp_lw_gas_optics_data_init + +end module rrtmgp_lw_gas_optics_data diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 new file mode 100644 index 00000000..c9796cda --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -0,0 +1,182 @@ +module rrtmgp_lw_gas_optics_pre + + implicit none + private + + public :: rrtmgp_lw_gas_optics_pre_run + +contains + +!> \section arg_table_rrtmgp_lw_gas_optics_pre_run Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_pre_run.html +!! + subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, gaslist, idxday, & + pverp, ktoprad, ktopcam, dolw, nradgas, gas_concs, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + + ! Set gas vmr for the gases in the radconstants module's gaslist. + + character(len=*), intent(in) :: gaslist(:) ! Radiatively active gases + integer, intent(in) :: nlay ! Number of layers in radiation calculation + integer, intent(in) :: ncol ! Total number of columns + integer, intent(in) :: pverp ! Total number of layer interfaces + integer, intent(in) :: idxday(:) ! Indices of daylight columns + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: nradgas ! Number of radiatively active gases + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculaion + real(kind_phys), intent(in) :: pmid(:,:) ! Air pressure at midpoints [Pa] + real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at interfaces [Pa] + real(kind_phys), intent(in) :: rad_const_array(:,:,:) ! array of radiatively-active constituent vmrs + ! last index corresponds to index in gaslist + + type(ty_gas_concs_ccpp), intent(inout) :: gas_concs ! the result is VMR inside gas_concs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, gas_idx, idx(ncol) + integer :: istat + real(kind_phys) :: gas_mmr(ncol, pverp-1) + real(kind_phys) :: gas_vmr(ncol, nlay) + real(kind_phys) :: mmr(ncol, nlay) + real(kind_phys) :: massratio + character(len=256) :: alloc_errmsg + + ! For ozone profile above model + real(kind_phys) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff + + character(len=*), parameter :: sub = 'rrtmgp_lw_gas_optics_pre_run' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dolw) then + return + end if + + ! set the column indices; just count for longwave + do i = 1, ncol + idx(i) = i + end do + + do gas_idx = 1, nradgas + + ! grab mass mixing ratio of gas + gas_mmr = rad_const_array(:,:,gas_idx) + + do i = 1, ncol + mmr(i,ktoprad:) = gas_mmr(idx(i),ktopcam:) + end do + + ! If an extra layer is being used, copy mmr from the top layer of CAM to the extra layer. + if (nlay == pverp) then + mmr(:,1) = mmr(:,2) + end if + + ! special case: H2O is specific humidity, not mixing ratio. Use r = q/(1-q): + if (gaslist(gas_idx) == 'H2O') then + mmr = mmr / (1._kind_phys - mmr) + end if + + ! convert MMR to VMR, multipy by ratio of dry air molar mas to gas molar mass. + call get_molar_mass_ratio(gaslist(gas_idx), massratio, errmsg, errflg) + if (errflg /= 0) then + return + end if + gas_vmr = mmr * massratio + + ! special case: Setting O3 in the extra layer: + ! + ! For the purpose of attenuating solar fluxes above the CAM model top, we assume that ozone + ! mixing decreases linearly in each column from the value in the top layer of CAM to zero at + ! the pressure level set by P_top. P_top has been set to 50 Pa (0.5 hPa) based on model tuning + ! to produce temperatures at the top of CAM that are most consistent with WACCM at similar pressure levels. + + if ((gaslist(gas_idx) == 'O3') .and. (nlay == pverp)) then + P_top = 50.0_kind_phys + do i = 1, ncol + P_int = pint(idx(i),1) ! pressure (Pa) at upper interface of CAM + P_mid = pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM + alpha = log(P_int/P_top) + beta = log(P_mid/P_int)/log(P_mid/P_top) + + a = ( (1._kind_phys + alpha) * exp(-alpha) - 1._kind_phys ) / alpha + b = 1._kind_phys - exp(-alpha) + + if (alpha .gt. 0) then ! only apply where top level is below 80 km + chi_mid = gas_vmr(i,1) ! molar mixing ratio of O3 at midpoint of top layer + chi_0 = chi_mid / (1._kind_phys + beta) + chi_eff = chi_0 * (a + b) + gas_vmr(i,1) = chi_eff + end if + end do + end if + + errmsg = gas_concs%gas_concs%set_vmr(gaslist(gas_idx), gas_vmr) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + end do + + end subroutine rrtmgp_lw_gas_optics_pre_run + +!========================================================================================= + + subroutine get_molar_mass_ratio(gas_name, massratio, errmsg, errflg) + use ccpp_kinds, only: kind_phys + + ! return the molar mass ratio of dry air to gas based on gas_name + + character(len=*), intent(in) :: gas_name + real(kind_phys), intent(out) :: massratio + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + real(kind_phys), parameter :: amdw = 1.607793_kind_phys ! Molecular weight of dry air / water vapor + real(kind_phys), parameter :: amdc = 0.658114_kind_phys ! Molecular weight of dry air / carbon dioxide + real(kind_phys), parameter :: amdo = 0.603428_kind_phys ! Molecular weight of dry air / ozone + real(kind_phys), parameter :: amdm = 1.805423_kind_phys ! Molecular weight of dry air / methane + real(kind_phys), parameter :: amdn = 0.658090_kind_phys ! Molecular weight of dry air / nitrous oxide + real(kind_phys), parameter :: amdo2 = 0.905140_kind_phys ! Molecular weight of dry air / oxygen + real(kind_phys), parameter :: amdc1 = 0.210852_kind_phys ! Molecular weight of dry air / CFC11 + real(kind_phys), parameter :: amdc2 = 0.239546_kind_phys ! Molecular weight of dry air / CFC12 + + character(len=*), parameter :: sub='get_molar_mass_ratio' + !---------------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + + select case (trim(gas_name)) + case ('H2O') + massratio = amdw + case ('CO2') + massratio = amdc + case ('O3') + massratio = amdo + case ('CH4') + massratio = amdm + case ('N2O') + massratio = amdn + case ('O2') + massratio = amdo2 + case ('CFC11') + massratio = amdc1 + case ('CFC12') + massratio = amdc2 + case default + write(errmsg, '(a,a,a)') sub, ': Invalid gas: ', trim(gas_name) + errflg = 1 + end select + +end subroutine get_molar_mass_ratio + + +end module rrtmgp_lw_gas_optics_pre diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 new file mode 100644 index 00000000..cadbc7f7 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -0,0 +1,251 @@ +!> \file rrtmgp_lw_main.F90 +!! + +!> This module contains the call to the RRTMGP-LW radiation routine +module rrtmgp_lw_main + implicit none + private + + public rrtmgp_lw_main_run +contains + +!> \section arg_table_rrtmgp_lw_main_run Argument Table +!! \htmlinclude rrtmgp_lw_main_run.html +!! + subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, use_LW_optimal_angles, & + nGauss_angles, nCol, iter_num, rrtmgp_phys_blksz, lw_optical_props_clrsky, & + lw_optical_props_clouds, top_at_1, sources, sfc_emiss_byband, lw_gas_props, & + aerlw, fluxlwUP_jac, lw_Ds, flux_clrsky, flux_allsky, errmsg, errflg) + use machine, only: kind_phys + use mo_rte_lw, only: rte_lw + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg + + ! Inputs + logical, intent(in) :: doLWrad !< Flag to perform longwave calculation + logical, intent(in) :: doLWclrsky !< Flag to compute clear-sky fluxes + logical, intent(in) :: doGP_lwscat !< Flag to include scattering in clouds + logical, intent(in) :: use_LW_jacobian !< Flag to compute Jacobian + logical, intent(in) :: use_LW_optimal_angles !< Flag to compute and use optimal angles + logical, intent(in) :: top_at_1 !< Flag for vertical ordering convention + + integer, target, intent(in) :: nGauss_angles !< Number of gaussian quadrature angles used + integer, intent(in) :: nCol !< Number of horizontal points + integer, intent(in) :: iter_num !< Radiation subcycle iteration number + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + + real(kind_phys), dimension(:,:), intent(in) :: sfc_emiss_byband !< Surface emissivity by band + class(ty_source_func_lw_ccpp), intent(in) :: sources !< Longwave sources object + + ! Outputs + real(kind_phys), dimension(:,:), target, intent(inout) :: fluxlwUP_jac !< Surface temperature flux Jacobian [W m-2 K-1] + class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] + class(ty_fluxes_broadband_ccpp), intent(inout) :: flux_clrsky !< Clear-sky flux [W m-2] + class(ty_optical_props_1scl_ccpp), intent(inout) :: aerlw !< Aerosol optical properties object + class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clear-sky optical properties object + class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clouds !< Cloud optical properties object + + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object + + real(kind_phys), dimension(:,:), target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point + character(len=*), intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag + + ! Local variables + integer :: iCol, iCol2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nCol) + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! + ! ################################################################################### + ! Increment + errmsg = aerlw%optical_props%increment(lw_optical_props_clrsky%optical_props) + call check_error_msg('rrtmgp_lw_main_increment_aerosol_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + ! Call RTE solver + if (doLWclrsky) then + if (use_lw_optimal_angles) then + errmsg = lw_gas_props%gas_props%compute_optimal_angles(lw_optical_props_clrsky%optical_props,lw_Ds) + call check_error_msg('rrtmgp_lw_main_opt_angle', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point + end if + else + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes) ! OUT - Fluxes + end if + end if + call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + end if + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! *Note* CCPP does not allow for polymorphic types, they are ambiguous to the CCPP + ! framework. rte-rrtmgp uses polymorphic types extensively, for example, querying the + ! type to determine physics configuration/pathway/etc... + ! + ! The logic in the code below is to satisfy the polymorphishm in the rte-rrtmgp code. + ! The rte-rrtmgp "increment" procedures are utilized to provide the correct type to the + ! rte solver (rte_lw). Rte_lw queries the type to determine if scattering is to be + ! included in the calculation. The increment procedures are called so that the correct + ! optical properties are inherited. + ! + ! ################################################################################### + + ! Include LW cloud-scattering? + if (doGP_lwscat) then + ! Increment + errmsg = lw_optical_props_clrsky%optical_props%increment(lw_optical_props_clouds%optical_props) + call check_error_msg('rrtmgp_lw_main_increment_clrsky_to_clouds', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + if (use_LW_jacobian) then + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + else + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + end if + else + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + else + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes) ! OUT - Fluxes + end if + end if + ! No scattering in LW clouds. + else + ! Increment + errmsg = lw_optical_props_clouds%optical_props%increment(lw_optical_props_clrsky%optical_props) + call check_error_msg('rrtmgp_lw_main_increment_clouds_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + if (use_LW_jacobian) then + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + end if + else + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes) ! OUT - Fluxes + end if + end if + end if + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + + end subroutine rrtmgp_lw_main_run +end module rrtmgp_lw_main diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 new file mode 100644 index 00000000..0d39ce1f --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -0,0 +1,194 @@ +module rrtmgp_lw_mcica_subcol_gen +! PEVERWHEE - dependencies = shr_RandNum_mod + +!---------------------------------------------------------------------------------------- +! +! Purpose: Create McICA stochastic arrays for lw cloud optical properties. +! Input cloud optical properties directly: cloud optical depth, single +! scattering albedo and asymmetry parameter. Output will be stochastic +! arrays of these variables. (longwave scattering is not yet available) +! +! Original code: From RRTMG, with the following copyright notice, +! based on Raisanen et al., QJRMS, 2004: +! -------------------------------------------------------------------------- +! | | +! | Copyright 2006-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- +! This code is a refactored version of code originally in the files +! rrtmgp_lw_mcica_subcol_gen.F90 and mcica_subcol_gen_sw.F90 +! +! Uses the KISS random number generator. +! +! Overlap assumption: maximum-random. +! +!---------------------------------------------------------------------------------------- + +implicit none +private +save + +public :: rrtmgp_lw_mcica_subcol_gen_run + +!======================================================================================== +contains +!======================================================================================== + +!> +!> \section arg_table_rrtmgp_lw_mcica_subcol_gen_run Argument Table +!! \htmlinclude rrtmgp_lw_mcica_subcol_gen_run.html +subroutine rrtmgp_lw_mcica_subcol_gen_run( & + dolw, ktoprad, kdist, nbnd, ngpt, ncol, pver, nver, & + changeseed, pmid, cldfrac, tauc, cloud_lw, & + errmsg, errflg ) + use ccpp_kinds, only: kind_phys + use shr_RandNum_mod, only: ShrKissRandGen + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + + ! Arrays use CAM vertical index convention: index increases from top to bottom. + ! This index ordering is assumed in the maximum-random overlap algorithm which starts + ! at the top of a column and marches down, with each layer depending on the state + ! of the layer above it. + ! + ! For GCM mode, changeseed must be offset between LW and SW by at least the + ! number of subcolumns + + ! arguments + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist ! Gas optics object + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: nbnd ! Number of spectral bands + integer, intent(in) :: ngpt ! Number of subcolumns (g-point intervals) + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: pver ! Number of model layers + integer, intent(in) :: nver ! Number of layers in radiation calculation + integer, intent(in) :: changeseed ! If the subcolumn generator is called multiple times, + ! permute the seed between each call. + real(kind_phys), dimension(:,:), intent(in) :: pmid ! Layer pressures at midpoints (Pa) + real(kind_phys), dimension(:,:), intent(in) :: cldfrac ! Layer cloud fraction + real(kind_phys), dimension(:,:,:), intent(in) :: tauc ! Cloud optical depth + type(ty_optical_props_1scl_ccpp), intent(inout) :: cloud_lw ! Cloud optics object + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + + integer :: idx, isubcol, kdx, ndx + + real(kind_phys), parameter :: cldmin = 1.0e-80_kind_phys ! min cloud fraction + real(kind_phys) :: cldf(ncol,nver) ! cloud fraction clipped to cldmin + + type(ShrKissRandGen) :: kiss_gen ! KISS RNG object + integer :: kiss_seed(ncol,4) + real(kind_phys) :: rand_num_1d(ncol,1) ! random number (kissvec) + real(kind_phys) :: rand_num(ncol,nver) ! random number (kissvec) + + real(kind_phys) :: cdf(ngpt,ncol,nver) ! random numbers + logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy + real(kind_phys) :: taucmcl(ngpt,ncol,nver) + !------------------------------------------------------------------------------------------ + + ! Set error variables + errflg = 0 + errmsg = '' + + ! If we're not doing longwave this timestep, no need to proceed + if (.not. dolw) then + return + end if + + ! clip cloud fraction + cldf(:,:) = cldfrac(:,:) + where (cldf(:,:) < cldmin) + cldf(:,:) = 0._kind_phys + end where + + ! Create a seed that depends on the state of the columns. + ! Use pmid from bottom four layers. + do idx = 1, ncol + kiss_seed(idx,1) = (pmid(idx,pver) - int(pmid(idx,pver))) * 1000000000 + kiss_seed(idx,2) = (pmid(idx,pver-1) - int(pmid(idx,pver-1))) * 1000000000 + kiss_seed(idx,3) = (pmid(idx,pver-2) - int(pmid(idx,pver-2))) * 1000000000 + kiss_seed(idx,4) = (pmid(idx,pver-3) - int(pmid(idx,pver-3))) * 1000000000 + end do + + ! create the RNG object + kiss_gen = ShrKissRandGen(kiss_seed) + + ! Advance randum number generator by changeseed values + do idx = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + + ! Generate random numbers in each subcolumn at every level + do isubcol = 1,ngpt + call kiss_gen%random(rand_num) + cdf(isubcol,:,:) = rand_num(:,:) + enddo + + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, use the same random number as in the layer above + ! - if the layer above is clear, use a new random number + + do kdx = 2, nver + do idx = 1, ncol + do isubcol = 1, ngpt + if (cdf(isubcol,idx,kdx-1) > 1._kind_phys - cldf(idx,kdx-1) ) then + cdf(isubcol,idx,kdx) = cdf(isubcol,idx,kdx-1) + else + cdf(isubcol,idx,kdx) = cdf(isubcol,idx,kdx) * (1._kind_phys - cldf(idx,kdx-1)) + end if + end do + end do + end do + + do kdx = 1, nver + iscloudy(:,:,kdx) = (cdf(:,:,kdx) >= 1._kind_phys - spread(cldf(:,kdx), dim=1, nCopies=ngpt) ) + end do + + ! -- generate subcolumns for homogeneous clouds ----- + ! where there is a cloud, set the subcolumn cloud properties; + ! incoming tauc should be in-cloud quantites and not grid-averaged quantities + do kdx = 1,nver + do idx = 1,ncol + do isubcol = 1,ngpt + if (iscloudy(isubcol,idx,kdx) .and. (cldf(idx,kdx) > 0._kind_phys) ) then + ndx = kdist%gas_props%convert_gpt2band(isubcol) + taucmcl(isubcol,idx,kdx) = tauc(ndx,idx,kdx) + else + taucmcl(isubcol,idx,kdx) = 0._kind_phys + end if + end do + end do + end do + + call kiss_gen%finalize() + + ! If there is an extra layer in the radiation then this initialization + ! will provide zero optical depths there + cloud_lw%optical_props%tau = 0.0_kind_phys + + ! Set the properties on g-points + do idx = 1, ngpt + cloud_lw%optical_props%tau(:,ktoprad:,idx) = taucmcl(idx,:,:) + end do + + ! validate checks that: tau > 0 + errmsg = cloud_lw%optical_props%validate() + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + +end subroutine rrtmgp_lw_mcica_subcol_gen_run + + +end module rrtmgp_lw_mcica_subcol_gen + diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 new file mode 100644 index 00000000..f7794296 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -0,0 +1,153 @@ +module rrtmgp_post + + implicit none + private + + public :: rrtmgp_post_run + +contains +!> \section arg_table_rrtmgp_post_run Argument Table +!! \htmlinclude rrtmgp_post_run.html +!! +subroutine rrtmgp_post_run(qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & + fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, qrs, qrl, netsw, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness [Pa] + real(kind_phys), dimension(:), intent(in) :: fsns ! Surface net shortwave flux [W m-2] + real(kind_phys), dimension(:,:), intent(in) :: qrs_prime ! Shortwave heating rate [J kg-1 s-1] + real(kind_phys), dimension(:,:), intent(in) :: qrl_prime ! Longwave heating rate [J kg-1 s-1] + type(ty_optical_props_2str_ccpp), intent(inout) :: atm_optics_sw ! Atmosphere optical properties object (shortwave) + type(ty_optical_props_1scl_ccpp), intent(inout) :: aer_lw ! Aerosol optical properties object (longwave) + type(ty_optical_props_2str_ccpp), intent(inout) :: aer_sw ! Aerosol optical properties object (shortwave) + type(ty_optical_props_1scl_ccpp), intent(inout) :: cloud_lw ! Cloud optical properties object (longwave) + type(ty_optical_props_2str_ccpp), intent(inout) :: cloud_sw ! Cloud optical properties object (shortwave) + type(ty_fluxes_broadband_ccpp), intent(inout) :: fswc ! Shortwave clear-sky flux object + type(ty_fluxes_broadband_ccpp), intent(inout) :: flwc ! Longwave clear-sky flux object + type(ty_fluxes_byband_ccpp), intent(inout) :: fsw ! Shortwave all-sky flux object + type(ty_fluxes_byband_ccpp), intent(inout) :: flw ! Longwave all-sky flux object + type(ty_source_func_lw_ccpp), intent(inout) :: sources_lw ! Longwave sources object + real(kind_phys), dimension(:,:), intent(out) :: qrs ! Shortwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] + real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] + real(kind_phys), dimension(:), intent(out) :: netsw ! Net shortwave flux to be sent to coupler [W m-2] + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Set error varaibles + errflg = 0 + errmsg = '' + ! The radiative heating rates are maintained across multiple physics timesteps + ! as Q*dp (for energy conservation). + qrs(:,:) = qrs_prime(:,:) * pdel(:,:) + qrl(:,:) = qrl_prime(:,:) * pdel(:,:) + + ! Set the netsw to be sent to the coupler + netsw(:) = fsns(:) + + call free_optics_sw(atm_optics_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_optics_sw(cloud_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_optics_sw(aer_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_fluxes_byband(fsw) + call free_fluxes_broadband(fswc) + + call sources_lw%sources%finalize() + call free_optics_lw(cloud_lw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_optics_lw(aer_lw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_fluxes_byband(flw) + call free_fluxes_broadband(flwc) + +end subroutine rrtmgp_post_run + + !========================================================================================= + +subroutine free_optics_sw(optics, errmsg, errflg) + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + + type(ty_optical_props_2str_ccpp), intent(inout) :: optics + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + errmsg = optics%optical_props%finalize_2str() + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + call optics%optical_props%finalize() + +end subroutine free_optics_sw + +!========================================================================================= + +subroutine free_optics_lw(optics, errmsg, errflg) + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + + type(ty_optical_props_1scl_ccpp), intent(inout) :: optics + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = optics%optical_props%finalize_1scl() + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + call optics%optical_props%finalize() + +end subroutine free_optics_lw + +!========================================================================================= + +subroutine free_fluxes_broadband(fluxes) + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + + class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes + + if (associated(fluxes%fluxes%flux_up)) deallocate(fluxes%fluxes%flux_up) + if (associated(fluxes%fluxes%flux_dn)) deallocate(fluxes%fluxes%flux_dn) + if (associated(fluxes%fluxes%flux_net)) deallocate(fluxes%fluxes%flux_net) + if (associated(fluxes%fluxes%flux_dn_dir)) deallocate(fluxes%fluxes%flux_dn_dir) + +end subroutine free_fluxes_broadband + +!========================================================================================= + +subroutine free_fluxes_byband(fluxes) + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + + if (associated(fluxes%fluxes%flux_up)) deallocate(fluxes%fluxes%flux_up) + if (associated(fluxes%fluxes%flux_dn)) deallocate(fluxes%fluxes%flux_dn) + if (associated(fluxes%fluxes%flux_net)) deallocate(fluxes%fluxes%flux_net) + if (associated(fluxes%fluxes%flux_dn_dir)) deallocate(fluxes%fluxes%flux_dn_dir) + + if (associated(fluxes%fluxes%bnd_flux_up)) deallocate(fluxes%fluxes%bnd_flux_up) + if (associated(fluxes%fluxes%bnd_flux_dn)) deallocate(fluxes%fluxes%bnd_flux_dn) + if (associated(fluxes%fluxes%bnd_flux_net)) deallocate(fluxes%fluxes%bnd_flux_net) + if (associated(fluxes%fluxes%bnd_flux_dn_dir)) deallocate(fluxes%fluxes%bnd_flux_dn_dir) + +end subroutine free_fluxes_byband + +end module rrtmgp_post diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 new file mode 100644 index 00000000..ea87d6d2 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -0,0 +1,402 @@ +module rrtmgp_pre + + implicit none + private + + public :: rrtmgp_pre_init + public :: rrtmgp_pre_timestep_init + public :: rrtmgp_pre_run + public :: radiation_do_ccpp ! Public because it needs to be accessed elsewhere in CAM + +CONTAINS + +!> \section arg_table_rrtmgp_pre_init Argument Table +!! \htmlinclude rrtmgp_pre_init.html +!! + subroutine rrtmgp_pre_init(nradgas, gaslist, available_gases, gaslist_lc, errmsg, errflg) + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use atmos_phys_string_utils, only: to_lower + integer, intent(in) :: nradgas ! Number of radiatively active gases + character(len=*), intent(in) :: gaslist(:) ! List of radiatively active gases + type(ty_gas_concs_ccpp), intent(inout) :: available_gases ! Gas concentrations object + character(len=*), intent(out) :: gaslist_lc(:) ! Lowercase verison of radiatively active gas list + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: idx + + ! Set error variables + errmsg = '' + errflg = 0 + + ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs_ccpp objects + ! work with CAM's uppercase names, but other objects that get input from the gas + ! concs objects don't work. + do idx = 1, nradgas + gaslist_lc(idx) = to_lower(gaslist(idx)) + end do + + errmsg = available_gases%gas_concs%init(gaslist_lc) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + + end subroutine rrtmgp_pre_init + +!> \section arg_table_rrtmgp_pre_timestep_init Argument Table +!! \htmlinclude rrtmgp_pre_timestep_init.html +!! + subroutine rrtmgp_pre_timestep_init(nstep, dtime, iradsw, irad_always, offset, errmsg, errflg) + integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: dtime ! Timestep size + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(out) :: offset ! Offset for next SW radiation timestep + integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + + logical :: dosw_next + integer :: nstepsw_next + + ! Get timestep of next radiation calculation + dosw_next = .false. + nstepsw_next = nstep + offset = 0 + do while (.not. dosw_next) + nstepsw_next = nstepsw_next + 1 + offset = offset + dtime + call radiation_do_ccpp('sw', nstepsw_next, iradsw, irad_always, dosw_next, errmsg, errflg) + if (errflg /= 0) then + return + end if + end do + + end subroutine rrtmgp_pre_timestep_init + +!> \section arg_table_rrtmgp_pre_run Argument Table +!! \htmlinclude rrtmgp_pre_run.html +!! + subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, ncol, & + next_cday, idxday, nday, idxnite, nnite, dosw, dolw, nlay, nlwbands, & + nswbands, spectralflux, nextsw_cday, fsw, fswc, flw, flwc, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + ! Inputs + real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine solar zenith angle + real(kind_phys), intent(in) :: next_cday ! The calendar day of the next timestep + integer, intent(in) :: dtime ! Timestep size [s] + integer, intent(in) :: nstep ! Timestep number + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: iradlw ! Freq. of longwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nlay ! Number of vertical layers + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: nswbands ! Number of shortwave bands + logical, intent(in) :: spectralflux ! Flag to calculate fluxes (up and down) per band + ! Outputs + real(kind_phys), intent(inout) :: nextsw_cday ! The next calendar day during which calculation will be performed + class(ty_fluxes_broadband_ccpp), intent(out) :: fswc ! Clear-sky shortwave flux object + class(ty_fluxes_byband_ccpp), intent(out) :: fsw ! All-sky shortwave flux object + class(ty_fluxes_broadband_ccpp), intent(out) :: flwc ! Clear-sky longwave flux object + class(ty_fluxes_byband_ccpp), intent(out) :: flw ! All-sky longwave flux object + integer, intent(out) :: nday ! Number of daylight columns + integer, intent(out) :: nnite ! Number of nighttime columns + integer, dimension(:), intent(out) :: idxday ! Indices of daylight columns + integer, dimension(:), intent(out) :: idxnite ! Indices of nighttime columns + logical, intent(out) :: dosw ! Flag to do shortwave calculation + logical, intent(out) :: dolw ! Flag to do longwave calculation + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: idx + + ! Set error variables + errflg = 0 + errmsg = '' + + ! Gather night/day column indices. + nday = 0 + nnite = 0 + do idx = 1, ncol + if ( coszrs(idx) > 0.0_kind_phys ) then + nday = nday + 1 + idxday(nday) = idx + else + nnite = nnite + 1 + idxnite(nnite) = idx + end if + end do + + ! Determine if we're going to do longwave and/or shortwave this timestep + call radiation_do_ccpp('sw', nstep, iradsw, irad_always, dosw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call radiation_do_ccpp('lw', nstep, iradlw, irad_always, dolw, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! determine if next radiation time-step not equal to next time-step + if (nstep >= 1) then + if (next_cday /= nextsw_cday) nextsw_cday = -1._kind_phys + end if + + ! Allocate the flux arrays and init to zero. + call initialize_rrtmgp_fluxes_byband(nday, nlay+1, nswbands, nswbands, spectralflux, fsw, errmsg, errflg, do_direct=.true.) + if (errflg /= 0) then + return + end if + call initialize_rrtmgp_fluxes_broadband(nday, nlay+1, nswbands, nswbands, spectralflux, fswc, errmsg, errflg, do_direct=.true.) + if (errflg /= 0) then + return + end if + call initialize_rrtmgp_fluxes_byband(ncol, nlay+1, nlwbands, nswbands, spectralflux, flw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call initialize_rrtmgp_fluxes_broadband(ncol, nlay+1, nlwbands, nswbands, spectralflux, flwc, errmsg, errflg) + if (errflg /= 0) then + return + end if + + end subroutine rrtmgp_pre_run + +!================================================================================================ + +subroutine radiation_do_ccpp(op, nstep, irad, irad_always, radiation_do, errmsg, errflg) + + ! Return radiation_do set to .true. if the specified operation is done this timestep. + + character(len=*), intent(in) :: op ! name of operation + integer, intent(in) :: nstep + integer, intent(in) :: irad + integer, intent(in) :: irad_always + integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + logical, intent(out) :: radiation_do ! return value + + !----------------------------------------------------------------------- + + ! Set error variables + errflg = 0 + errmsg = '' + + select case (op) + case ('sw') ! do a shortwave heating calc this timestep? + radiation_do = nstep == 0 .or. irad == 1 & + .or. (mod(nstep-1,irad) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case ('lw') ! do a longwave heating calc this timestep? + radiation_do = nstep == 0 .or. irad == 1 & + .or. (mod(nstep-1,irad) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case default + errflg = 1 + errmsg = 'radiation_do_ccpp: unknown operation:'//op + end select + +end subroutine radiation_do_ccpp + +!========================================================================================= + +subroutine initialize_rrtmgp_fluxes_broadband(ncol, nlevels, nbands, nswbands, spectralflux, fluxes, errmsg, errflg, do_direct) + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + + ! Allocate flux arrays and set values to zero. + + ! Arguments + integer, intent(in) :: ncol, nlevels, nbands, nswbands + logical, intent(in) :: spectralflux + class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes + logical, optional, intent(in) :: do_direct + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + logical :: do_direct_local + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'initialize_rrtmgp_fluxes' + !---------------------------------------------------------------------------- + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Broadband fluxes + allocate(fluxes%fluxes%flux_up(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_up". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_dn(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_net(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_net". Message: ', & + alloc_errmsg + return + end if + if (do_direct_local) then + allocate(fluxes%fluxes%flux_dn_dir(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn_dir". Message: ', & + alloc_errmsg + return + end if + end if + + ! Initialize + call reset_fluxes_broadband(fluxes) + +end subroutine initialize_rrtmgp_fluxes_broadband + +!========================================================================================= + +subroutine initialize_rrtmgp_fluxes_byband(ncol, nlevels, nbands, nswbands, spectralflux, fluxes, errmsg, errflg, do_direct) + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + + ! Allocate flux arrays and set values to zero. + + ! Arguments + integer, intent(in) :: ncol, nlevels, nbands, nswbands + logical, intent(in) :: spectralflux + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + logical, optional, intent(in) :: do_direct + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + logical :: do_direct_local + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'initialize_rrtmgp_fluxes_byband' + !---------------------------------------------------------------------------- + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Broadband fluxes + allocate(fluxes%fluxes%flux_up(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_up". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_dn(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_net(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_net". Message: ', & + alloc_errmsg + return + end if + if (do_direct_local) then + allocate(fluxes%fluxes%flux_dn_dir(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn_dir". Message: ', & + alloc_errmsg + return + end if + end if + + ! Fluxes by band always needed for SW. Only allocate for LW + ! when spectralflux is true. + if (nbands == nswbands .or. spectralflux) then + allocate(fluxes%fluxes%bnd_flux_up(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_up". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%bnd_flux_dn(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_dn". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%bnd_flux_net(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_net". Message: ', & + alloc_errmsg + return + end if + if (do_direct_local) then + allocate(fluxes%fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_dn_dir". Message: ', & + alloc_errmsg + return + end if + end if + end if + + ! Initialize + call reset_fluxes_byband(fluxes) + +end subroutine initialize_rrtmgp_fluxes_byband + +!========================================================================================= + +subroutine reset_fluxes_broadband(fluxes) + use ccpp_kinds, only: kind_phys + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + + ! Reset flux arrays to zero. + + class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes + !---------------------------------------------------------------------------- + + ! Reset broadband fluxes + fluxes%fluxes%flux_up(:,:) = 0._kind_phys + fluxes%fluxes%flux_dn(:,:) = 0._kind_phys + fluxes%fluxes%flux_net(:,:) = 0._kind_phys + if (associated(fluxes%fluxes%flux_dn_dir)) fluxes%fluxes%flux_dn_dir(:,:) = 0._kind_phys + +end subroutine reset_fluxes_broadband + +!========================================================================================= + +subroutine reset_fluxes_byband(fluxes) + use ccpp_kinds, only: kind_phys + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + + ! Reset flux arrays to zero. + + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + !---------------------------------------------------------------------------- + + ! Reset broadband fluxes + fluxes%fluxes%flux_up(:,:) = 0._kind_phys + fluxes%fluxes%flux_dn(:,:) = 0._kind_phys + fluxes%fluxes%flux_net(:,:) = 0._kind_phys + if (associated(fluxes%fluxes%flux_dn_dir)) fluxes%fluxes%flux_dn_dir(:,:) = 0._kind_phys + + ! Reset band-by-band fluxes + if (associated(fluxes%fluxes%bnd_flux_up)) fluxes%fluxes%bnd_flux_up(:,:,:) = 0._kind_phys + if (associated(fluxes%fluxes%bnd_flux_dn)) fluxes%fluxes%bnd_flux_dn(:,:,:) = 0._kind_phys + if (associated(fluxes%fluxes%bnd_flux_net)) fluxes%fluxes%bnd_flux_net(:,:,:) = 0._kind_phys + if (associated(fluxes%fluxes%bnd_flux_dn_dir)) fluxes%fluxes%bnd_flux_dn_dir(:,:,:) = 0._kind_phys + +end subroutine reset_fluxes_byband + +!========================================================================================= + +end module rrtmgp_pre diff --git a/schemes/rrtmgp/utils/calculate_net_heating.F90 b/schemes/rrtmgp/utils/calculate_net_heating.F90 new file mode 100644 index 00000000..89f2f26a --- /dev/null +++ b/schemes/rrtmgp/utils/calculate_net_heating.F90 @@ -0,0 +1,66 @@ +module calculate_net_heating +!----------------------------------------------------------------------- +! +! Purpose: Provide an interface to convert shortwave and longwave +! radiative heating terms into net heating. +! +! This module provides a hook to allow incorporating additional +! radiative terms (eUV heating and nonLTE longwave cooling). +! +! Original version: B.A. Boville +!----------------------------------------------------------------------- + +implicit none +private + +! Public interfaces +public :: calculate_net_heating_run + +!=============================================================================== +contains +!=============================================================================== + +!> \section arg_table_calculate_net_heating_run Argument Table +!! \htmlinclude calculate_net_heating_run.html +!! +subroutine calculate_net_heating_run(ncol, rad_heat, qrl_prime, qrs_prime, fsns, fsnt, & + flns, flnt, is_offline_dyn, net_flx, errmsg, errflg) +!----------------------------------------------------------------------- +! Compute net radiative heating from qrs and qrl, and the associated net +! boundary flux. +!----------------------------------------------------------------------- + use ccpp_kinds, only: kind_phys + + ! Arguments + integer, intent(in) :: ncol ! horizontal dimension + real(kind_phys), intent(in) :: qrl_prime(:,:) ! longwave heating [J kg-1 s-1] + real(kind_phys), intent(in) :: qrs_prime(:,:) ! shortwave heating [J kg-1 s-1] + real(kind_phys), intent(in) :: fsns(:) ! Surface solar absorbed flux [W m-2] + real(kind_phys), intent(in) :: fsnt(:) ! Net column abs solar flux at model top [W m-2] + real(kind_phys), intent(in) :: flns(:) ! Srf longwave cooling (up-down) flux [W m-2] + real(kind_phys), intent(in) :: flnt(:) ! Net outgoing lw flux at model top [W m-2] + logical, intent(in) :: is_offline_dyn ! is offline dycore + real(kind_phys), intent(inout) :: rad_heat(:,:) ! radiative heating [J kg-1 s-1] + real(kind_phys), intent(out) :: net_flx(:) ! net boundary flux [W m-2] + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + ! Local variables + integer :: idx + !----------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + if (.not. is_offline_dyn) then + rad_heat(:,:) = (qrs_prime(:,:) + qrl_prime(:,:)) + end if + + do idx = 1, ncol + net_flx(idx) = fsnt(idx) - fsns(idx) - flnt(idx) + flns(idx) + end do + +end subroutine calculate_net_heating_run + +!================================================================================================ +end module calculate_net_heating diff --git a/schemes/rrtmgp/utils/radiation_tools.F90 b/schemes/rrtmgp/utils/radiation_tools.F90 new file mode 100644 index 00000000..e941a346 --- /dev/null +++ b/schemes/rrtmgp/utils/radiation_tools.F90 @@ -0,0 +1,98 @@ +!>\file radiation_tools.F90 +!! + +!> This module contains tools for radiation +module radiation_tools + use machine, only: & + kind_phys ! Working type + implicit none + + real(kind_phys) :: & + rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP + rrtmgp_minT ! Minimum temperature allowed in RRTMGP +contains + +!> + subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev) + ! Inputs + integer, intent(in) :: & + nCol,nLev + real(kind_phys),intent(in) :: & + minP + real(kind_phys),dimension(nCol),intent(in) :: & + tsfc + real(kind_phys),dimension(nCol,nLev),intent(in) :: & + p_lay,t_lay + real(kind_phys),dimension(nCol,nLev+1),intent(in) :: & + p_lev + + ! Outputs + real(kind_phys),dimension(nCol,nLev+1),intent(out) :: & + t_lev + + ! Local + integer :: iCol,iLay, iSFC, iTOA + logical :: top_at_1 + real(kind_phys), dimension(nCol,nLev) :: tem2da, tem2db + + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + else + iSFC = 1 + iTOA = nLev + endif + + if (iTOA .eq. 1) then + tem2da(1:nCol,2:iSFC) = log(p_lay(1:nCol,2:iSFC)) + tem2db(1:nCol,2:iSFC) = log(p_lev(1:nCol,2:iSFC)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1) ) + tem2db(iCol,1) = log(max(minP, p_lev(iCol,1)) ) + tem2db(iCol,iSFC) = log(p_lev(iCol,iSFC) ) + enddo + t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) + do iLay = 2, iSFC + do iCol = 1, nCol + t_lev(iCol,iLay) = t_lay(iCol,iLay) + (t_lay(iCol,iLay-1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay-1) - tem2da(iCol,iLay)) + enddo + enddo + t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) + else + tem2da(1:nCol,2:iTOA) = log(p_lay(1:nCol,2:iTOA)) + tem2db(1:nCol,2:iTOA) = log(p_lev(1:nCol,2:iTOA)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1)) + tem2db(iCol,1) = log(p_lev(iCol,1)) + tem2db(iCol,iTOA) = log(max(minP, p_lev(iCol,iTOA)) ) + enddo + + t_lev(1:NCOL,1) = tsfc(1:NCOL) + do iLay = 1, iTOA-1 + do iCol = 1, nCol + t_lev(iCol,iLay+1) = t_lay(iCol,iLay) + (t_lay(iCol,iLay+1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay+1) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay+1) - tem2da(iCol,iLay)) + enddo + enddo + t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) + endif + + end subroutine cmp_tlev + +!> + subroutine check_error_msg(routine_name, error_msg) + character(len=*), intent(in) :: & + error_msg, routine_name + + if(error_msg /= "") then + print*,"ERROR("//trim(routine_name)//"): " + print*,trim(error_msg) + return + end if + end subroutine check_error_msg + +end module radiation_tools diff --git a/schemes/rrtmgp/utils/radiation_utils.F90 b/schemes/rrtmgp/utils/radiation_utils.F90 new file mode 100644 index 00000000..d0e40893 --- /dev/null +++ b/schemes/rrtmgp/utils/radiation_utils.F90 @@ -0,0 +1,205 @@ +module radiation_utils + use ccpp_kinds, only: kind_phys + + implicit none + private + + public :: radiation_utils_init + public :: get_sw_spectral_boundaries_ccpp + public :: get_lw_spectral_boundaries_ccpp + public :: get_mu_lambda_weights_ccpp + + real(kind_phys), allocatable :: wavenumber_low_shortwave(:) + real(kind_phys), allocatable :: wavenumber_high_shortwave(:) + real(kind_phys), allocatable :: wavenumber_low_longwave(:) + real(kind_phys), allocatable :: wavenumber_high_longwave(:) + integer :: nswbands + integer :: nlwbands + logical :: wavenumber_boundaries_set = .false. + +contains + + subroutine radiation_utils_init(nswbands_in, nlwbands_in, low_shortwave, high_shortwave, & + low_longwave, high_longwave, errmsg, errflg) + integer, intent(in) :: nswbands_in ! Number of shortwave bands + integer, intent(in) :: nlwbands_in ! Number of longwave bands + real(kind_phys), intent(in) :: low_shortwave(:) ! Low range values for shortwave bands (cm-1) + real(kind_phys), intent(in) :: high_shortwave(:) ! High range values for shortwave bands (cm-1) + real(kind_phys), intent(in) :: low_longwave(:) ! Low range values for longwave bands (cm-1) + real(kind_phys), intent(in) :: high_longwave(:) ! High range values for longwave bands (cm-1) + integer, intent(out) :: errflg + character(len=*),intent(out) :: errmsg + ! Local variables + character(len=256) :: alloc_errmsg + + errflg = 0 + errmsg = '' + nswbands = nswbands_in + nlwbands = nlwbands_in + allocate(wavenumber_low_shortwave(nswbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_low_shortwave, message: ', & + alloc_errmsg + end if + allocate(wavenumber_high_shortwave(nswbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_high_shortwave, message: ', & + alloc_errmsg + end if + allocate(wavenumber_low_longwave(nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_low_longwave, message: ', & + alloc_errmsg + end if + allocate(wavenumber_high_longwave(nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_high_longwave, message: ', & + alloc_errmsg + end if + + wavenumber_low_shortwave = low_shortwave + wavenumber_high_shortwave = high_shortwave + wavenumber_low_longwave = low_longwave + wavenumber_high_longwave = high_longwave + + wavenumber_boundaries_set = .true. + + end subroutine radiation_utils_init + +!========================================================================================= + + subroutine get_sw_spectral_boundaries_ccpp(low_boundaries, high_boundaries, units, errmsg, errflg) + + ! provide spectral boundaries of each shortwave band in the units requested + + character(len=*), intent(in) :: units ! requested units + real(kind_phys), dimension(:), intent(out) :: low_boundaries ! low range bounds for shortwave bands in requested units + real(kind_phys), dimension(:), intent(out) :: high_boundaries ! high range bounds for shortwave bands in requested units + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + character(len=*), parameter :: sub = 'get_sw_spectral_boundaries_ccpp' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. wavenumber_boundaries_set) then + write(errmsg,'(a,a)') sub, ': ERROR, wavenumber boundaries not set.' + end if + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_shortwave + high_boundaries = wavenumber_high_shortwave + case('m','meter','meters') + low_boundaries = 1.e-2_kind_phys/wavenumber_high_shortwave + high_boundaries = 1.e-2_kind_phys/wavenumber_low_shortwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_kind_phys/wavenumber_high_shortwave + high_boundaries = 1.e7_kind_phys/wavenumber_low_shortwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_kind_phys/wavenumber_high_shortwave + high_boundaries = 1.e4_kind_phys/wavenumber_low_shortwave + case('cm','centimeter','centimeters') + low_boundaries = 1._kind_phys/wavenumber_high_shortwave + high_boundaries = 1._kind_phys/wavenumber_low_shortwave + case default + write(errmsg, '(a,a,a)') sub, ': ERROR, requested spectral units not recognized: ', units + errflg = 1 + end select + + end subroutine get_sw_spectral_boundaries_ccpp + +!========================================================================================= + +subroutine get_lw_spectral_boundaries_ccpp(low_boundaries, high_boundaries, units, errmsg, errflg) + + ! provide spectral boundaries of each longwave band in the units requested + + character(len=*), intent(in) :: units ! requested units + real(kind_phys), intent(out) :: low_boundaries(nlwbands) ! low range bounds for longwave bands in requested units + real(kind_phys), intent(out) :: high_boundaries(nlwbands) ! high range bounds for longwave bands in requested units + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + character(len=*), parameter :: sub = 'get_lw_spectral_boundaries_ccpp' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. wavenumber_boundaries_set) then + write(errmsg,'(a,a)') sub, ': ERROR, wavenumber boundaries not set.' + end if + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_longwave + high_boundaries = wavenumber_high_longwave + case('m','meter','meters') + low_boundaries = 1.e-2_kind_phys/wavenumber_high_longwave + high_boundaries = 1.e-2_kind_phys/wavenumber_low_longwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_kind_phys/wavenumber_high_longwave + high_boundaries = 1.e7_kind_phys/wavenumber_low_longwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_kind_phys/wavenumber_high_longwave + high_boundaries = 1.e4_kind_phys/wavenumber_low_longwave + case('cm','centimeter','centimeters') + low_boundaries = 1._kind_phys/wavenumber_high_longwave + high_boundaries = 1._kind_phys/wavenumber_low_longwave + case default + write(errmsg, '(a,a,a)') sub, ': ERROR, requested spectral units not recognized: ', units + errflg = 1 + end select + +end subroutine get_lw_spectral_boundaries_ccpp + +!========================================================================================= + +subroutine get_mu_lambda_weights_ccpp(nmu, nlambda, g_mu, g_lambda, lamc, pgam, & + mu_wgts, lambda_wgts, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp_init, lininterp, & + extrap_method_bndry + ! Get mu and lambda interpolation weights + integer, intent(in) :: nmu ! number of mu values + integer, intent(in) :: nlambda ! number of lambda values + real(kind_phys), intent(in) :: g_mu(:) ! mu values + real(kind_phys), intent(in) :: g_lambda(:,:) ! lambda table + real(kind_phys), intent(in) :: lamc ! prognosed value of lambda for cloud + real(kind_phys), intent(in) :: pgam ! prognosed value of mu for cloud + ! Output interpolation weights. Caller is responsible for freeing these. + type(interp_type), intent(out) :: mu_wgts ! mu interpolation weights + type(interp_type), intent(out) :: lambda_wgts ! lambda interpolation weights + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: ilambda + real(kind_phys) :: g_lambda_interp(nlambda) + + ! Set error variables + errmsg = '' + errflg = 0 + + ! Make interpolation weights for mu. + ! (Put pgam in a temporary array for this purpose.) + call lininterp_init(g_mu, nmu, [pgam], 1, extrap_method_bndry, mu_wgts) + + ! Use mu weights to interpolate to a row in the lambda table. + do ilambda = 1, nlambda + call lininterp(g_lambda(:,ilambda), nmu, & + g_lambda_interp(ilambda:ilambda), 1, mu_wgts) + end do + + ! Make interpolation weights for lambda. + call lininterp_init(g_lambda_interp, nlambda, [lamc], 1, & + extrap_method_bndry, lambda_wgts) + +end subroutine get_mu_lambda_weights_ccpp + +!========================================================================================= + +end module radiation_utils diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 new file mode 100644 index 00000000..f2d80ea2 --- /dev/null +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -0,0 +1,62 @@ +module rrtmgp_dry_static_energy_tendency +!----------------------------------------------------------------------- +! +! Purpose: Provide an interface to convert shortwave and longwave +! radiative heating terms into net heating. +! +! This module provides a hook to allow incorporating additional +! radiative terms (eUV heating and nonLTE longwave cooling). +! +! Original version: B.A. Boville +!----------------------------------------------------------------------- + +implicit none +private + +! Public interfaces +public :: rrtmgp_dry_static_energy_tendency_run + +!=============================================================================== +contains +!=============================================================================== + +!> \section arg_table_rrtmgp_dry_static_energy_tendency_run Argument Table +!! \htmlinclude rrtmgp_dry_static_energy_tendency_run.html +!! +subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_heat, & + qrs, qrl, qrs_prime, qrl_prime, errmsg, errflg) +!----------------------------------------------------------------------- +! Compute net radiative heating from qrs and qrl, and the associated net +! boundary flux. +!----------------------------------------------------------------------- + use ccpp_kinds, only: kind_phys + + ! Arguments + real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness + logical, intent(in) :: calc_sw_heat ! Flag to calculate net shortwave heating + logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating + real(kind_phys), dimension(:,:), intent(in) :: qrs ! shortwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) + real(kind_phys), dimension(:,:), intent(in) :: qrl ! longwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) + real(kind_phys), dimension(:,:), intent(out) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(out) :: qrl_prime ! longwave heating rate (J kg-1 s-1) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + !----------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + + if (calc_sw_heat) then + qrs_prime(:,:) = qrs(:,:) / pdel(:,:) + end if + + if (calc_lw_heat) then + qrl_prime(:,:) = qrl(:,:) / pdel(:,:) + end if + +end subroutine rrtmgp_dry_static_energy_tendency_run + +!================================================================================================ +end module rrtmgp_dry_static_energy_tendency diff --git a/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta b/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta index c5811a27..1288ee9b 100644 --- a/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta +++ b/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta @@ -25,7 +25,7 @@ standard_name = vertically_integrated_total_energy_using_dycore_energy_formula_at_start_of_physics_timestep units = J m-2 type = real | kind = kind_phys - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) intent = in [ te_cur_dyn ] standard_name = vertically_integrated_total_energy_using_dycore_energy_formula diff --git a/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.F90 b/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.F90 new file mode 100644 index 00000000..cd89a833 --- /dev/null +++ b/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.F90 @@ -0,0 +1,84 @@ +! Diagnostics for RK stratiform - cloud particle sedimentation +module cloud_particle_sedimentation_diagnostics + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: cloud_particle_sedimentation_diagnostics_init + public :: cloud_particle_sedimentation_diagnostics_run + +contains + + !> \section arg_table_cloud_particle_sedimentation_diagnostics_init Argument Table + !! \htmlinclude cloud_particle_sedimentation_diagnostics_init.html + subroutine cloud_particle_sedimentation_diagnostics_init(errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables: + + errmsg = '' + errflg = 0 + + ! History add field calls + call history_add_field('DQSED', 'tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_sedimentation', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('DISED', 'tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_sedimentation', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('DLSED', 'tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_sedimentation', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('HSED', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_sedimentation', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('PRECSED', 'stratiform_cloud_water_surface_flux_due_to_sedimentation', horiz_only, 'inst', 'm s-1') + call history_add_field('SNOWSED', 'stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation', horiz_only, 'inst', 'm s-1') + call history_add_field('RAINSED', 'stratiform_rain_flux_at_surface_due_to_sedimentation', horiz_only, 'inst', 'm s-1') + + end subroutine cloud_particle_sedimentation_diagnostics_init + + !> \section arg_table_cloud_particle_sedimentation_diagnostics_run Argument Table + !! \htmlinclude cloud_particle_sedimentation_diagnostics_run.html + subroutine cloud_particle_sedimentation_diagnostics_run( & + ncol, & + wvtend, icetend, liqtend, htend, & + snow_sed, sfliq, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + integer, intent(in) :: ncol + real(kind_phys), intent(in) :: wvtend(:,:) ! water vapor tendency -- to apply wv tendency + real(kind_phys), intent(in) :: icetend(:,:) ! ice condensate tendency -- to apply cldice tendency + real(kind_phys), intent(in) :: liqtend(:,:) ! liquid condensate tendency -- to apply cldliq tendency + real(kind_phys), intent(in) :: htend(:,:) ! heating rate [J kg-1 s-1] -- to apply s tendency + + real(kind_phys), intent(in) :: snow_sed(:) ! stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation [m s-1] + real(kind_phys), intent(in) :: sfliq(:) ! stratiform_rain_flux_at_surface_due_to_sedimentation [kg m-2 s-1] + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + real(kind_phys), parameter :: rhofw = 1000._kind_phys ! density of fresh water [kg m-3] + real(kind_phys) :: prec_sed(ncol) + + ! repeat computation of prec_sed here for diagnostics [m s-1] + prec_sed(:ncol) = sfliq(:ncol)/rhofw + snow_sed(:ncol) + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('DQSED' , wvtend) + call history_out_field('DISED' , icetend) + call history_out_field('DLSED' , liqtend) + call history_out_field('HSED' , htend) + + call history_out_field('PRECSED', prec_sed) ! calculated as m s-1 + call history_out_field('SNOWSED', snow_sed) ! already in m s-1 + call history_out_field('RAINSED', sfliq/rhofw) ! convert from kg m-2 s-1 to m s-1 (precip units) for output + + end subroutine cloud_particle_sedimentation_diagnostics_run + +end module cloud_particle_sedimentation_diagnostics diff --git a/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta b/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta new file mode 100644 index 00000000..b638b250 --- /dev/null +++ b/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta @@ -0,0 +1,77 @@ +[ccpp-table-properties] + name = cloud_particle_sedimentation_diagnostics + type = scheme + +[ccpp-arg-table] + name = cloud_particle_sedimentation_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = cloud_particle_sedimentation_diagnostics_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ wvtend ] + standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ icetend ] + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ liqtend ] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ htend ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ snow_sed ] + standard_name = stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ sfliq ] + standard_name = stratiform_rain_flux_at_surface_due_to_sedimentation + units = kg m-2 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.F90 b/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.F90 new file mode 100644 index 00000000..74a69996 --- /dev/null +++ b/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.F90 @@ -0,0 +1,57 @@ +! Diagnostics for cloud fraction +module compute_cloud_fraction_diagnostics + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: compute_cloud_fraction_diagnostics_init + public :: compute_cloud_fraction_diagnostics_run + +contains + + !> \section arg_table_compute_cloud_fraction_diagnostics_init Argument Table + !! \htmlinclude compute_cloud_fraction_diagnostics_init.html + subroutine compute_cloud_fraction_diagnostics_init(errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables: + + errmsg = '' + errflg = 0 + + ! History add field calls + call history_add_field('CLDST', 'stratiform_cloud_area_fraction', 'lev', 'avg', 'fraction') + + end subroutine compute_cloud_fraction_diagnostics_init + + !> \section arg_table_compute_cloud_fraction_diagnostics_run Argument Table + !! \htmlinclude compute_cloud_fraction_diagnostics_run.html + subroutine compute_cloud_fraction_diagnostics_run( & + cldst, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + real(kind_phys), intent(in) :: cldst(:,:) + + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('CLDST', cldst) + + end subroutine compute_cloud_fraction_diagnostics_run + +end module compute_cloud_fraction_diagnostics diff --git a/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta b/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta new file mode 100644 index 00000000..e0167a72 --- /dev/null +++ b/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta @@ -0,0 +1,41 @@ +[ccpp-table-properties] + name = compute_cloud_fraction_diagnostics + type = scheme + +[ccpp-arg-table] + name = compute_cloud_fraction_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = compute_cloud_fraction_diagnostics_run + type = scheme +[ cldst ] + standard_name = stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/sima_diagnostics/convect_shallow_diagnostics.F90 b/schemes/sima_diagnostics/convect_shallow_diagnostics.F90 index 1504a1c9..b3ec2971 100644 --- a/schemes/sima_diagnostics/convect_shallow_diagnostics.F90 +++ b/schemes/sima_diagnostics/convect_shallow_diagnostics.F90 @@ -1,5 +1,4 @@ ! Diagnostics for shallow convection and merged deep + shallow convection -! Haipeng Lin, December 2024 module convect_shallow_diagnostics use ccpp_kinds, only: kind_phys diff --git a/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.F90 b/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.F90 new file mode 100644 index 00000000..fedcded9 --- /dev/null +++ b/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.F90 @@ -0,0 +1,63 @@ +! Diagnostics for cloud fraction - convective cloud cover +module convective_cloud_cover_diagnostics + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: convective_cloud_cover_diagnostics_init + public :: convective_cloud_cover_diagnostics_run + +contains + + !> \section arg_table_convective_cloud_cover_diagnostics_init Argument Table + !! \htmlinclude convective_cloud_cover_diagnostics_init.html + subroutine convective_cloud_cover_diagnostics_init(errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables: + + errmsg = '' + errflg = 0 + + ! History add field calls + call history_add_field('SH_CLD', 'shallow_convective_cloud_area_fraction', 'lev', 'avg', 'fraction') + call history_add_field('DP_CLD', 'deep_convective_cloud_area_fraction', 'lev', 'avg', 'fraction') + call history_add_field('CONCLD', 'convective_cloud_area_fraction', 'lev', 'avg', 'fraction') + + end subroutine convective_cloud_cover_diagnostics_init + + !> \section arg_table_convective_cloud_cover_diagnostics_run Argument Table + !! \htmlinclude convective_cloud_cover_diagnostics_run.html + subroutine convective_cloud_cover_diagnostics_run( & + shallowcu, deepcu, concld, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + real(kind_phys), intent(in) :: shallowcu(:, :) ! Shallow convective cloud fraction [fraction] + real(kind_phys), intent(in) :: deepcu(:, :) ! Deep convective cloud fraction [fraction] + real(kind_phys), intent(in) :: concld(:, :) ! Convective cloud cover [fraction] + + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('SH_CLD', shallowcu) + call history_out_field('DP_CLD', deepcu) + call history_out_field('CONCLD', concld) + + end subroutine convective_cloud_cover_diagnostics_run + +end module convective_cloud_cover_diagnostics diff --git a/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta b/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta new file mode 100644 index 00000000..85796f3f --- /dev/null +++ b/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta @@ -0,0 +1,53 @@ +[ccpp-table-properties] + name = convective_cloud_cover_diagnostics + type = scheme + +[ccpp-arg-table] + name = convective_cloud_cover_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = convective_cloud_cover_diagnostics_run + type = scheme +[ shallowcu ] + standard_name = shallow_convective_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ deepcu ] + standard_name = deep_convective_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ concld ] + standard_name = convective_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/sima_diagnostics/rk_stratiform_diagnostics.F90 b/schemes/sima_diagnostics/rk_stratiform_diagnostics.F90 new file mode 100644 index 00000000..90c37cb0 --- /dev/null +++ b/schemes/sima_diagnostics/rk_stratiform_diagnostics.F90 @@ -0,0 +1,327 @@ +! Diagnostics for RK stratiform - miscellaneous interstitial schemes +module rk_stratiform_diagnostics + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: rk_stratiform_diagnostics_init + public :: rk_stratiform_cloud_fraction_perturbation_diagnostics_run + public :: rk_stratiform_condensate_repartioning_diagnostics_run + public :: rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run + public :: rk_stratiform_cloud_optical_properties_diagnostics_run + +contains + + !> \section arg_table_rk_stratiform_diagnostics_init Argument Table + !! \htmlinclude rk_stratiform_diagnostics_init.html + subroutine rk_stratiform_diagnostics_init(errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! There is one initialization scheme for all RK diagnostics + ! but there are separate run phases for diagnostics + ! pertaining to each interstitial scheme. See RK SDF file. + + errmsg = '' + errflg = 0 + + ! rk_stratiform_cloud_fraction_perturbation_diagnostics + call history_add_field('AST', 'cloud_area_fraction', 'lev', 'avg', 'fraction') + + ! rk_stratiform_condensate_repartioning_diagnostics + call history_add_field('FICE', 'mass_fraction_of_ice_content_within_stratiform_cloud', 'lev', 'avg', 'fraction') + call history_add_field('REPARTICE', 'tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_cloud_ice_and_cloud_liquid_repartitioning', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('REPARTLIQ', 'tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_cloud_ice_and_cloud_liquid_repartitioning', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('HREPART', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning', 'lev', 'avg', 'J kg-1 s-1') + + ! rk_stratiform_prognostic_cloud_water_tendencies_diagnostics + call history_add_field('FWAUT', 'relative_importance_of_cloud_liquid_water_autoconversion', 'lev', 'avg', 'fraction') + call history_add_field('FSAUT', 'relative_importance_of_cloud_ice_autoconversion', 'lev', 'avg', 'fraction') + call history_add_field('FRACW', 'relative_importance_of_rain_accreting_cloud_liquid_water', 'lev', 'avg', 'fraction') + call history_add_field('FSACW', 'relative_importance_of_snow_accreting_cloud_liquid_water', 'lev', 'avg', 'fraction') + call history_add_field('FSACI', 'relative_importance_of_snow_accreting_cloud_ice', 'lev', 'avg', 'fraction') + call history_add_field('PCSNOW', 'lwe_snow_precipitation_rate_at_surface_due_to_microphysics', horiz_only, 'avg', 'fraction') + call history_add_field('CME', 'net_condensation_rate_due_to_microphysics', 'lev', 'avg', 'kg kg-1 s-1') ! qme. + call history_add_field('CMEICE', 'rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('CMELIQ', 'rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('ICE2PR', 'tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('LIQ2PR', 'tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion', 'lev', 'avg', 'kg kg-1 s-1') + + call history_add_field('HPROGCLD', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_microphysics', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('HEVAP', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('HMELT', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('HCME', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('HFREEZ', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation', 'lev', 'avg', 'J kg-1 s-1') + + call history_add_field('PRODPREC', 'precipitation_production_due_to_microphysics', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('EVAPPREC', 'rate_of_evaporation_of_precipitation_due_to_microphysics', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('EVAPSNOW', 'rate_of_evaporation_of_falling_snow_due_to_microphysics', 'lev', 'avg', 'kg kg-1 s-1') + + ! ... for COSP/CFMIP + call history_add_field('LS_FLXPRC', 'stratiform_rain_and_snow_flux_at_interface', 'ilev', 'avg', 'kg m-2 s-1') + call history_add_field('LS_FLXSNW', 'stratiform_snow_flux_at_interface', 'ilev', 'avg', 'kg m-2 s-1') + call history_add_field('PRACWO', 'accretion_of_cloud_liquid_water_by_rain', 'lev', 'avg', 's-1') + call history_add_field('PSACWO', 'accretion_of_cloud_liquid_water_by_snow', 'lev', 'avg', 's-1') + call history_add_field('PSACIO', 'accretion_of_cloud_ice_by_snow', 'lev', 'avg', 's-1') + + call history_add_field('CLDLIQSTR', 'stratiform_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + call history_add_field('CLDICESTR', 'stratiform_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + call history_add_field('CLDLIQCON', 'convective_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + call history_add_field('CLDICECON', 'convective_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + + ! rk_stratiform_cloud_optical_properties_diagnostics + call history_add_field('IWC', 'stratiform_cloud_ice_water_content', 'lev', 'avg', 'kg m-3') + call history_add_field('LWC', 'stratiform_cloud_liquid_water_content', 'lev', 'avg', 'kg m-3') + call history_add_field('ICIMR', 'in_cloud_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + call history_add_field('ICWMR', 'in_cloud_cloud_liquid_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + + call history_add_field('REI', 'effective_radius_of_stratiform_cloud_ice_particle', 'lev', 'avg', 'um') + call history_add_field('REL', 'effective_radius_of_stratiform_cloud_liquid_water_particle', 'lev', 'avg', 'um') + + + end subroutine rk_stratiform_diagnostics_init + + !> \section arg_table_rk_stratiform_cloud_fraction_perturbation_diagnostics_run Argument Table + !! \htmlinclude rk_stratiform_cloud_fraction_perturbation_diagnostics_run.html + subroutine rk_stratiform_cloud_fraction_perturbation_diagnostics_run( & + cloud, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + real(kind_phys), intent(in) :: cloud(:, :) ! cloud_area_fraction [fraction] + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('AST', cloud) + + end subroutine rk_stratiform_cloud_fraction_perturbation_diagnostics_run + + !> \section arg_table_rk_stratiform_condensate_repartioning_diagnostics_run Argument Table + !! \htmlinclude rk_stratiform_condensate_repartioning_diagnostics_run.html + subroutine rk_stratiform_condensate_repartioning_diagnostics_run( & + fice, tend_cldice, tend_cldliq, repartht, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + real(kind_phys), intent(in) :: fice(:,:) ! mass_fraction_of_ice_content_within_stratiform_cloud [fraction] + real(kind_phys), intent(in) :: tend_cldice(:,:) ! tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1] + real(kind_phys), intent(in) :: tend_cldliq(:,:) ! tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1] + real(kind_phys), intent(in) :: repartht(:,:) ! [J kg-1 s-1] + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('FICE', fice) + call history_out_field('REPARTICE', tend_cldice) + call history_out_field('REPARTLIQ', tend_cldliq) + call history_out_field('HREPART', repartht) + + end subroutine rk_stratiform_condensate_repartioning_diagnostics_run + + !> \section arg_table_rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run Argument Table + !! \htmlinclude rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run.html + subroutine rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run( & + ncol, pver, & + cloud, concld, & + cldliq, cldice, & + fwaut, fsaut, fracw, fsacw, fsaci, & + snow_pcw, cme, cmeice, cmeliq, ice2pr, liq2pr, & + tend_s, & + evapheat, meltheat, cmeheat, prfzheat, & + prodprec, evapprec, evapsnow, & + lsflxprc, lsflxsnw, & + pracwo, psacwo, psacio, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + integer, intent(in) :: ncol + integer, intent(in) :: pver + real(kind_phys), intent(in) :: cloud(:,:) ! cloud_area_fraction [fraction] + real(kind_phys), intent(in) :: concld(:,:) ! convective_cloud_area_fraction [fraction] + real(kind_phys), intent(in) :: cldliq(:,:) ! adv: cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + real(kind_phys), intent(in) :: cldice(:,:) ! adv: cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + + real(kind_phys), intent(in) :: fwaut(:,:) + real(kind_phys), intent(in) :: fsaut(:,:) + real(kind_phys), intent(in) :: fracw(:,:) + real(kind_phys), intent(in) :: fsacw(:,:) + real(kind_phys), intent(in) :: fsaci(:,:) + + real(kind_phys), intent(in) :: snow_pcw(:) + real(kind_phys), intent(in) :: cme(:,:) + real(kind_phys), intent(in) :: cmeice(:,:) + real(kind_phys), intent(in) :: cmeliq(:,:) + real(kind_phys), intent(in) :: ice2pr(:,:) + real(kind_phys), intent(in) :: liq2pr(:,:) + + real(kind_phys), intent(in) :: tend_s(:,:) + real(kind_phys), intent(in) :: evapheat(:,:) + real(kind_phys), intent(in) :: meltheat(:,:) + real(kind_phys), intent(in) :: cmeheat(:,:) + real(kind_phys), intent(in) :: prfzheat(:,:) + + real(kind_phys), intent(in) :: prodprec(:,:) + real(kind_phys), intent(in) :: evapprec(:,:) + real(kind_phys), intent(in) :: evapsnow(:,:) + real(kind_phys), intent(in) :: lsflxprc(:,:) + real(kind_phys), intent(in) :: lsflxsnw(:,:) + real(kind_phys), intent(in) :: pracwo(:,:) + real(kind_phys), intent(in) :: psacwo(:,:) + real(kind_phys), intent(in) :: psacio(:,:) + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + real(kind_phys) :: cldliqstr(ncol, pver) ! [kg kg-1] + real(kind_phys) :: cldicestr(ncol, pver) ! [kg kg-1] + real(kind_phys) :: cldliqcon(ncol, pver) ! [kg kg-1] + real(kind_phys) :: cldicecon(ncol, pver) ! [kg kg-1] + integer :: i, k + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('FWAUT', fwaut) + call history_out_field('FSAUT', fsaut) + call history_out_field('FRACW', fracw) + call history_out_field('FSACW', fsacw) + call history_out_field('FSACI', fsaci) + + call history_out_field('PCSNOW', snow_pcw) + call history_out_field('CME', cme) + call history_out_field('CMEICE', cmeice) + call history_out_field('CMELIQ', cmeliq) + call history_out_field('ICE2PR', ice2pr) + call history_out_field('LIQ2PR', liq2pr) + + call history_out_field('HPROGCLD', tend_s) + call history_out_field('HEVAP', evapheat) + call history_out_field('HMELT', meltheat) + call history_out_field('HCME', cmeheat) + call history_out_field('HFREEZ', prfzheat) + + call history_out_field('PRODPREC', prodprec) + call history_out_field('EVAPPREC', evapprec) + call history_out_field('EVAPSNOW', evapsnow) + + call history_out_field('LS_FLXPRC', lsflxprc) + call history_out_field('LS_FLXSNW', lsflxsnw) + call history_out_field('PRACWO', pracwo) + call history_out_field('PSACWO', psacwo) + call history_out_field('PSACIO', psacio) + + ! Derived diagnostics -- mass mixing ratio for stratiform or convective cloud liquid / cloud ice + cldliqstr(:,:) = 0._kind_phys + cldicestr(:,:) = 0._kind_phys + cldliqcon(:,:) = 0._kind_phys + cldicecon(:,:) = 0._kind_phys + do k = 1, pver + do i = 1, ncol + if(cloud(i,k) > 0._kind_phys) then + ! convective mass mixing ratios + cldliqcon(i,k) = cldliq(i,k)/cloud(i,k) * concld(i,k) + cldicecon(i,k) = cldice(i,k)/cloud(i,k) * concld(i,k) + + ! stratiform (large-scale) mass mixing ratios + cldliqstr(i,k) = cldliq(i,k)/cloud(i,k) * (cloud(i,k) - concld(i,k)) + cldicestr(i,k) = cldice(i,k)/cloud(i,k) * (cloud(i,k) - concld(i,k)) + endif + enddo + enddo + + call history_out_field('CLDLIQCON', cldliqcon) + call history_out_field('CLDICECON', cldicecon) + + call history_out_field('CLDLIQSTR', cldliqstr) + call history_out_field('CLDICESTR', cldicestr) + + end subroutine rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run + + !> \section arg_table_rk_stratiform_cloud_optical_properties_diagnostics_run Argument Table + !! \htmlinclude rk_stratiform_cloud_optical_properties_diagnostics_run.html + subroutine rk_stratiform_cloud_optical_properties_diagnostics_run( & + ncol, pver, & + rair, & + pmid, & + t, & + cldice, cldliq, & + rhcloud, & + rel, rei, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input arguments + integer, intent(in) :: ncol + integer, intent(in) :: pver + real(kind_phys), intent(in) :: rair + real(kind_phys), intent(in) :: pmid(:,:) ! air_pressure [Pa] + real(kind_phys), intent(in) :: t(:,:) ! air_temperature [K] + real(kind_phys), intent(in) :: cldliq(:,:) ! adv: cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + real(kind_phys), intent(in) :: cldice(:,:) ! adv: cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + real(kind_phys), intent(in) :: rhcloud(:,:) ! cloud_area_fraction_from_relative_humidity_method [fraction] + real(kind_phys), intent(in) :: rel(:,:) ! effective_radius_of_stratiform_cloud_liquid_water_particle [um] + real(kind_phys), intent(in) :: rei(:,:) ! effective_radius_of_stratiform_cloud_ice_particle [um] + + ! Output arguments + character(len=512), intent(out) :: errmsg ! error message + integer, intent(out) :: errflg ! error flag + + ! Temporaries for diagnostic output. + real(kind_phys) :: iwc(ncol,pver) ! stratiform_cloud_ice_water_content [kg m-3] + real(kind_phys) :: lwc(ncol,pver) ! stratiform_cloud_liquid_water_content [kg m-3] + real(kind_phys) :: icimr(ncol,pver) ! in_cloud_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + real(kind_phys) :: icwmr(ncol,pver) ! in_cloud_cloud_liquid_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + + integer :: i, k + + + ! Prognostic cloud water diagnostics + ! needs updated cloud fraction + do k = 1, pver + do i = 1, ncol + iwc(i,k) = cldice(i,k)*pmid(i,k)/(rair*t(i,k)) + lwc(i,k) = cldliq(i,k)*pmid(i,k)/(rair*t(i,k)) + icimr(i,k) = cldice(i,k) / max(0.01_kind_phys, rhcloud(i,k)) + icwmr(i,k) = cldliq(i,k) / max(0.01_kind_phys, rhcloud(i,k)) + end do + end do + + call history_out_field('IWC', iwc) + call history_out_field('LWC', lwc) + call history_out_field('ICIMR', icimr) + call history_out_field('ICWMR', icwmr) + + ! Cloud optical properties + call history_out_field('REL', rel) + call history_out_field('REI', rei) + + end subroutine rk_stratiform_cloud_optical_properties_diagnostics_run + + +end module rk_stratiform_diagnostics diff --git a/schemes/sima_diagnostics/rk_stratiform_diagnostics.meta b/schemes/sima_diagnostics/rk_stratiform_diagnostics.meta new file mode 100644 index 00000000..9346b7d2 --- /dev/null +++ b/schemes/sima_diagnostics/rk_stratiform_diagnostics.meta @@ -0,0 +1,371 @@ +[ccpp-table-properties] + name = rk_stratiform_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-table-properties] + name = rk_stratiform_cloud_fraction_perturbation_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_cloud_fraction_perturbation_diagnostics_run + type = scheme +[ cloud ] + standard_name = cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-table-properties] + name = rk_stratiform_condensate_repartioning_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_condensate_repartioning_diagnostics_run + type = scheme +[ fice ] + standard_name = mass_fraction_of_ice_content_within_stratiform_cloud + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ tend_cldice ] + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ tend_cldliq ] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ repartht ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-table-properties] + name = rk_stratiform_prognostic_cloud_water_tendencies_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ cloud ] + standard_name = cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ concld ] + standard_name = convective_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldliq ] + standard_name = cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in + advected = true +[ cldice ] + standard_name = cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in + advected = true +[ fwaut ] + standard_name = relative_importance_of_cloud_liquid_water_autoconversion + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ fsaut ] + standard_name = relative_importance_of_cloud_ice_autoconversion + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ fracw ] + standard_name = relative_importance_of_rain_accreting_cloud_liquid_water + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ fsacw ] + standard_name = relative_importance_of_snow_accreting_cloud_liquid_water + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ fsaci ] + standard_name = relative_importance_of_snow_accreting_cloud_ice + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ snow_pcw ] + standard_name = lwe_snow_precipitation_rate_at_surface_due_to_microphysics + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ cme ] + standard_name = net_condensation_rate_due_to_microphysics + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cmeice ] + standard_name = rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cmeliq ] + standard_name = rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ ice2pr ] + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ liq2pr ] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ tend_s ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ evapheat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ meltheat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cmeheat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ prfzheat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ prodprec ] + standard_name = precipitation_production_due_to_microphysics + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ evapprec ] + standard_name = rate_of_evaporation_of_precipitation_due_to_microphysics + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ evapsnow ] + standard_name = rate_of_evaporation_of_falling_snow_due_to_microphysics + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ lsflxprc ] + standard_name = stratiform_rain_and_snow_flux_at_interface + units = kg m-2 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = in +[ lsflxsnw ] + standard_name = stratiform_snow_flux_at_interface + units = kg m-2 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = in +[ pracwo ] + standard_name = accretion_of_cloud_liquid_water_by_rain + units = s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ psacwo ] + standard_name = accretion_of_cloud_liquid_water_by_snow + units = s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ psacio ] + standard_name = accretion_of_cloud_ice_by_snow + units = s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-table-properties] + name = rk_stratiform_cloud_optical_properties_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_cloud_optical_properties_diagnostics_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ rair ] + standard_name = gas_constant_of_dry_air + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ pmid ] + standard_name = air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ t ] + standard_name = air_temperature + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldice ] + standard_name = cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldliq ] + standard_name = cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ rhcloud ] + standard_name = cloud_area_fraction_from_relative_humidity_method + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ rel ] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle + units = um + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ rei ] + standard_name = effective_radius_of_stratiform_cloud_ice_particle + units = um + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/tropopause_find/tropopause_find.meta b/schemes/tropopause_find/tropopause_find.meta index bc0978e1..a34f9df0 100644 --- a/schemes/tropopause_find/tropopause_find.meta +++ b/schemes/tropopause_find/tropopause_find.meta @@ -115,7 +115,7 @@ standard_name = tropopause_air_pressure_from_tropopause_climatology_dataset units = Pa type = real | kind = kind_phys - dimensions = (horizontal_dimension, number_of_time_slices_in_tropopause_climatology_dataset) + dimensions = (horizontal_loop_extent, number_of_time_slices_in_tropopause_climatology_dataset) intent = in [ tropp_days ] standard_name = tropopause_calendar_days_from_tropopause_climatology diff --git a/suites/suite_cam4.xml b/suites/suite_cam4.xml index dec0a682..7c3fc7f8 100644 --- a/suites/suite_cam4.xml +++ b/suites/suite_cam4.xml @@ -5,8 +5,8 @@ CAM4 PHYSICS SUITE Deep convection ZM Shallow convection Hack - Macrophysics RK (not implemented) - Microphysics RK (not implemented) + Macrophysics RK + Microphysics RK Radiation RRTMGP (not implemented) Chemistry None (not implemented) Vertical Diffusion HB (not implemented) @@ -127,8 +127,88 @@ check_energy_chng + + tropopause_find + + + rk_stratiform_diagnostics + + + rk_stratiform_check_qtlcwat + + + cloud_particle_sedimentation + cloud_particle_sedimentation_diagnostics + apply_constituent_tendencies + apply_heating_rate + qneg + geopotential_temp + rk_stratiform_sedimentation + + + rk_stratiform_detrain_convective_condensate + apply_constituent_tendencies + qneg + geopotential_temp + + + convective_cloud_cover + convective_cloud_cover_diagnostics + compute_cloud_fraction + rk_stratiform_cloud_fraction_perturbation + rk_stratiform_cloud_fraction_perturbation_diagnostics + + + rk_stratiform_external_forcings + + + cloud_fraction_fice + + + prognostic_cloud_water + + + rk_stratiform_condensate_repartioning + rk_stratiform_condensate_repartioning_diagnostics + apply_constituent_tendencies + qneg + geopotential_temp + + + rk_stratiform_prognostic_cloud_water_tendencies + rk_stratiform_prognostic_cloud_water_tendencies_diagnostics + apply_constituent_tendencies + apply_heating_rate + qneg + geopotential_temp + + + compute_cloud_fraction + compute_cloud_fraction_diagnostics + + + rk_stratiform_cloud_optical_properties + rk_stratiform_cloud_optical_properties_diagnostics + + + rk_stratiform_save_qtlcwat sima_state_diagnostics @@ -155,7 +235,9 @@ check_energy_save_teout - dme_adjust + + + - dme_adjust + + + + + sima_state_diagnostics diff --git a/suites/suite_tj2016.xml b/suites/suite_tj2016.xml index bb80922d..3214de84 100644 --- a/suites/suite_tj2016.xml +++ b/suites/suite_tj2016.xml @@ -25,8 +25,10 @@ qneg + thermo_water_update + + + + char*512 + file_io_test + file_io_test + filename_of_rrtmgp_shortwave_coefficients + none + + A shortwave coefficients file for RRTMGP + (to use for testing CCPP File I/O capabilities). + + + ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-sw-g112.nc + + + diff --git a/test/test_suites/suite_convection_permitting.xml b/test/test_suites/suite_convection_permitting.xml new file mode 100644 index 00000000..8bd916f7 --- /dev/null +++ b/test/test_suites/suite_convection_permitting.xml @@ -0,0 +1,18 @@ + + + + + calc_exner + geopotential_height_wrt_sfc_to_msl + bl_gwdo_compat_pre + bl_gwdo_compat + bl_gwdo_diagnostics + mmm_physics_accumulate_tendencies + apply_tendency_of_eastward_wind + apply_tendency_of_northward_wind + sima_state_diagnostics + + + sima_tend_diagnostics + + diff --git a/test/test_suites/suite_dme_adjust.xml b/test/test_suites/suite_dme_adjust.xml index ee8050ac..38a319de 100644 --- a/test/test_suites/suite_dme_adjust.xml +++ b/test/test_suites/suite_dme_adjust.xml @@ -4,6 +4,7 @@ initialize_constituents dme_adjust + sima_state_diagnostics diff --git a/test/test_suites/suite_file_io_test.xml b/test/test_suites/suite_file_io_test.xml new file mode 100644 index 00000000..211c47a1 --- /dev/null +++ b/test/test_suites/suite_file_io_test.xml @@ -0,0 +1,8 @@ + + + + + + file_io_test + + diff --git a/test/test_suites/suite_rasch_kristjansson.xml b/test/test_suites/suite_rasch_kristjansson.xml index 1281df89..b76ffb2b 100644 --- a/test/test_suites/suite_rasch_kristjansson.xml +++ b/test/test_suites/suite_rasch_kristjansson.xml @@ -23,7 +23,7 @@ cloud_particle_sedimentation - + cloud_particle_sedimentation_diagnostics apply_constituent_tendencies apply_heating_rate qneg @@ -45,10 +45,10 @@ relative humidity derivative used in the prognostic_cloud_water scheme. --> convective_cloud_cover - + convective_cloud_cover_diagnostics compute_cloud_fraction rk_stratiform_cloud_fraction_perturbation - + rk_stratiform_cloud_fraction_perturbation_diagnostics @@ -67,7 +67,7 @@ repartition heating from change in cloud ice is determined here, but only the constituent tendencies are applied in the repartitioning step. --> rk_stratiform_condensate_repartioning - + rk_stratiform_condensate_repartioning_diagnostics apply_constituent_tendencies qneg geopotential_temp @@ -76,7 +76,7 @@ repartition heating determined in condensate_repartitioning scheme is applied here, together with other heating fluxes from prognostic_cloud_water. --> rk_stratiform_prognostic_cloud_water_tendencies - + rk_stratiform_prognostic_cloud_water_tendencies_diagnostics apply_constituent_tendencies apply_heating_rate qneg @@ -84,13 +84,14 @@ compute_cloud_fraction - + compute_cloud_fraction_diagnostics rk_stratiform_cloud_optical_properties - + rk_stratiform_cloud_optical_properties_diagnostics rk_stratiform_save_qtlcwat + diff --git a/test/unit-test/CMakeLists.txt b/test/unit-test/CMakeLists.txt index 49d17506..c3287718 100644 --- a/test/unit-test/CMakeLists.txt +++ b/test/unit-test/CMakeLists.txt @@ -34,6 +34,8 @@ target_include_directories(utilities PUBLIC ${CMAKE_CURRENT_BINARY_DIR}) set(PHYS_UTILS_SRC ../../phys_utils/atmos_phys_pbl_utils.F90 + ../../phys_utils/atmos_phys_string_utils.F90 + ../../phys_utils/atmos_phys_rad_utils.F90 include/ccpp_kinds.F90 ) @@ -41,8 +43,9 @@ add_library(phys_utils ${PHYS_UTILS_SRC}) target_compile_options(phys_utils PRIVATE -ffree-line-length-none) target_include_directories(phys_utils PUBLIC ${CMAKE_CURRENT_BINARY_DIR}) +add_subdirectory(../../schemes/mmm mmm) + if(ATMOSPHERIC_PHYSICS_ENABLE_TESTS OR ATMOSPHERIC_PHYSICS_ENABLE_CODE_COVERAGE) enable_testing() add_subdirectory(tests) endif() - diff --git a/test/unit-test/tests/CMakeLists.txt b/test/unit-test/tests/CMakeLists.txt index 705189f1..d425a177 100644 --- a/test/unit-test/tests/CMakeLists.txt +++ b/test/unit-test/tests/CMakeLists.txt @@ -1,2 +1,3 @@ add_subdirectory(utilities) add_subdirectory(phys_utils) +add_subdirectory(mmm) diff --git a/test/unit-test/tests/mmm/CMakeLists.txt b/test/unit-test/tests/mmm/CMakeLists.txt new file mode 100644 index 00000000..69528847 --- /dev/null +++ b/test/unit-test/tests/mmm/CMakeLists.txt @@ -0,0 +1,8 @@ +add_pfunit_ctest(mmm_physics_compat_tests + TEST_SOURCES + mmm_physics_compat_tests.pf + OTHER_SOURCES + ../../include/ccpp_kinds.F90 + LINK_LIBRARIES + mmm_physics_compat +) diff --git a/test/unit-test/tests/mmm/mmm_physics_compat_tests.pf b/test/unit-test/tests/mmm/mmm_physics_compat_tests.pf new file mode 100644 index 00000000..bdd7b21e --- /dev/null +++ b/test/unit-test/tests/mmm/mmm_physics_compat_tests.pf @@ -0,0 +1,124 @@ +@test +subroutine test_mmm_physics_accumulate_tendencies_timestep_init() + use ccpp_kinds, only: kind_phys + use funit + use mmm_physics_compat, only: mmm_physics_accumulate_tendencies_timestep_init + + integer, parameter :: ncol = 100, pver = 10 + real(kind_phys) :: dudt(ncol, pver), dvdt(ncol, pver) + real(kind_phys) :: rublten(ncol, pver), rvblten(ncol, pver) + character(100) :: errmsg + integer :: errflg + + dudt(:, :) = huge(0.0_kind_phys) + dvdt(:, :) = huge(0.0_kind_phys) + rublten(:, :) = huge(0.0_kind_phys) + rvblten(:, :) = huge(0.0_kind_phys) + + call mmm_physics_accumulate_tendencies_timestep_init( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + ! Everything should be zeroed out. + @assertEqual(0.0_kind_phys, dudt) + @assertEqual(0.0_kind_phys, dvdt) + @assertEqual(0.0_kind_phys, rublten) + @assertEqual(0.0_kind_phys, rvblten) + @assertEqual('', errmsg) + @assertEqual(0, errflg) +end subroutine test_mmm_physics_accumulate_tendencies_timestep_init + +@test +subroutine test_mmm_physics_accumulate_tendencies_run() + use ccpp_kinds, only: kind_phys + use funit + use mmm_physics_compat, only: mmm_physics_accumulate_tendencies_run + + integer, parameter :: ncol = 100, pver = 10 + real(kind_phys) :: dudt(ncol, pver), dvdt(ncol, pver) + real(kind_phys) :: rublten(ncol, pver), rvblten(ncol, pver) + character(100) :: errmsg + integer :: errflg + + dudt(:, :) = 0.0_kind_phys + dvdt(:, :) = 0.0_kind_phys + rublten(:, :) = 1.0_kind_phys + rvblten(:, :) = 1.0_kind_phys + + call mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + ! Should accumulate MMM tendencies into CAM-SIMA ones. + @assertEqual(1.0_kind_phys, dudt) + @assertEqual(1.0_kind_phys, dvdt) + @assertEqual(0.0_kind_phys, rublten) + @assertEqual(0.0_kind_phys, rvblten) + @assertEqual('', errmsg) + @assertEqual(0, errflg) + + rublten(:, :) = 2.0_kind_phys + rvblten(:, :) = 2.0_kind_phys + + call mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + ! Should accumulate MMM tendencies into CAM-SIMA ones. + @assertEqual(3.0_kind_phys, dudt) + @assertEqual(3.0_kind_phys, dvdt) + @assertEqual(0.0_kind_phys, rublten) + @assertEqual(0.0_kind_phys, rvblten) + @assertEqual('', errmsg) + @assertEqual(0, errflg) + + call mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + call mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + ! Consecutive calls should be idempotent. + @assertEqual(3.0_kind_phys, dudt) + @assertEqual(3.0_kind_phys, dvdt) + @assertEqual(0.0_kind_phys, rublten) + @assertEqual(0.0_kind_phys, rvblten) + @assertEqual('', errmsg) + @assertEqual(0, errflg) +end subroutine test_mmm_physics_accumulate_tendencies_run + +@test +subroutine test_geopotential_height_wrt_sfc_to_msl_run() + use ccpp_kinds, only: kind_phys + use funit + use mmm_physics_compat, only: geopotential_height_wrt_sfc_to_msl_run + + integer, parameter :: ncol = 100, pver = 10 + real(kind_phys) :: gravit, phis(ncol), zmsfc(ncol, pver) + real(kind_phys) :: zmmsl(ncol, pver) + character(100) :: errmsg + integer :: errflg + + gravit = 9.8_kind_phys + phis(:) = 98.0_kind_phys + zmsfc(:, :) = 10.0_kind_phys + zmmsl(:, :) = huge(0.0_kind_phys) + + call geopotential_height_wrt_sfc_to_msl_run( & + ncol, & + gravit, phis, zmsfc, & + zmmsl, & + errmsg, errflg) + + ! Should compute geopotential height wrt mean sea level correctly. + @assertEqual(20.0_kind_phys, zmmsl) + @assertEqual('', errmsg) + @assertEqual(0, errflg) +end subroutine test_geopotential_height_wrt_sfc_to_msl_run diff --git a/test/unit-test/tests/phys_utils/CMakeLists.txt b/test/unit-test/tests/phys_utils/CMakeLists.txt index 5e3020cc..17499a47 100644 --- a/test/unit-test/tests/phys_utils/CMakeLists.txt +++ b/test/unit-test/tests/phys_utils/CMakeLists.txt @@ -1,4 +1,6 @@ add_pfunit_ctest(phys_utils_tests TEST_SOURCES test_atmos_pbl_utils.pf + TEST_SOURCES test_atmos_string_utils.pf + TEST_SOURCES test_atmos_rad_utils.pf LINK_LIBRARIES phys_utils ) diff --git a/test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf b/test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf new file mode 100644 index 00000000..9d615967 --- /dev/null +++ b/test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf @@ -0,0 +1,41 @@ +@test +subroutine wavenumber_is_visible() + use funit + use atmos_phys_rad_utils, only : is_visible + use ccpp_kinds, only : kind_phys + + real(kind_phys), parameter :: test_wavenumber = 15555._kind_phys + logical :: output_logical + + output_logical = is_visible(test_wavenumber) + + @assertEqual(.true., output_logical) +end subroutine wavenumber_is_visible + +@test +subroutine wavenumber_is_not_visible() + use funit + use atmos_phys_rad_utils, only : is_visible + use ccpp_kinds, only : kind_phys + + real(kind_phys), parameter :: test_wavenumber = 823._kind_phys + logical :: output_logical + + output_logical = is_visible(test_wavenumber) + + @assertEqual(.false., output_logical) +end subroutine wavenumber_is_not_visible + +@test +subroutine wavenumber_is_on_the_cusp() + use funit + use atmos_phys_rad_utils, only : is_visible + use ccpp_kinds, only : kind_phys + + real(kind_phys), parameter :: test_wavenumber = 14286._kind_phys + logical :: output_logical + + output_logical = is_visible(test_wavenumber) + + @assertEqual(.false., output_logical) +end subroutine wavenumber_is_on_the_cusp diff --git a/test/unit-test/tests/phys_utils/test_atmos_string_utils.pf b/test/unit-test/tests/phys_utils/test_atmos_string_utils.pf new file mode 100644 index 00000000..890d0c64 --- /dev/null +++ b/test/unit-test/tests/phys_utils/test_atmos_string_utils.pf @@ -0,0 +1,103 @@ +@test +subroutine mixed_case_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = 'Mixed Case StrinG' + character(len=17) :: output_string + + output_string = to_lower(test_string) + + @assertEqual('mixed case string', output_string) +end subroutine mixed_case_to_lower_case + +@test +subroutine lower_case_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = ' lower case string' + character(len=18) :: output_string + + output_string = to_lower(test_string) + + @assertEqual(' lower case string', output_string) +end subroutine lower_case_to_lower_case + +@test +subroutine upper_case_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = 'UPPER CASE STRING' + character(len=17) :: output_string + + output_string = to_lower(test_string) + + @assertEqual('upper case string', output_string) +end subroutine upper_case_to_lower_case + +@test +subroutine non_letters_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = 'string with 3 NON-letters!' + character(len=26) :: output_string + + output_string = to_lower(test_string) + + @assertEqual('string with 3 non-letters!', output_string) +end subroutine non_letters_to_lower_case + +@test +subroutine mixed_case_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = 'Mixed Case StrinG' + character(len=17) :: output_string + + output_string = to_upper(test_string) + + @assertEqual('MIXED CASE STRING', output_string) +end subroutine mixed_case_to_upper_case + +@test +subroutine lower_case_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = ' lower case string' + character(len=18) :: output_string + + output_string = to_upper(test_string) + + @assertEqual(' LOWER CASE STRING', output_string) +end subroutine lower_case_to_upper_case + +@test +subroutine upper_case_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = 'UPPER CASE STRING' + character(len=17) :: output_string + + output_string = to_upper(test_string) + + @assertEqual('UPPER CASE STRING', output_string) +end subroutine upper_case_to_upper_case + +@test +subroutine non_letters_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = 'string with 3 NON-letters!' + character(len=26) :: output_string + + output_string = to_upper(test_string) + + @assertEqual('STRING WITH 3 NON-LETTERS!', output_string) +end subroutine non_letters_to_upper_case diff --git a/to_be_ccppized/ccpp_tuvx_utils.F90 b/to_be_ccppized/ccpp_tuvx_utils.F90 index e7329d56..eb15675d 100644 --- a/to_be_ccppized/ccpp_tuvx_utils.F90 +++ b/to_be_ccppized/ccpp_tuvx_utils.F90 @@ -1,3 +1,5 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 module ccpp_tuvx_utils implicit none @@ -5,8 +7,6 @@ module ccpp_tuvx_utils private public :: rebin, read_extraterrestrial_flux - character(len=50), dimension(4), public :: filepath_of_extraterrestrial_flux - contains !> Regrids normalized flux data to match a specified wavelength grid @@ -60,32 +60,14 @@ end subroutine rebin !> Reads a data file to retrieve the extraterrestrial radiation flux values. ! This function is a temporary implementation and will be replaced in ! future versions of the code. - subroutine read_extraterrestrial_flux(num_wavelength_grid_sections, & - wavelength_grid_interfaces, extraterrestrial_flux) - use ccpp_kinds, only: kind_phys - - integer, intent(out) :: num_wavelength_grid_sections ! (count) - real(kind_phys), allocatable, intent(out) :: wavelength_grid_interfaces(:) ! nm - real(kind_phys), allocatable, intent(out) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 + subroutine read_extraterrestrial_flux() + character(len=50), dimension(4) :: filepath_of_extraterrestrial_flux filepath_of_extraterrestrial_flux(1) = 'musica_configurations/chapman/tuvx/data/profiles/solar/susim_hi.flx' filepath_of_extraterrestrial_flux(2) = 'musica_configurations/chapman/tuvx/data/profiles/solar/atlas3_1994_317_a.dat' filepath_of_extraterrestrial_flux(3) = 'musica_configurations/chapman/tuvx/data/profiles/solar/sao2010.solref.converted' filepath_of_extraterrestrial_flux(4) = 'musica_configurations/chapman/tuvx/data/profiles/solar/neckel.flx' - num_wavelength_grid_sections = 8 - - allocate(wavelength_grid_interfaces(num_wavelength_grid_sections + 1)) - allocate(extraterrestrial_flux(num_wavelength_grid_sections)) - - wavelength_grid_interfaces(:) = & - [200.0_kind_phys, 210.0_kind_phys, 220.0_kind_phys, 230.0_kind_phys, & - 240.0_kind_phys, 250.0_kind_phys, 260.0_kind_phys, 270.0_kind_phys, 280.0_kind_phys] - - extraterrestrial_flux(:) = & - [1.5e13_kind_phys, 1.5e13_kind_phys, 1.4e13_kind_phys, 1.4e13_kind_phys, & - 1.3e13_kind_phys, 1.2e13_kind_phys, 1.1e13_kind_phys, 1.0e13_kind_phys] - end subroutine read_extraterrestrial_flux end module ccpp_tuvx_utils \ No newline at end of file