diff --git a/cime_config/buildlib b/cime_config/buildlib index 4d9222c8b..ca58c7612 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -103,6 +103,7 @@ def _build_cam(): case.get_value("COMP_INTERFACE")), os.path.join(atm_root, "src", "dynamics", "utils"), os.path.join(atm_root, "src", "physics", "utils"), + os.path.join(atm_root, "src", "aerosol"), os.path.join(atm_root, "src", "history"), os.path.join(atm_root, "src", "history", "buffers", "src"), os.path.join(atm_root, "src", "history", "buffers", "src", "hash"), diff --git a/cime_config/namelist_definition_cam.xml b/cime_config/namelist_definition_cam.xml index c07fe112d..e04b2cf13 100644 --- a/cime_config/namelist_definition_cam.xml +++ b/cime_config/namelist_definition_cam.xml @@ -403,6 +403,182 @@ + + + char*256(120) + radiation + rad_aer_nl + none + + Definitions for the aerosol modes that may be used in the rad_climate and + rad_aer_diag_* variables. + + + UNSET + + + + + char*256(640) + radiation + rad_aer_nl + none + + Definitions for the aerosol bins that may be used in the rad_climate and + rad_aer_diag_* variables. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + A list of the radiatively active species, i.e., species that affect the + climate simulation via the radiative heating rate calculation. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + A list of species to be used in the first diagnostic radiative heating rate + calculation. These species are not the ones affecting the climate + simulation. This is a hook for performing radiative forcing calculations. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + Analogous to rad_aer_diag_1, but for the 2nd diagnostic calculation. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + Analogous to rad_aer_diag_1, but for the 3rd diagnostic calculation. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + Analogous to rad_aer_diag_1, but for the 4th diagnostic calculation. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + Analogous to rad_aer_diag_1, but for the 5th diagnostic calculation. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + Analogous to rad_aer_diag_1, but for the 6th diagnostic calculation. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + Analogous to rad_aer_diag_1, but for the 7th diagnostic calculation. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + Analogous to rad_aer_diag_1, but for the 8th diagnostic calculation. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + Analogous to rad_aer_diag_1, but for the 9th diagnostic calculation. + + + UNSET + + + + + char*256(80) + radiation + rad_aer_nl + none + + Analogous to rad_aer_diag_1, but for the 10th diagnostic calculation. + + + UNSET + + + + diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 4681270a8..ba0b71464 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -220,6 +220,17 @@ + + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_analy_ic_cam4/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_analy_ic_cam4/user_nl_cam index 6df48b413..87a6b0ce9 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq_analy_ic_cam4/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_analy_ic_cam4/user_nl_cam @@ -27,3 +27,9 @@ hist_add_inst_fields;h1:slflx_PBL,qtflx_PBL,uflx_PBL,vflx_PBL,slflx_cg_PBL,qtflx hist_add_inst_fields;h1:slten_PBL,qtten_PBL,uten_PBL,vten_PBL,qvten_PBL,qlten_PBL,qiten_PBL,tten_PBL,rhten_PBL hist_add_inst_fields;h1:qt_pre_PBL,sl_pre_PBL,slv_pre_PBL,u_pre_PBL,v_pre_PBL,qv_pre_PBL,ql_pre_PBL,qi_pre_PBL,t_pre_PBL,rh_pre_PBL hist_add_inst_fields;h1:DTV,DUV,DVV,DTVKE + +! QPC4 is an aquaplanet case - disable prescribed aerosol data +prescribed_aero_file = '' +prescribed_aero_specifier = '' +prescribed_volcaero_file = '' +aerodep_flx_file = '' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_microp_aero_bam_derecho/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq_microp_aero_bam_derecho/shell_commands new file mode 100644 index 000000000..59bcbd621 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_microp_aero_bam_derecho/shell_commands @@ -0,0 +1 @@ + ./xmlchange CAM_CONFIG_OPTS="--dyn none --physics-suites microp_aero_bam" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_microp_aero_bam_derecho/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_microp_aero_bam_derecho/user_nl_cam new file mode 100644 index 000000000..4a9662890 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_microp_aero_bam_derecho/user_nl_cam @@ -0,0 +1,68 @@ +! this snapshot was constructed by: +! (1) set -chem none in CAM_CONFIG_OPTS in a FHIST_LTso (or any other CAM7 case) +! n.b. only CAM7 is supported as its PUMAS accepts tendencies from microp_aero/nucleate_ice +! and CAM7 PUMAS is the target for CAM-SIMA CCPPization, not pumas-frozen. +! (2) isolating the microp_aero section in physpkg.F90 +! as the default 'microp_section' snapshot point will also include the actual microphysics (e.g., PUMAS) +! (3) cld_macmic_num_steps = 1 also has to be set in CAM user_nl_cam when creating the snapshot. + +! this is a CAM7 LT nochem snapshot +pver = 58 + +debug_output = 1 + +! tolerances for testing +ncdata_check_err = .true. +min_difference = 2e-15 + +ncdata = '/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_fhistc_ltso_microp_aero_derecho_gnu_before_c20260518.nc' +ncdata_check = '/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_fhistc_ltso_microp_aero_derecho_gnu_after_c20260518.nc' + +use_hetfrz_classnuc = .false. + +! nucleate_ice: +nucleate_ice_incloud = .false. +nucleate_ice_strat = 1.0D0 +nucleate_ice_subgrid = 1.2D0 +nucleate_ice_subgrid_strat = 1.2D0 +nucleate_ice_use_troplev = .true. +use_preexisting_ice = .true. + +! microp_aero: +microp_aero_wsub_min = 0.1D0 +microp_aero_wsub_scale = 0.9D0 +microp_aero_wsubi_min = 0.001D0 +microp_aero_wsubi_scale = 1.5D0 + +! BAM aerosols: +rad_aer_climate = 'N:sulf:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/sulfate_rrtmg_c080918.nc', 'N:dust1:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/dust1_rrtmg_c080918.nc', + 'N:dust2:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/dust2_rrtmg_c080918.nc', 'N:dust3:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/dust3_rrtmg_c080918.nc', + 'N:dust4:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/dust4_rrtmg_c080918.nc', 'N:bcar1:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/bcpho_rrtmg_c080918.nc', + 'N:bcar2:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/bcphi_rrtmg_c080918.nc', 'N:ocar1:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/ocpho_rrtmg_c080918.nc', + 'N:ocar2:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/ocphi_rrtmg_c080918.nc', 'N:sslt1:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/seasalt1_rrtmg_c080918.nc', + 'N:sslt2:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/seasalt2_rrtmg_c080918.nc', 'N:sslt3:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/seasalt3_rrtmg_c080918.nc', + 'N:sslt4:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/seasalt4_rrtmg_c080918.nc' + +! diagnostics for microp_aero BAM suite +hist_output_frequency;h1: 1*nsteps +hist_write_nstep0;h1: .true. +hist_precision;h1: REAL64 +hist_max_frames;h1: 1 + +! scale_subgrid_vertical_velocity diagnostics +hist_add_inst_fields;h1: WSUB,WSUBI + +! nucleate_ice diagnostics +hist_add_inst_fields;h1: NIHFTEN,NIIMMTEN,NIDEPTEN,NIMEYTEN +hist_add_inst_fields;h1: NIREGM,NISUBGRID,NITROP_PD +hist_add_inst_fields;h1: FHOM,WICE,WEFF +hist_add_inst_fields;h1: INnso4TEN,INnbcTEN,INndustTEN,INondustTEN,INhetTEN,INhomTEN +hist_add_inst_fields;h1: INFrehom,INFreIN + +! ndrop_bam diagnostics: CCN at fixed supersaturation levels +hist_add_inst_fields;h1: CCN1,CCN2,CCN3,CCN4,CCN5,CCN6 + +! ndrop_bam diagnostics: aerosol number concentration (names from physprops files) +hist_add_inst_fields;h1: SULFATE_m3,DUST1_m3,DUST2_m3,DUST3_m3,DUST4_m3 +hist_add_inst_fields;h1: BCPHO_m3,BCPHI_m3,OCPHO_m3,OCPHI_m3 +hist_add_inst_fields;h1: SEASALT1_m3,SEASALT2_m3,SEASALT3_m3,SEASALT4_m3 diff --git a/src/aerosol/aerosol_instances_mod.F90 b/src/aerosol/aerosol_instances_mod.F90 new file mode 100644 index 000000000..b647cd113 --- /dev/null +++ b/src/aerosol/aerosol_instances_mod.F90 @@ -0,0 +1,261 @@ +module aerosol_instances_mod + ! aerosol_instances_mod owns and manages the concrete aerosol_properties and + ! aerosol_state objects for every active aerosol model (modal, CARMA, bulk) + ! and every radiation list (climate + diagnostics). + ! + ! Lifecycle in CAM-SIMA: + ! 1. aerosol_instances_init() -- called once during init, after + ! rad_aer_init(). Creates persistent aerosol_properties objects for + ! each (aerosol_model, list_idx) pair. + ! 2. aerosol_instances_init_states() -- called once during init, after + ! aerosol_instances_init(). Creates persistent aerosol_state objects + ! for each (aerosol_model, list_idx) pair. States store a pointer + ! to the CCPP constituents array, which persists for the run. + ! 3. aerosol_instances_get_props() -- returns a pointer to a properties + ! object for a given (aerosol_model, list_idx). + ! 4. aerosol_instances_get_state() -- returns a pointer to a state + ! object for a given (aerosol_model, list_idx). + ! 5. aerosol_instances_final() -- deallocates all objects at shutdown. + + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + use radiative_aerosol_definitions, only: N_DIAG + + implicit none + private + + public :: aerosol_instances_init + public :: aerosol_instances_init_states + public :: aerosol_instances_get_props + public :: aerosol_instances_get_state + public :: aerosol_instances_get_num_models + public :: aerosol_instances_is_active + public :: aerosol_instances_final + public :: aero_state_entry_t + + type :: aero_props_entry_t + class(aerosol_properties), pointer :: obj => null() + end type aero_props_entry_t + + type :: aero_state_entry_t + class(aerosol_state), pointer :: obj => null() + end type aero_state_entry_t + + ! Module holds aerosol properties objects, dimensioned (iaermod, 0:N_DIAG). + type(aero_props_entry_t), allocatable, target :: aero_props_all(:,:) + + ! Persistent aerosol state objects, dimensioned (iaermod, 0:N_DIAG). + ! States store a pointer to the CCPP constituents array which persists for the run. + type(aero_state_entry_t), allocatable, target :: aero_states_all(:,:) + + ! Number of aerosol models active at runtime. + ! Note: Multiple aerosol models can be active at once, e.g., using bulk for volcanic aerosol and modal for others. + ! When retrieving properties via aerosol_instances_get_props, ensure that the aerosol model + ! matches what is needed (e.g., aero_props%model_is('MAM') == .true.) + integer :: num_aero_models_ = 0 + + logical :: modal_active_ = .false. + logical :: carma_active_ = .false. + logical :: bulk_active_ = .false. + +contains + subroutine aerosol_instances_init() + use radiative_aerosol, only: rad_aer_get_info + use radiative_aerosol_definitions, only: active_calls + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use carma_aerosol_properties_mod, only: carma_aerosol_properties + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use cam_abortutils, only: endrun + + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + + integer :: nmodes, nbins, nbulk_aerosols + integer :: iaermod, ilist, istat + + character(len=*), parameter :: subname = 'aerosol_instances_init: ' + + num_aero_models_ = 0 + + call rad_aer_get_info(0, nmodes=nmodes, nbins=nbins, naero=nbulk_aerosols) + modal_active_ = nmodes > 0 + carma_active_ = nbins > 0 + bulk_active_ = nbulk_aerosols > 0 + + if (masterproc) then + write(iulog,*) subname,'nmodes,nbins,nbulk_aerosols: ',nmodes,nbins,nbulk_aerosols + end if + + if (modal_active_) num_aero_models_ = num_aero_models_ + 1 + if (carma_active_) num_aero_models_ = num_aero_models_ + 1 + if (bulk_active_) num_aero_models_ = num_aero_models_ + 1 + + if (num_aero_models_ < 1) return + + allocate(aero_props_all(num_aero_models_, 0:N_DIAG), stat=istat) + if (istat /= 0) then + call endrun(subname//'allocation error: aero_props_all') + end if + + do ilist = 0, N_DIAG + ! only populate aerosol properties for active climate/diagnostic lists. + if (.not. active_calls(ilist)) cycle + + call rad_aer_get_info(ilist, nmodes=nmodes, nbins=nbins, naero=nbulk_aerosols) + + iaermod = 0 + if (modal_active_) then + iaermod = iaermod + 1 + if (nmodes > 0) then + aero_props_all(iaermod, ilist)%obj => modal_aerosol_properties(ilist) + end if + end if + if (carma_active_) then + iaermod = iaermod + 1 + if (nbins > 0) then + aero_props_all(iaermod, ilist)%obj => carma_aerosol_properties(ilist) + end if + end if + if (bulk_active_) then + iaermod = iaermod + 1 + if (nbulk_aerosols > 0) then + aero_props_all(iaermod, ilist)%obj => bulk_aerosol_properties(ilist) + end if + end if + end do + + end subroutine aerosol_instances_init + + function aerosol_instances_get_props(iaermod, list_idx) result(props) + integer, intent(in) :: iaermod + integer, intent(in) :: list_idx + class(aerosol_properties), pointer :: props + + props => aero_props_all(iaermod, list_idx)%obj + + end function aerosol_instances_get_props + + pure integer function aerosol_instances_get_num_models() + aerosol_instances_get_num_models = num_aero_models_ + end function aerosol_instances_get_num_models + + logical function aerosol_instances_is_active(model_name) + character(len=*), intent(in) :: model_name + + select case (trim(model_name)) + case ('modal') + aerosol_instances_is_active = modal_active_ + case ('carma') + aerosol_instances_is_active = carma_active_ + case ('bulk') + aerosol_instances_is_active = bulk_active_ + case default + aerosol_instances_is_active = .false. + end select + + end function aerosol_instances_is_active + + subroutine aerosol_instances_final() + integer :: iaermod, ilist + + ! Deallocate persistent state objects + if (allocated(aero_states_all)) then + do ilist = 0, N_DIAG + do iaermod = 1, num_aero_models_ + if (associated(aero_states_all(iaermod, ilist)%obj)) then + deallocate(aero_states_all(iaermod, ilist)%obj) + nullify(aero_states_all(iaermod, ilist)%obj) + end if + end do + end do + deallocate(aero_states_all) + end if + + ! Deallocate properties objects + if (allocated(aero_props_all)) then + do ilist = 0, N_DIAG + do iaermod = 1, num_aero_models_ + if (associated(aero_props_all(iaermod, ilist)%obj)) then + deallocate(aero_props_all(iaermod, ilist)%obj) + nullify(aero_props_all(iaermod, ilist)%obj) + end if + end do + end do + deallocate(aero_props_all) + end if + + num_aero_models_ = 0 + + end subroutine aerosol_instances_final + + ! Initialize persistent aerosol state objects for all active lists + ! and all active aerosol models. + ! + ! Called once at init time, after aerosol_instances_init(). + ! States store a pointer to the CCPP constituents array which persists + ! for the entire run. + subroutine aerosol_instances_init_states(constituents) + use radiative_aerosol_definitions, only: active_calls + use modal_aerosol_state_mod, only: modal_aerosol_state + use carma_aerosol_state_mod, only: carma_aerosol_state + use bulk_aerosol_state_mod, only: bulk_aerosol_state + use aerosol_mmr_host, only: aero_host_binding, aero_host_binding_t + + use ccpp_kinds, only: kind_phys + use cam_abortutils, only: endrun + use physics_grid, only: ncol => columns_on_task + + real(kind_phys), pointer, intent(in) :: constituents(:,:,:) + + integer :: iaermod, ilist, istat + type(aero_host_binding_t) :: host + character(len=*), parameter :: subname = 'aerosol_instances_init_states: ' + + if (num_aero_models_ < 1) return + + allocate(aero_states_all(num_aero_models_, 0:N_DIAG), stat=istat) + if (istat /= 0) then + call endrun(subname//'allocation error: aero_states_all') + end if + + host = aero_host_binding(constituents) + + do ilist = 0, N_DIAG + if (.not. active_calls(ilist)) cycle + + iaermod = 0 + if (modal_active_) then + iaermod = iaermod + 1 + if (associated(aero_props_all(iaermod, ilist)%obj)) then + aero_states_all(iaermod, ilist)%obj => & + modal_aerosol_state(ncol, host, ilist) + end if + end if + if (carma_active_) then + iaermod = iaermod + 1 + if (associated(aero_props_all(iaermod, ilist)%obj)) then + aero_states_all(iaermod, ilist)%obj => & + carma_aerosol_state(ncol, host, ilist) + end if + end if + if (bulk_active_) then + iaermod = iaermod + 1 + if (associated(aero_props_all(iaermod, ilist)%obj)) then + aero_states_all(iaermod, ilist)%obj => & + bulk_aerosol_state(ncol, host, ilist) + end if + end if + end do + + end subroutine aerosol_instances_init_states + + function aerosol_instances_get_state(iaermod, list_idx) result(astate) + integer, intent(in) :: iaermod + integer, intent(in) :: list_idx + class(aerosol_state), pointer :: astate + + astate => aero_states_all(iaermod, list_idx)%obj + + end function aerosol_instances_get_state + +end module aerosol_instances_mod diff --git a/src/aerosol/aerosol_mmr_host.F90 b/src/aerosol/aerosol_mmr_host.F90 new file mode 100644 index 000000000..a4664b2a8 --- /dev/null +++ b/src/aerosol/aerosol_mmr_host.F90 @@ -0,0 +1,981 @@ +module aerosol_mmr_host + +!------------------------------------------------------------------------------------------------ +! +! Host-binding module for aerosol MMR retrieval (CAM-SIMA flavor). +! +! This is the CAM-SIMA side of a per-host module pair: CAM provides a module +! of the same name backed by physics_state and the physics buffer. The pair +! owns the opaque aero_host_binding_t handle; shared aerosol interface code +! stores and passes the handle without referencing host-model data structures +! directly. Here the routines access the CCPP constituents array to return +! mixing ratio pointers. +! +! Ported from the CAM flavor: replaces pbuf/state%q with CCPP constituents. +! +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ccpp_kinds, only: kind_phys + +implicit none +private +save + +! Opaque host-binding handle: aggregates the host-model data references +! (for CAM-SIMA: the CCPP constituents array) needed to retrieve aerosol +! fields. Shared aerosol interface code stores and passes this handle +! without referencing host-model data structures directly; only this +! module looks inside it. +type :: aero_host_binding_t + real(kind_phys), pointer :: constituents(:,:,:) => null() +end type aero_host_binding_t + +! define generic interface for MMR retrieval +interface rad_cnst_get_aer_mmr + module procedure rad_cnst_get_aer_mmr_by_idx + module procedure rad_cnst_get_mam_mmr_by_idx + module procedure rad_cnst_get_aer_mmr_by_idx_host + module procedure rad_cnst_get_mam_mmr_by_idx_host +end interface + +! generic interfaces dispatching between the legacy (constituents) variants +! and the host-binding handle variants +interface rad_cnst_get_mode_num + module procedure rad_cnst_get_mode_num_ccpp + module procedure rad_cnst_get_mode_num_host +end interface + +interface rad_cnst_get_bin_num + module procedure rad_cnst_get_bin_num_ccpp + module procedure rad_cnst_get_bin_num_host +end interface + +interface rad_cnst_get_bin_mmr_by_idx + module procedure rad_cnst_get_bin_mmr_by_idx_ccpp + module procedure rad_cnst_get_bin_mmr_by_idx_host +end interface + +! values for constituents with requested value of zero +real(r8), allocatable, target :: zero_cols(:,:) + +public :: aero_host_binding_t +public :: aero_host_binding ! build a handle from host data structures +public :: aerosol_mmr_init ! allocate zero_cols +public :: get_host_idx +public :: resolve_mode_idx, resolve_bin_idx +public :: resolve_bulk_idx +public :: rad_cnst_get_aer_mmr +public :: rad_cnst_get_mam_mmr_idx +public :: rad_cnst_get_mode_num +public :: rad_cnst_get_mode_num_idx +public :: rad_cnst_get_bin_mmr_by_idx +public :: rad_cnst_get_bin_num +public :: rad_cnst_get_bin_num_idx +public :: rad_cnst_get_carma_mmr_idx +public :: rad_cnst_get_bin_mmr +public :: rad_aer_diag_init +public :: rad_aer_diag_out + +!============================================================================== +contains +!============================================================================== + +subroutine aerosol_mmr_init() + use physics_grid, only: columns_on_task + use vert_coord, only: pver + ! Allocate zero_cols array (must be called after grid/vert is set up) + if (.not. allocated(zero_cols)) then + allocate(zero_cols(columns_on_task, pver)) + zero_cols = 0._r8 + end if +end subroutine aerosol_mmr_init + +!================================================================================================ + +function aero_host_binding(constituents) result(host) + + ! Build a host-binding handle from CAM-SIMA host data structures. + ! Called from host-side wiring only (aerosol_instances_mod); the + ! resulting handle is stored opaquely by the aerosol_state objects. + + real(kind_phys), pointer, intent(in) :: constituents(:,:,:) + type(aero_host_binding_t) :: host + + host%constituents => constituents + +end function aero_host_binding + +!================================================================================================ + +integer function get_host_idx(source, name, routine) + + ! Get index of name in the CCPP constituents array. + ! Both 'A' (advected) and 'N' (non-advected) sources resolve through + ! const_get_index, which searches the unified CCPP constituent table. + ! 'Z' returns -1 (zero field). + + use cam_constituents, only: const_get_index + use cam_abortutils, only: endrun + + character(len=*), intent(in) :: source + character(len=*), intent(in) :: name + character(len=*), intent(in) :: routine ! name of calling routine + + integer :: idx + !----------------------------------------------------------------------------- + + if (source(1:1) == 'N' .or. source(1:1) == 'A') then + call const_get_index(trim(name), idx) + ! const_get_index aborts by default if name is not found + else if (source(1:1) == 'Z') then + idx = -1 + else + call endrun(routine//' ERROR: invalid source for specie '//trim(name)) + end if + + get_host_idx = idx + +end function get_host_idx + +!=========================== + +subroutine resolve_mode_idx(modes) + + ! Initialize the mode definitions by looking up the relevant indices in the + ! CCPP constituents array, and getting the physprop IDs + + use phys_prop, only: physprop_get_id + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: modes_t + + ! Arguments + type(modes_t), intent(inout) :: modes + + ! Local variables + integer :: m, ispec, nspec + + character(len=*), parameter :: routine = 'resolve_mode_idx' + !----------------------------------------------------------------------------- + + do m = 1, modes%nmodes + + ! indices for number mixing ratio components + modes%comps(m)%idx_num_a = get_host_idx(modes%comps(m)%source_num_a, modes%comps(m)%camname_num_a, routine) + modes%comps(m)%idx_num_c = get_host_idx(modes%comps(m)%source_num_c, modes%comps(m)%camname_num_c, routine) + + ! allocate memory for species + nspec = modes%comps(m)%nspec + allocate( & + modes%comps(m)%idx_mmr_a(nspec), & + modes%comps(m)%idx_mmr_c(nspec), & + modes%comps(m)%idx_props(nspec) ) + + do ispec = 1, nspec + + ! indices for species mixing ratio components + modes%comps(m)%idx_mmr_a(ispec) = get_host_idx(modes%comps(m)%source_mmr_a(ispec), & + modes%comps(m)%camname_mmr_a(ispec), routine) + modes%comps(m)%idx_mmr_c(ispec) = get_host_idx(modes%comps(m)%source_mmr_c(ispec), & + modes%comps(m)%camname_mmr_c(ispec), routine) + + ! get physprop ID + modes%comps(m)%idx_props(ispec) = physprop_get_id(modes%comps(m)%props(ispec)) + if (modes%comps(m)%idx_props(ispec) == -1) then + call endrun(routine//' : ERROR idx not found for '//trim(modes%comps(m)%props(ispec))) + end if + + end do + + end do + +end subroutine resolve_mode_idx + +!=========================== + +subroutine resolve_bin_idx(bins) + + ! Initialize the bin definitions by looking up the relevant indices in the + ! CCPP constituents array, and getting the physprop IDs + + use phys_prop, only: physprop_get_id + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: bins_t + + ! Arguments + type(bins_t), intent(inout) :: bins + + ! Local variables + integer :: m, ispec, nspec + + character(len=*), parameter :: routine = 'resolve_bin_idx' + !----------------------------------------------------------------------------- + + do m = 1, bins%nbins + + ! indices for number mixing ratio components + bins%comps(m)%idx_num_a = get_host_idx(bins%comps(m)%source_num_a, bins%comps(m)%camname_num_a, routine) + bins%comps(m)%idx_num_c = get_host_idx(bins%comps(m)%source_num_c, bins%comps(m)%camname_num_c, routine) + if ( bins%comps(m)%source_mass_a /= 'NOTSET' .and. bins%comps(m)%camname_mass_a /= 'NOTSET' ) then + bins%comps(m)%idx_mass_a = get_host_idx(bins%comps(m)%source_mass_a, bins%comps(m)%camname_mass_a, routine) + endif + if ( bins%comps(m)%source_mass_c /= 'NOTSET' .and. bins%comps(m)%camname_mass_c /= 'NOTSET' ) then + bins%comps(m)%idx_mass_c = get_host_idx(bins%comps(m)%source_mass_c, bins%comps(m)%camname_mass_c, routine) + endif + + ! allocate memory for species + nspec = bins%comps(m)%nspec + allocate( & + bins%comps(m)%idx_mmr_a(nspec), & + bins%comps(m)%idx_mmr_c(nspec), & + bins%comps(m)%idx_props(nspec) ) + + do ispec = 1, nspec + + ! indices for species mixing ratio components + bins%comps(m)%idx_mmr_a(ispec) = get_host_idx(bins%comps(m)%source_mmr_a(ispec), & + bins%comps(m)%camname_mmr_a(ispec), routine) + bins%comps(m)%idx_mmr_c(ispec) = get_host_idx(bins%comps(m)%source_mmr_c(ispec), & + bins%comps(m)%camname_mmr_c(ispec), routine) + + ! get physprop ID + bins%comps(m)%idx_props(ispec) = physprop_get_id(bins%comps(m)%props(ispec)) + if (bins%comps(m)%idx_props(ispec) == -1) then + call endrun(routine//' : ERROR idx not found for '//trim(bins%comps(m)%props(ispec))) + end if + + end do + + end do + +end subroutine resolve_bin_idx + +!=========================== + +subroutine resolve_bulk_idx(aerlist) + + ! Resolve host-specific indices for bulk aerosols via CCPP constituents. + ! Must be called before list_resolve_physprops (which resolves physprop IDs). + + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: aerlist_t + + type(aerlist_t), intent(inout) :: aerlist + + integer :: i + character(len=*), parameter :: routine = 'resolve_bulk_idx' + !----------------------------------------------------------------------------- + + do i = 1, aerlist%numaerosols + aerlist%aer(i)%idx = get_host_idx(aerlist%aer(i)%source, aerlist%aer(i)%camname, routine) + end do + +end subroutine resolve_bulk_idx + +!================================================================================================ + +subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, constituents, mmr) + + ! Return pointer to mass mixing ratio for the bulk aerosol from the specified + ! climate or diagnostic list, using the CCPP constituents array. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: N_DIAG, aerlist_t, bulk_aerosol_list + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: aer_idx + real(kind_phys), target, intent(in) :: constituents(:,:,:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: idx + character(len=1) :: source + type(aerlist_t), pointer :: aerlist + character(len=*), parameter :: subname = 'rad_cnst_get_aer_mmr_by_idx' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + aerlist => bulk_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + ! Check for valid input aerosol index + if (aer_idx < 1 .or. aer_idx > aerlist%numaerosols) then + write(iulog,*) subname//': aer_idx= ', aer_idx, ' numaerosols= ', aerlist%numaerosols + call endrun(subname//': aerosol list index out of range') + end if + + ! Get data source + source = aerlist%aer(aer_idx)%source + idx = aerlist%aer(aer_idx)%idx + select case( source ) + case ('A','N') + mmr => constituents(:,:,idx) + case ('Z') + mmr => zero_cols + end select + +end subroutine rad_cnst_get_aer_mmr_by_idx + +!================================================================================================ + +subroutine rad_cnst_get_aer_mmr_by_idx_host(list_idx, aer_idx, host, mmr) + + ! Host-binding handle variant: unpack the handle and delegate. + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: aer_idx + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: mmr(:,:) + + call rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, host%constituents, mmr) + +end subroutine rad_cnst_get_aer_mmr_by_idx_host + +!================================================================================================ + +subroutine rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, constituents, mmr) + + ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified + ! climate or diagnostic list, using the CCPP constituents array. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: N_DIAG, modelist_t, modal_aerosol_list, modes + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + real(kind_phys), target, intent(in) :: constituents(:,:,:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: m_idx + integer :: idx + character(len=1) :: source + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_by_idx' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => modal_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = mlist%idx(mode_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + ! Get data source + if (phase == 'a') then + source = modes%comps(m_idx)%source_mmr_a(spec_idx) + idx = modes%comps(m_idx)%idx_mmr_a(spec_idx) + else if (phase == 'c') then + source = modes%comps(m_idx)%source_mmr_c(spec_idx) + idx = modes%comps(m_idx)%idx_mmr_c(spec_idx) + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') + end if + + select case( source ) + case ('A','N') + mmr => constituents(:,:,idx) + case ('Z') + mmr => zero_cols + end select + +end subroutine rad_cnst_get_mam_mmr_by_idx + +!================================================================================================ + +subroutine rad_cnst_get_mam_mmr_by_idx_host(list_idx, mode_idx, spec_idx, phase, host, mmr) + + ! Host-binding handle variant: unpack the handle and delegate. + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: mmr(:,:) + + call rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, host%constituents, mmr) + +end subroutine rad_cnst_get_mam_mmr_by_idx_host + +!================================================================================================ + +subroutine rad_cnst_get_bin_mmr_by_idx_ccpp(list_idx, bin_idx, spec_idx, phase, constituents, mmr) + + ! Return pointer to mass mixing ratio for the sectional aerosol specie. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: N_DIAG, binlist_t, sectional_aerosol_list, bins + + ! Arguments + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + integer, intent(in) :: spec_idx + character(len=1), intent(in) :: phase + real(kind_phys), target, intent(in) :: constituents(:,:,:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: s_idx, idx + character(len=1) :: source + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_mmr_by_idx' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + slist => sectional_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + s_idx = slist%idx(bin_idx) + + if (spec_idx < 1 .or. spec_idx > bins%comps(s_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', bins%comps(s_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + if (phase == 'a') then + source = bins%comps(s_idx)%source_mmr_a(spec_idx) + idx = bins%comps(s_idx)%idx_mmr_a(spec_idx) + else if (phase == 'c') then + source = bins%comps(s_idx)%source_mmr_c(spec_idx) + idx = bins%comps(s_idx)%idx_mmr_c(spec_idx) + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') + end if + + select case( source ) + case ('A','N') + mmr => constituents(:,:,idx) + case ('Z') + mmr => zero_cols + end select + +end subroutine rad_cnst_get_bin_mmr_by_idx_ccpp + +!================================================================================================ + +subroutine rad_cnst_get_bin_mmr_by_idx_host(list_idx, bin_idx, spec_idx, phase, host, mmr) + + ! Host-binding handle variant: unpack the handle and delegate. + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: bin_idx ! bin index + integer, intent(in) :: spec_idx ! index of specie in the bin + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: mmr(:,:) + + call rad_cnst_get_bin_mmr_by_idx_ccpp(list_idx, bin_idx, spec_idx, phase, host%constituents, mmr) + +end subroutine rad_cnst_get_bin_mmr_by_idx_host + +!================================================================================================ + +subroutine rad_cnst_get_mam_mmr_idx(mode_idx, spec_idx, idx) + + ! Return constituent index of mam specie mass mixing ratio for aerosol modes in + ! the climate list. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: modelist_t, modes, modal_aerosol_list + + integer, intent(in) :: mode_idx + integer, intent(in) :: spec_idx + integer, intent(out) :: idx + + integer :: m_idx + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_idx' + !----------------------------------------------------------------------------- + + mlist => modal_aerosol_list(0) + + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + m_idx = mlist%idx(mode_idx) + + if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + idx = modes%comps(m_idx)%idx_mmr_a(spec_idx) + +end subroutine rad_cnst_get_mam_mmr_idx + +!================================================================================================ + +subroutine rad_cnst_get_carma_mmr_idx(bin_idx, spec_idx, idx) + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: binlist_t, bins, sectional_aerosol_list + + integer, intent(in) :: bin_idx + integer, intent(in) :: spec_idx + integer, intent(out) :: idx + + integer :: b_idx + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_carma_mmr_idx' + !----------------------------------------------------------------------------- + + slist => sectional_aerosol_list(0) + + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + b_idx = slist%idx(bin_idx) + + if (spec_idx < 1 .or. spec_idx > bins%comps(b_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', bins%comps(b_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + idx = bins%comps(b_idx)%idx_mmr_a(spec_idx) + +end subroutine rad_cnst_get_carma_mmr_idx + +!================================================================================================ + +subroutine rad_cnst_get_bin_mmr(list_idx, bin_idx, phase, constituents, mmr) + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: N_DIAG, binlist_t, sectional_aerosol_list, bins + + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + character(len=1), intent(in) :: phase + real(kind_phys), target, intent(in) :: constituents(:,:,:) + real(r8), pointer :: mmr(:,:) + + integer :: m_idx, idx + character(len=1) :: source + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_mmr' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + slist => sectional_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + m_idx = slist%idx(bin_idx) + + if (phase == 'a') then + source = bins%comps(m_idx)%source_mass_a + idx = bins%comps(m_idx)%idx_mass_a + else if (phase == 'c') then + source = bins%comps(m_idx)%source_mass_c + idx = bins%comps(m_idx)%idx_mass_c + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') + end if + + select case( source ) + case ('A','N') + mmr => constituents(:,:,idx) + case ('Z') + mmr => zero_cols + end select + +end subroutine rad_cnst_get_bin_mmr + +!================================================================================================ + +subroutine rad_cnst_get_mode_num_ccpp(list_idx, mode_idx, phase, constituents, num) + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: N_DIAG, modelist_t, modal_aerosol_list, modes + + integer, intent(in) :: list_idx + integer, intent(in) :: mode_idx + character(len=1), intent(in) :: phase + real(kind_phys), target, intent(in) :: constituents(:,:,:) + real(r8), pointer :: num(:,:) + + integer :: m_idx, idx + character(len=1) :: source + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mode_num' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => modal_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + m_idx = mlist%idx(mode_idx) + + if (phase == 'a') then + source = modes%comps(m_idx)%source_num_a + idx = modes%comps(m_idx)%idx_num_a + else if (phase == 'c') then + source = modes%comps(m_idx)%source_num_c + idx = modes%comps(m_idx)%idx_num_c + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') + end if + + select case( source ) + case ('A','N') + num => constituents(:,:,idx) + case ('Z') + num => zero_cols + end select + +end subroutine rad_cnst_get_mode_num_ccpp + +!================================================================================================ + +subroutine rad_cnst_get_mode_num_host(list_idx, mode_idx, phase, host, num) + + ! Host-binding handle variant: unpack the handle and delegate. + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: num(:,:) + + call rad_cnst_get_mode_num_ccpp(list_idx, mode_idx, phase, host%constituents, num) + +end subroutine rad_cnst_get_mode_num_host + +!================================================================================================ + +subroutine rad_cnst_get_bin_num_ccpp(list_idx, bin_idx, phase, constituents, num) + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: N_DIAG, binlist_t, sectional_aerosol_list, bins + + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + character(len=1), intent(in) :: phase + real(kind_phys), target, intent(in) :: constituents(:,:,:) + real(r8), pointer :: num(:,:) + + integer :: m_idx, idx + character(len=1) :: source + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_num' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + slist => sectional_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + m_idx = slist%idx(bin_idx) + + if (phase == 'a') then + source = bins%comps(m_idx)%source_num_a + idx = bins%comps(m_idx)%idx_num_a + else if (phase == 'c') then + source = bins%comps(m_idx)%source_num_c + idx = bins%comps(m_idx)%idx_num_c + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') + end if + + select case( source ) + case ('A','N') + num => constituents(:,:,idx) + case ('Z') + num => zero_cols + end select + +end subroutine rad_cnst_get_bin_num_ccpp + +!================================================================================================ + +subroutine rad_cnst_get_bin_num_host(list_idx, bin_idx, phase, host, num) + + ! Host-binding handle variant: unpack the handle and delegate. + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: bin_idx ! bin index + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: num(:,:) + + call rad_cnst_get_bin_num_ccpp(list_idx, bin_idx, phase, host%constituents, num) + +end subroutine rad_cnst_get_bin_num_host + +!================================================================================================ + +subroutine rad_cnst_get_mode_num_idx(mode_idx, cnst_idx) + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: modelist_t, modes, modal_aerosol_list + + integer, intent(in) :: mode_idx + integer, intent(out) :: cnst_idx + + integer :: m_idx + character(len=1) :: source + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mode_num_idx' + !----------------------------------------------------------------------------- + + mlist => modal_aerosol_list(0) + + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + m_idx = mlist%idx(mode_idx) + + source = modes%comps(m_idx)%source_num_a + if (source /= 'A') then + write(iulog,*) subname//': source= ', source + call endrun(subname//': requested mode number index not in constituent array') + end if + + cnst_idx = modes%comps(m_idx)%idx_num_a + +end subroutine rad_cnst_get_mode_num_idx + +!================================================================================================ + +subroutine rad_cnst_get_bin_num_idx(bin_idx, cnst_idx) + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: binlist_t, bins, sectional_aerosol_list + + integer, intent(in) :: bin_idx + integer, intent(out) :: cnst_idx + + integer :: b_idx + character(len=1) :: source + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_num_idx' + !----------------------------------------------------------------------------- + + slist => sectional_aerosol_list(0) + + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + b_idx = slist%idx(bin_idx) + + source = bins%comps(b_idx)%source_num_a + if (source /= 'A') then + write(iulog,*) subname//': source= ', source + call endrun(subname//': requested bin number index not in constituent array') + end if + + cnst_idx = bins%comps(b_idx)%idx_num_a + +end subroutine rad_cnst_get_bin_num_idx + +!================================================================================================ + +subroutine rad_aer_diag_init(alist) + + ! Add diagnostic fields to the master fieldlist. + + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: aerlist_t + + type(aerlist_t), intent(inout) :: alist + + integer :: i, naer + character(len=64) :: name + character(len=2) :: list_id + character(len=4) :: suffix + character(len=128):: long_name + character(len=32) :: long_name_description + !----------------------------------------------------------------------------- + + naer = alist%numaerosols + if (naer == 0) return + + ! Determine whether this is a climate or diagnostic list. + list_id = alist%list_id + if (len_trim(list_id) == 0) then + suffix = '_c' + long_name_description = ' used in climate calculation' + else + suffix = '_d' // list_id + long_name_description = ' used in diagnostic calculation' + end if + + do i = 1, naer + + ! construct names for mass per layer diagnostic fields + name = 'm_' // trim(alist%aer(i)%camname) // trim(suffix) + alist%aer(i)%mass_name = name + long_name = trim(alist%aer(i)%camname)//' mass per layer'//long_name_description + call history_add_field(trim(name), trim(long_name), 'lev', 'A', 'kg/m^2') + + ! construct names for column burden diagnostic fields + name = 'cb_' // trim(alist%aer(i)%camname) // trim(suffix) + long_name = trim(alist%aer(i)%camname)//' column burden'//long_name_description + call history_add_field(trim(name), trim(long_name), horiz_only, 'A', 'kg/m^2') + + ! error check for name length + if (len_trim(name) > 64) then + write(iulog,*) 'rad_aer_diag_init: '//trim(name)//' longer than 64 characters' + call endrun('rad_aer_diag_init: name too long: '//trim(name)) + end if + + end do + +end subroutine rad_aer_diag_init + +!================================================================================================ + +subroutine rad_aer_diag_out(list_idx, constituents, pdeldry, ncol) + + ! Output the mass per layer, and total column burdens for aerosol + ! constituents in either the climate or diagnostic lists. + ! Uses CCPP constituents array instead of physics state / pbuf. + + use physconst, only: rga + use cam_history, only: history_out_field + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: N_DIAG, aerlist_t, bulk_aerosol_list + + ! Arguments + integer, intent(in) :: list_idx + real(kind_phys), target, intent(in) :: constituents(:,:,:) + real(r8), intent(in) :: pdeldry(:,:) + integer, intent(in) :: ncol + + ! Local variables + integer :: i, naer + integer :: idx, nlev + character(len=1) :: source + character(len=32) :: name, cbname + real(r8), allocatable :: mass(:,:) + real(r8), allocatable :: cb(:) + real(r8), pointer :: mmr(:,:) + type(aerlist_t), pointer :: aerlist + character(len=*), parameter :: subname = 'rad_aer_diag_out' + !----------------------------------------------------------------------------- + + nlev = size(constituents, 2) + + ! Associate pointer with requested aerosol list + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + aerlist => bulk_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + naer = aerlist%numaerosols + if (naer == 0) return + + allocate(mass(ncol, nlev)) + allocate(cb(ncol)) + + do i = 1, naer + + source = aerlist%aer(i)%source + idx = aerlist%aer(i)%idx + name = aerlist%aer(i)%mass_name + cbname = 'cb_' // name(3:len_trim(name)) + + select case( source ) + case ('A','N') + mmr => constituents(:,:,idx) + case ('Z') + mmr => zero_cols + end select + + mass(:ncol,:) = mmr(:ncol,:) * pdeldry(:ncol,:) * rga + call history_out_field(trim(name), mass(:ncol,:)) + + cb(:ncol) = sum(mass(:ncol,:), 2) + call history_out_field(trim(cbname), cb(:ncol)) + + end do + + deallocate(mass) + deallocate(cb) + +end subroutine rad_aer_diag_out + +!================================================================================================ + +end module aerosol_mmr_host diff --git a/src/aerosol/aerosol_optics_core.F90 b/src/aerosol/aerosol_optics_core.F90 new file mode 100644 index 000000000..63d47f849 --- /dev/null +++ b/src/aerosol/aerosol_optics_core.F90 @@ -0,0 +1,409 @@ +!------------------------------------------------------------------------------- +! Portable aerosol optics core: +! Creates the aerosol_optics object +! Calculates per-bin SW/LW aerosol optics. +!------------------------------------------------------------------------------- +module aerosol_optics_core + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + private + + public :: create_aerosol_optics_object + public :: aerosol_optics_sw_bin + public :: aerosol_optics_lw_bin + + ! Jasper Kok et al. (2017) Fig. 1d: 20-60 % higher mass extinction efficiency + ! because dust is aspherical. Currently not captured by the spherical assumption + ! in the optical calculation. Asphericity is strong for D > 1 um (coarse mode). + real(r8), parameter, public :: dustaspherical_opts = 1.3_r8 + +contains + + !=============================================================================== + ! Dispatch to the appropriate concrete aerosol_optics constructor based on + ! the opticstype string from aeroprops%optics_params. + ! Returns a null pointer for unrecognized opticstype (caller handles error). + !=============================================================================== + function create_aerosol_optics_object(aeroprops, aerostate, ibin, & + ncol, nlev, nswbands, nlwbands, numrh, & + relh, sulfwtpct, crefwsw, crefwlw, & + geometric_radius) result(aero_optics) + + use phys_prop, only: ot_length + + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + use aerosol_optics_mod, only: aerosol_optics + + use refractive_aerosol_optics_mod, only: refractive_aerosol_optics + use hygrocoreshell_aerosol_optics_mod, only: hygrocoreshell_aerosol_optics + use hygrowghtpct_aerosol_optics_mod, only: hygrowghtpct_aerosol_optics + use hygro_aerosol_optics_mod, only: hygro_aerosol_optics + use hygroscopic_aerosol_optics_mod, only: hygroscopic_aerosol_optics + use insoluble_aerosol_optics_mod, only: insoluble_aerosol_optics + use volcrad_aerosol_optics_mod, only: volcrad_aerosol_optics + + class(aerosol_properties), intent(in), target :: aeroprops + class(aerosol_state), intent(in), target :: aerostate + integer, intent(in) :: ibin + integer, intent(in) :: ncol + integer, intent(in) :: nlev + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands + integer, intent(in) :: numrh + real(r8), intent(in) :: relh(:, :) + real(r8), intent(in) :: sulfwtpct(:, :) + complex(r8), intent(in) :: crefwsw(:) + complex(r8), intent(in) :: crefwlw(:) + real(r8), intent(in), optional, pointer :: geometric_radius(:, :) + + class(aerosol_optics), pointer :: aero_optics + + character(len=ot_length) :: opticstype + + nullify (aero_optics) + + call aeroprops%optics_params(bin_ndx=ibin, opticstype=opticstype) + + select case (trim(opticstype)) + case ('modal') ! refractive method + aero_optics => refractive_aerosol_optics(aeroprops, aerostate, ibin, & + ncol, nlev, nswbands, nlwbands, crefwsw, crefwlw) + case ('hygroscopic_coreshell') + aero_optics => hygrocoreshell_aerosol_optics(aeroprops, aerostate, & + ibin, ncol, nlev, relh) + case ('hygroscopic_wtp') + aero_optics => hygrowghtpct_aerosol_optics(aeroprops, aerostate, & + ibin, ncol, nlev, sulfwtpct) + case ('hygro') + ! Short-wave hygroscopic aerosol, Long-wave non-hygroscopic + ! aerosol optical properties + aero_optics => hygro_aerosol_optics(aeroprops, aerostate, & + ibin, ncol, nlev, numrh, relh) + case ('hygroscopic') + ! Short-wave and long-wave hygroscopic aerosol properties + aero_optics => hygroscopic_aerosol_optics(aeroprops, aerostate, ibin, & + ncol, nlev, numrh, relh) + case ('nonhygro', 'insoluble') + aero_optics => insoluble_aerosol_optics(aeroprops, aerostate, ibin) + + case ('volcanic_radius', 'volcanic_radius1', 'volcanic_radius2', 'volcanic_radius3', 'volcanic_radius5') + if (present(geometric_radius)) then + if (associated(geometric_radius)) then + aero_optics => volcrad_aerosol_optics(aeroprops, aerostate, & + ibin, ncol, nlev, geometric_radius) + end if + end if + + end select + + end function create_aerosol_optics_object + + !=============================================================================== + ! Per-bin SW aerosol optics including dust asphericity correction. + ! + ! Returns per-bin extinction optical depth (tau_bin), single-scatter albedo + ! (ssa_bin), and asymmetry parameter (asm_bin). For coarse dust modes, + ! tau_bin at the visible band (idx_sw_diag) is modified by the asphericity + ! correction (1.3x for dust-attributed AOD). + !=============================================================================== + subroutine aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & + ncol, nlev, top_lev, nswbands, nlwbands, numrh, & + idx_sw_diag, & + relh, sulfwtpct, mass, crefwsw, crefwlw, & + geometric_radius, & + tau_bin, ssa_bin, asm_bin, & + pabs_vis, dopaer0_vis, & + errmsg, errflg) + use aerosol_properties_mod, only: aerosol_properties + use aerosol_properties_mod, only: aero_name_len + use aerosol_state_mod, only: aerosol_state + use aerosol_optics_mod, only: aerosol_optics + + class(aerosol_properties), intent(in), target :: aeroprops + class(aerosol_state), intent(in), target :: aerostate + integer, intent(in) :: ibin + integer, intent(in) :: ncol, nlev, top_lev + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands + integer, intent(in) :: numrh + integer, intent(in) :: idx_sw_diag + real(r8), intent(in) :: relh(:, :) + real(r8), intent(in) :: sulfwtpct(:, :) + real(r8), intent(in) :: mass(:, :) ! layer mass (pdeldry*rga) + complex(r8), intent(in) :: crefwsw(:) + complex(r8), intent(in) :: crefwlw(:) + real(r8), intent(in), optional, pointer :: geometric_radius(:, :) + + real(r8), intent(out) :: tau_bin(:, :, :) ! (ncol,nlev,nswbands) extinction OD + real(r8), intent(out) :: ssa_bin(:, :, :) ! (ncol,nlev,nswbands) single scatter albedo + real(r8), intent(out) :: asm_bin(:, :, :) ! (ncol,nlev,nswbands) asymmetry parameter + + ! Diagnostic outputs for BFB absorption diagnostics in CAM + real(r8), intent(out) :: pabs_vis(:, :) ! (ncol,nlev) specific absorption at vis band + real(r8), intent(out) :: dopaer0_vis(:, :) ! (ncol,nlev) pre-asphericity tau at vis band + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + class(aerosol_optics), pointer :: aero_optics + real(r8) :: pext(ncol), pabs(ncol), palb(ncol), pasm(ncol) + integer :: iwav, ilev, icol, ispec + + ! For asphericity computation + logical :: coarse_dust_mode + character(len=aero_name_len) :: modetype + real(r8) :: wetvol(ncol, nlev), watervol(ncol, nlev) + real(r8) :: vol(ncol) + real(r8) :: scatdust(ncol), absdust(ncol), hygrodust(ncol) + real(r8) :: scatbc(ncol), absbc(ncol), hygrobc(ncol) + real(r8) :: scatpom(ncol), abspom(ncol), hygropom(ncol) + real(r8) :: scatsoa(ncol), abssoa(ncol), hygrosoa(ncol) + real(r8) :: scatsulf(ncol), abssulf(ncol), hygrosulf(ncol) + real(r8) :: scatsslt(ncol), abssslt(ncol), hygrosslt(ncol) + real(r8) :: scath2o, absh2o, sumscat, sumabs, sumhygro + real(r8) :: aodc, dustaod0 + real(r8) :: specdens + character(len=32) :: spectype + real(r8), pointer :: specmmr(:, :) + real(r8) :: hygro_aer + complex(r8), pointer :: specrefindex(:) + + errflg = 0 + errmsg = '' + + tau_bin = 0._r8 + ssa_bin = 0._r8 + asm_bin = 0._r8 + pabs_vis = 0._r8 + dopaer0_vis = 0._r8 + + ! Create aerosol optics object + aero_optics => create_aerosol_optics_object(aeroprops, aerostate, ibin, & + ncol, nlev, nswbands, nlwbands, numrh, & + relh, sulfwtpct, crefwsw, crefwlw, & + geometric_radius) + + if (.not. associated(aero_optics)) then + errflg = 1 + errmsg = 'unrecognized aerosol optics type, could not create object' + return + end if + + ! Determine if this is a coarse dust mode (MAM only) + coarse_dust_mode = .false. + if (aeroprops%model_is('MAM')) then + modetype = aeroprops%bin_name(bin_ndx=ibin) + coarse_dust_mode = (modetype == 'coarse' .or. modetype == 'coarse_dust') + end if + + ! Main optics loop + do iwav = 1, nswbands + do ilev = top_lev, nlev + call aero_optics%sw_props(ncol, ilev, iwav, pext, pabs, palb, pasm) + + do icol = 1, ncol + tau_bin(icol, ilev, iwav) = pext(icol)*mass(icol, ilev) + ssa_bin(icol, ilev, iwav) = palb(icol) + asm_bin(icol, ilev, iwav) = pasm(icol) + end do + + ! Save specific absorption at visible band for BFB diagnostics + if (iwav == idx_sw_diag) then + pabs_vis(1:ncol, ilev) = pabs(1:ncol) + end if + end do + end do + + ! Save pre-asphericity tau at visible band for BFB diagnostics + if (idx_sw_diag > 0) then + dopaer0_vis(1:ncol, top_lev:nlev) = tau_bin(1:ncol, top_lev:nlev, idx_sw_diag) + end if + + ! Apply asphericity correction at visible band for coarse dust + ! dmleung 20 Oct 2025: coarse-mode dust is aspherical, with ~30 % enhanced + ! extinction compared with spherical coarse-mode dust. + ! ref: Fig. 1d of Jasper F. Kok et al. (2017) + if (coarse_dust_mode .and. idx_sw_diag > 0) then + wetvol(:ncol, :nlev) = aerostate%wet_volume(aeroprops, ibin, ncol, nlev) + watervol(:ncol, :nlev) = aerostate%water_volume(aeroprops, ibin, ncol, nlev) + + do ilev = top_lev, nlev + scatdust(:ncol) = 0._r8 + absdust(:ncol) = 0._r8 + hygrodust(:ncol) = 0._r8 + scatsulf(:ncol) = 0._r8 + abssulf(:ncol) = 0._r8 + hygrosulf(:ncol) = 0._r8 + scatbc(:ncol) = 0._r8 + absbc(:ncol) = 0._r8 + hygrobc(:ncol) = 0._r8 + scatpom(:ncol) = 0._r8 + abspom(:ncol) = 0._r8 + hygropom(:ncol) = 0._r8 + scatsoa(:ncol) = 0._r8 + abssoa(:ncol) = 0._r8 + hygrosoa(:ncol) = 0._r8 + scatsslt(:ncol) = 0._r8 + abssslt(:ncol) = 0._r8 + hygrosslt(:ncol) = 0._r8 + + ! loop over species ... + do ispec = 1, aeroprops%nspecies(ibin) + call aeroprops%get(ibin, ispec, density=specdens, & + spectype=spectype, refindex_sw=specrefindex, hygro=hygro_aer) + call aerostate%get_ambient_mmr(species_ndx=ispec, bin_ndx=ibin, mmr=specmmr) + + do icol = 1, ncol + vol(icol) = specmmr(icol, ilev)/specdens + + select case (trim(spectype)) + case ('dust') + if (associated(specrefindex)) then + scatdust(icol) = vol(icol)*specrefindex(idx_sw_diag)%re + absdust(icol) = -vol(icol)*specrefindex(idx_sw_diag)%im + end if + hygrodust(icol) = vol(icol)*hygro_aer + case ('black-c') + if (associated(specrefindex)) then + scatbc(icol) = vol(icol)*specrefindex(idx_sw_diag)%re + absbc(icol) = -vol(icol)*specrefindex(idx_sw_diag)%im + end if + hygrobc(icol) = vol(icol)*hygro_aer + case ('sulfate') + if (associated(specrefindex)) then + scatsulf(icol) = vol(icol)*specrefindex(idx_sw_diag)%re + abssulf(icol) = -vol(icol)*specrefindex(idx_sw_diag)%im + end if + hygrosulf(icol) = vol(icol)*hygro_aer + case ('p-organic') + if (associated(specrefindex)) then + scatpom(icol) = vol(icol)*specrefindex(idx_sw_diag)%re + abspom(icol) = -vol(icol)*specrefindex(idx_sw_diag)%im + end if + hygropom(icol) = vol(icol)*hygro_aer + case ('s-organic') + if (associated(specrefindex)) then + scatsoa(icol) = vol(icol)*specrefindex(idx_sw_diag)%re + abssoa(icol) = -vol(icol)*specrefindex(idx_sw_diag)%im + end if + hygrosoa(icol) = vol(icol)*hygro_aer + case ('seasalt') + if (associated(specrefindex)) then + scatsslt(icol) = vol(icol)*specrefindex(idx_sw_diag)%re + abssslt(icol) = -vol(icol)*specrefindex(idx_sw_diag)%im + end if + hygrosslt(icol) = vol(icol)*hygro_aer + end select + end do + end do + + do icol = 1, ncol + if (wetvol(icol, ilev) > 1.e-40_r8 .and. vol(icol) > 0._r8) then + + ! partition optical depth into contributions from each constituent + ! assume contribution is proportional to refractive index X volume + + scath2o = watervol(icol, ilev)*crefwsw(idx_sw_diag)%re + absh2o = -watervol(icol, ilev)*crefwsw(idx_sw_diag)%im + sumscat = scatsulf(icol) + scatpom(icol) + scatsoa(icol) + scatbc(icol) + & + scatdust(icol) + scatsslt(icol) + scath2o + sumabs = abssulf(icol) + abspom(icol) + abssoa(icol) + absbc(icol) + & + absdust(icol) + abssslt(icol) + absh2o + sumhygro = hygrosulf(icol) + hygropom(icol) + hygrosoa(icol) + hygrobc(icol) + & + hygrodust(icol) + hygrosslt(icol) + + scatdust(icol) = (scatdust(icol) + scath2o*hygrodust(icol)/sumhygro)/sumscat + absdust(icol) = (absdust(icol) + absh2o*hygrodust(icol)/sumhygro)/sumabs + + aodc = (absdust(icol)*(1.0_r8 - ssa_bin(icol, ilev, idx_sw_diag)) & + + ssa_bin(icol, ilev, idx_sw_diag)*scatdust(icol)) & + *tau_bin(icol, ilev, idx_sw_diag) + + ! dustaod0 is the single-level spherical dust AOD + dustaod0 = aodc + + ! scale up dust AOD by 30 % + tau_bin(icol, ilev, idx_sw_diag) = tau_bin(icol, ilev, idx_sw_diag) & + - dustaod0 + dustaod0*dustaspherical_opts + + end if + end do + end do ! ilev + end if ! if coarse_dust_mode && idx_sw_diag > 0 + + deallocate (aero_optics) + end subroutine aerosol_optics_sw_bin + + !=============================================================================== + ! Per-bin LW aerosol optics. Returns absorption optical depth (tau_lw_bin) + ! and raw specific absorption (absorp_bin) for diagnostic use. + !=============================================================================== + subroutine aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & + ncol, nlev, nswbands, nlwbands, numrh, & + relh, sulfwtpct, mass, crefwsw, crefwlw, & + geometric_radius, & + tau_lw_bin, absorp_bin, & + errmsg, errflg) + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + use aerosol_optics_mod, only: aerosol_optics + + class(aerosol_properties), intent(in), target :: aeroprops + class(aerosol_state), intent(in), target :: aerostate + integer, intent(in) :: ibin + integer, intent(in) :: ncol, nlev + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands + integer, intent(in) :: numrh + real(r8), intent(in) :: relh(:, :) + real(r8), intent(in) :: sulfwtpct(:, :) + real(r8), intent(in) :: mass(:, :) + complex(r8), intent(in) :: crefwsw(:) + complex(r8), intent(in) :: crefwlw(:) + real(r8), intent(in), optional, pointer :: geometric_radius(:, :) + real(r8), intent(out) :: tau_lw_bin(:, :, :) ! (ncol,nlev,nlwbands) absorption OD + real(r8), intent(out) :: absorp_bin(:, :, :) ! (ncol,nlev,nlwbands) raw specific absorption (pabs) + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + class(aerosol_optics), pointer :: aero_optics + real(r8) :: pabs(ncol) + integer :: iwav, ilev, icol + + errflg = 0 + errmsg = '' + + tau_lw_bin = 0._r8 + absorp_bin = 0._r8 + + ! Create aerosol optics object + aero_optics => create_aerosol_optics_object(aeroprops, aerostate, ibin, & + ncol, nlev, nswbands, nlwbands, numrh, & + relh, sulfwtpct, crefwsw, crefwlw, & + geometric_radius) + + if (.not. associated(aero_optics)) then + errflg = 1 + errmsg = 'unrecognized aerosol optics type, could not create object' + return + end if + + do iwav = 1, nlwbands + do ilev = 1, nlev + call aero_optics%lw_props(ncol, ilev, iwav, pabs) + + do icol = 1, ncol + tau_lw_bin(icol, ilev, iwav) = pabs(icol)*mass(icol, ilev) + absorp_bin(icol, ilev, iwav) = pabs(icol) + end do + end do + end do + + deallocate (aero_optics) + + end subroutine aerosol_optics_lw_bin + +end module aerosol_optics_core diff --git a/src/aerosol/aerosol_optics_mod.F90 b/src/aerosol/aerosol_optics_mod.F90 new file mode 100644 index 000000000..be4deedef --- /dev/null +++ b/src/aerosol/aerosol_optics_mod.F90 @@ -0,0 +1,58 @@ +module aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private + public :: aerosol_optics + + !> aerosol_optics defines interfaces to optical properties of any aerosol package + !! + !! Each aerosol optics type must extend the abstract aerosol_optics class + !! to define details of how aerosol optics properties are derived from + !! aerosol states. + type, abstract :: aerosol_optics + + contains + + procedure(aeropts_sw_props),deferred :: sw_props + procedure(aeropts_lw_props),deferred :: lw_props + + end type aerosol_optics + + abstract interface + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine aeropts_sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + import :: aerosol_optics, r8 + + class(aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + end subroutine aeropts_sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine aeropts_lw_props(self, ncol, ilev, iwav, pabs) + import :: aerosol_optics, r8 + + class(aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + end subroutine aeropts_lw_props + + end interface + +end module aerosol_optics_mod diff --git a/src/aerosol/aerosol_physical_properties.F90 b/src/aerosol/aerosol_physical_properties.F90 new file mode 100644 index 000000000..e57b251c5 --- /dev/null +++ b/src/aerosol/aerosol_physical_properties.F90 @@ -0,0 +1,1669 @@ +! Properties of aerosols that are used by radiation and other parameterizations. +! +! This module is a utility used by the radiative_aerosol module. The properties stored +! here are meant to be accessed via that module. This module knows nothing about how +! this data is associated with the constituents that are radiatively active or those that +! are being used for diagnostic calculations. +module phys_prop + use shr_kind_mod, only: r8 => shr_kind_r8 + use pio, only: file_desc_t, var_desc_t, pio_get_var, pio_inq_varid, & + pio_inq_dimlen, pio_inq_dimid + + use radiation_namelist, only: nswbands, nlwbands + + implicit none + private + save + + integer, parameter, public :: ot_length = 32 + + public :: physprop_accum_unique_files ! Make a list of the unique set of files that contain properties + ! This is an initialization step that must be done before calling physprop_init + public :: physprop_init ! Initialization -- read the input datasets + public :: physprop_get_id ! Return ID used to access the property data from the input files + public :: physprop_get ! Return data for specified ID + + ! Data from one input dataset is stored in a structure of type(physprop_type). + type :: physprop_type + character(len=256) :: sourcefile ! Absolute pathname of data file. + character(len=ot_length) :: opticsmethod ! one of {hygro,nonhygro} + + ! for hygroscopic species of externally mixed aerosols + real(r8), pointer :: sw_hygro_ext(:, :) + real(r8), pointer :: sw_hygro_ssa(:, :) + real(r8), pointer :: sw_hygro_asm(:, :) + real(r8), pointer :: lw_hygro_abs(:, :) + + ! for nonhygroscopic species of externally mixed aerosols + real(r8), pointer :: sw_nonhygro_ext(:) + real(r8), pointer :: sw_nonhygro_ssa(:) + real(r8), pointer :: sw_nonhygro_asm(:) + real(r8), pointer :: sw_nonhygro_scat(:) + real(r8), pointer :: sw_nonhygro_ascat(:) + real(r8), pointer :: lw_abs(:) + + ! complex refractive index + complex(r8), pointer :: refindex_aer_sw(:) + complex(r8), pointer :: refindex_aer_lw(:) + + ! for radius-dependent mass-specific quantities + real(r8), pointer :: r_sw_ext(:, :) + real(r8), pointer :: r_sw_scat(:, :) + real(r8), pointer :: r_sw_ascat(:, :) + real(r8), pointer :: r_lw_abs(:, :) + real(r8), pointer :: mu(:) + + ! for modal optics + real(r8), pointer :: extpsw(:, :, :, :) ! specific extinction + real(r8), pointer :: abspsw(:, :, :, :) ! specific absorption + real(r8), pointer :: asmpsw(:, :, :, :) ! asymmetry factor + real(r8), pointer :: absplw(:, :, :, :) ! specific absorption + real(r8), pointer :: refrtabsw(:, :) ! table of real refractive indices for aerosols visible + real(r8), pointer :: refitabsw(:, :) ! table of imag refractive indices for aerosols visible + real(r8), pointer :: refrtablw(:, :) ! table of real refractive indices for aerosols infrared + real(r8), pointer :: refitablw(:, :) ! table of imag refractive indices for aerosols infrared + + ! for core/shell optics + real(r8), pointer :: extpsw2(:, :) ! specific extinction + real(r8), pointer :: abspsw2(:, :) ! specific absorption + real(r8), pointer :: asmpsw2(:, :) ! asymmetry factor + real(r8), pointer :: absplw2(:, :) ! specific absorption + real(r8), pointer :: corefrac(:) ! table of real refractive indices for aerosols visible + integer :: nfraC ! number of Chebyshev coefficients + + ! for hygroscopic species of pure sulfate + real(r8), pointer :: sw_hygro_ext_wtp(:, :) + real(r8), pointer :: sw_hygro_ssa_wtp(:, :) + real(r8), pointer :: sw_hygro_asm_wtp(:, :) + real(r8), pointer :: lw_hygro_abs_wtp(:, :) + real(r8), pointer :: wgtpct(:) ! weight percent + integer :: nwtp ! number weight percent + + ! for hygroscopic species of externally mixed aerosols + real(r8), pointer :: sw_hygro_coreshell_ext(:, :, :, :, :) + real(r8), pointer :: sw_hygro_coreshell_ssa(:, :, :, :, :) + real(r8), pointer :: sw_hygro_coreshell_asm(:, :, :, :, :) + real(r8), pointer :: lw_hygro_coreshell_abs(:, :, :, :, :) + real(r8), pointer :: bcdust(:) ! table of bc-dust mass ratio + real(r8), pointer :: kap(:) ! table of kappa + real(r8), pointer :: relh(:) ! table of relative humidity + integer :: nbcdust + integer :: nkap + integer :: nrelh + + ! microphysics parameters. + character(len=32) :: aername ! for output of number concentration + real(r8) :: density_aer ! density of aerosol (kg/m3) + real(r8) :: hygro_aer ! hygroscopicity of aerosol + real(r8) :: dryrad_aer ! number mode radius (m) of aerosol size distribution + real(r8) :: dispersion_aer ! geometric standard deviation of aerosol size distribution + real(r8) :: num_to_mass_aer ! ratio of number concentration to mass concentration (#/kg) + ! *** Is this actually (kg/#) ??? + + ! mode parameters + integer :: ncoef ! number of Chebyshev coefficients + integer :: prefr ! dimension in table of real refractive indices + integer :: prefi ! dimension in table of imag refractive indices + real(r8) :: sigmag ! geometric standard deviation of the number distribution for aerosol mode + real(r8) :: dgnum ! geometric dry mean diameter of the number distribution for aerosol mode + real(r8) :: dgnumlo ! lower limit of dgnum + real(r8) :: dgnumhi ! upper limit of dgnum + real(r8) :: rhcrystal ! crystalization relative humidity for mode + real(r8) :: rhdeliques ! deliquescence relative humidity for mode + + end type physprop_type + + ! This module stores data in an array of physprop_type structures. The way this data + ! is accessed outside the module is via a physprop ID, which is an index into the array. + integer :: numphysprops = 0 ! an incremental total across ALL clim and diag constituents + type(physprop_type), pointer :: physprop(:) + + ! Temporary storage location for filenames in namelist, and construction of dynamic index + ! to properties. The unique filenames specified in the namelist are the identifiers of + ! the properties. Searching the uniquefilenames array provides the index into the physprop + ! array. + character(len=256), allocatable :: uniquefilenames(:) + + ! Number of evenly spaced intervals in rh used in this module and in the aer_rad_props module + ! for calculations of aerosol hygroscopic growth. + integer, parameter, public :: nrh = 1000 + +contains + + ! Count number of aerosols in input radname array. Aerosols are identified + ! as strings with a ".nc" suffix. + ! Construct a cumulative list of unique filenames containing physical property data. + subroutine physprop_accum_unique_files(radname, type) + character(len=*), intent(in) :: radname(:) + character(len=1), intent(in) :: type(:) + + integer :: ncnst, i + character(len=*), parameter :: subname = 'physprop_accum_unique_files' + !------------------------------------------------------------------------------------ + + ! Initial guess for number of files we need. + if (.not. allocated(uniquefilenames)) allocate (uniquefilenames(50)) + + ncnst = ubound(radname, 1) + + do i = 1, ncnst + ! check if radname is either a bulk aerosol or a mode + if (type(i) == 'A' .or. type(i) == 'M' .or. type(i) == 'B') then + + ! check if this filename has been used by another aerosol. If not + ! then add it to the list of unique names. + if (physprop_get_id(radname(i)) < 0) then + numphysprops = numphysprops + 1 + if (numphysprops > size(uniquefilenames)) then + call double_capacity(uniquefilenames) + end if + uniquefilenames(numphysprops) = trim(radname(i)) + end if + end if + end do + + contains + + ! Simple routine to re-allocate an array with twice the size, but with + ! the inital values being preserved. + subroutine double_capacity(array) + use cam_abortutils, only: endrun + character(len=256), intent(inout), allocatable :: array(:) + character(len=256), allocatable :: tmp(:) + integer :: ierr + + allocate (tmp(size(array)*2), stat=ierr) + if (ierr /= 0) then + call endrun('physprop_accum_unique_files: Allocation error.') + end if + + tmp(:size(array)) = array + + deallocate (array, stat=ierr) + if (ierr /= 0) then + call endrun('physprop_accum_unique_files: Deallocation error.') + end if + + call move_alloc(tmp, array) + + end subroutine double_capacity + + end subroutine physprop_accum_unique_files + + ! Read properties from the aerosol data files. + ! ***N.B.*** The calls to physprop_accum_unique_files must be made before calling + ! this init routine. physprop_accum_unique_files is responsible for building + ! the list of files to be read here. + subroutine physprop_init() + use ioFileMod, only: cam_get_file + use cam_pio_utils, only: cam_pio_openfile + use pio, only: PIO_NOWRITE + use pio, only: pio_closefile + + ! Local variables + integer :: fileindex + type(file_desc_t) :: nc_id ! index to netcdf file + character(len=256) :: locfn ! path to actual file used + character(len=32) :: aername_str ! string read from netCDF file -- may contain trailing + ! nulls which aren't dealt with by trim() + + integer :: ierr ! error codes from mpi + + ! numphysprops is the number of unique physical properties files + ! as counted by the physprop_accum_unique_files subroutine, which is called + ! multiple times for different lists of radiatively active aerosol. + allocate (physprop(numphysprops)) + do fileindex = 1, numphysprops + nullify (physprop(fileindex)%sw_hygro_ext) + nullify (physprop(fileindex)%sw_hygro_ssa) + nullify (physprop(fileindex)%sw_hygro_asm) + nullify (physprop(fileindex)%lw_hygro_abs) + + nullify (physprop(fileindex)%sw_hygro_ext_wtp) + nullify (physprop(fileindex)%sw_hygro_ssa_wtp) + nullify (physprop(fileindex)%sw_hygro_asm_wtp) + nullify (physprop(fileindex)%lw_hygro_abs_wtp) + nullify (physprop(fileindex)%wgtpct) + + nullify (physprop(fileindex)%sw_hygro_coreshell_ext) + nullify (physprop(fileindex)%sw_hygro_coreshell_ssa) + nullify (physprop(fileindex)%sw_hygro_coreshell_asm) + nullify (physprop(fileindex)%lw_hygro_coreshell_abs) + nullify (physprop(fileindex)%bcdust) + nullify (physprop(fileindex)%kap) + nullify (physprop(fileindex)%relh) + + nullify (physprop(fileindex)%sw_nonhygro_ext) + nullify (physprop(fileindex)%sw_nonhygro_ssa) + nullify (physprop(fileindex)%sw_nonhygro_asm) + nullify (physprop(fileindex)%sw_nonhygro_scat) + nullify (physprop(fileindex)%sw_nonhygro_ascat) + nullify (physprop(fileindex)%lw_abs) + + nullify (physprop(fileindex)%refindex_aer_sw) + nullify (physprop(fileindex)%refindex_aer_lw) + + nullify (physprop(fileindex)%r_sw_ext) + nullify (physprop(fileindex)%r_sw_scat) + nullify (physprop(fileindex)%r_sw_ascat) + nullify (physprop(fileindex)%r_lw_abs) + nullify (physprop(fileindex)%mu) + + nullify (physprop(fileindex)%extpsw) + nullify (physprop(fileindex)%abspsw) + nullify (physprop(fileindex)%asmpsw) + nullify (physprop(fileindex)%absplw) + nullify (physprop(fileindex)%refrtabsw) + nullify (physprop(fileindex)%refitabsw) + nullify (physprop(fileindex)%refrtablw) + nullify (physprop(fileindex)%refitablw) + + nullify (physprop(fileindex)%extpsw2) + nullify (physprop(fileindex)%abspsw2) + nullify (physprop(fileindex)%asmpsw2) + nullify (physprop(fileindex)%absplw2) + nullify (physprop(fileindex)%corefrac) + + call cam_get_file(uniquefilenames(fileindex), locfn) + physprop(fileindex)%sourcefile = locfn + + ! Open the physprop file + call cam_pio_openfile(nc_id, locfn, PIO_NOWRITE) + + call aerosol_optics_init(physprop(fileindex), nc_id) + + ! Close the physprop file + call pio_closefile(nc_id) + + end do + end subroutine physprop_init + + ! Look for filename in the global list of unique filenames (module data uniquefilenames). + ! If found, return it's index in the list. Otherwise return -1. + integer function physprop_get_id(filename) + character(len=*), intent(in) :: filename + integer iphysprop + + physprop_get_id = -1 + do iphysprop = 1, numphysprops + if (trim(uniquefilenames(iphysprop)) == trim(filename)) then + physprop_get_id = iphysprop + return + end if + end do + + end function physprop_get_id + + ! Return requested properties for specified ID. + subroutine physprop_get(id, sourcefile, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_abs, & + sw_hygro_ext_wtp, sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_abs_wtp, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_abs, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + extpsw, abspsw, asmpsw, absplw, refrtabsw, & + refitabsw, refrtablw, refitablw, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & + num_to_mass_aer, ncoef, prefr, prefi, sigmag, & + dgnum, dgnumlo, dgnumhi, rhcrystal, rhdeliques, & + extpsw2, abspsw2, asmpsw2, absplw2, corefrac, nfrac, & + wgtpct, bcdust, kap, relh, & + nkap, nwtp, nbcdust, nrelh, & + sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, & + sw_hygro_coreshell_asm, lw_hygro_coreshell_abs) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + ! Arguments + integer, intent(in) :: id + character(len=256), optional, intent(out) :: sourcefile ! Absolute pathname of data file. + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:, :) + real(r8), optional, pointer :: sw_hygro_ssa(:, :) + real(r8), optional, pointer :: sw_hygro_asm(:, :) + real(r8), optional, pointer :: lw_hygro_abs(:, :) + real(r8), optional, pointer :: sw_hygro_ext_wtp(:, :) + real(r8), optional, pointer :: sw_hygro_ssa_wtp(:, :) + real(r8), optional, pointer :: sw_hygro_asm_wtp(:, :) + real(r8), optional, pointer :: lw_hygro_abs_wtp(:, :) + real(r8), optional, pointer :: wgtpct(:) + integer, optional, intent(out) :: nwtp + + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:, :, :, :, :) + real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:, :, :, :, :) + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:, :, :, :, :) + real(r8), optional, pointer :: lw_hygro_coreshell_abs(:, :, :, :, :) + real(r8), optional, pointer :: kap(:) + integer, optional, intent(out) :: nkap + real(r8), optional, pointer :: bcdust(:) + integer, optional, intent(out) :: nbcdust + real(r8), optional, pointer :: relh(:) + integer, optional, intent(out) :: nrelh + + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_abs(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + real(r8), optional, pointer :: r_sw_ext(:, :) + real(r8), optional, pointer :: r_sw_scat(:, :) + real(r8), optional, pointer :: r_sw_ascat(:, :) + real(r8), optional, pointer :: r_lw_abs(:, :) + real(r8), optional, pointer :: mu(:) + real(r8), optional, pointer :: extpsw(:, :, :, :) + real(r8), optional, pointer :: abspsw(:, :, :, :) + real(r8), optional, pointer :: asmpsw(:, :, :, :) + real(r8), optional, pointer :: absplw(:, :, :, :) + real(r8), optional, pointer :: refrtabsw(:, :) + real(r8), optional, pointer :: refitabsw(:, :) + real(r8), optional, pointer :: refrtablw(:, :) + real(r8), optional, pointer :: refitablw(:, :) + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + integer, optional, intent(out) :: ncoef + integer, optional, intent(out) :: prefr + integer, optional, intent(out) :: prefi + real(r8), optional, intent(out) :: sigmag + real(r8), optional, intent(out) :: dgnum + real(r8), optional, intent(out) :: dgnumlo + real(r8), optional, intent(out) :: dgnumhi + real(r8), optional, intent(out) :: rhcrystal + real(r8), optional, intent(out) :: rhdeliques + + ! for core/shell + real(r8), optional, pointer :: extpsw2(:, :) + real(r8), optional, pointer :: abspsw2(:, :) + real(r8), optional, pointer :: asmpsw2(:, :) + real(r8), optional, pointer :: absplw2(:, :) + real(r8), optional, pointer :: corefrac(:) + integer, optional, intent(out) :: nfrac + + ! Local variables + character(len=*), parameter :: subname = 'physprop_get' + !------------------------------------------------------------------------------------ + + if (id <= 0 .or. id > numphysprops) then + write (iulog, *) subname//': illegal ID value: ', id + call endrun(subname//': ID out of range') + end if + + if (present(sourcefile)) sourcefile = physprop(id)%sourcefile + if (present(opticstype)) opticstype = physprop(id)%opticsmethod + if (present(sw_hygro_ext)) sw_hygro_ext => physprop(id)%sw_hygro_ext + if (present(sw_hygro_ssa)) sw_hygro_ssa => physprop(id)%sw_hygro_ssa + if (present(sw_hygro_asm)) sw_hygro_asm => physprop(id)%sw_hygro_asm + if (present(lw_hygro_abs)) lw_hygro_abs => physprop(id)%lw_hygro_abs + if (present(sw_hygro_ext_wtp)) sw_hygro_ext_wtp => physprop(id)%sw_hygro_ext_wtp + if (present(sw_hygro_ssa_wtp)) sw_hygro_ssa_wtp => physprop(id)%sw_hygro_ssa_wtp + if (present(sw_hygro_asm_wtp)) sw_hygro_asm_wtp => physprop(id)%sw_hygro_asm_wtp + if (present(lw_hygro_abs_wtp)) lw_hygro_abs_wtp => physprop(id)%lw_hygro_abs_wtp + if (present(wgtpct)) wgtpct => physprop(id)%wgtpct + if (present(nwtp)) nwtp = physprop(id)%nwtp + if (present(sw_hygro_coreshell_ext)) sw_hygro_coreshell_ext => physprop(id)%sw_hygro_coreshell_ext + if (present(sw_hygro_coreshell_ssa)) sw_hygro_coreshell_ssa => physprop(id)%sw_hygro_coreshell_ssa + if (present(sw_hygro_coreshell_asm)) sw_hygro_coreshell_asm => physprop(id)%sw_hygro_coreshell_asm + if (present(lw_hygro_coreshell_abs)) lw_hygro_coreshell_abs => physprop(id)%lw_hygro_coreshell_abs + if (present(kap)) kap => physprop(id)%kap + if (present(nkap)) nkap = physprop(id)%nkap + if (present(bcdust)) bcdust => physprop(id)%bcdust + if (present(nbcdust)) nbcdust = physprop(id)%nbcdust + if (present(relh)) relh => physprop(id)%relh + if (present(nrelh)) nrelh = physprop(id)%nrelh + if (present(sw_nonhygro_ext)) sw_nonhygro_ext => physprop(id)%sw_nonhygro_ext + if (present(sw_nonhygro_ssa)) sw_nonhygro_ssa => physprop(id)%sw_nonhygro_ssa + if (present(sw_nonhygro_asm)) sw_nonhygro_asm => physprop(id)%sw_nonhygro_asm + if (present(sw_nonhygro_scat)) sw_nonhygro_scat => physprop(id)%sw_nonhygro_scat + if (present(sw_nonhygro_ascat)) sw_nonhygro_ascat => physprop(id)%sw_nonhygro_ascat + if (present(lw_abs)) lw_abs => physprop(id)%lw_abs + + if (present(refindex_aer_sw)) refindex_aer_sw => physprop(id)%refindex_aer_sw + if (present(refindex_aer_lw)) refindex_aer_lw => physprop(id)%refindex_aer_lw + + if (present(r_sw_ext)) r_sw_ext => physprop(id)%r_sw_ext + if (present(r_sw_scat)) r_sw_scat => physprop(id)%r_sw_scat + if (present(r_sw_ascat)) r_sw_ascat => physprop(id)%r_sw_ascat + if (present(r_lw_abs)) r_lw_abs => physprop(id)%r_lw_abs + if (present(mu)) mu => physprop(id)%mu + + if (present(extpsw)) extpsw => physprop(id)%extpsw + if (present(abspsw)) abspsw => physprop(id)%abspsw + if (present(asmpsw)) asmpsw => physprop(id)%asmpsw + if (present(absplw)) absplw => physprop(id)%absplw + if (present(refrtabsw)) refrtabsw => physprop(id)%refrtabsw + if (present(refitabsw)) refitabsw => physprop(id)%refitabsw + if (present(refrtablw)) refrtablw => physprop(id)%refrtablw + if (present(refitablw)) refitablw => physprop(id)%refitablw + + if (present(aername)) aername = physprop(id)%aername + if (present(density_aer)) density_aer = physprop(id)%density_aer + if (present(hygro_aer)) hygro_aer = physprop(id)%hygro_aer + if (present(dryrad_aer)) dryrad_aer = physprop(id)%dryrad_aer + if (present(dispersion_aer)) dispersion_aer = physprop(id)%dispersion_aer + if (present(num_to_mass_aer)) num_to_mass_aer = physprop(id)%num_to_mass_aer + + if (present(ncoef)) ncoef = physprop(id)%ncoef + if (present(prefr)) prefr = physprop(id)%prefr + if (present(prefi)) prefi = physprop(id)%prefi + if (present(sigmag)) sigmag = physprop(id)%sigmag + if (present(dgnum)) dgnum = physprop(id)%dgnum + if (present(dgnumlo)) dgnumlo = physprop(id)%dgnumlo + if (present(dgnumhi)) dgnumhi = physprop(id)%dgnumhi + if (present(rhcrystal)) rhcrystal = physprop(id)%rhcrystal + if (present(rhdeliques)) rhdeliques = physprop(id)%rhdeliques + + ! For core/shell bins + if (present(extpsw2)) extpsw2 => physprop(id)%extpsw2 + if (present(abspsw2)) abspsw2 => physprop(id)%abspsw2 + if (present(asmpsw2)) asmpsw2 => physprop(id)%asmpsw2 + if (present(absplw2)) absplw2 => physprop(id)%absplw2 + if (present(corefrac)) corefrac => physprop(id)%corefrac + if (present(nfrac)) nfrac = physprop(id)%nfrac + + end subroutine physprop_get + +!================================================================================================ +! Private methods +!================================================================================================ + + ! Determine the opticstype, then call the appropriate routine to read the data. + subroutine aerosol_optics_init(phys_prop, nc_id) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type(file_desc_t), intent(inout) :: nc_id ! identifier for netcdf file + + integer :: opticslength_id, opticslength + type(var_desc_t) :: op_type_id + integer :: ierr ! mpi error codes + character(len=ot_length) :: opticstype_str ! string read from netCDF file -- may contain trailing + ! nulls which aren't dealt with by trim() + + ierr = pio_inq_dimid(nc_id, 'opticsmethod_len', opticslength_id) + ierr = pio_inq_dimlen(nc_id, opticslength_id, opticslength) + if (opticslength .gt. ot_length) then + call endrun(" optics type length in "//phys_prop%sourcefile//" excedes maximum length of 32") + end if + ierr = pio_inq_varid(nc_id, 'opticsmethod', op_type_id) + ierr = pio_get_var(nc_id, op_type_id, phys_prop%opticsmethod) + + select case (phys_prop%opticsmethod) + case ('zero') + call zero_optics_init(phys_prop, nc_id) + + case ('hygro') + call hygro_optics_init(phys_prop, nc_id) + + case ('hygroscopic') + call hygroscopic_optics_init(phys_prop, nc_id) + + case ('hygroscopic_wtp') + call hygroscopic_wtp_optics_init(phys_prop, nc_id) + + case ('hygroscopic_coreshell') + call hygroscopic_coreshell_optics_init(phys_prop, nc_id) + + case ('nonhygro') + call nonhygro_optics_init(phys_prop, nc_id) + + case ('insoluble') + call insoluble_optics_init(phys_prop, nc_id) + + case ('volcanic_radius', 'volcanic_radius1', 'volcanic_radius2', 'volcanic_radius3') + call volcanic_radius_optics_init(phys_prop, nc_id) + + case ('volcanic') + call volcanic_optics_init(phys_prop, nc_id) + + case ('modal') + call modal_optics_init(phys_prop, nc_id) + + case ('sectional') + call bin_optics_init(phys_prop, nc_id) + + case ('sectional_props') + call bindef_optics_init(phys_prop, nc_id) + + ! ... other types of optics can be added here + + case default + call endrun('aerosol_optics_init: unsupported optics type '// & + trim(phys_prop%opticsmethod)//' in file '//phys_prop%sourcefile) + end select + + end subroutine aerosol_optics_init + +!================================================================================================ + + ! Read optics data of type 'hygro' and interpolate it to CAM's rh mesh. + subroutine hygro_optics_init(phys_prop, nc_id) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr ! error flag + + integer :: rh_idx_id, lw_band_id, sw_band_id + integer :: kbnd, krh + integer :: rh_id, sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: nbnd, swbands + + ! temp data from hygroscopic file before interpolation onto cam-rh-mesh + integer :: nfilerh ! number of rh values in file + real(r8), allocatable, dimension(:) :: frh + real(r8), allocatable, dimension(:, :) :: fsw_ext + real(r8), allocatable, dimension(:, :) :: fsw_ssa + real(r8), allocatable, dimension(:, :) :: fsw_asm + + real(r8) :: rh ! real rh value on cam rh mesh (indexvalue) + !------------------------------------------------------------------------------------ + + allocate (phys_prop%sw_hygro_ext(nrh, nswbands)) + allocate (phys_prop%sw_hygro_ssa(nrh, nswbands)) + allocate (phys_prop%sw_hygro_asm(nrh, nswbands)) + allocate (phys_prop%lw_abs(nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'rh_idx', rh_idx_id) + + ierr = pio_inq_dimlen(nc_id, rh_idx_id, nfilerh) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ierr = pio_inq_varid(nc_id, 'rh', rh_id) + + ierr = pio_inq_varid(nc_id, 'ext_sw', sw_ext_id) + + ierr = pio_inq_varid(nc_id, 'ssa_sw', sw_ssa_id) + + ierr = pio_inq_varid(nc_id, 'asm_sw', sw_asm_id) + + ierr = pio_inq_varid(nc_id, 'abs_lw', lw_ext_id) + + ! specific optical properties on file's rh mesh + allocate (fsw_ext(nfilerh, nswbands)) + allocate (fsw_asm(nfilerh, nswbands)) + allocate (fsw_ssa(nfilerh, nswbands)) + allocate (frh(nfilerh)) + + ierr = pio_get_var(nc_id, rh_id, frh) + + ierr = pio_get_var(nc_id, sw_ext_id, fsw_ext) + + ierr = pio_get_var(nc_id, sw_ssa_id, fsw_ssa) + + ierr = pio_get_var(nc_id, sw_asm_id, fsw_asm) + + ierr = pio_get_var(nc_id, lw_ext_id, phys_prop%lw_abs) + + ! interpolate onto cam's rh mesh + do kbnd = 1, nswbands + do krh = 1, nrh + rh = 1.0_r8/nrh*(krh - 1) + phys_prop%sw_hygro_ext(krh, kbnd) = & + exp_interpol(frh, fsw_ext(:, kbnd)/fsw_ext(1, kbnd), rh) & + *fsw_ext(1, kbnd) + phys_prop%sw_hygro_ssa(krh, kbnd) = & + lin_interpol(frh, fsw_ssa(:, kbnd)/fsw_ssa(1, kbnd), rh) & + *fsw_ssa(1, kbnd) + phys_prop%sw_hygro_asm(krh, kbnd) = & + lin_interpol(frh, fsw_asm(:, kbnd)/fsw_asm(1, kbnd), rh) & + *fsw_asm(1, kbnd) + end do + end do + + deallocate (fsw_ext, fsw_asm, fsw_ssa, frh) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + + end subroutine hygro_optics_init + +!================================================================================================ + + subroutine zero_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'nonhygro' + + type(physprop_type), intent(inout) :: phys_prop ! storage for file data + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id + integer :: sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: swbands, nbnd + integer :: ierr ! error flag + !------------------------------------------------------------------------------------ + + ! perhaps this doesn't even need allocated. + allocate (phys_prop%sw_nonhygro_ext(nswbands)) + allocate (phys_prop%sw_nonhygro_ssa(nswbands)) + allocate (phys_prop%sw_nonhygro_asm(nswbands)) + allocate (phys_prop%lw_abs(nlwbands)) + + phys_prop%sw_nonhygro_ext = 0._r8 + phys_prop%sw_nonhygro_ssa = 0._r8 + phys_prop%sw_nonhygro_asm = 0._r8 + phys_prop%lw_abs = 0._r8 + + end subroutine zero_optics_init + +!================================================================================================ + + ! Read optics data of type 'nonhygro' + subroutine insoluble_optics_init(phys_prop, nc_id) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! storage for file data + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id + integer :: sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: swbands, nbnd + integer :: ierr ! error flag + integer :: start(2), count(2) + !------------------------------------------------------------------------------------ + + allocate (phys_prop%sw_nonhygro_ext(nswbands)) + allocate (phys_prop%sw_nonhygro_ssa(nswbands)) + allocate (phys_prop%sw_nonhygro_asm(nswbands)) + allocate (phys_prop%lw_abs(nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ! read file data + ierr = pio_inq_varid(nc_id, 'ext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw', sw_ssa_id) + ierr = pio_inq_varid(nc_id, 'asm_sw', sw_asm_id) + ierr = pio_inq_varid(nc_id, 'abs_lw', lw_ext_id) + + start = 1 + count = (/1, swbands/) + + ierr = pio_get_var(nc_id, sw_ext_id, start, count, phys_prop%sw_nonhygro_ext) + ierr = pio_get_var(nc_id, sw_ssa_id, start, count, phys_prop%sw_nonhygro_ssa) + ierr = pio_get_var(nc_id, sw_asm_id, start, count, phys_prop%sw_nonhygro_asm) + count = (/1, nbnd/) + ierr = pio_get_var(nc_id, lw_ext_id, start, count, phys_prop%lw_abs) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + + end subroutine insoluble_optics_init + +!================================================================================================ + + ! Read optics data of type 'volcanic_radius' + subroutine volcanic_radius_optics_init(phys_prop, nc_id) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! storage for file data + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id, mu_id, mu_did + integer :: sw_ext_id, sw_scat_id, sw_ascat_id, lw_abs_id + integer :: swbands, nbnd, n_mu_samples + integer :: ierr ! error flag + !------------------------------------------------------------------------------------ + + ierr = pio_inq_dimid(nc_id, 'mu_samples', mu_did) + ierr = pio_inq_dimlen(nc_id, mu_did, n_mu_samples) + + allocate (phys_prop%r_sw_ext(nswbands, n_mu_samples)) + allocate (phys_prop%r_sw_scat(nswbands, n_mu_samples)) + allocate (phys_prop%r_sw_ascat(nswbands, n_mu_samples)) + allocate (phys_prop%r_lw_abs(nlwbands, n_mu_samples)) + allocate (phys_prop%mu(n_mu_samples)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ! read file data + ierr = pio_inq_varid(nc_id, 'bext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'bsca_sw', sw_scat_id) + ierr = pio_inq_varid(nc_id, 'basc_sw', sw_ascat_id) + ierr = pio_inq_varid(nc_id, 'babs_lw', lw_abs_id) + ierr = pio_inq_varid(nc_id, 'mu_samples', mu_id) + + ierr = pio_get_var(nc_id, sw_ext_id, phys_prop%r_sw_ext) + ierr = pio_get_var(nc_id, sw_scat_id, phys_prop%r_sw_scat) + ierr = pio_get_var(nc_id, sw_ascat_id, phys_prop%r_sw_ascat) + ierr = pio_get_var(nc_id, lw_abs_id, phys_prop%r_lw_abs) + ierr = pio_get_var(nc_id, mu_id, phys_prop%mu) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + + end subroutine volcanic_radius_optics_init + +!================================================================================================ + + ! Read optics data of type 'volcanic' + subroutine volcanic_optics_init(phys_prop, nc_id) + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! storage for file data + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id + integer :: sw_ext_id, sw_scat_id, sw_ascat_id, lw_abs_id + integer :: swbands, nbnd + integer :: ierr ! error flag + !------------------------------------------------------------------------------------ + + allocate (phys_prop%sw_nonhygro_ext(nswbands)) + allocate (phys_prop%sw_nonhygro_scat(nswbands)) + allocate (phys_prop%sw_nonhygro_ascat(nswbands)) + allocate (phys_prop%lw_abs(nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + if (masterproc) write (iulog, *) 'swbands', swbands + + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ! read file data + ierr = pio_inq_varid(nc_id, 'bext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'bsca_sw', sw_scat_id) + ierr = pio_inq_varid(nc_id, 'basc_sw', sw_ascat_id) + ierr = pio_inq_varid(nc_id, 'babs_lw', lw_abs_id) + + ierr = pio_get_var(nc_id, sw_ext_id, phys_prop%sw_nonhygro_ext) + ierr = pio_get_var(nc_id, sw_scat_id, phys_prop%sw_nonhygro_scat) + ierr = pio_get_var(nc_id, sw_ascat_id, phys_prop%sw_nonhygro_ascat) + ierr = pio_get_var(nc_id, lw_abs_id, phys_prop%lw_abs) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + + end subroutine volcanic_optics_init + +!================================================================================================ + + ! Read optics data of type 'hygroscopic' and interpolate it to CAM's rh mesh. + subroutine hygroscopic_optics_init(phys_prop, nc_id) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr ! error flag + + integer :: rh_idx_id, lw_band_id, sw_band_id + integer :: kbnd, krh + integer :: rh_id, sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: nbnd, swbands + + ! temp data from hygroscopic file before interpolation onto cam-rh-mesh + integer :: nfilerh ! number of rh values in file + real(r8), allocatable, dimension(:) :: frh + real(r8), allocatable, dimension(:, :) :: fsw_ext + real(r8), allocatable, dimension(:, :) :: fsw_ssa + real(r8), allocatable, dimension(:, :) :: fsw_asm + real(r8), allocatable, dimension(:, :) :: flw_abs + + real(r8) :: rh ! real rh value on cam rh mesh (indexvalue) + character(len=*), parameter :: sub = 'hygroscopic_optics_init' + !------------------------------------------------------------------------------------ + + allocate (phys_prop%sw_hygro_ext(nrh, nswbands)) + allocate (phys_prop%sw_hygro_ssa(nrh, nswbands)) + allocate (phys_prop%sw_hygro_asm(nrh, nswbands)) + allocate (phys_prop%lw_hygro_abs(nrh, nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'rh_idx', rh_idx_id) + ierr = pio_inq_dimlen(nc_id, rh_idx_id, nfilerh) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ierr = pio_inq_varid(nc_id, 'rh', rh_id) + ierr = pio_inq_varid(nc_id, 'ext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw', sw_ssa_id) + ierr = pio_inq_varid(nc_id, 'asm_sw', sw_asm_id) + ierr = pio_inq_varid(nc_id, 'abs_lw', lw_ext_id) + + ! specific optical properties on file's rh mesh + allocate (fsw_ext(nfilerh, nswbands)) + allocate (fsw_asm(nfilerh, nswbands)) + allocate (fsw_ssa(nfilerh, nswbands)) + allocate (flw_abs(nfilerh, nlwbands)) + allocate (frh(nfilerh)) + + ierr = pio_get_var(nc_id, rh_id, frh) + ierr = pio_get_var(nc_id, sw_ext_id, fsw_ext) + ierr = pio_get_var(nc_id, sw_ssa_id, fsw_ssa) + ierr = pio_get_var(nc_id, sw_asm_id, fsw_asm) + ierr = pio_get_var(nc_id, lw_ext_id, flw_abs) + + ! interpolate onto cam's rh mesh + do kbnd = 1, nswbands + do krh = 1, nrh + rh = 1.0_r8/nrh*(krh - 1) + phys_prop%sw_hygro_ext(krh, kbnd) = & + exp_interpol(frh, fsw_ext(:, kbnd)/fsw_ext(1, kbnd), rh) & + *fsw_ext(1, kbnd) + phys_prop%sw_hygro_ssa(krh, kbnd) = & + lin_interpol(frh, fsw_ssa(:, kbnd)/fsw_ssa(1, kbnd), rh) & + *fsw_ssa(1, kbnd) + phys_prop%sw_hygro_asm(krh, kbnd) = & + lin_interpol(frh, fsw_asm(:, kbnd)/fsw_asm(1, kbnd), rh) & + *fsw_asm(1, kbnd) + end do + end do + do kbnd = 1, nlwbands + do krh = 1, nrh + rh = 1.0_r8/nrh*(krh - 1) + phys_prop%lw_hygro_abs(krh, kbnd) = & + exp_interpol(frh, flw_abs(:, kbnd)/flw_abs(1, kbnd), rh) & + *flw_abs(1, kbnd) + end do + end do + + deallocate (fsw_ext, fsw_asm, fsw_ssa, flw_abs, frh) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + + end subroutine hygroscopic_optics_init + +!================================================================================================ + + ! Read optics data of type 'nonhygro' + subroutine nonhygro_optics_init(phys_prop, nc_id) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! storage for file data + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id + integer :: sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: swbands, nbnd + integer :: ierr ! error flag + !------------------------------------------------------------------------------------ + + allocate (phys_prop%sw_nonhygro_ext(nswbands)) + allocate (phys_prop%sw_nonhygro_ssa(nswbands)) + allocate (phys_prop%sw_nonhygro_asm(nswbands)) + allocate (phys_prop%lw_abs(nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ! read file data + ierr = pio_inq_varid(nc_id, 'ext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw', sw_ssa_id) + ierr = pio_inq_varid(nc_id, 'asm_sw', sw_asm_id) + ierr = pio_inq_varid(nc_id, 'abs_lw', lw_ext_id) + + ierr = pio_get_var(nc_id, sw_ext_id, phys_prop%sw_nonhygro_ext) + ierr = pio_get_var(nc_id, sw_ssa_id, phys_prop%sw_nonhygro_ssa) + ierr = pio_get_var(nc_id, sw_asm_id, phys_prop%sw_nonhygro_asm) + ierr = pio_get_var(nc_id, lw_ext_id, phys_prop%lw_abs) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + + end subroutine nonhygro_optics_init + +!================================================================================================ + + ! Read refractive indices of aerosol + subroutine refindex_aer_init(phys_prop, nc_id) + use cam_abortutils, only: endrun + use pio, only: pio_seterrorhandling + use pio, only: PIO_BCAST_ERROR, PIO_NOERR, PIO_INTERNAL_ERROR + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! storage for file data + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: i + integer :: istat1, istat2, istat3 ! status flags + integer :: vid_real, vid_im ! variable ids + real(r8), pointer :: ref_real(:), ref_im(:) ! tmp storage for components of complex index + character(len=*), parameter :: subname = 'refindex_aer_init' + !------------------------------------------------------------------------------------ + + ! assume that the dimensions lw_band and sw_band have already been checked + ! by the calling subroutine + + ! Check that the variables are present before allocating storage and reading. + ! Since we're setting complex data values, both the real and imaginary parts must + ! be present or neither will be read. + + ! set PIO to return control to the caller when variable not found + call pio_seterrorhandling(nc_id, PIO_BCAST_ERROR) + + istat1 = pio_inq_varid(nc_id, 'refindex_real_aer_sw', vid_real) + istat2 = pio_inq_varid(nc_id, 'refindex_im_aer_sw', vid_im) + + if (istat1 == PIO_NOERR .and. istat2 == PIO_NOERR) then + + allocate (ref_real(nswbands), ref_im(nswbands)) + + istat3 = pio_get_var(nc_id, vid_real, ref_real) + if (istat3 /= PIO_NOERR) then + call endrun(subname//': ERROR reading refindex_real_aer_sw') + end if + + istat3 = pio_get_var(nc_id, vid_im, ref_im) + if (istat3 /= PIO_NOERR) then + call endrun(subname//': ERROR reading refindex_im_aer_sw') + end if + + ! successfully read refindex data -- set complex values in physprop object + allocate (phys_prop%refindex_aer_sw(nswbands)) + do i = 1, nswbands + phys_prop%refindex_aer_sw(i) = cmplx(ref_real(i), abs(ref_im(i)), & + kind=r8) + end do + + deallocate (ref_real, ref_im) + + end if + + istat1 = pio_inq_varid(nc_id, 'refindex_real_aer_lw', vid_real) + istat2 = pio_inq_varid(nc_id, 'refindex_im_aer_lw', vid_im) + + if (istat1 == PIO_NOERR .and. istat2 == PIO_NOERR) then + + allocate (ref_real(nlwbands), ref_im(nlwbands)) + + istat3 = pio_get_var(nc_id, vid_real, ref_real) + if (istat3 /= PIO_NOERR) then + call endrun(subname//': ERROR reading refindex_real_aer_lw') + end if + + istat3 = pio_get_var(nc_id, vid_im, ref_im) + if (istat3 /= PIO_NOERR) then + call endrun(subname//': ERROR reading refindex_im_aer_lw') + end if + + ! successfully read refindex data -- set complex value in physprop object + allocate (phys_prop%refindex_aer_lw(nlwbands)) + do i = 1, nlwbands + phys_prop%refindex_aer_lw(i) = cmplx(ref_real(i), abs(ref_im(i)), & + kind=r8) + end do + + deallocate (ref_real, ref_im) + + end if + + ! reset PIO to handle errors internally + call pio_seterrorhandling(nc_id, PIO_INTERNAL_ERROR) + + end subroutine refindex_aer_init + +!================================================================================================ + + ! Read optics data for modal aerosols + subroutine modal_optics_init(props, ncid) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: props ! storage for file data + type(file_desc_t), intent(inout) :: ncid ! indentifier for netcdf file + + ! Local variables + integer :: ierr + integer :: did + integer :: ival + type(var_desc_t) :: vid + real(r8), pointer :: rval(:, :, :, :, :) ! temp array used to eliminate a singleton dimension + + character(len=*), parameter :: subname = 'modal_optics_init' + !------------------------------------------------------------------------------------ + + ! Check dimensions for number of lw and sw bands + + ierr = pio_inq_dimid(ncid, 'lw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nlwbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of lw bands') + + ierr = pio_inq_dimid(ncid, 'sw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nswbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of sw bands') + + ! Get other dimensions + ierr = pio_inq_dimid(ncid, 'coef_number', did) + ierr = pio_inq_dimlen(ncid, did, props%ncoef) + + ierr = pio_inq_dimid(ncid, 'refindex_real', did) + ierr = pio_inq_dimlen(ncid, did, props%prefr) + + ierr = pio_inq_dimid(ncid, 'refindex_im', did) + ierr = pio_inq_dimlen(ncid, did, props%prefi) + + ! Allocate arrays + allocate ( & + props%extpsw(props%ncoef, props%prefr, props%prefi, nswbands), & + props%abspsw(props%ncoef, props%prefr, props%prefi, nswbands), & + props%asmpsw(props%ncoef, props%prefr, props%prefi, nswbands), & + props%absplw(props%ncoef, props%prefr, props%prefi, nlwbands), & + props%refrtabsw(props%prefr, nswbands), & + props%refitabsw(props%prefi, nswbands), & + props%refrtablw(props%prefr, nlwbands), & + props%refitablw(props%prefi, nlwbands)) + + ! allocate temp to remove the mode dimension from the sw variables + allocate (rval(props%ncoef, props%prefr, props%prefi, 1, nswbands)) + + ierr = pio_inq_varid(ncid, 'extpsw', vid) + ierr = pio_get_var(ncid, vid, rval) + props%extpsw = rval(:, :, :, 1, :) + + ierr = pio_inq_varid(ncid, 'abspsw', vid) + ierr = pio_get_var(ncid, vid, rval) + props%abspsw = rval(:, :, :, 1, :) + + ierr = pio_inq_varid(ncid, 'asmpsw', vid) + ierr = pio_get_var(ncid, vid, rval) + props%asmpsw = rval(:, :, :, 1, :) + + deallocate (rval) + + ! allocate temp to remove the mode dimension from the lw variables + allocate (rval(props%ncoef, props%prefr, props%prefi, 1, nlwbands)) + + ierr = pio_inq_varid(ncid, 'absplw', vid) + ierr = pio_get_var(ncid, vid, rval) + props%absplw = rval(:, :, :, 1, :) + + deallocate (rval) + + ierr = pio_inq_varid(ncid, 'refindex_real_sw', vid) + ierr = pio_get_var(ncid, vid, props%refrtabsw) + + ierr = pio_inq_varid(ncid, 'refindex_im_sw', vid) + ierr = pio_get_var(ncid, vid, props%refitabsw) + + ierr = pio_inq_varid(ncid, 'refindex_real_lw', vid) + ierr = pio_get_var(ncid, vid, props%refrtablw) + + ierr = pio_inq_varid(ncid, 'refindex_im_lw', vid) + ierr = pio_get_var(ncid, vid, props%refitablw) + + ierr = pio_inq_varid(ncid, 'sigmag', vid) + ierr = pio_get_var(ncid, vid, props%sigmag) + + ierr = pio_inq_varid(ncid, 'dgnum', vid) + ierr = pio_get_var(ncid, vid, props%dgnum) + + ierr = pio_inq_varid(ncid, 'dgnumlo', vid) + ierr = pio_get_var(ncid, vid, props%dgnumlo) + + ierr = pio_inq_varid(ncid, 'dgnumhi', vid) + ierr = pio_get_var(ncid, vid, props%dgnumhi) + + ierr = pio_inq_varid(ncid, 'rhcrystal', vid) + ierr = pio_get_var(ncid, vid, props%rhcrystal) + + ierr = pio_inq_varid(ncid, 'rhdeliques', vid) + ierr = pio_get_var(ncid, vid, props%rhdeliques) + + end subroutine modal_optics_init + +!================================================================================================ + + ! Read optics data for sectional aerosols + subroutine bin_optics_init(props, ncid) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: props ! storage for file data + type(file_desc_t), intent(inout) :: ncid ! indentifier for netcdf file + + ! Local variables + integer :: ierr + integer :: did + integer :: ival + type(var_desc_t) :: vid + + character(len=*), parameter :: subname = 'bin_optics_init' + !------------------------------------------------------------------------------------ + + ! Check dimensions for number of lw and sw bands + + ierr = pio_inq_dimid(ncid, 'lw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nlwbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of lw bands') + + ierr = pio_inq_dimid(ncid, 'sw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nswbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of sw bands') + + ! Get other dimensions + ierr = pio_inq_dimid(ncid, 'corefrac', did) + ierr = pio_inq_dimlen(ncid, did, props%nfrac) + + ! Allocate arrays + allocate ( & + props%extpsw2(props%nfrac, nswbands), & + props%abspsw2(props%nfrac, nswbands), & + props%asmpsw2(props%nfrac, nswbands), & + props%absplw2(props%nfrac, nlwbands), & + props%corefrac(props%nfrac)) + + ierr = pio_inq_varid(ncid, 'extpsw2', vid) + ierr = pio_get_var(ncid, vid, props%extpsw2) + + ierr = pio_inq_varid(ncid, 'abspsw2', vid) + ierr = pio_get_var(ncid, vid, props%abspsw2) + + ierr = pio_inq_varid(ncid, 'asmpsw2', vid) + ierr = pio_get_var(ncid, vid, props%asmpsw2) + + ierr = pio_inq_varid(ncid, 'absplw2', vid) + ierr = pio_get_var(ncid, vid, props%absplw2) + + ierr = pio_inq_varid(ncid, 'corefrac', vid) + ierr = pio_get_var(ncid, vid, props%corefrac) + + end subroutine bin_optics_init + +!================================================================================================ + + ! Read optics data for sectional aerosols + subroutine bindef_optics_init(props, ncid) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: props ! storage for file data + type(file_desc_t), intent(inout) :: ncid ! indentifier for netcdf file + + ! Local variables + integer :: ierr + integer :: did + integer :: ival + type(var_desc_t) :: vid + + character(len=*), parameter :: subname = 'bindef_optics_init' + !------------------------------------------------------------------------------------ + + ! Check dimensions for number of lw and sw bands + + ierr = pio_inq_dimid(ncid, 'lw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nlwbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of lw bands') + + ierr = pio_inq_dimid(ncid, 'sw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nswbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of sw bands') + + ierr = pio_inq_varid(ncid, 'density', vid) + ierr = pio_get_var(ncid, vid, props%density_aer) + + ierr = pio_inq_varid(ncid, 'hygroscopicity', vid) + ierr = pio_get_var(ncid, vid, props%hygro_aer) + + ! read refractive index data if available + call refindex_aer_init(props, ncid) + + end subroutine bindef_optics_init + +!================================================================================================ + + ! Read properties for bulk aerosols + subroutine bulk_props_init(physprop, nc_id) + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: physprop ! storage for file data + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr + type(var_desc_t) :: vid + + character(len=*), parameter :: subname = 'bulk_props_init' + !------------------------------------------------------------------------------------ + + ! read microphys + ierr = pio_inq_varid(nc_id, 'name', vid) + ierr = pio_get_var(nc_id, vid, physprop%aername) + + ! use GLC function to remove trailing nulls and blanks. + ! physprop%aername = aername_str(:GLC(aername_str)) + + ierr = pio_inq_varid(nc_id, 'density', vid) + ierr = pio_get_var(nc_id, vid, physprop%density_aer) + + ierr = pio_inq_varid(nc_id, 'sigma_logr', vid) + ierr = pio_get_var(nc_id, vid, physprop%dispersion_aer) + + ierr = pio_inq_varid(nc_id, 'dryrad', vid) + ierr = pio_get_var(nc_id, vid, physprop%dryrad_aer) + + ierr = pio_inq_varid(nc_id, 'hygroscopicity', vid) + ierr = pio_get_var(nc_id, vid, physprop%hygro_aer) + + ierr = pio_inq_varid(nc_id, 'num_to_mass_ratio', vid) + ierr = pio_get_var(nc_id, vid, physprop%num_to_mass_aer) + + ! Output select data to log file + ! if (debug .and. masterproc .and. idx_sw_diag > 0) then + ! if (trim(physprop%aername) == 'SULFATE') then + ! write (iulog, '(2x, a)') '_______ hygroscopic growth in visible band _______' + ! call aer_optics_log_rh('SO4', physprop%sw_hygro_ext(:, idx_sw_diag), & + ! physprop%sw_hygro_ssa(:, idx_sw_diag), physprop%sw_hygro_asm(:, idx_sw_diag)) + ! end if + ! write (iulog, *) subname//': finished for ', trim(physprop%aername) + ! end if + + end subroutine bulk_props_init + +!================================================================================================ + + ! Purpose: + ! interpolates f(x) to point y + ! assuming f(x) = f(x0) exp a(x - x0) + ! where a = ( ln f(x1) - ln f(x0) ) / (x1 - x0) + ! x0 <= x <= x1 + ! assumes x is monotonically increasing + ! Author: D. Fillmore + function exp_interpol(x, f, y) result(g) + real(r8), intent(in), dimension(:) :: x ! grid points + real(r8), intent(in), dimension(:) :: f ! grid function values + real(r8), intent(in) :: y ! interpolation point + real(r8) :: g ! interpolated function value + + integer :: k ! interpolation point index + integer :: n ! length of x + real(r8) :: a + + n = size(x) + + ! find k such that x(k) < y =< x(k+1) + ! set k = 1 if y <= x(1) and k = n-1 if y > x(n) + + if (y <= x(1)) then + k = 1 + else if (y >= x(n)) then + k = n - 1 + else + k = 1 + do while (y > x(k + 1) .and. k < n) + k = k + 1 + end do + end if + + ! interpolate + a = (log(f(k + 1)/f(k)))/(x(k + 1) - x(k)) + g = f(k)*exp(a*(y - x(k))) + return + end function exp_interpol + +!================================================================================================ + + ! Purpose: + ! interpolates f(x) to point y + ! assuming f(x) = f(x0) + a * (x - x0) + ! where a = ( f(x1) - f(x0) ) / (x1 - x0) + ! x0 <= x <= x1 + ! assumes x is monotonically increasing + ! Author: D. Fillmore + pure function lin_interpol(x, f, y) result(g) + real(r8), intent(in), dimension(:) :: x ! grid points + real(r8), intent(in), dimension(:) :: f ! grid function values + real(r8), intent(in) :: y ! interpolation point + real(r8) :: g ! interpolated function value + + integer :: k ! interpolation point index + integer :: n ! length of x + real(r8) :: a + + n = size(x) + + ! find k such that x(k) < y =< x(k+1) + ! set k = 1 if y <= x(1) and k = n-1 if y > x(n) + if (y <= x(1)) then + k = 1 + else if (y >= x(n)) then + k = n - 1 + else + k = 1 + do while (y > x(k + 1) .and. k < n) + k = k + 1 + end do + end if + + ! interpolate + a = (f(k + 1) - f(k))/(x(k + 1) - x(k)) + g = f(k) + a*(y - x(k)) + return + end function lin_interpol + +!================================================================================================ + + ! Write aerosol optical constants to log file + ! Author: D. Fillmore + subroutine aer_optics_log(name, ext, ssa, asm) + use cam_logfile, only: iulog + + character(len=*), intent(in) :: name + real(r8), intent(in) :: ext(:) + real(r8), intent(in) :: ssa(:) + real(r8), intent(in) :: asm(:) + + integer :: kbnd, nbnd + + nbnd = ubound(ext, 1) + + write (iulog, '(2x, a)') name + write (iulog, '(2x, a, 4x, a, 4x, a, 4x, a)') 'SW band', 'ext (m^2 kg^-1)', ' ssa', ' asm' + do kbnd = 1, nbnd + write (iulog, '(2x, i7, 4x, f13.2, 4x, f4.2, 4x, f4.2)') kbnd, ext(kbnd), ssa(kbnd), asm(kbnd) + end do + + end subroutine aer_optics_log + +!================================================================================================ + + ! Write out aerosol optical properties for a set of test rh values + ! to test hygroscopic growth interpolation + ! Author: D. Fillmore + subroutine aer_optics_log_rh(name, ext, ssa, asm) + use cam_logfile, only: iulog + + character(len=*), intent(in) :: name + real(r8), intent(in) :: ext(nrh) + real(r8), intent(in) :: ssa(nrh) + real(r8), intent(in) :: asm(nrh) + + integer :: krh_test + integer, parameter :: nrh_test = 36 + integer :: krh + real(r8) :: rh + real(r8) :: rh_test(nrh_test) + real(r8) :: exti + real(r8) :: ssai + real(r8) :: asmi + real(r8) :: wrh + !------------------------------------------------------------------------------------ + + do krh_test = 1, nrh_test + rh_test(krh_test) = sqrt(sqrt(sqrt(sqrt(((krh_test - 1.0_r8)/(nrh_test - 1)))))) + end do + write (iulog, '(2x, a)') name + write (iulog, '(2x, a, 4x, a, 4x, a, 4x, a)') ' rh', 'ext (m^2 kg^-1)', ' ssa', ' asm' + + ! loop through test rh values + do krh_test = 1, nrh_test + ! find corresponding rh index + rh = rh_test(krh_test) + krh = min(floor((rh)*nrh) + 1, nrh - 1) + wrh = (rh)*nrh - krh + exti = ext(krh + 1)*(wrh + 1) - ext(krh)*wrh + ssai = ssa(krh + 1)*(wrh + 1) - ssa(krh)*wrh + asmi = asm(krh + 1)*(wrh + 1) - asm(krh)*wrh + write (iulog, '(2x, f5.3, 4x, f13.3, 4x, f5.3, 4x, f5.3)') rh_test(krh_test), exti, ssai, asmi + end do + + end subroutine aer_optics_log_rh + +!================================================================================================ + + ! Read optics data of type 'hygroscopic_coreshell' and interpolate it to CAM's rh mesh. + subroutine hygroscopic_coreshell_optics_init(phys_prop, nc_id) + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr ! error flag + + integer :: rh_id, lw_band_id, sw_band_id, coreshell_id, dstbc_id, kap_id + integer :: sw_ext_id, sw_ssa_id, sw_asm_id, lw_abs_id + integer :: nbnd, swbands, did + + ! temp data from hygroscopic file before interpolation onto cam-rh-mesh + integer :: nrh ! number of rh values in file + integer :: nfrac ! number of core/shell ratio values in file + integer :: nbcdust, nkap + + real(r8) :: rh ! real rh value on cam rh mesh (indexvalue) + character(len=*), parameter :: sub = 'hygroscopic_coreshell_optics_init' + !------------------------------------------------------------------------------------ + + if (masterproc) then + write (iulog, *) sub//': Read file '//trim(phys_prop%sourcefile) + end if + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + if (nbnd .ne. nlwbands) call endrun(trim(phys_prop%sourcefile)// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + if (swbands .ne. nswbands) call endrun(trim(phys_prop%sourcefile)// & + ' has the wrong number of sw bands') + + ierr = pio_inq_dimid(nc_id, 'coreshellratio', did) + ierr = pio_inq_dimlen(nc_id, did, phys_prop%nfrac) + + ierr = pio_inq_dimid(nc_id, 'dstbcratio', did) + ierr = pio_inq_dimlen(nc_id, did, phys_prop%nbcdust) + + ierr = pio_inq_dimid(nc_id, 'kap', did) + ierr = pio_inq_dimlen(nc_id, did, phys_prop%nkap) + + ierr = pio_inq_dimid(nc_id, 'rh_idx', rh_id) + ierr = pio_inq_dimlen(nc_id, rh_id, phys_prop%nrelh) + + allocate (phys_prop%sw_hygro_coreshell_ext(phys_prop%nrelh, nswbands, & + phys_prop%nfrac, phys_prop%nbcdust, phys_prop%nkap)) + allocate (phys_prop%sw_hygro_coreshell_ssa(phys_prop%nrelh, nswbands, & + phys_prop%nfrac, phys_prop%nbcdust, phys_prop%nkap)) + allocate (phys_prop%sw_hygro_coreshell_asm(phys_prop%nrelh, nswbands, & + phys_prop%nfrac, phys_prop%nbcdust, phys_prop%nkap)) + allocate (phys_prop%lw_hygro_coreshell_abs(phys_prop%nrelh, nlwbands, & + phys_prop%nfrac, phys_prop%nbcdust, phys_prop%nkap)) + allocate (phys_prop%corefrac(phys_prop%nfrac)) + allocate (phys_prop%bcdust(phys_prop%nbcdust)) + allocate (phys_prop%kap(phys_prop%nkap)) + allocate (phys_prop%relh(phys_prop%nrelh)) + + ierr = pio_inq_varid(nc_id, 'rh', rh_id) + ierr = pio_inq_varid(nc_id, 'coreshellratio', coreshell_id) ! modified by Pengfei for coreshell + ierr = pio_inq_varid(nc_id, 'dstbcratio', dstbc_id) ! modified by Pengfei for coreshell + ierr = pio_inq_varid(nc_id, 'kap', kap_id) + + ierr = pio_inq_varid(nc_id, 'ext_sw_coreshell', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw_coreshell', sw_ssa_id) + ierr = pio_inq_varid(nc_id, 'asm_sw_coreshell', sw_asm_id) + ierr = pio_inq_varid(nc_id, 'abs_lw_coreshell', lw_abs_id) + + ierr = pio_get_var(nc_id, sw_ext_id, phys_prop%sw_hygro_coreshell_ext) + ierr = pio_get_var(nc_id, sw_ssa_id, phys_prop%sw_hygro_coreshell_ssa) + ierr = pio_get_var(nc_id, sw_asm_id, phys_prop%sw_hygro_coreshell_asm) + ierr = pio_get_var(nc_id, lw_abs_id, phys_prop%lw_hygro_coreshell_abs) + ierr = pio_get_var(nc_id, kap_id, phys_prop%kap) + ierr = pio_get_var(nc_id, rh_id, phys_prop%relh) + ierr = pio_get_var(nc_id, dstbc_id, phys_prop%bcdust) + ierr = pio_get_var(nc_id, coreshell_id, phys_prop%corefrac) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + end subroutine hygroscopic_coreshell_optics_init + +!================================================================================================ + + ! Read optics data of type 'hygroscopic' and interpolate it to CAM's rh mesh. + subroutine hygroscopic_wtp_optics_init(phys_prop, nc_id) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + + type(physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr ! error flag + + integer :: lw_band_id, sw_band_id, did + integer :: sw_ext_wtp_id, sw_ssa_wtp_id, sw_asm_wtp_id, lw_ext_wtp_id, wtp_id + integer :: nbnd, swbands + + real(r8) :: rh ! real rh value on cam rh mesh (indexvalue) + character(len=*), parameter :: sub = 'hygroscopic_wtp_optics_init' + + ! Get other dimensions + ierr = pio_inq_dimid(nc_id, 'wgtpct', did) + ierr = pio_inq_dimlen(nc_id, did, phys_prop%nwtp) + + allocate (phys_prop%sw_hygro_ext_wtp(phys_prop%nwtp, nswbands)) + allocate (phys_prop%sw_hygro_ssa_wtp(phys_prop%nwtp, nswbands)) + allocate (phys_prop%sw_hygro_asm_wtp(phys_prop%nwtp, nswbands)) + allocate (phys_prop%lw_hygro_abs_wtp(phys_prop%nwtp, nlwbands)) + allocate (phys_prop%wgtpct(phys_prop%nwtp)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ierr = pio_inq_varid(nc_id, 'ext_sw_wtp', sw_ext_wtp_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw_wtp', sw_ssa_wtp_id) + ierr = pio_inq_varid(nc_id, 'asm_sw_wtp', sw_asm_wtp_id) + ierr = pio_inq_varid(nc_id, 'abs_lw_wtp', lw_ext_wtp_id) + ierr = pio_inq_varid(nc_id, 'wgtpct', wtp_id) + + ierr = pio_get_var(nc_id, sw_ext_wtp_id, phys_prop%sw_hygro_ext_wtp) + ierr = pio_get_var(nc_id, sw_ssa_wtp_id, phys_prop%sw_hygro_ssa_wtp) + ierr = pio_get_var(nc_id, sw_asm_wtp_id, phys_prop%sw_hygro_asm_wtp) + ierr = pio_get_var(nc_id, lw_ext_wtp_id, phys_prop%lw_hygro_abs_wtp) + ierr = pio_get_var(nc_id, wtp_id, phys_prop%wgtpct) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + + end subroutine hygroscopic_wtp_optics_init + +end module phys_prop diff --git a/src/aerosol/aerosol_properties_mod.F90 b/src/aerosol/aerosol_properties_mod.F90 new file mode 100644 index 000000000..db2f74022 --- /dev/null +++ b/src/aerosol/aerosol_properties_mod.F90 @@ -0,0 +1,928 @@ +module aerosol_properties_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private + + public :: aerosol_properties + + !> aerosol_properties 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_properties class to define the details of their configuration. Any + !! package must implement each of the deferred procedures of the abstract + !! aerosol_properties class, may include additional private data members and + !! type-bound procedures, and may override functions of the abstract class. + !! + !! Please see the modal_aerosol_properties module for an example of how the + !! aerosol_properties class can be extended for a specific aerosol package. + type, abstract :: aerosol_properties + private + integer :: nbins_ = 0 ! number of aerosol bins + integer :: ncnst_tot_ = 0 ! total number of constituents + integer, allocatable :: nmasses_(:) ! number of species masses + integer, allocatable :: nspecies_(:) ! number of species + integer, allocatable :: indexer_(:,:) ! unique indices of the aerosol elements + real(r8), allocatable :: alogsig_(:) ! natural log of geometric deviation of the number distribution for aerosol bin + real(r8), allocatable :: f1_(:) ! eq 28 Abdul-Razzak et al 1998 + real(r8), allocatable :: f2_(:) ! eq 29 Abdul-Razzak et al 1998 + real(r8), allocatable :: dgnum_(:) ! geometric mean diameter (m) + real(r8), allocatable :: dgnumhi_(:) ! upper bound diameter (m) + real(r8), allocatable :: dgnumlo_(:) ! lower bound diameter (m) + real(r8), allocatable :: rhcrystal_(:) ! crystallization RH + real(r8), allocatable :: rhdeliques_(:) ! deliquescence RH + ! Abdul-Razzak, H., S.J. Ghan, and C. Rivera-Carpio, A parameterization of aerosol activation, + ! 1, Singleaerosoltype. J. Geophys. Res., 103, 6123-6132, 1998. + real(r8) :: soa_equivso4_factor_ = -huge(1._r8) + real(r8) :: pom_equivso4_factor_ = -huge(1._r8) + integer, public :: list_idx_ = 0 ! radiation list index (0=climate) + contains + procedure :: list_idx => get_list_idx + procedure :: initialize => aero_props_init + procedure :: nbins => get_nbins + procedure :: ncnst_tot + procedure,private :: nspecies_per_bin + procedure,private :: nspecies_all_bins + generic :: nspecies => nspecies_all_bins,nspecies_per_bin + procedure,private :: n_masses_all_bins + procedure,private :: n_masses_per_bin + generic :: nmasses => n_masses_all_bins,n_masses_per_bin + procedure :: indexer + procedure :: maxsat + procedure(aero_amcube), deferred :: amcube + procedure :: alogsig => get_alogsig + procedure :: dgnum => get_dgnum + procedure :: dgnumhi => get_dgnumhi + procedure :: dgnumlo => get_dgnumlo + procedure :: rhcrystal => get_rhcrystal + procedure :: rhdeliques => get_rhdeliques + procedure(aero_number_transported), deferred :: number_transported + procedure(aero_props_get), deferred :: get + procedure(aero_actfracs), deferred :: actfracs + procedure(aero_num_names), deferred :: num_names + procedure(aero_mmr_names), deferred :: mmr_names + procedure(aero_amb_num_name), deferred :: amb_num_name + procedure(aero_amb_mmr_name), deferred :: amb_mmr_name + procedure(aero_species_type), deferred :: species_type + procedure(aero_icenuc_updates_num), deferred :: icenuc_updates_num + procedure(aero_icenuc_updates_mmr), deferred :: icenuc_updates_mmr + procedure(aero_apply_num_limits), deferred :: apply_number_limits + procedure(aero_hetfrz_species), deferred :: hetfrz_species + procedure :: soa_equivso4_factor ! SOA Hygroscopicity / Sulfate Hygroscopicity + procedure :: pom_equivso4_factor ! POM Hygroscopicity / Sulfate Hygroscopicity + procedure(aero_soluble), deferred :: soluble + procedure(aero_min_mass_mean_rad), deferred :: min_mass_mean_rad + procedure :: optics_params + procedure(aero_physprop_id), deferred :: physprop_id + procedure(aero_bin_name), deferred :: bin_name + procedure(aero_scav_diam), deferred :: scav_diam + procedure(aero_resuspension_resize), deferred :: resuspension_resize + procedure(aero_rebin_bulk_fluxes), deferred :: rebin_bulk_fluxes + procedure(aero_hydrophilic), deferred :: hydrophilic + procedure(aero_id_query), deferred :: model_is + + procedure :: final => aero_props_final + end type aerosol_properties + + integer, public, parameter :: aero_name_len = 32 ! common length of aerosols names, species, etc + + abstract interface + + !------------------------------------------------------------------------------ + ! returns number of transported aerosol constituents + !------------------------------------------------------------------------------ + integer function aero_number_transported(self) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + end function aero_number_transported + + !------------------------------------------------------------------------ + ! returns aerosol properties: + ! density + ! hygroscopicity + ! species type + ! species name + ! short wave species refractive indices + ! long wave species refractive indices + ! species morphology + !------------------------------------------------------------------------ + subroutine aero_props_get(self, bin_ndx, species_ndx, density, hygro, spec_mw, & + spectype, specname, specmorph, refindex_sw, refindex_lw, num_to_mass_aer, & + dryrad) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: species_ndx ! species index + real(r8), optional, intent(out) :: density ! density (kg/m3) + real(r8), optional, intent(out) :: hygro ! hygroscopicity + real(r8), optional, intent(out) :: spec_mw ! species molecular weight + character(len=*), optional, intent(out) :: spectype ! species type + character(len=*), optional, intent(out) :: specname ! species name + character(len=*), optional, intent(out) :: specmorph ! species morphology + complex(r8), pointer, optional, intent(out) :: refindex_sw(:) ! short wave species refractive indices + complex(r8), pointer, optional, intent(out) :: refindex_lw(:) ! long wave species refractive indices + real(r8), optional, intent(out) :: num_to_mass_aer ! ratio of number to mass concentration + real(r8), optional, intent(out) :: dryrad ! dry radius (m) + + end subroutine aero_props_get + + !------------------------------------------------------------------------ + ! returns the physprop ID for a given bin index + !------------------------------------------------------------------------ + integer function aero_physprop_id(self, bin_ndx) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + end function aero_physprop_id + + !------------------------------------------------------------------------ + ! returns species type + !------------------------------------------------------------------------ + subroutine aero_species_type(self, bin_ndx, species_ndx, spectype) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: spectype ! species type + + end subroutine aero_species_type + + !------------------------------------------------------------------------ + ! returns mass and number activation fractions + !------------------------------------------------------------------------ + subroutine aero_actfracs(self, bin_ndx, smc, smax, fn, fm ) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8),intent(in) :: smc ! critical supersaturation for particles of bin radius + real(r8),intent(in) :: smax ! maximum supersaturation for multiple competing aerosols + real(r8),intent(out) :: fn ! activation fraction for aerosol number + real(r8),intent(out) :: fm ! activation fraction for aerosol mass + + end subroutine aero_actfracs + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine aero_num_names(self, bin_ndx, name_a, name_c) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol number dens + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol number dens + end subroutine aero_num_names + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine aero_mmr_names(self, bin_ndx, species_ndx, name_a, name_c) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol MMR + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol MMR + end subroutine aero_mmr_names + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine aero_amb_num_name(self, bin_ndx, name) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens + + end subroutine aero_amb_num_name + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine aero_amb_mmr_name(self, bin_ndx, species_ndx, name) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR + + end subroutine aero_amb_mmr_name + + !------------------------------------------------------------------------------ + ! returns radius^3 (m3) of a given bin number + !------------------------------------------------------------------------------ + pure elemental real(r8) function aero_amcube(self, bin_ndx, volconc, numconc) + import :: aerosol_properties, r8 + + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(in) :: volconc ! volume conc (m3/m3) + real(r8), intent(in) :: numconc ! number conc (1/m3) + + end function aero_amcube + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to given aerosol bin number + !------------------------------------------------------------------------------ + function aero_icenuc_updates_num(self, bin_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + logical :: res + + end function aero_icenuc_updates_num + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to a given species within a bin + !------------------------------------------------------------------------------ + function aero_icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + logical :: res + + end function aero_icenuc_updates_mmr + + !------------------------------------------------------------------------------ + ! apply max / min to number concentration + !------------------------------------------------------------------------------ + subroutine aero_apply_num_limits( self, naerosol, vaerosol, ncol, nlev, m ) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:,:) ! number conc (1/m3) + real(r8), intent(in) :: vaerosol(:,:) ! volume conc (m3/m3) + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vert levels + integer, intent(in) :: m ! mode or bin index + + end subroutine aero_apply_num_limits + + !------------------------------------------------------------------------------ + ! returns TRUE if species `spc_ndx` in aerosol subset `bin_ndx` contributes to + ! the particles' ability to act as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function aero_hetfrz_species(self, bin_ndx, spc_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: spc_ndx ! species number + + logical :: res + + end function aero_hetfrz_species + + !------------------------------------------------------------------------------ + ! returns minimum mass mean radius (meters) + !------------------------------------------------------------------------------ + function aero_min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + real(r8) :: minrad ! meters + + end function aero_min_mass_mean_rad + + !------------------------------------------------------------------------------ + ! returns TRUE if soluble + !------------------------------------------------------------------------------ + logical function aero_soluble(self,bin_ndx) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + end function aero_soluble + + !------------------------------------------------------------------------------ + ! returns name for a given aerosol bin + !------------------------------------------------------------------------------ + function aero_bin_name(self, bin_ndx) result(name) + import :: aerosol_properties, r8, aero_name_len + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + character(len=aero_name_len) :: name + + end function aero_bin_name + + !------------------------------------------------------------------------------ + ! returns scavenging diameter for a given aerosol bin number + !------------------------------------------------------------------------------ + function aero_scav_diam(self, bin_ndx) result(diam) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: diam + + end function aero_scav_diam + + !------------------------------------------------------------------------------ + ! adjust aerosol concentration tendencies to create larger sizes of aerosols + ! during resuspension + !------------------------------------------------------------------------------ + subroutine aero_resuspension_resize(self, dcondt) + import :: aerosol_properties, r8 + + class(aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + + end subroutine aero_resuspension_resize + + !------------------------------------------------------------------------------ + ! returns bulk deposition fluxes of the specified species type + ! rebinned to specified diameter limits + !------------------------------------------------------------------------------ + subroutine aero_rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, & + error_code, error_string) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + character(len=*),intent(in) :: bulk_type ! aerosol type to rebin + real(r8), intent(in) :: dep_fluxes(:) ! kg/m2 + real(r8), intent(in) :: diam_edges(:) ! meters + real(r8), intent(out) :: bulk_fluxes(:) ! kg/m2 + integer, intent(out) :: error_code ! error code (0 if no error) + character(len=*), intent(out) :: error_string ! error string + + end subroutine aero_rebin_bulk_fluxes + + !------------------------------------------------------------------------------ + ! Returns TRUE if bin is hydrophilic, otherwise FALSE + !------------------------------------------------------------------------------ + logical function aero_hydrophilic(self, bin_ndx) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + end function aero_hydrophilic + + !------------------------------------------------------------------------------ + ! Returns TRUE if the aerosol model matches the query, otherwise FALSE + !------------------------------------------------------------------------------ + logical function aero_id_query(self, query) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query + end function aero_id_query + + end interface + +contains + + !------------------------------------------------------------------------------ + ! object initializer + !------------------------------------------------------------------------------ + subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ierr, list_idx, & + dgnum, dgnumhi, dgnumlo, rhcrystal, rhdeliques) + class(aerosol_properties), intent(inout) :: self + integer, intent(in) :: nbin ! number of bins + integer, intent(in) :: ncnst ! total number of constituents + integer, intent(in) :: nspec(nbin) ! number of species in each bin + integer, intent(in) :: nmasses(nbin) ! number of masses in each bin + real(r8),intent(in) :: alogsig(nbin) ! natural log of the standard deviation (sigma) of the aerosol bins + real(r8),intent(in) :: f1(nbin) ! eq 28 Abdul-Razzak et al 1998 + real(r8),intent(in) :: f2(nbin) ! eq 29 Abdul-Razzak et al 1998 + integer,intent(out) :: ierr + integer, optional, intent(in) :: list_idx ! radiation list index (0=climate) + real(r8), optional, intent(in) :: dgnum(nbin) ! geometric mean diameter (m) + real(r8), optional, intent(in) :: dgnumhi(nbin) ! upper bound diameter (m) + real(r8), optional, intent(in) :: dgnumlo(nbin) ! lower bound diameter (m) + real(r8), optional, intent(in) :: rhcrystal(nbin) ! crystallization RH + real(r8), optional, intent(in) :: rhdeliques(nbin) ! deliquescence RH + + integer :: imas,ibin,indx + character(len=*),parameter :: prefix = 'aerosol_properties::aero_props_init: ' + + real(r8), parameter :: spechygro_so4 = 0.507_r8 ! Sulfate hygroscopicity + real(r8), parameter :: spechygro_soa = 0.14_r8 ! SOA hygroscopicity + real(r8), parameter :: spechygro_pom = 0.1_r8 ! POM hygroscopicity + + ierr = 0 + + allocate(self%nspecies_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%nmasses_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%alogsig_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%f1_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%f2_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + if (present(dgnum)) then + allocate(self%dgnum_(nbin),stat=ierr) + if( ierr /= 0 ) return + end if + if (present(dgnumhi)) then + allocate(self%dgnumhi_(nbin),stat=ierr) + if( ierr /= 0 ) return + end if + if (present(dgnumlo)) then + allocate(self%dgnumlo_(nbin),stat=ierr) + if( ierr /= 0 ) return + end if + if (present(rhcrystal)) then + allocate(self%rhcrystal_(nbin),stat=ierr) + if( ierr /= 0 ) return + end if + if (present(rhdeliques)) then + allocate(self%rhdeliques_(nbin),stat=ierr) + if( ierr /= 0 ) return + end if + + allocate( self%indexer_(nbin,0:maxval(nmasses)),stat=ierr ) + if( ierr /= 0 ) then + return + end if + + ! Local indexing compresses the mode and number/mass indices into one index. + ! This indexing is used by the pointer arrays used to reference state and pbuf + ! fields. We add number = 0, total mass = 1 (if available), and mass from each + ! constituency into mm. + + self%indexer_ = -1 + indx = 0 + + do ibin=1,nbin + do imas = 0,nmasses(ibin) + indx = indx+1 + self%indexer_(ibin,imas) = indx + end do + end do + + self%nbins_ = nbin + self%ncnst_tot_ = ncnst + self%nmasses_(:) = nmasses(:) + self%nspecies_(:) = nspec(:) + self%alogsig_(:) = alogsig(:) + self%f1_(:) = f1(:) + self%f2_(:) = f2(:) + + if (present(dgnum)) then + self%dgnum_(:) = dgnum(:) + end if + if (present(dgnumhi)) then + self%dgnumhi_(:) = dgnumhi(:) + end if + if (present(dgnumlo)) then + self%dgnumlo_(:) = dgnumlo(:) + end if + if (present(rhcrystal)) then + self%rhcrystal_(:) = rhcrystal(:) + end if + if (present(rhdeliques)) then + self%rhdeliques_(:) = rhdeliques(:) + end if + + self%soa_equivso4_factor_ = spechygro_soa/spechygro_so4 + self%pom_equivso4_factor_ = spechygro_pom/spechygro_so4 + + if (present(list_idx)) then + self%list_idx_ = list_idx + else + self%list_idx_ = 0 + end if + + end subroutine aero_props_init + + !------------------------------------------------------------------------------ + ! Object clean + !------------------------------------------------------------------------------ + subroutine aero_props_final(self) + class(aerosol_properties), intent(inout) :: self + + if (allocated(self%nspecies_)) then + deallocate(self%nspecies_) + end if + if (allocated(self%nmasses_)) then + deallocate(self%nmasses_) + end if + if (allocated(self%indexer_)) then + deallocate(self%indexer_) + endif + if (allocated(self%alogsig_)) then + deallocate(self%alogsig_) + endif + if (allocated(self%f1_)) then + deallocate(self%f1_) + endif + if (allocated(self%f2_)) then + deallocate(self%f2_) + endif + if (allocated(self%dgnum_)) then + deallocate(self%dgnum_) + endif + if (allocated(self%dgnumhi_)) then + deallocate(self%dgnumhi_) + endif + if (allocated(self%dgnumlo_)) then + deallocate(self%dgnumlo_) + endif + if (allocated(self%rhcrystal_)) then + deallocate(self%rhcrystal_) + endif + if (allocated(self%rhdeliques_)) then + deallocate(self%rhdeliques_) + endif + + self%nbins_ = 0 + self%ncnst_tot_ = 0 + self%list_idx_ = 0 + + end subroutine aero_props_final + + !------------------------------------------------------------------------------ + ! returns number of species in a bin + !------------------------------------------------------------------------------ + pure function nspecies_per_bin(self,bin_ndx) result(val) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer :: val + + val = self%nspecies_(bin_ndx) + end function nspecies_per_bin + + !------------------------------------------------------------------------------ + ! returns number of species for all bins + !------------------------------------------------------------------------------ + pure function nspecies_all_bins(self) result(arr) + class(aerosol_properties), intent(in) :: self + integer :: arr(self%nbins_) + + arr(:) = self%nspecies_(:) + + end function nspecies_all_bins + + !------------------------------------------------------------------------------ + ! returns number of species masses in a given bin number + !------------------------------------------------------------------------------ + pure function n_masses_per_bin(self,bin_ndx) result(val) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer :: val + + val = self%nmasses_(bin_ndx) + end function n_masses_per_bin + + !------------------------------------------------------------------------------ + ! returns an array of number of species masses for all bins + !------------------------------------------------------------------------------ + pure function n_masses_all_bins(self) result(arr) + class(aerosol_properties), intent(in) :: self + integer :: arr(self%nbins_) + + arr(:) = self%nmasses_(:) + end function n_masses_all_bins + + !------------------------------------------------------------------------------ + ! returns a single index for given bin and species + !------------------------------------------------------------------------------ + pure integer function indexer(self,bin_ndx,species_ndx) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + indexer = self%indexer_(bin_ndx,species_ndx) + end function indexer + + !------------------------------------------------------------------------------ + ! returns the total number of bins + !------------------------------------------------------------------------------ + pure function get_nbins(self) result(nbins) + class(aerosol_properties), intent(in) :: self + integer :: nbins + + nbins = self%nbins_ + end function get_nbins + + !------------------------------------------------------------------------------ + ! returns number of constituents (or elements) totaled across all bins + !------------------------------------------------------------------------------ + pure integer function ncnst_tot(self) + class(aerosol_properties), intent(in) :: self + + ncnst_tot = self%ncnst_tot_ + end function ncnst_tot + + !------------------------------------------------------------------------------ + ! returns the natural log of geometric standard deviation of the number distribution for aerosol bin + !------------------------------------------------------------------------------ + pure real(r8) function get_alogsig(self, bin_ndx) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + get_alogsig = self%alogsig_(bin_ndx) + end function get_alogsig + + !------------------------------------------------------------------------------ + ! returns the geometric mean diameter for aerosol bin + !------------------------------------------------------------------------------ + pure real(r8) function get_dgnum(self, bin_ndx) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + + if (allocated(self%dgnum_)) then + get_dgnum = self%dgnum_(bin_ndx) + else + get_dgnum = -huge(1._r8) + end if + end function get_dgnum + + !------------------------------------------------------------------------------ + ! returns the upper bound diameter for aerosol bin + !------------------------------------------------------------------------------ + pure real(r8) function get_dgnumhi(self, bin_ndx) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + + if (allocated(self%dgnumhi_)) then + get_dgnumhi = self%dgnumhi_(bin_ndx) + else + get_dgnumhi = -huge(1._r8) + end if + end function get_dgnumhi + + !------------------------------------------------------------------------------ + ! returns the lower bound diameter for aerosol bin + !------------------------------------------------------------------------------ + pure real(r8) function get_dgnumlo(self, bin_ndx) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + + if (allocated(self%dgnumlo_)) then + get_dgnumlo = self%dgnumlo_(bin_ndx) + else + get_dgnumlo = -huge(1._r8) + end if + end function get_dgnumlo + + !------------------------------------------------------------------------------ + ! returns the crystallization RH for aerosol bin + !------------------------------------------------------------------------------ + pure real(r8) function get_rhcrystal(self, bin_ndx) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + + if (allocated(self%rhcrystal_)) then + get_rhcrystal = self%rhcrystal_(bin_ndx) + else + get_rhcrystal = -huge(1._r8) + end if + end function get_rhcrystal + + !------------------------------------------------------------------------------ + ! returns the deliquescence RH for aerosol bin + !------------------------------------------------------------------------------ + pure real(r8) function get_rhdeliques(self, bin_ndx) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + + if (allocated(self%rhdeliques_)) then + get_rhdeliques = self%rhdeliques_(bin_ndx) + else + get_rhdeliques = -huge(1._r8) + end if + end function get_rhdeliques + + !------------------------------------------------------------------------------ + ! returns maximum supersaturation + !------------------------------------------------------------------------------ + function maxsat(self, zeta,eta,smc) result(smax) + + !------------------------------------------------------------------------- + ! Calculates maximum supersaturation for multiple competing aerosols. + ! + ! Abdul-Razzak and Ghan, A parameterization of aerosol activation. + ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844., 2000 + !------------------------------------------------------------------------- + + class(aerosol_properties), intent(in) :: self + real(r8), intent(in) :: zeta(self%nbins_) ! Abdul-Razzak and Ghan eq 10 + real(r8), intent(in) :: eta(self%nbins_) ! Abdul-Razzak and Ghan eq 11 + real(r8), intent(in) :: smc(self%nbins_) ! critical supersaturation + + real(r8) :: smax ! maximum supersaturation + + integer :: m + integer :: nbins + real(r8) :: sum, g1, g2, g1sqrt, g2sqrt + + real(r8), parameter :: small_maxsat = 1.e-20_r8 ! for weak forcing + real(r8), parameter :: large_maxsat = 1.e20_r8 ! for small eta + + smax=0.0_r8 + nbins = self%nbins_ + + check_loop: do m=1,nbins + if((zeta(m) > 1.e5_r8*eta(m)) .or. (smc(m)*smc(m) > 1.e5_r8*eta(m))) then + ! weak forcing -- essentially none activated + smax=small_maxsat + else + ! significant activation of this mode -- calc activation all modes + exit check_loop + endif + ! No significant activation in any mode. Do nothing. + if (m == nbins) return + enddo check_loop + + sum=0.0_r8 + + do m=1,nbins + if(eta(m) > 1.e-20_r8)then + ! from Abdul-Razzak and Ghan 2000 + g1=zeta(m)/eta(m) + g1sqrt=sqrt(g1) + g1=g1sqrt*g1 + g2=smc(m)/sqrt(eta(m)+3._r8*zeta(m)) + g2sqrt=sqrt(g2) + g2=g2sqrt*g2 + sum=sum+(self%f1_(m)*g1+self%f2_(m)*g2)/(smc(m)*smc(m)) + else + sum=large_maxsat + endif + enddo + + smax=1._r8/sqrt(sum) + + end function maxsat + + !------------------------------------------------------------------------------ + ! returns the ratio of SOA Hygroscopicity / Sulfate Hygroscopicity + !------------------------------------------------------------------------------ + pure real(r8) function soa_equivso4_factor(self) + class(aerosol_properties), intent(in) :: self + + soa_equivso4_factor = self%soa_equivso4_factor_ + + end function soa_equivso4_factor + + !------------------------------------------------------------------------------ + ! returns the ratio of POM Hygroscopicity / Sulfate Hygroscopicity + !------------------------------------------------------------------------------ + pure real(r8) function pom_equivso4_factor(self) + class(aerosol_properties), intent(in) :: self + + pom_equivso4_factor = self%pom_equivso4_factor_ + + end function pom_equivso4_factor + + !------------------------------------------------------------------------------ + ! returns the radiation list index + !------------------------------------------------------------------------------ + pure integer function get_list_idx(self) + class(aerosol_properties), intent(in) :: self + + get_list_idx = self%list_idx_ + + end function get_list_idx + + !------------------------------------------------------------------------ + ! returns optics type and table parameters + ! + ! Generalized implementation that retrieves optics data from phys_prop + ! using the physprop ID provided by each concrete subclass. + !------------------------------------------------------------------------ + subroutine optics_params(self, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absplw, & + refrtabsw, refitabsw, refrtablw, refitablw, ncoef, prefr, prefi, sw_hygro_ext_wtp, & + sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, wgtpct, nwtp, & + sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, & + corefrac, bcdust, kap, relh, nfrac, nbcdust, nkap, nrelh, & + sw_hygroscopic_ext, sw_hygroscopic_ssa, sw_hygroscopic_asm, lw_hygroscopic_ext, & + sw_insoluble_ext, sw_insoluble_ssa, sw_insoluble_asm, lw_insoluble_ext, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_mu, r_lw_abs) + + use phys_prop, only: physprop_get + + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! mode/bin index + + character(len=*), optional, intent(out) :: opticstype + + ! refactive index table parameters + real(r8), optional, pointer :: extpsw(:,:,:,:) ! short wave specific extinction + real(r8), optional, pointer :: abspsw(:,:,:,:) ! short wave specific absorption + real(r8), optional, pointer :: asmpsw(:,:,:,:) ! short wave asymmetry factor + real(r8), optional, pointer :: absplw(:,:,:,:) ! long wave specific absorption + real(r8), optional, pointer :: refrtabsw(:,:) ! table of short wave real refractive indices for aerosols + real(r8), optional, pointer :: refitabsw(:,:) ! table of short wave imaginary refractive indices for aerosols + real(r8), optional, pointer :: refrtablw(:,:) ! table of long wave real refractive indices for aerosols + real(r8), optional, pointer :: refitablw(:,:) ! table of long wave imaginary refractive indices for aerosols + integer, optional, intent(out) :: ncoef ! number of chebychev polynomials + integer, optional, intent(out) :: prefr ! number of real refractive indices in table + integer, optional, intent(out) :: prefi ! number of imaginary refractive indices in table + + ! hygrowghtpct table parameters + real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:) ! short wave extinction table + real(r8), optional, pointer :: sw_hygro_ssa_wtp(:,:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_hygro_ext_wtp(:,:) ! long wave absorption table + real(r8), optional, pointer :: wgtpct(:) ! weight percent of H2SO4/H2O solution + integer, optional, intent(out) :: nwtp ! number of weight percent values + + ! hygrocoreshell table parameters + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) ! short wave extinction table + real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_hygro_coreshell_ext(:,:,:,:,:) ! long wave absorption table + real(r8), optional, pointer :: corefrac(:) ! core fraction dimension values + real(r8), optional, pointer :: bcdust(:) ! bc/(bc + dust) fraction dimension values + real(r8), optional, pointer :: kap(:) ! hygroscopicity dimension values + real(r8), optional, pointer :: relh(:) ! relative humidity dimension values + integer, optional, intent(out) :: nfrac ! core fraction dimension size + integer, optional, intent(out) :: nbcdust ! bc/(bc + dust) fraction dimension size + integer, optional, intent(out) :: nkap ! hygroscopicity dimension size + integer, optional, intent(out) :: nrelh ! relative humidity dimension size + + ! hygroscopic + real(r8), optional, pointer :: sw_hygroscopic_ext(:,:) ! short wave extinction table + real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_hygroscopic_ext(:,:) ! long wave absorption table + + ! non-hygroscopic (insoluble) + real(r8), optional, pointer :: sw_insoluble_ext(:) ! short wave extinction table + real(r8), optional, pointer :: sw_insoluble_ssa(:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_insoluble_asm(:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_insoluble_ext(:) ! long wave absorption table + + ! volcanic radius + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat (:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_mu(:) + real(r8), optional, pointer :: r_lw_abs(:,:) + + integer :: id + + id = self%physprop_id(bin_ndx) + + ! Retrieve all requested parameters from physprop. + ! Absent optional arguments are passed through as absent to physprop_get. + ! Pointer fields that are not populated for this physprop are nullified + ! during physprop_init, so physprop_get returns disassociated pointers + ! for unused optics types. + ! + ! Several parameter names differ between this interface and physprop_get: + ! lw_hygro_ext_wtp -> lw_hygro_abs_wtp + ! lw_hygro_coreshell_ext -> lw_hygro_coreshell_abs + ! sw_hygroscopic_ext -> sw_hygro_ext + ! sw_hygroscopic_ssa -> sw_hygro_ssa + ! sw_hygroscopic_asm -> sw_hygro_asm + ! lw_hygroscopic_ext -> lw_hygro_abs + ! sw_insoluble_ext -> sw_nonhygro_ext + ! sw_insoluble_ssa -> sw_nonhygro_ssa + ! sw_insoluble_asm -> sw_nonhygro_asm + ! lw_insoluble_ext -> lw_abs + ! r_mu -> mu + + call physprop_get(id, opticstype=opticstype, & + ! refractive index table parameters (modal) + extpsw=extpsw, abspsw=abspsw, asmpsw=asmpsw, absplw=absplw, & + refrtabsw=refrtabsw, refitabsw=refitabsw, & + refrtablw=refrtablw, refitablw=refitablw, & + ncoef=ncoef, prefr=prefr, prefi=prefi, & + ! hygrowghtpct table parameters (CARMA) + sw_hygro_ext_wtp=sw_hygro_ext_wtp, & + sw_hygro_ssa_wtp=sw_hygro_ssa_wtp, & + sw_hygro_asm_wtp=sw_hygro_asm_wtp, & + lw_hygro_abs_wtp=lw_hygro_ext_wtp, & + wgtpct=wgtpct, nwtp=nwtp, & + ! hygrocoreshell table parameters (CARMA) + sw_hygro_coreshell_ext=sw_hygro_coreshell_ext, & + sw_hygro_coreshell_ssa=sw_hygro_coreshell_ssa, & + sw_hygro_coreshell_asm=sw_hygro_coreshell_asm, & + lw_hygro_coreshell_abs=lw_hygro_coreshell_ext, & + corefrac=corefrac, bcdust=bcdust, kap=kap, relh=relh, & + nfrac=nfrac, nbcdust=nbcdust, nkap=nkap, nrelh=nrelh, & + ! hygroscopic table parameters (bulk) + sw_hygro_ext=sw_hygroscopic_ext, & + sw_hygro_ssa=sw_hygroscopic_ssa, & + sw_hygro_asm=sw_hygroscopic_asm, & + lw_hygro_abs=lw_hygroscopic_ext, & + ! non-hygroscopic / insoluble table parameters (bulk) + sw_nonhygro_ext=sw_insoluble_ext, & + sw_nonhygro_ssa=sw_insoluble_ssa, & + sw_nonhygro_asm=sw_insoluble_asm, & + lw_abs=lw_insoluble_ext, & + ! volcanic radius table parameters (bulk) + r_sw_ext=r_sw_ext, r_sw_scat=r_sw_scat, & + r_sw_ascat=r_sw_ascat, r_lw_abs=r_lw_abs, mu=r_mu) + + end subroutine optics_params + +end module aerosol_properties_mod diff --git a/src/aerosol/aerosol_state_mod.F90 b/src/aerosol/aerosol_state_mod.F90 new file mode 100644 index 000000000..24cb00bcf --- /dev/null +++ b/src/aerosol/aerosol_state_mod.F90 @@ -0,0 +1,970 @@ +module aerosol_state_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_properties_mod, only: aerosol_properties, aero_name_len + use physconst, only: pi + + implicit none + + private + + public :: aerosol_state + public :: ptr2d_t + + !> aerosol_state defines the interface to the time-varying aerosol state + !! variables (e.g., mixing ratios, number concentrations). This includes the + !! aerosol portion of the overall model state. + !! + !! Each aerosol package (e.g., MAM, CARMA, etc) must extend the aerosol_state + !! class to allow access to the state information (transported and not transported) + !! of the aerosol package. Any package must implement each of the deferred + !! procedures of the abstract aerosol_state class, may include additional private + !! data members and type-bound procedures, and may override functions of the + !! abstract class. + !! + !! Please see the modal_aerosol_state module for an example of how the aerosol_state + !! class can be extended for a specific aerosol package. + type, abstract :: aerosol_state + integer :: list_idx_ = 0 ! radiation climate/diagnostic list index + integer :: ncol_ = 0 ! number of active columns + contains + procedure :: list_idx => get_list_idx + procedure :: set_list_idx + procedure :: ncol => get_ncol + procedure :: set_ncol + procedure(aero_get_transported), deferred :: get_transported + procedure(aero_set_transported), deferred :: set_transported + procedure(aero_get_amb_total_bin_mmr), deferred :: ambient_total_bin_mmr + procedure(aero_get_state_mmr), deferred :: get_ambient_mmr + procedure(aero_get_state_mmr), deferred :: get_cldbrne_mmr + procedure(aero_get_state_num), deferred :: get_ambient_num + procedure(aero_get_state_num), deferred :: get_cldbrne_num + procedure(aero_get_states), deferred :: get_states + procedure(aero_update_bin), deferred :: update_bin + procedure :: loadaer + procedure(aero_icenuc_size_wght_arr), deferred :: icenuc_size_wght_arr + procedure(aero_icenuc_size_wght_val), deferred :: icenuc_size_wght_val + generic :: icenuc_size_wght => icenuc_size_wght_arr,icenuc_size_wght_val + procedure :: icenuc_type_wght_base + procedure :: icenuc_type_wght => icenuc_type_wght_base + procedure :: nuclice_get_numdens + procedure :: get_amb_species_numdens + procedure :: get_cld_species_numdens + procedure :: coated_frac + procedure :: mass_mean_radius + procedure :: watact_mfactor + procedure(aero_hetfrz_size_wght), deferred :: hetfrz_size_wght + procedure(aero_hygroscopicity), deferred :: hygroscopicity + procedure(aero_water_uptake), deferred :: water_uptake + procedure(aero_wgtpct), deferred :: wgtpct + procedure :: refractive_index_sw + procedure :: refractive_index_lw + procedure(aero_volume), deferred :: dry_volume + procedure(aero_volume), deferred :: wet_volume + procedure(aero_volume), deferred :: water_volume + procedure(aero_wet_diam), deferred :: wet_diameter + procedure :: convcld_actfrac + procedure :: sol_factb_interstitial + procedure(aero_aqu_gain_binfraction), deferred :: aqu_gain_binfraction + end type aerosol_state + + ! for state fields + type ptr2d_t + real(r8), pointer :: fld(:,:) + end type ptr2d_t + + real(r8), parameter :: per_cm3 = 1.e-6_r8 ! factor for m-3 to cm-3 conversions + real(r8), parameter :: per_m3 = 1.e6_r8 ! factor for cm-3 to m-3 conversions + real(r8), parameter :: kg2mug = 1.e9_r8 ! factor for kg to micrograms (mug) conversions + + abstract interface + + !------------------------------------------------------------------------ + ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer) + !------------------------------------------------------------------------ + function aero_get_amb_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot) + import :: aerosol_state, aerosol_properties, r8 + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + + real(r8) :: mmr_tot ! mass mixing ratios totaled for all species + + end function aero_get_amb_total_bin_mmr + + !------------------------------------------------------------------------ + ! returns aerosol mass mixing ratio for a given species index and bin index + !------------------------------------------------------------------------ + subroutine aero_get_state_mmr(self, species_ndx, bin_ndx, mmr) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + end subroutine aero_get_state_mmr + + !------------------------------------------------------------------------ + ! returns aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------ + subroutine aero_get_state_num(self, bin_ndx, num) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) ! number densities (ncol,nlev) + end subroutine aero_get_state_num + + !------------------------------------------------------------------------ + ! returns interstitial and cloud-borne aerosol states + !------------------------------------------------------------------------ + subroutine aero_get_states( self, aero_props, raer, qqcw ) + import :: aerosol_state, aerosol_properties, ptr2d_t + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! properties of the aerosol model + type(ptr2d_t), intent(out) :: raer(:) ! state of interstitial aerosols + type(ptr2d_t), intent(out) :: qqcw(:) ! state of cloud-borne aerosols + + end subroutine aero_get_states + + !------------------------------------------------------------------------------ + ! sets transported components + ! This updates the aerosol model state from the host transported aerosol constituents array. + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine aero_set_transported( self, transported_array ) + import :: aerosol_state, r8 + class(aerosol_state), intent(inout) :: self + real(r8), intent(in) :: transported_array(:,:,:) + end subroutine aero_set_transported + + !------------------------------------------------------------------------------ + ! returns transported components + ! This updates the transported aerosol constituent array to match the aerosol model state. + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine aero_get_transported( self, transported_array ) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + real(r8), intent(out) :: transported_array(:,:,:) + end subroutine aero_get_transported + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin + !------------------------------------------------------------------------------ + subroutine aero_icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght(:,:) + + end subroutine aero_icenuc_size_wght_arr + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin, column and vertical layer + !------------------------------------------------------------------------------ + subroutine aero_icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght + + end subroutine aero_icenuc_size_wght_val + + !------------------------------------------------------------------------------ + ! updates state and tendency + !------------------------------------------------------------------------------ + subroutine aero_update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend ) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + real(r8),intent(in) :: delmmr_sum ! mass mixing ratio change summed over all species in bin + real(r8),intent(in) :: delnum_sum ! number mixing ratio change summed over all species in bin + integer, intent(in) :: tnd_ndx ! tendency index + real(r8),intent(in) :: dtime ! time step size (sec) + real(r8),intent(inout) :: tend(:,:,:) ! tendency + + end subroutine aero_update_bin + + !------------------------------------------------------------------------------ + ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act + ! as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function aero_hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: wght(ncol,nlev) + + end function aero_hetfrz_size_wght + + !------------------------------------------------------------------------------ + ! returns hygroscopicity for a given radiation diagnostic list number and + ! bin number + !------------------------------------------------------------------------------ + subroutine aero_hygroscopicity(self, bin_ndx, kappa) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) + + end subroutine aero_hygroscopicity + + !------------------------------------------------------------------------------ + ! returns aerosol wet diameter and aerosol water concentration for a given + ! radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + subroutine aero_water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) + import :: aerosol_state, aerosol_properties, r8 + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) + real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) + + end subroutine aero_water_uptake + + !------------------------------------------------------------------------------ + ! aerosol weight percent of H2SO4/H2O solution + !------------------------------------------------------------------------------ + function aero_wgtpct(self, ncol, nlev) result(wtp) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ncol,nlev + real(r8) :: wtp(ncol,nlev) ! weight percent of H2SO4/H2O solution for given icol, ilev + + end function aero_wgtpct + + !------------------------------------------------------------------------------ + ! aerosol volume interface + !------------------------------------------------------------------------------ + function aero_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) + import :: aerosol_state, aerosol_properties, r8 + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + end function aero_volume + + !------------------------------------------------------------------------------ + ! aerosol wet diameter + !------------------------------------------------------------------------------ + function aero_wet_diam(self, bin_idx, ncol, nlev) result(diam) + import :: aerosol_state, r8 + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: diam(ncol,nlev) + + end function aero_wet_diam + + !------------------------------------------------------------------------------ + ! aqueous chemistry partitioning -- used in sox_cldaero_update + !------------------------------------------------------------------------------ + subroutine aero_aqu_gain_binfraction(self, aero_props, type, qcw, delso4_o3rxn, faqgain) + import :: aerosol_state, aerosol_properties, r8 + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + character(len=*), intent(in) :: type ! aerosol species type + real(r8), intent(in) :: qcw(:,:,:) ! cloud-borne aerosol volume mixing ratio + real(r8), intent(in) :: delso4_o3rxn(:,:) ! sulfate concentration change due to oxidation + real(r8), intent(out) :: faqgain(:,:,:) ! fraction gain in each mode / bin + + end subroutine aero_aqu_gain_binfraction + + end interface + +contains + + !------------------------------------------------------------------------------ + ! returns the radiation climate/diagnostic list index + !------------------------------------------------------------------------------ + pure integer function get_list_idx(self) + class(aerosol_state), intent(in) :: self + get_list_idx = self%list_idx_ + end function get_list_idx + + !------------------------------------------------------------------------------ + ! sets the radiation climate/diagnostic list index + !------------------------------------------------------------------------------ + subroutine set_list_idx(self, list_idx) + class(aerosol_state), intent(inout) :: self + integer, intent(in) :: list_idx + self%list_idx_ = list_idx + end subroutine set_list_idx + + !------------------------------------------------------------------------------ + ! returns the number of active columns + !------------------------------------------------------------------------------ + pure integer function get_ncol(self) + class(aerosol_state), intent(in) :: self + get_ncol = self%ncol_ + end function get_ncol + + !------------------------------------------------------------------------------ + ! sets the number of active columns + !------------------------------------------------------------------------------ + subroutine set_ncol(self, ncol) + class(aerosol_state), intent(inout) :: self + integer, intent(in) :: ncol + self%ncol_ = ncol + end subroutine set_ncol + + !------------------------------------------------------------------------------ + ! returns aerosol number, volume concentrations, and bulk hygroscopicity + !------------------------------------------------------------------------------ + subroutine loadaer( self, aero_props, ncol, nlev, m, cs, phase, & + naerosol, vaerosol, hygro, errnum, errstr, pom_hygro) + + use aerosol_properties_mod, only: aerosol_properties + + ! input arguments + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: ncol, nlev + integer, intent(in) :: m ! mode or bin index + real(r8), intent(in) :: cs(:,:) ! air density (kg/m3) + integer, intent(in) :: phase ! phase of aerosol: 1 for interstitial, 2 for cloud-borne, 3 for sum + + ! output arguments + real(r8), intent(out) :: naerosol(:,:) ! number conc (1/m3) + real(r8), intent(out) :: vaerosol(:,:) ! volume conc (m3/m3) + real(r8), intent(out) :: hygro(:,:) ! bulk hygroscopicity of mode + + integer , intent(out) :: errnum + character(len=*), intent(out) :: errstr + + real(r8), optional, intent(in) :: pom_hygro ! POM hygroscopicity override + + ! internal + real(r8), pointer :: raer(:,:) ! interstitial aerosol mass, number mixing ratios + real(r8), pointer :: qqcw(:,:) ! cloud-borne aerosol mass, number mixing ratios + real(r8) :: specdens, spechygro + character(len=aero_name_len) :: spectype + + real(r8) :: vol(ncol,nlev) ! aerosol volume mixing ratio + integer :: l + !------------------------------------------------------------------------------- + errnum = 0 + + vaerosol(:,:) = 0._r8 + hygro(:,:) = 0._r8 + + do l = 1, aero_props%nspecies(m) + + call self%get_ambient_mmr(species_ndx=l, bin_ndx=m, mmr=raer) + call self%get_cldbrne_mmr(species_ndx=l, bin_ndx=m, mmr=qqcw) + call aero_props%get(m,l, density=specdens, hygro=spechygro, spectype=spectype) + if (present(pom_hygro)) then + if (spectype=='p-organic'.and.pom_hygro>0._r8) then + spechygro=pom_hygro + endif + endif + + if (phase == 3) then + vol(:ncol,:) = max(raer(:ncol,:) + qqcw(:ncol,:), 0._r8)/specdens + else if (phase == 2) then + vol(:ncol,:) = max(qqcw(:ncol,:), 0._r8)/specdens + else if (phase == 1) then + vol(:ncol,:) = max(raer(:ncol,:), 0._r8)/specdens + else + errnum = -1 + write(errstr,*)'phase = ',phase,' in aerosol_state::loadaer not recognized' + return + end if + + vaerosol(:ncol,:) = vaerosol(:ncol,:) + vol(:ncol,:) + hygro(:ncol,:) = hygro(:ncol,:) + vol(:ncol,:)*spechygro + end do + + where(vaerosol(:ncol,:) > 1.0e-30_r8) + hygro(:ncol,:) = hygro(:ncol,:)/(vaerosol(:ncol,:)) + vaerosol(:ncol,:) = vaerosol(:ncol,:)*cs(:ncol,:) + elsewhere + hygro(:ncol,:) = 0._r8 + vaerosol(:ncol,:) = 0._r8 + end where + + ! aerosol number mixing ratios (#/kg) + call self%get_ambient_num(m, raer) + call self%get_cldbrne_num(m, qqcw) + if (phase == 3) then + naerosol(:ncol,:) = (raer(:ncol,:) + qqcw(:ncol,:))*cs(:ncol,:) ! #/kg -> #/m3 + else if (phase == 2) then + naerosol(:ncol,:) = qqcw(:ncol,:)*cs(:ncol,:) + else + naerosol(:ncol,:) = raer(:ncol,:)*cs(:ncol,:) + end if + + ! adjust number + call aero_props%apply_number_limits( naerosol, vaerosol, ncol, nlev, m ) + + end subroutine loadaer + + !------------------------------------------------------------------------------ + ! returns ambient aerosol number density for a given bin number and species type + !------------------------------------------------------------------------------ + subroutine get_amb_species_numdens(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, numdens) + use aerosol_properties_mod, only: aerosol_properties + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: numdens(:,:) ! species number densities (#/cm^3) + + real(r8), pointer :: num(:,:) + real(r8) :: type_wght(ncol,nlev) + real(r8) :: size_wght(ncol,nlev) + + size_wght = self%hetfrz_size_wght(bin_ndx, ncol, nlev) + + call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, type_wght) + + call self%get_ambient_num(bin_ndx, num) + + numdens(:ncol,:) = num(:ncol,:)*rho(:ncol,:)*type_wght(:ncol,:)*size_wght(:ncol,:)*per_cm3 + + end subroutine get_amb_species_numdens + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number density for a given bin number and species type + !------------------------------------------------------------------------------ + subroutine get_cld_species_numdens(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, numdens) + use aerosol_properties_mod, only: aerosol_properties + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: numdens(:,:) ! number densities (#/cm^3) + + real(r8), pointer :: num(:,:) + real(r8) :: type_wght(ncol,nlev) + real(r8) :: size_wght(ncol,nlev) + + size_wght = self%hetfrz_size_wght(bin_ndx, ncol, nlev) + + call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, type_wght, cloud_borne=.true.) + + call self%get_cldbrne_num(bin_ndx, num) + + numdens(:ncol,:) = num(:ncol,:)*rho(:ncol,:)*type_wght(:ncol,:)*size_wght(:ncol,:)*per_cm3 + + end subroutine get_cld_species_numdens + + !------------------------------------------------------------------------------ + ! returns aerosol type weights for a given aerosol type and bin + !------------------------------------------------------------------------------ + subroutine icenuc_type_wght_base(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + + use aerosol_properties_mod, only: aerosol_properties + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: wght(:,:) ! type weights + logical, optional, intent(in) :: cloud_borne ! if TRUE cloud-borne aerosols are used + ! otherwise ambient aerosols are used + + real(r8) :: mass(ncol,nlev) + real(r8) :: totalmass(ncol,nlev) + real(r8), pointer :: aer_bin(:,:) + + character(len=aero_name_len) :: spectype, sptype + integer :: ispc + logical :: cldbrne + + if (present(cloud_borne)) then + cldbrne = cloud_borne + else + cldbrne = .false. + end if + + wght(:,:) = 0._r8 + totalmass(:,:) = 0._r8 + mass(:,:) = 0._r8 + + if (species_type=='sulfate_strat') then + sptype = 'sulfate' + else + sptype = species_type + end if + + do ispc = 1, aero_props%nspecies(bin_ndx) + + if (cldbrne) then + call self%get_cldbrne_mmr(species_ndx=ispc, bin_ndx=bin_ndx, mmr=aer_bin) + else + call self%get_ambient_mmr(species_ndx=ispc, bin_ndx=bin_ndx, mmr=aer_bin) + end if + call aero_props%species_type(bin_ndx, ispc, spectype=spectype) + + totalmass(:ncol,:) = totalmass(:ncol,:) + aer_bin(:ncol,:)*rho(:ncol,:) + + if (trim(spectype) == trim(sptype)) then + mass(:ncol,:) = mass(:ncol,:) + aer_bin(:ncol,:)*rho(:ncol,:) + end if + + end do + + where (totalmass(:ncol,:) > 0._r8) + wght(:ncol,:) = mass(:ncol,:)/totalmass(:ncol,:) + end where + + end subroutine icenuc_type_wght_base + + !------------------------------------------------------------------------------ + subroutine nuclice_get_numdens(self, aero_props, use_preexisting_ice, ncol, nlev, rho, dust_num_col, sulf_num_col, soot_num_col, sulf_num_tot_col ) + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + logical, intent(in) :: use_preexisting_ice + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: dust_num_col(:,:) ! dust number densities (#/cm^3) + real(r8), intent(out) :: sulf_num_col(:,:) ! sulfate number densities (#/cm^3) + real(r8), intent(out) :: soot_num_col(:,:) ! soot number densities (#/cm^3) + real(r8), intent(out) :: sulf_num_tot_col(:,:) ! stratopsheric sulfate number densities (#/cm^3) + + integer :: ibin,ispc + character(len=aero_name_len) :: spectype + real(r8) :: size_wghts(ncol,nlev) + real(r8) :: type_wghts(ncol,nlev) + + real(r8), pointer :: num_col(:,:) + + dust_num_col(:,:) = 0._r8 + sulf_num_col(:,:) = 0._r8 + soot_num_col(:,:) = 0._r8 + sulf_num_tot_col(:,:) = 0._r8 + + ! collect number densities (#/cm^3) for dust, sulfate, and soot + do ibin = 1,aero_props%nbins() + + call self%get_ambient_num(ibin, num_col) + + do ispc = 1,aero_props%nspecies(ibin) + + call aero_props%species_type(ibin, ispc, spectype) + + call self%icenuc_size_wght(ibin, ncol, nlev, spectype, use_preexisting_ice, size_wghts) + + call self%icenuc_type_wght(ibin, ncol, nlev, spectype, aero_props, rho, type_wghts) + + select case ( trim(spectype) ) + case('dust') + dust_num_col(:ncol,:) = dust_num_col(:ncol,:) & + + size_wghts(:ncol,:)*type_wghts(:ncol,:)*num_col(:ncol,:)*rho(:ncol,:)*per_cm3 + case('sulfate') + ! This order of ops gives bit-for-bit results for cam5 phys ( use_preexisting_ice = .false. ) + sulf_num_col(:ncol,:) = sulf_num_col(:ncol,:) & + + num_col(:ncol,:)*rho(:ncol,:)*per_cm3 * size_wghts(:ncol,:)*type_wghts(:ncol,:) + case('black-c') + soot_num_col(:ncol,:) = soot_num_col(:ncol,:) & + + size_wghts(:ncol,:)*type_wghts(:ncol,:)*num_col(:ncol,:)*rho(:ncol,:)*per_cm3 + end select + + enddo + + ! stratospheric sulfates -- special case not included in the species loop above + call self%icenuc_size_wght(ibin, ncol, nlev, 'sulfate_strat', use_preexisting_ice, size_wghts) + call self%icenuc_type_wght(ibin, ncol, nlev, 'sulfate_strat', aero_props, rho, type_wghts) + sulf_num_tot_col(:ncol,:) = sulf_num_tot_col(:ncol,:) & + + size_wghts(:ncol,:)*type_wghts(:ncol,:)*num_col(:ncol,:)*rho(:ncol,:)*per_cm3 + + enddo + + end subroutine nuclice_get_numdens + + !------------------------------------------------------------------------------ + ! returns the fraction of particle surface area of aerosol subset `bin_ndx` covered + ! by at least a monolayer of species `species_type` [0-1] + !------------------------------------------------------------------------------ + function coated_frac(self, bin_ndx, species_type, ncol, nlev, aero_props, radius) result(frac) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(in) :: species_type ! species type + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: radius(:,:) ! m + + real(r8) :: frac(ncol,nlev) ! coated fraction + + !------------coated variables-------------------- + real(r8), parameter :: n_so4_monolayers_dust = 1.0_r8 ! number of so4(+nh4) monolayers needed to coat a dust particle + real(r8), parameter :: dr_so4_monolayers_dust = n_so4_monolayers_dust * 4.76e-10_r8 + real(r8) :: vol_shell(ncol,nlev) + real(r8) :: vol_core(ncol,nlev) + real(r8) :: alnsg, fac_volsfc + real(r8) :: tmp1(ncol,nlev), tmp2(ncol,nlev) + real(r8),pointer :: sulf_mmr(:,:) + real(r8),pointer :: soa_mmr(:,:) + real(r8),pointer :: pom_mmr(:,:) + real(r8),pointer :: aer_mmr(:,:) + + integer :: sulf_ndx + integer :: soa_ndx + integer :: pom_ndx + integer :: species_ndx + + real(r8) :: specdens_so4 + real(r8) :: specdens_pom + real(r8) :: specdens_soa + real(r8) :: specdens + + character(len=aero_name_len) :: spectype + integer :: ispc + + frac = -huge(1._r8) + + sulf_ndx = -1 + pom_ndx = -1 + soa_ndx = -1 + species_ndx = -1 + + do ispc = 1, aero_props%nspecies(bin_ndx) + call aero_props%species_type(bin_ndx, ispc, spectype) + + select case ( trim(spectype) ) + case('sulfate') + sulf_ndx = ispc + case('p-organic') + pom_ndx = ispc + case('s-organic') + soa_ndx = ispc + end select + if (spectype==species_type) then + species_ndx = ispc + end if + end do + + vol_shell(:ncol,:) = 0._r8 + + if (sulf_ndx>0) then + call aero_props%get(bin_ndx, sulf_ndx, density=specdens_so4) + call self%get_ambient_mmr(species_ndx=sulf_ndx, bin_ndx=bin_ndx, mmr=sulf_mmr) + vol_shell(:ncol,:) = vol_shell(:ncol,:) + sulf_mmr(:ncol,:)/specdens_so4 + end if + if (pom_ndx>0) then + call aero_props%get(bin_ndx, pom_ndx, density=specdens_pom) + call self%get_ambient_mmr(species_ndx=pom_ndx, bin_ndx=bin_ndx, mmr=pom_mmr) + vol_shell(:ncol,:) = vol_shell(:ncol,:) + pom_mmr(:ncol,:)*aero_props%pom_equivso4_factor()/specdens_pom + end if + if (soa_ndx>0) then + call aero_props%get(bin_ndx, soa_ndx, density=specdens_soa) + call self%get_ambient_mmr(species_ndx=soa_ndx, bin_ndx=bin_ndx, mmr=soa_mmr) + vol_shell(:ncol,:) = vol_shell(:ncol,:) + soa_mmr(:ncol,:)*aero_props%soa_equivso4_factor()/specdens_soa + end if + + call aero_props%get(bin_ndx, species_ndx, density=specdens) + call self%get_ambient_mmr(species_ndx=species_ndx, bin_ndx=bin_ndx, mmr=aer_mmr) + vol_core(:ncol,:) = aer_mmr(:ncol,:)/specdens + + alnsg = aero_props%alogsig(bin_ndx) + fac_volsfc = exp(2.5_r8*alnsg**2) + + tmp1(:ncol,:) = vol_shell(:ncol,:)*(radius(:ncol,:)*2._r8)*fac_volsfc + tmp2(:ncol,:) = max(6.0_r8*dr_so4_monolayers_dust*vol_core(:ncol,:), 0.0_r8) + + where(tmp1(:ncol,:)>0._r8 .and. tmp2(:ncol,:)>0._r8) + frac(:ncol,:) = tmp1(:ncol,:)/tmp2(:ncol,:) + elsewhere + frac(:ncol,:) = 0.001_r8 + end where + + where(frac(:ncol,:)>1._r8) + frac(:ncol,:) = 1._r8 + end where + where(frac(:ncol,:) < 0.001_r8) + frac(:ncol,:) = 0.001_r8 + end where + + end function coated_frac + + !------------------------------------------------------------------------------ + ! returns the radius [m] of particles in aerosol subset `bin_ndx` assuming all particles are + ! the same size and only species `species_ndx` contributes to the particle volume + !------------------------------------------------------------------------------ + function mass_mean_radius(self, bin_ndx, species_ndx, ncol, nlev, aero_props, rho) result(radius) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + + real(r8) :: radius(ncol,nlev) ! m + + character(len=aero_name_len) :: species_type + real(r8) :: aer_numdens(ncol,nlev) ! kg/m3 + real(r8) :: aer_massdens(ncol,nlev) ! kg/m3 + real(r8),pointer :: aer_mmr(:,:) ! kg/kg + + real(r8) :: specdens,minrad + real(r8) :: wght(ncol,nlev) + integer :: i,k + + wght = self%hetfrz_size_wght(bin_ndx, ncol, nlev) + + call aero_props%species_type(bin_ndx, species_ndx, spectype=species_type) + + call aero_props%get(bin_ndx, species_ndx, density=specdens) ! kg/m3 + call self%get_ambient_mmr(species_ndx=species_ndx, bin_ndx=bin_ndx, mmr=aer_mmr) ! kg/kg + call self%get_amb_species_numdens(bin_ndx, ncol, nlev, species_type, aero_props, rho, aer_numdens) ! #/cm3 + + aer_massdens(:ncol,:) = aer_mmr(:ncol,:)*rho(:ncol,:)*wght(:ncol,:) ! kg/m3 + + minrad = aero_props%min_mass_mean_rad(bin_ndx, species_ndx) + + do k = 1,nlev + do i = 1,ncol + if (aer_massdens(i,k)*1.0e-3_r8 > 1.0e-30_r8 .and. aer_numdens(i,k) > 1.0e-3_r8) then + radius(i,k) = (3._r8/(4*pi*specdens)*aer_massdens(i,k)/(aer_numdens(i,k)*per_m3))**(1._r8/3._r8) ! m + else + radius(i,k) = minrad + end if + end do + end do + + end function mass_mean_radius + + !------------------------------------------------------------------------------ + ! calculates water activity mass factor -- density*(1.-(OC+BC)/(OC+BC+SO4)) [mug m-3] + ! of species `species_type` in subset `bin_ndx` + !------------------------------------------------------------------------------ + subroutine watact_mfactor(self, bin_ndx, species_type, ncol, nlev, aero_props, rho, wact_factor) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(in) :: species_type ! species type + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: wact_factor(:,:) ! water activity factor -- density*(1.-(OC+BC)/(OC+BC+SO4)) [mug m-3] + + real(r8), pointer :: aer_mmr(:,:) + real(r8), pointer :: bin_num(:,:) + real(r8) :: tot2_mmr(ncol,nlev) + real(r8) :: tot1_mmr(ncol,nlev) + real(r8) :: aer_numdens(ncol,nlev) + integer :: ispc + character(len=aero_name_len) :: spectype + + real(r8) :: awcam(ncol,nlev) ! mass density [mug m-3] + real(r8) :: awfacm(ncol,nlev) ! mass factor ! (OC+BC)/(OC+BC+SO4) + + tot2_mmr = 0.0_r8 + tot1_mmr = 0.0_r8 + + if (aero_props%soluble(bin_ndx)) then + + do ispc = 1, aero_props%nspecies(bin_ndx) + + call aero_props%species_type(bin_ndx, ispc, spectype) + + if (trim(spectype)=='black-c' .or. trim(spectype)=='p-organic' .or. trim(spectype)=='s-organic') then + call self%get_ambient_mmr(species_ndx=ispc, bin_ndx=bin_ndx, mmr=aer_mmr) + tot2_mmr(:ncol,:) = tot2_mmr(:ncol,:) + aer_mmr(:ncol,:) + end if + if (trim(spectype)=='sulfate') then + call self%get_ambient_mmr(species_ndx=ispc, bin_ndx=bin_ndx, mmr=aer_mmr) + tot1_mmr(:ncol,:) = tot1_mmr(:ncol,:) + aer_mmr(:ncol,:) + end if + end do + + end if + + tot1_mmr(:ncol,:) = tot1_mmr(:ncol,:) + tot2_mmr(:ncol,:) + + call self%get_amb_species_numdens(bin_ndx, ncol, nlev, species_type, aero_props, rho, aer_numdens) ! #/cm3 + call self%get_ambient_num(bin_ndx, bin_num) ! #/kg + + where(bin_num(:ncol,:)>0._r8) + awcam(:ncol,:) = ((aer_numdens(:ncol,:)*per_m3/bin_num(:ncol,:)) * tot1_mmr(:ncol,:)) * kg2mug ! [mug m-3] + elsewhere + awcam(:ncol,:) = 0._r8 + end where + + where(tot1_mmr(:ncol,:)>0) + awfacm(:ncol,:) = tot2_mmr(:ncol,:) / tot1_mmr(:ncol,:) + elsewhere + awfacm(:ncol,:) = 0._r8 + end where + + wact_factor(:ncol,:) = awcam(:ncol,:)*(1._r8-awfacm(:ncol,:)) + + end subroutine watact_mfactor + + !------------------------------------------------------------------------------ + ! aerosol short wave refactive index + !------------------------------------------------------------------------------ + function refractive_index_sw(self, ncol, ilev, ibin, iwav, aero_props) result(crefin) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ncol ! number of columes + integer, intent(in) :: ilev ! level index + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: iwav ! wave length index + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + complex(r8) :: crefin(ncol) ! complex refractive index + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + complex(r8), pointer :: specrefindex(:) ! species refractive index + real(r8) :: specdens ! species density (kg/m3) + integer :: ispec, icol + real(r8) :: vol(ncol) + + crefin(:ncol) = (0._r8, 0._r8) + + do ispec = 1, aero_props%nspecies(ibin) + + call self%get_ambient_mmr(species_ndx=ispec, bin_ndx=ibin, mmr=specmmr) + call aero_props%get(ibin, ispec, density=specdens, refindex_sw=specrefindex) + + do icol = 1, ncol + vol(icol) = specmmr(icol,ilev)/specdens + crefin(icol) = crefin(icol) + vol(icol)*specrefindex(iwav) + end do + end do + + end function refractive_index_sw + + !------------------------------------------------------------------------------ + ! aerosol long wave refactive index + !------------------------------------------------------------------------------ + function refractive_index_lw(self, ncol, ilev, ibin, iwav, aero_props) result(crefin) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ncol ! number of columes + integer, intent(in) :: ilev ! level index + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: iwav ! wave length index + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + complex(r8) :: crefin(ncol) ! complex refractive index + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + complex(r8), pointer :: specrefindex(:) ! species refractive index + real(r8) :: specdens ! species density (kg/m3) + integer :: ispec, icol + real(r8) :: vol(ncol) + + crefin(:ncol) = (0._r8, 0._r8) + + do ispec = 1, aero_props%nspecies(ibin) + + call self%get_ambient_mmr(species_ndx=ispec, bin_ndx=ibin, mmr=specmmr) + call aero_props%get(ibin, ispec, density=specdens, refindex_lw=specrefindex) + + do icol = 1, ncol + vol(icol) = specmmr(icol,ilev)/specdens + crefin(icol) = crefin(icol) + vol(icol)*specrefindex(iwav) + end do + end do + + end function refractive_index_lw + + !------------------------------------------------------------------------------ + ! prescribed aerosol activation fraction for convective cloud + !------------------------------------------------------------------------------ + function convcld_actfrac(self, aero_props, ibin, ispc, ncol, nlev) result(frac) + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: ispc ! species index + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: frac(ncol,nlev) + + frac = 0.8_r8 ! rce 2010/05/02 + + end function convcld_actfrac + + !------------------------------------------------------------------------------ + ! below cloud solubility factor for interstitial aerosols + !------------------------------------------------------------------------------ + function sol_factb_interstitial(self, bin_ndx, ncol, nlev, aero_props) result(sol_factb) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + real(r8) :: sol_factb(ncol,nlev) + + real(r8), pointer :: aer_mmr(:,:) + real(r8) :: totmmr(ncol,nlev) + real(r8) :: solmmr(ncol,nlev) + integer :: ispc + real(r8) :: spechygro + + sol_factb(:,:) = 0.0_r8 + + totmmr(:,:) = 0._r8 + solmmr(:,:) = 0._r8 + + do ispc = 1, aero_props%nspecies(bin_ndx) + + call aero_props%get(bin_ndx, ispc, hygro=spechygro) + call self%get_ambient_mmr(species_ndx=ispc, bin_ndx=bin_ndx, mmr=aer_mmr) + + totmmr(:ncol,:) = totmmr(:ncol,:) + aer_mmr(:ncol,:) + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*spechygro + + end do !nspec + + where ( totmmr > 0._r8 ) + sol_factb = solmmr/totmmr + end where + + end function sol_factb_interstitial + + +end module aerosol_state_mod diff --git a/src/aerosol/bulk_aerosol_properties_mod.F90 b/src/aerosol/bulk_aerosol_properties_mod.F90 new file mode 100644 index 000000000..4b68185b5 --- /dev/null +++ b/src/aerosol/bulk_aerosol_properties_mod.F90 @@ -0,0 +1,546 @@ +!-------------------------------------------------------------------------------- +! For bulk aerosol representation. +! Here each aerosol is treated as a separate bin. +!-------------------------------------------------------------------------------- +module bulk_aerosol_properties_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use string_utils, only : to_lower + + use aerosol_properties_mod, only: aerosol_properties + + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_props + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + + implicit none + + private + + public :: bulk_aerosol_properties + + type, extends(aerosol_properties) :: bulk_aerosol_properties + + private + + contains + + procedure :: number_transported + procedure :: get + procedure :: amcube + procedure :: actfracs + procedure :: num_names + procedure :: mmr_names + procedure :: amb_num_name + procedure :: amb_mmr_name + procedure :: species_type + procedure :: icenuc_updates_num + procedure :: icenuc_updates_mmr + procedure :: apply_number_limits + procedure :: hetfrz_species + procedure :: physprop_id + procedure :: soluble + procedure :: min_mass_mean_rad + procedure :: bin_name + procedure :: scav_diam + procedure :: resuspension_resize + procedure :: rebin_bulk_fluxes + procedure :: hydrophilic + procedure :: model_is + + final :: destructor + + end type bulk_aerosol_properties + + interface bulk_aerosol_properties + procedure :: constructor + end interface bulk_aerosol_properties + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(list_idx) result(newobj) + + integer, optional, intent(in) :: list_idx ! radiation list index (0=climate) + type(bulk_aerosol_properties), pointer :: newobj + + integer,allocatable :: nspecies(:) + real(r8),allocatable :: alogsig(:) + real(r8),allocatable :: f1(:) + integer :: ierr, naero, i + integer :: list_idx_loc + real(r8) :: dispersion_val + + list_idx_loc = 0 + if (present(list_idx)) list_idx_loc = list_idx + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + call rad_aer_get_info(list_idx_loc, naero=naero) + + ! Here treat each aerosol as a separate bin + allocate( nspecies(naero),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( alogsig(naero),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( f1(naero),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + ! Bulk aerosols have 1 chemical species in each bin + nspecies(:) = 1 + + ! Read actual dispersion (sigma_logr) from physprop files + do i = 1, naero + call rad_aer_get_props(list_idx_loc, i, dispersion_aer=dispersion_val) + alogsig(i) = log(dispersion_val) + end do + f1(:) = 1._r8 + + ! For bulk aerosols, the number of bins and total number of constituents are + ! the same (naero) -- one constituent (species and mass) per bin. + call newobj%initialize(nbin=naero, ncnst=naero, nspec=nspecies, nmasses=nspecies, & + alogsig=alogsig, f1=f1, f2=f1, ierr=ierr, list_idx=list_idx_loc) + + deallocate(nspecies) + deallocate(alogsig) + deallocate(f1) + + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(bulk_aerosol_properties), intent(inout) :: self + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! returns number of transported aerosol constituents + !------------------------------------------------------------------------------ + integer function number_transported(self) + class(bulk_aerosol_properties), intent(in) :: self + ! to be implemented later + number_transported = -1 + end function number_transported + + + !------------------------------------------------------------------------ + ! returns aerosol properties: + ! density + ! hygroscopicity + ! species type + ! species name + ! short wave species refractive indices + ! long wave species refractive indices + ! species morphology + !------------------------------------------------------------------------ + subroutine get(self, bin_ndx, species_ndx, density, hygro, spec_mw, & + spectype, specname, specmorph, refindex_sw, refindex_lw, num_to_mass_aer, & + dryrad) + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: species_ndx ! species index + real(r8), optional, intent(out) :: density ! density (kg/m3) + real(r8), optional, intent(out) :: hygro ! hygroscopicity + real(r8), optional, intent(out) :: spec_mw ! species molecular weight + character(len=*), optional, intent(out) :: spectype ! species type + character(len=*), optional, intent(out) :: specname ! species name + character(len=*), optional, intent(out) :: specmorph ! species morphology + complex(r8), pointer, optional, intent(out) :: refindex_sw(:) ! short wave species refractive indices + complex(r8), pointer, optional, intent(out) :: refindex_lw(:) ! long wave species refractive indices + real(r8), optional, intent(out) :: num_to_mass_aer ! ratio of number to mass concentration + real(r8), optional, intent(out) :: dryrad ! dry radius (m) + + character(len=20) :: aername + + if (present(density)) then + call rad_aer_get_props(self%list_idx_, bin_ndx, density_aer=density) + end if + + if (present(hygro)) then + call rad_aer_get_props(self%list_idx_, bin_ndx, hygro_aer=hygro) + end if + if (present(spectype)) then + + call rad_aer_get_props(self%list_idx_, bin_ndx, aername=aername) + + select case ( to_lower( aername(:4) ) ) + case('dust') + spectype = 'dust' + case('sulf','volc') + spectype = 'sulfate' + case('bcar','bcph') + spectype = 'black-c' + case('ocar','ocph') + spectype = 'p-organic' + case('sslt','seas','ssam','sscm') + spectype = 'seasalt' + case default + spectype = 'UNKNOWN' + call endrun('ERROR: bulk_aerosol_properties_mod%get aername not recognized : '//aername) + end select + + end if + if (present(specmorph)) then + call endrun('ERROR: bulk_aerosol_properties_mod%get specmorph not yet implemented') + end if + if (present(specname)) then + call rad_aer_get_props(self%list_idx_, bin_ndx, aername=specname) + end if + if (present(refindex_sw)) then + call rad_aer_get_props(self%list_idx_, bin_ndx, refindex_aer_sw=refindex_sw) + end if + if (present(refindex_lw)) then + call rad_aer_get_props(self%list_idx_, bin_ndx, refindex_aer_lw=refindex_lw) + end if + if (present(num_to_mass_aer)) then + call rad_aer_get_props(self%list_idx_, bin_ndx, num_to_mass_aer=num_to_mass_aer) + end if + if (present(dryrad)) then + call rad_aer_get_props(self%list_idx_, bin_ndx, dryrad_aer=dryrad) + end if + if (present(spec_mw)) then + call rad_aer_get_props(self%list_idx_, bin_ndx, aername=aername) + + select case ( to_lower( aername(:4) ) ) + case('sulf','volc') + spec_mw = 96._r8 + case('bcar','bcph','ocar','ocph') + spec_mw = 12._r8 + case('dust') + spec_mw = 12._r8 !!! ???? + case('sslt','seas','ssam','sscm') + spec_mw = 57._r8 + case default + spec_mw = nan + call endrun('ERROR: bulk_aerosol_properties_mod%get aername not recognized : '//aername) + end select + end if + + end subroutine get + + !------------------------------------------------------------------------ + ! returns the physprop ID for a given bin (aerosol) index + !------------------------------------------------------------------------ + integer function physprop_id(self, bin_ndx) + use radiative_aerosol, only: rad_aer_bulk_physprop_id + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + + physprop_id = rad_aer_bulk_physprop_id(self%list_idx_, bin_ndx) + + end function physprop_id + + !------------------------------------------------------------------------------ + ! returns radius^3 (m3) of a given bin number + !------------------------------------------------------------------------------ + pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(in) :: volconc ! volume conc (m3/m3) + real(r8), intent(in) :: numconc ! number conc (1/m3) + + amcube = nan ! to be implemented later if needed + + end function amcube + + !------------------------------------------------------------------------------ + ! returns mass and number activation fractions + !------------------------------------------------------------------------------ + subroutine actfracs(self, bin_ndx, smc, smax, fn, fm ) + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8),intent(in) :: smc ! critical supersaturation for particles of bin radius + real(r8),intent(in) :: smax ! maximum supersaturation for multiple competing aerosols + real(r8),intent(out) :: fn ! activation fraction for aerosol number + real(r8),intent(out) :: fm ! activation fraction for aerosol mass + + ! to be implemented later if needed + call endrun('ERROR: bulk_aerosol_properties_mod%actfracs not yet implemented') + + end subroutine actfracs + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine num_names(self, bin_ndx, name_a, name_c) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol number dens + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol number dens + + ! to be implemented later if needed + call endrun('ERROR: bulk_aerosol_properties_mod%num_names not yet implemented') + + end subroutine num_names + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol MMR + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol MMR + + ! to be implemented later if needed + call endrun('ERROR: bulk_aerosol_properties_mod%mmr_names not yet implemented') + + end subroutine mmr_names + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine amb_num_name(self, bin_ndx, name) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens + + ! to be implemented later if needed + call endrun('ERROR: bulk_aerosol_properties_mod%amb_num_name not yet implemented') + + end subroutine amb_num_name + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine amb_mmr_name(self, bin_ndx, species_ndx, name) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR + + ! to be implemented later if needed + call endrun('ERROR: bulk_aerosol_properties_mod%amb_mmr_name not yet implemented') + + end subroutine amb_mmr_name + + !------------------------------------------------------------------------ + ! returns species type + !------------------------------------------------------------------------ + subroutine species_type(self, bin_ndx, species_ndx, spectype) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: spectype ! species type + + call self%get(bin_ndx, species_ndx, spectype=spectype) + + end subroutine species_type + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to given aerosol bin number + !------------------------------------------------------------------------------ + function icenuc_updates_num(self, bin_ndx) result(res) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + logical :: res + + ! to be implemented later if needed + res = .false. + + end function icenuc_updates_num + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to a given species within a bin + !------------------------------------------------------------------------------ + function icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + logical :: res + + ! to be implemented later if needed + res = .false. + end function icenuc_updates_mmr + + !------------------------------------------------------------------------------ + ! apply max / min to number concentration + !------------------------------------------------------------------------------ + subroutine apply_number_limits( self, naerosol, vaerosol, ncol, nlev, m ) + class(bulk_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:,:) ! number conc (1/m3) + real(r8), intent(in) :: vaerosol(:,:) ! volume conc (m3/m3) + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vert levels + integer, intent(in) :: m ! mode or bin index + + ! no-op for bulk aerosols: no min/max number constraints since numbers are diagnosed + ! from bulk mass concentrations + return + + end subroutine apply_number_limits + + !------------------------------------------------------------------------------ + ! returns TRUE if species `spc_ndx` in aerosol subset `bin_ndx` contributes to + ! the particles' ability to act as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_species(self, bin_ndx, spc_ndx) result(res) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: spc_ndx ! species number + + logical :: res + + ! to be implemented later if needed + res = .false. + end function hetfrz_species + + !------------------------------------------------------------------------------ + ! returns TRUE if soluble + !------------------------------------------------------------------------------ + logical function soluble(self,bin_ndx) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + character(len=20) :: aername + logical :: primary_carbon ! primary carbons (CB1 and OC1) are hydrophobic + + call rad_aer_get_props(self%list_idx_, bin_ndx, aername=aername) + + aername = to_lower(aername) + + primary_carbon = (aername=='bcpho') .or. (aername=='ocpho') + soluble = .not. primary_carbon + + end function soluble + + !------------------------------------------------------------------------------ + ! returns minimum mass mean radius (meters) + !------------------------------------------------------------------------------ + function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + real(r8) :: minrad ! meters + + minrad = 0._r8 + + end function min_mass_mean_rad + + !------------------------------------------------------------------------------ + ! returns name for a given aerosol bin + !------------------------------------------------------------------------------ + function bin_name(self, bin_ndx) result(name) + use aerosol_properties_mod, only: aero_name_len + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + character(len=aero_name_len) :: name + character(len=64), allocatable :: names(:) + integer :: naer, astat + + call rad_aer_get_info(self%list_idx_, naero=naer) + + allocate( names(naer), stat=astat) + if( astat/= 0 ) call endrun('bulk_aerosol_properties_mod%bin_name: names allocate error') + + call rad_aer_get_info(self%list_idx_, aernames=names) + + name = names(bin_ndx) + + deallocate(names) + + end function bin_name + + !------------------------------------------------------------------------------ + ! returns scavenging diameter (cm) for a given aerosol bin number + !------------------------------------------------------------------------------ + function scav_diam(self, bin_ndx) result(diam) + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: diam + + diam = nan ! to be implemented later if needed + + end function scav_diam + + !------------------------------------------------------------------------------ + ! adjust aerosol concentration tendencies to create larger sizes of aerosols + ! during resuspension + !------------------------------------------------------------------------------ + subroutine resuspension_resize(self, dcondt) + + class(bulk_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + + dcondt = nan ! to be implemented later if needed + + end subroutine resuspension_resize + + !------------------------------------------------------------------------------ + ! returns bulk deposition fluxes of the specified species type + ! rebinned to specified diameter limits + !------------------------------------------------------------------------------ + subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, & + error_code, error_string) + + class(bulk_aerosol_properties), intent(in) :: self + character(len=*),intent(in) :: bulk_type ! aerosol type to rebin + real(r8), intent(in) :: dep_fluxes(:) ! kg/m2 + real(r8), intent(in) :: diam_edges(:) ! meters + real(r8), intent(out) :: bulk_fluxes(:) ! kg/m2 + integer, intent(out) :: error_code ! error code (0 if no error) + character(len=*), intent(out) :: error_string ! error string + + ! to be implemented later if needed + call endrun('ERROR: bulk_aerosol_properties_mod%rebin_bulk_fluxes not yet implemented') + + end subroutine rebin_bulk_fluxes + + !------------------------------------------------------------------------------ + ! Returns TRUE if bin is hydrophilic, otherwise FALSE + !------------------------------------------------------------------------------ + logical function hydrophilic(self, bin_ndx) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + hydrophilic = self%soluble(bin_ndx) + + end function hydrophilic + + !------------------------------------------------------------------------------ + ! returns TRUE if bulk aerosol representation + !------------------------------------------------------------------------------ + pure logical function model_is(self, query) + class(bulk_aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query + + if (trim(query) == 'BAM' .or. trim(query) == 'bam') then + model_is = .true. + else if (trim(query) == 'bulk_model') then + model_is = .true. + else + model_is = .false. + end if + + end function model_is + +end module bulk_aerosol_properties_mod diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 new file mode 100644 index 000000000..f192f928f --- /dev/null +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -0,0 +1,618 @@ +module bulk_aerosol_state_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_mmr_host, only: rad_cnst_get_aer_mmr, aero_host_binding_t + use cam_abortutils, only: endrun + + use aerosol_state_mod, only: aerosol_state, ptr2d_t + use aerosol_properties_mod, only: aerosol_properties + use radiative_aerosol, only: rad_aer_get_props + use string_utils, only: to_lower + + implicit none + + private + + ! BAM sulfate scaling factor: + real(r8), parameter :: bam_sulfate_scale = 2.0_r8 + + public :: bulk_aerosol_state + + type, extends(aerosol_state) :: bulk_aerosol_state + private + + ! Opaque host-binding handle used to retrieve aerosol fields from + ! host model data; built by host-side wiring (aerosol_instances_mod) + type(aero_host_binding_t) :: host_ + + ! Per-object workspace for derived number mixing ratio. + ! Allocated in constructor, deallocated in destructor. + real(r8), pointer :: num_work_(:,:) => null() ! (horizontal_dimension, vertical_layer_dimension) + real(r8), pointer :: zero_fld_(:,:) => null() ! (horizontal_dimension, vertical_layer_dimension) + + contains + + procedure :: get_transported + procedure :: set_transported + procedure :: ambient_total_bin_mmr + procedure :: get_ambient_mmr + procedure :: get_cldbrne_mmr + procedure :: get_ambient_num + procedure :: get_cldbrne_num + procedure :: get_states + procedure :: icenuc_size_wght_arr + procedure :: icenuc_size_wght_val + procedure :: icenuc_type_wght + procedure :: update_bin + procedure :: hetfrz_size_wght + procedure :: hygroscopicity + procedure :: water_uptake + procedure :: dry_volume + procedure :: wet_volume + procedure :: water_volume + procedure :: wet_diameter + procedure :: convcld_actfrac + procedure :: wgtpct + procedure :: aqu_gain_binfraction + procedure :: get_bulk_num_and_mass + ! for bit-for-bit + procedure :: nuclice_get_numdens => nuclice_get_numdens_bam + + final :: destructor + + end type bulk_aerosol_state + + interface bulk_aerosol_state + procedure :: constructor + end interface bulk_aerosol_state + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(ncol, host, list_idx) result(newobj) + use vert_coord, only: pver + + integer, intent(in) :: ncol + type(aero_host_binding_t), intent(in) :: host + integer, intent(in), optional :: list_idx + type(bulk_aerosol_state), pointer :: newobj + + integer :: ierr + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%host_ = host + + ! set number of active columns internally to prevent loops from accessing beyond + ! meaningful data in arrays + call newobj%set_ncol(ncol) + + if (present(list_idx)) call newobj%set_list_idx(list_idx) + + ! Allocate per-object workspace for derived number fields. + allocate(newobj%num_work_(ncol, pver), stat=ierr) + if (ierr /= 0) call endrun('bulk_aerosol_state constructor: num_work_ allocation error') + newobj%num_work_(:,:) = 0._r8 + allocate(newobj%zero_fld_(ncol, pver), stat=ierr) + if (ierr /= 0) call endrun('bulk_aerosol_state constructor: zero_fld_ allocation error') + newobj%zero_fld_(:,:) = 0._r8 + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(bulk_aerosol_state), intent(inout) :: self + + ! disassociate the host binding (data referenced within is not owned here) + self%host_ = aero_host_binding_t() + + if (associated(self%num_work_)) then + deallocate(self%num_work_) + nullify(self%num_work_) + end if + if (associated(self%zero_fld_)) then + deallocate(self%zero_fld_) + nullify(self%zero_fld_) + end if + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! sets transported components + ! This aerosol model with the state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine set_transported( self, transported_array ) + class(bulk_aerosol_state), intent(inout) :: self + real(r8), intent(in) :: transported_array(:,:,:) + ! to be implemented later + end subroutine set_transported + + !------------------------------------------------------------------------------ + ! returns transported components + ! This returns to current state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine get_transported( self, transported_array ) + class(bulk_aerosol_state), intent(in) :: self + real(r8), intent(out) :: transported_array(:,:,:) + ! to be implemented later + end subroutine get_transported + + !------------------------------------------------------------------------ + ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer) + !------------------------------------------------------------------------ + function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot) + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + + real(r8) :: mmr_tot ! mass mixing ratios totaled for all species + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call self%get_ambient_mmr(species_ndx=1, bin_ndx=bin_ndx, mmr=mmr) + + mmr_tot = mmr(col_ndx, lyr_ndx) + + end function ambient_total_bin_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol mass mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + ! species_ndx is ignored in the bulk implementation. + ! bin_ndx is used to identify each individual bulk aerosol. + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, self%host_, mmr) + + end subroutine get_ambient_mmr + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + ! BAM has no cloud-borne aerosol equivalent, return zero array. + mmr => self%zero_fld_ + + end subroutine get_cldbrne_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_num(self, bin_ndx, num) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) ! number densities + + real(r8), pointer :: mmr(:,:) + real(r8) :: ntm + character(len=32) :: aname + integer :: nc + + ! Derive number mixing ratio from mass: num = mmr * num_to_mass_aer (* bam_sulfate_scale for sulfate). + ! This matches the inline computation formerly in microp_aero.F90 and nucleate_ice_cam.F90. + ! Computed into per-object workspace (num_work_); callers must use or copy before the next call. + ! Only active columns (1:ncol) are computed to avoid FPE on uninitialised padding columns. + + nc = self%ncol() + + call self%get_ambient_mmr(species_ndx=1, bin_ndx=bin_ndx, mmr=mmr) + call rad_aer_get_props(self%list_idx_, bin_ndx, num_to_mass_aer=ntm, aername=aname) + + ! Apply bam_sulfate_scale to sulfate/volcanic aerosol + select case ( to_lower( aname(:4) ) ) + case ('sulf', 'volc') ! both treated as 'sulfate' in aero_props%get type. + self%num_work_(:nc,:) = mmr(:nc,:) * ntm * bam_sulfate_scale + case default + self%num_work_(:nc,:) = mmr(:nc,:) * ntm + end select + + num => self%num_work_ + + end subroutine get_ambient_num + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_num(self, bin_ndx, num) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) + + ! BAM has no cloud-borne equivalent, return zero array. + num => self%zero_fld_ + + end subroutine get_cldbrne_num + + !------------------------------------------------------------------------------ + ! returns interstitial and cloud-borne aerosol states + !------------------------------------------------------------------------------ + subroutine get_states( self, aero_props, raer, qqcw ) + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + type(ptr2d_t), intent(out) :: raer(:) + type(ptr2d_t), intent(out) :: qqcw(:) + + call endrun('ERROR: bulk_aerosol_state_mod%get_states not yet implemented') + + end subroutine get_states + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght(:,:) + + ! Empirical 1/25 scaling factor for BAM ice nucleation number densities. + ! This was previously hardcoded inline in nucleate_ice_cam.F90:633. + wght(:ncol,:nlev) = 1._r8 / 25._r8 + + end subroutine icenuc_size_wght_arr + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin, column and vertical layer + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght + + ! Empirical 1/25 scaling factor for BAM ice nucleation number densities. + wght = 1._r8 / 25._r8 + + end subroutine icenuc_size_wght_val + + !------------------------------------------------------------------------------ + ! returns aerosol type weights for a given aerosol type and bin + !------------------------------------------------------------------------------ + subroutine icenuc_type_wght(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: wght(:,:) ! type weights + logical, optional, intent(in) :: cloud_borne ! if TRUE cloud-borne aerosols are used + ! otherwise ambient aerosols are used + + character(len=32) :: bin_spectype + + ! BAM has exactly 1 species per bin. The type weight is 1.0 when the queried + ! species type matches the bin's species, 0.0 otherwise. This avoids the + ! base class computation (which reads MMR just to compute mass/totalmass = 1.0). + + call aero_props%species_type(bin_ndx, 1, bin_spectype) + + if (trim(bin_spectype) == trim(species_type) .or. & + (species_type == 'sulfate_strat' .and. bin_spectype == 'sulfate')) then + wght(:ncol,:nlev) = 1._r8 + else + wght(:ncol,:nlev) = 0._r8 + end if + + end subroutine icenuc_type_wght + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend ) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + real(r8),intent(in) :: delmmr_sum ! mass mixing ratio change summed over all species in bin + real(r8),intent(in) :: delnum_sum ! number mixing ratio change summed over all species in bin + integer, intent(in) :: tnd_ndx ! tendency index + real(r8),intent(in) :: dtime ! time step size (sec) + real(r8),intent(inout) :: tend(:,:,:) ! tendency + + ! No-op for BAM: ice nucleation does not produce aerosol tendencies + ! (no interstitial-to-cloud-borne transfer for bulk aerosols). + + end subroutine update_bin + + !------------------------------------------------------------------------------ + ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act + ! as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + real(r8) :: wght(ncol,nlev) + + call endrun('ERROR: bulk_aerosol_state_mod%hetfrz_size_wght not yet implemented') + + end function hetfrz_size_wght + + !------------------------------------------------------------------------------ + ! returns hygroscopicity for a given radiation diagnostic list number and + ! bin number + !------------------------------------------------------------------------------ + subroutine hygroscopicity(self, bin_ndx, kappa) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) + + call endrun('ERROR: bulk_aerosol_state_mod%hygroscopicity not yet implemented') + + end subroutine hygroscopicity + + !------------------------------------------------------------------------------ + ! returns aerosol wet diameter and aerosol water concentration for a given + ! radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) + + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) + real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) + + call endrun('ERROR: bulk_aerosol_state_mod%water_uptake not yet implemented') + + end subroutine water_uptake + + !------------------------------------------------------------------------------ + ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function dry_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) + + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + real(r8), pointer :: mmr(:,:) ! kg/kg + real(r8) :: dens ! kg/m3 + + call aero_props%get(bin_idx, 1, density=dens) + call self%get_ambient_mmr(species_ndx=1, bin_ndx=bin_idx, mmr=mmr) + + vol(:ncol,:nlev) = mmr(:ncol,:nlev)/dens + + end function dry_volume + + !------------------------------------------------------------------------------ + ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function wet_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) + + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + vol = self%dry_volume(aero_props, bin_idx, ncol, nlev) & + + self%water_volume(aero_props, bin_idx, ncol, nlev) + + end function wet_volume + + !------------------------------------------------------------------------------ + ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function water_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) + + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + vol = 0._r8 + + end function water_volume + + !------------------------------------------------------------------------------ + ! aerosol wet diameter + !------------------------------------------------------------------------------ + function wet_diameter(self, bin_idx, ncol, nlev) result(diam) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: diam(ncol,nlev) + + call endrun('ERROR: bulk_aerosol_state_mod%wet_diameter not yet implemented') + + end function wet_diameter + + !------------------------------------------------------------------------------ + ! prescribed aerosol activation fraction for convective cloud + !------------------------------------------------------------------------------ + function convcld_actfrac(self, aero_props, ibin, ispc, ncol, nlev) result(frac) + + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: ispc ! species index + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: frac(ncol,nlev) + + call endrun('ERROR: bulk_aerosol_state_mod%convcld_actfrac not yet implemented') + + end function convcld_actfrac + + !------------------------------------------------------------------------------ + ! aerosol weight percent of H2SO4/H2O solution + !------------------------------------------------------------------------------ + function wgtpct(self, ncol, nlev) result(wtp) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: ncol, nlev + real(r8) :: wtp(ncol,nlev) ! weight percent of H2SO4/H2O solution for given icol, ilev + + wtp = -huge(1._r8) + + end function wgtpct + + !------------------------------------------------------------------------------ + ! aqueous chemistry partitioning -- used in sox_cldaero_update + !------------------------------------------------------------------------------ + subroutine aqu_gain_binfraction(self, aero_props, type, qcw, delso4_o3rxn, faqgain) + + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + character(len=*), intent(in) :: type + real(r8), intent(in) :: qcw(:,:,:) + real(r8), intent(in) :: delso4_o3rxn(:,:) + real(r8), intent(out) :: faqgain(:,:,:) ! fraction gain in each mode / bin + + faqgain(:,:,:) = 1._r8 + + end subroutine aqu_gain_binfraction + + !------------------------------------------------------------------------------ + ! Compute BAM number concentration (#/m3) and mass concentration (kg/m3) + ! for a single bin. Applies bam_sulfate_scale only to SULFATE (not volcanic). + ! b4b operation order: (mmr * rho) first, then * ntm [* 2.0 for sulfate]. + !------------------------------------------------------------------------------ + subroutine get_bulk_num_and_mass(self, bin_ndx, ncol, rho, naer2, maerosol) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx + integer, intent(in) :: ncol + real(r8), intent(in) :: rho(:,:) ! air density (kg/m3), (ncol,pver) + real(r8), intent(out) :: naer2(:,:) ! number concentration (#/m3) + real(r8), intent(out) :: maerosol(:,:) ! mass concentration (kg/m3) + + real(r8), pointer :: mmr(:,:) + real(r8) :: ntm + character(len=32) :: aname + + call self%get_ambient_mmr(species_ndx=1, bin_ndx=bin_ndx, mmr=mmr) + call rad_aer_get_props(self%list_idx_, bin_ndx, num_to_mass_aer=ntm, aername=aname) + + ! b4b operation order: (mmr * rho) first, then * ntm [* 2.0 for sulfate] + ! + ! Note: only SULFATE gets the scale factor here. + ! Volcanic aerosol (which also has spectype 'sulfate') does not get scaled in the + ! ndrop_bam/CCN path (which only scales idxsul, SULFATE here) + ! Ice nucleation has been unified to also use this path, but it does scale volcanic + ! aerosol; it will apply this scale factor separately. + maerosol(:ncol,:) = mmr(:ncol,:) * rho(:ncol,:) + + select case ( to_lower( aname(:4) ) ) + case ('sulf') + naer2(:ncol,:) = maerosol(:ncol,:) * ntm * bam_sulfate_scale + case default + naer2(:ncol,:) = maerosol(:ncol,:) * ntm + end select + + end subroutine get_bulk_num_and_mass + + ! NOTE on bit-for-bit: The base-class nuclice_get_numdens computes: + ! size_wght * type_wght * num_col(#/kg) * rho * per_cm3 + ! where for BAM: num_col = mmr * ntm [* bam_sulfate_scale], size_wght = 1/25, type_wght = 1.0 + ! giving: (1/25) * 1.0 * (mmr * ntm) * rho * 1e-6 + ! + ! The original inline BAM code (nucleate_ice_cam.F90, removed) computed: + ! naer2 = aer_mmr * rho * ntm (mmr * rho first, then * ntm) + ! dust_num = naer2 / 25 * 1e-6 + ! giving: (mmr * rho * ntm) / 25 * 1e-6 + ! + ! These differ only in floating-point operation order (associativity). + ! It has been shown that this rearranging causes answer differences, so we + ! use this subroutine to replicate the original behavior. + subroutine nuclice_get_numdens_bam(self, aero_props, use_preexisting_ice, & + ncol, nlev, rho, dust_num_col, sulf_num_col, soot_num_col, sulf_num_tot_col) + + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + logical, intent(in) :: use_preexisting_ice + integer, intent(in) :: ncol + integer, intent(in) :: nlev + real(r8), intent(in) :: rho(:,:) + real(r8), intent(out) :: dust_num_col(:,:) + real(r8), intent(out) :: sulf_num_col(:,:) + real(r8), intent(out) :: soot_num_col(:,:) + real(r8), intent(out) :: sulf_num_tot_col(:,:) + + real(r8) :: naer2_1bin(ncol,nlev) + real(r8) :: maerosol_1bin(ncol,nlev) + character(len=32) :: spectype, aname + integer :: m, i, k + real(r8), parameter :: per_cm3 = 1.e-6_r8 + + dust_num_col(:,:) = 0._r8 + sulf_num_col(:,:) = 0._r8 + soot_num_col(:,:) = 0._r8 + sulf_num_tot_col(:,:) = 0._r8 + + do m = 1, aero_props%nbins() + call aero_props%species_type(m, 1, spectype) + call self%get_bulk_num_and_mass(m, ncol, rho, naer2_1bin, maerosol_1bin) + + ! get_bulk_num_and_mass only applied bam_sulfate_scale to SULFATE (by name). + ! For the nucleate_ice path, volcanic aerosol (spectype 'sulfate', name 'volc*') + ! also needs the scale, matching the original inline code which scaled ALL + ! spectype=='sulfate' bins including volcanic aerosol, so we will do it here: + ! (but do not do it again for SULFATE) + if (spectype == 'sulfate') then + call rad_aer_get_props(self%list_idx_, m, aername=aname) + if (to_lower(aname(:4)) == 'volc') then + naer2_1bin(:ncol,:nlev) = naer2_1bin(:ncol,:nlev) * bam_sulfate_scale + end if + end if + + do k = 1, nlev + do i = 1, ncol + select case (trim(spectype)) + case ('dust') + dust_num_col(i,k) = dust_num_col(i,k) + naer2_1bin(i,k) / 25._r8 * per_cm3 + case ('sulfate') + sulf_num_col(i,k) = sulf_num_col(i,k) + naer2_1bin(i,k) / 25._r8 * per_cm3 + sulf_num_tot_col(i,k) = sulf_num_tot_col(i,k) + naer2_1bin(i,k) / 25._r8 * per_cm3 + case ('black-c') + soot_num_col(i,k) = soot_num_col(i,k) + naer2_1bin(i,k) / 25._r8 * per_cm3 + end select + end do + end do + end do + + end subroutine nuclice_get_numdens_bam + +end module bulk_aerosol_state_mod diff --git a/src/aerosol/carma_aerosol_properties_mod.F90 b/src/aerosol/carma_aerosol_properties_mod.F90 new file mode 100644 index 000000000..28979b8e5 --- /dev/null +++ b/src/aerosol/carma_aerosol_properties_mod.F90 @@ -0,0 +1,219 @@ +module carma_aerosol_properties_mod + !----------------------------------------------------------------------------- + ! Stub module for CARMA aerosol properties not yet implemented in CAM-SIMA. + ! Exports the constructor interface so aerosol_instances_mod compiles. + !----------------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use aerosol_properties_mod, only: aerosol_properties, aero_name_len + + implicit none + private + + public :: carma_aerosol_properties + + type, extends(aerosol_properties) :: carma_aerosol_properties + private + contains + procedure :: number_transported + procedure :: get + procedure :: amcube + procedure :: actfracs + procedure :: num_names + procedure :: mmr_names + procedure :: amb_num_name + procedure :: amb_mmr_name + procedure :: species_type + procedure :: icenuc_updates_num + procedure :: icenuc_updates_mmr + procedure :: apply_number_limits + procedure :: hetfrz_species + procedure :: physprop_id + procedure :: soluble + procedure :: min_mass_mean_rad + procedure :: bin_name + procedure :: scav_diam + procedure :: resuspension_resize + procedure :: rebin_bulk_fluxes + procedure :: hydrophilic + procedure :: model_is + end type carma_aerosol_properties + + interface carma_aerosol_properties + procedure :: constructor + end interface carma_aerosol_properties + +contains + + function constructor(list_idx) result(newobj) + integer, optional, intent(in) :: list_idx + type(carma_aerosol_properties), pointer :: newobj + nullify(newobj) + call endrun('carma_aerosol_properties: not implemented in CAM-SIMA') + end function constructor + + integer function number_transported(self) + class(carma_aerosol_properties), intent(in) :: self + number_transported = -1 + call endrun('carma_aerosol_properties%number_transported: not implemented') + end function number_transported + + subroutine get(self, bin_ndx, species_ndx, density, hygro, spec_mw, & + spectype, specname, specmorph, refindex_sw, refindex_lw, num_to_mass_aer, dryrad) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + real(r8), optional, intent(out) :: density, hygro + real(r8), optional, intent(out) :: spec_mw ! species molecular weight + character(len=*), optional, intent(out) :: spectype, specname, specmorph + complex(r8), pointer, optional, intent(out) :: refindex_sw(:), refindex_lw(:) + real(r8), optional, intent(out) :: num_to_mass_aer, dryrad + call endrun('carma_aerosol_properties%get: not implemented') + end subroutine get + + pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8), intent(in) :: volconc, numconc + amcube = -huge(1._r8) + end function amcube + + subroutine actfracs(self, bin_ndx, smc, smax, fn, fm) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8), intent(in) :: smc, smax + real(r8), intent(out) :: fn, fm + call endrun('carma_aerosol_properties%actfracs: not implemented') + end subroutine actfracs + + subroutine num_names(self, bin_ndx, name_a, name_c) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + character(len=*), intent(out) :: name_a, name_c + call endrun('carma_aerosol_properties%num_names: not implemented') + end subroutine num_names + + subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + character(len=*), intent(out) :: name_a, name_c + call endrun('carma_aerosol_properties%mmr_names: not implemented') + end subroutine mmr_names + + subroutine amb_num_name(self, bin_ndx, name) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + character(len=*), intent(out) :: name + call endrun('carma_aerosol_properties%amb_num_name: not implemented') + end subroutine amb_num_name + + subroutine amb_mmr_name(self, bin_ndx, species_ndx, name) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + character(len=*), intent(out) :: name + call endrun('carma_aerosol_properties%amb_mmr_name: not implemented') + end subroutine amb_mmr_name + + subroutine species_type(self, bin_ndx, species_ndx, spectype) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + character(len=*), intent(out) :: spectype + call endrun('carma_aerosol_properties%species_type: not implemented') + end subroutine species_type + + function icenuc_updates_num(self, bin_ndx) result(res) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + logical :: res + res = .false. + end function icenuc_updates_num + + function icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + logical :: res + res = .false. + end function icenuc_updates_mmr + + subroutine apply_number_limits( self, naerosol, vaerosol, ncol, nlev, m ) + class(carma_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:,:) ! number conc (1/m3) + real(r8), intent(in) :: vaerosol(:,:) ! volume conc (m3/m3) + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vert levels + integer, intent(in) :: m + call endrun('carma_aerosol_properties%apply_number_limits: not implemented') + end subroutine apply_number_limits + + function hetfrz_species(self, bin_ndx, spc_ndx) result(res) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, spc_ndx + logical :: res + res = .false. + end function hetfrz_species + + integer function physprop_id(self, bin_ndx) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + physprop_id = -1 + call endrun('carma_aerosol_properties%physprop_id: not implemented') + end function physprop_id + + logical function soluble(self, bin_ndx) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + soluble = .false. + call endrun('carma_aerosol_properties%soluble: not implemented') + end function soluble + + function min_mass_mean_rad(self, bin_ndx, species_ndx) result(minrad) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + real(r8) :: minrad + minrad = 0._r8 + end function min_mass_mean_rad + + function bin_name(self, bin_ndx) result(name) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + character(len=aero_name_len) :: name + name = '' + call endrun('carma_aerosol_properties%bin_name: not implemented') + end function bin_name + + function scav_diam(self, bin_ndx) result(diam) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8) :: diam + diam = -huge(1._r8) + end function scav_diam + + subroutine resuspension_resize(self, dcondt) + class(carma_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + call endrun('carma_aerosol_properties%resuspension_resize: not implemented') + end subroutine resuspension_resize + + subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, & + error_code, error_string) + class(carma_aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: bulk_type + real(r8), intent(in) :: dep_fluxes(:), diam_edges(:) + real(r8), intent(out) :: bulk_fluxes(:) + integer, intent(out) :: error_code + character(len=*), intent(out) :: error_string + call endrun('carma_aerosol_properties%rebin_bulk_fluxes: not implemented') + end subroutine rebin_bulk_fluxes + + logical function hydrophilic(self, bin_ndx) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + hydrophilic = .false. + end function hydrophilic + + pure logical function model_is(self, query) + class(carma_aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query + model_is = (trim(query) == 'CARMA' .or. trim(query) == 'carma') + end function model_is + +end module carma_aerosol_properties_mod diff --git a/src/aerosol/carma_aerosol_state_mod.F90 b/src/aerosol/carma_aerosol_state_mod.F90 new file mode 100644 index 000000000..1e0bc7240 --- /dev/null +++ b/src/aerosol/carma_aerosol_state_mod.F90 @@ -0,0 +1,215 @@ +module carma_aerosol_state_mod + !----------------------------------------------------------------------------- + ! Stub module for CARMA aerosol state not yet implemented in CAM-SIMA. + ! Exports the constructor interface so aerosol_instances_mod compiles. + !----------------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use aerosol_mmr_host, only: aero_host_binding_t + use aerosol_state_mod, only: aerosol_state, ptr2d_t + use aerosol_properties_mod, only: aerosol_properties + + implicit none + private + + public :: carma_aerosol_state + + type, extends(aerosol_state) :: carma_aerosol_state + private + contains + procedure :: get_transported + procedure :: set_transported + procedure :: ambient_total_bin_mmr + procedure :: get_ambient_mmr + procedure :: get_cldbrne_mmr + procedure :: get_ambient_num + procedure :: get_cldbrne_num + procedure :: get_states + procedure :: icenuc_size_wght_arr + procedure :: icenuc_size_wght_val + procedure :: update_bin + procedure :: hetfrz_size_wght + procedure :: hygroscopicity + procedure :: water_uptake + procedure :: dry_volume + procedure :: wet_volume + procedure :: water_volume + procedure :: wet_diameter + procedure :: aqu_gain_binfraction + procedure :: wgtpct + end type carma_aerosol_state + + interface carma_aerosol_state + procedure :: constructor + end interface carma_aerosol_state + +contains + + function constructor(ncol, host, list_idx) result(newobj) + integer, intent(in) :: ncol + type(aero_host_binding_t), intent(in) :: host + integer, intent(in), optional :: list_idx + type(carma_aerosol_state), pointer :: newobj + nullify(newobj) + call endrun('carma_aerosol_state: not implemented in CAM-SIMA') + end function constructor + + subroutine set_transported(self, transported_array) + class(carma_aerosol_state), intent(inout) :: self + real(r8), intent(in) :: transported_array(:,:,:) + call endrun('carma_aerosol_state%set_transported: not implemented') + end subroutine set_transported + + subroutine get_transported(self, transported_array) + class(carma_aerosol_state), intent(in) :: self + real(r8), intent(out) :: transported_array(:,:,:) + call endrun('carma_aerosol_state%get_transported: not implemented') + end subroutine get_transported + + function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot) + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_ndx, col_ndx, lyr_ndx + real(r8) :: mmr_tot + mmr_tot = 0._r8 + call endrun('carma_aerosol_state%ambient_total_bin_mmr: not implemented') + end function ambient_total_bin_mmr + + subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx, bin_ndx + real(r8), pointer :: mmr(:,:) + nullify(mmr) + call endrun('carma_aerosol_state%get_ambient_mmr: not implemented') + end subroutine get_ambient_mmr + + subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx, bin_ndx + real(r8), pointer :: mmr(:,:) + nullify(mmr) + call endrun('carma_aerosol_state%get_cldbrne_mmr: not implemented') + end subroutine get_cldbrne_mmr + + subroutine get_ambient_num(self, bin_ndx, num) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8), pointer :: num(:,:) + nullify(num) + call endrun('carma_aerosol_state%get_ambient_num: not implemented') + end subroutine get_ambient_num + + subroutine get_cldbrne_num(self, bin_ndx, num) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8), pointer :: num(:,:) + nullify(num) + call endrun('carma_aerosol_state%get_cldbrne_num: not implemented') + end subroutine get_cldbrne_num + + subroutine get_states(self, aero_props, raer, qqcw) + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + type(ptr2d_t), intent(out) :: raer(:), qqcw(:) + call endrun('carma_aerosol_state%get_states: not implemented') + end subroutine get_states + + subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx, ncol, nlev + character(len=*), intent(in) :: species_type + logical, intent(in) :: use_preexisting_ice + real(r8), intent(out) :: wght(:,:) + call endrun('carma_aerosol_state%icenuc_size_wght_arr: not implemented') + end subroutine icenuc_size_wght_arr + + subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx, col_ndx, lyr_ndx + character(len=*), intent(in) :: species_type + logical, intent(in) :: use_preexisting_ice + real(r8), intent(out) :: wght + call endrun('carma_aerosol_state%icenuc_size_wght_val: not implemented') + end subroutine icenuc_size_wght_val + + subroutine update_bin(self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx, col_ndx, lyr_ndx, tnd_ndx + real(r8), intent(in) :: delmmr_sum, delnum_sum, dtime + real(r8), intent(inout) :: tend(:,:,:) + call endrun('carma_aerosol_state%update_bin: not implemented') + end subroutine update_bin + + function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx, ncol, nlev + real(r8) :: wght(ncol,nlev) + call endrun('carma_aerosol_state%hetfrz_size_wght: not implemented') + end function hetfrz_size_wght + + subroutine hygroscopicity(self, bin_ndx, kappa) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8), intent(out) :: kappa(:,:) + call endrun('carma_aerosol_state%hygroscopicity: not implemented') + end subroutine hygroscopicity + + subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_idx, ncol, nlev + real(r8), intent(out) :: dgnumwet(ncol,nlev), qaerwat(ncol,nlev) + call endrun('carma_aerosol_state%water_uptake: not implemented') + end subroutine water_uptake + + function dry_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_idx, ncol, nlev + real(r8) :: vol(ncol,nlev) + vol = -huge(1._r8) + end function dry_volume + + function wet_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_idx, ncol, nlev + real(r8) :: vol(ncol,nlev) + vol = -huge(1._r8) + end function wet_volume + + function water_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_idx, ncol, nlev + real(r8) :: vol(ncol,nlev) + vol = -huge(1._r8) + end function water_volume + + function wet_diameter(self, bin_idx, ncol, nlev) result(diam) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx, ncol, nlev + real(r8) :: diam(ncol,nlev) + call endrun('carma_aerosol_state%wet_diameter: not implemented') + end function wet_diameter + + function wgtpct(self, ncol, nlev) result(wtp) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: ncol, nlev + real(r8) :: wtp(ncol,nlev) + wtp = -huge(1._r8) + end function wgtpct + + subroutine aqu_gain_binfraction(self, aero_props, type, qcw, delso4_o3rxn, faqgain) + + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + character(len=*), intent(in) :: type ! aerosol species type + real(r8), intent(in) :: qcw(:,:,:) ! cloud-borne aerosol volume mixing ratio + real(r8), intent(in) :: delso4_o3rxn(:,:) ! sulfate concentration change due to oxidation + real(r8), intent(out) :: faqgain(:,:,:) ! fraction gain in each mode / bin + + call endrun('carma_aerosol_state%aqu_gain_binfraction: not implemented') + end subroutine aqu_gain_binfraction + +end module carma_aerosol_state_mod diff --git a/src/aerosol/hygro_aerosol_optics_mod.F90 b/src/aerosol/hygro_aerosol_optics_mod.F90 new file mode 100644 index 000000000..b116cddf9 --- /dev/null +++ b/src/aerosol/hygro_aerosol_optics_mod.F90 @@ -0,0 +1,159 @@ +!------------------------------------------------------------------------------- +! Short-wave hygroscopic aerosol, Long-wave non-hygroscopic (insoluble) +! aerosol optical properties +!------------------------------------------------------------------------------- +module hygro_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + use aerosol_optics_mod, only: aerosol_optics + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + + implicit none + + private + + public :: hygro_aerosol_optics + + type, extends(aerosol_optics) :: hygro_aerosol_optics + + ! aerosol optics properties tables (from physprops files) + real(r8), pointer :: ext_sw(:,:) => null() + real(r8), pointer :: ssa_sw(:,:) => null() + real(r8), pointer :: asm_sw(:,:) => null() + real(r8), pointer :: abs_lw(:) => null() + + ! from state + real(r8), allocatable :: wrh(:,:) ! (-) weighting on left side values ! (pcols,pver) + integer , allocatable :: krh(:,:) ! index into rh mesh + + ! aerosol mass mixing ratio + real(r8), pointer :: mmr(:,:) + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type hygro_aerosol_optics + + interface hygro_aerosol_optics + procedure :: constructor + end interface hygro_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ibin, ncols, nlevs, numrh, relhum) & + result(newobj) + class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object + class(aerosol_state), intent(in) :: aero_state ! aerosol_state object + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncols, nlevs, numrh + real(r8),intent(in) :: relhum(ncols,nlevs) + + type(hygro_aerosol_optics), pointer :: newobj + + real(r8) :: rhtrunc(ncols,nlevs) + integer :: ierr + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%wrh(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%krh(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + +! NOTE should try to use table_interp_mod utility !!! + rhtrunc(1:ncols,1:nlevs) = min(relhum(1:ncols,1:nlevs),1._r8) + newobj%krh(1:ncols,1:nlevs) = min(floor( rhtrunc(1:ncols,1:nlevs) * numrh ) + 1, numrh - 1) ! index into rh mesh + newobj%wrh(1:ncols,1:nlevs) = rhtrunc(1:ncols,1:nlevs) * numrh - newobj%krh(1:ncols,1:nlevs) ! (-) weighting on left side values + + ! optical properties tables + call aero_props%optics_params(ibin, & + sw_hygroscopic_ext=newobj%ext_sw, & + sw_hygroscopic_ssa=newobj%ssa_sw, & + sw_hygroscopic_asm=newobj%asm_sw, & + lw_insoluble_ext=newobj%abs_lw ) + + call aero_state%get_ambient_mmr(species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(hygro_aerosol_optics), intent(in) :: self + + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + pext(icol) = (1._r8 + self%wrh(icol,ilev)) * self%ext_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%ext_sw(self%krh(icol,ilev), iwav) + palb(icol) = (1._r8 + self%wrh(icol,ilev)) * self%ssa_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%ssa_sw(self%krh(icol,ilev), iwav) + pasm(icol) = (1._r8 + self%wrh(icol,ilev)) * self%asm_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%asm_sw(self%krh(icol,ilev), iwav) + + pext(icol) = pext(icol) * self%mmr(icol,ilev) + + pabs(icol) = pext(icol) * ( 1._r8 - palb(icol) ) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(hygro_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + integer :: icol + + pabs(:ncol) = self%abs_lw(iwav) * self%mmr(:ncol,ilev) + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(hygro_aerosol_optics), intent(inout) :: self + + deallocate(self%wrh) + deallocate(self%krh) + + end subroutine destructor + +end module hygro_aerosol_optics_mod diff --git a/src/aerosol/hygrocoreshell_aerosol_optics_mod.F90 b/src/aerosol/hygrocoreshell_aerosol_optics_mod.F90 new file mode 100644 index 000000000..e6e36e777 --- /dev/null +++ b/src/aerosol/hygrocoreshell_aerosol_optics_mod.F90 @@ -0,0 +1,290 @@ +module hygrocoreshell_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_optics_mod, only: aerosol_optics + use aerosol_state_mod, only: aerosol_state + use aerosol_properties_mod, only: aerosol_properties + use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_calcwghts + + implicit none + + private + public :: hygrocoreshell_aerosol_optics + + !> hygrocoreshell_aerosol_optics + !! Table look up implementation of aerosol_optics to parameterize aerosol + !! radiative properties in terms of core mass fraction, black carbon/dust fraction, + !! kappa and relative humidity + type, extends(aerosol_optics) :: hygrocoreshell_aerosol_optics + + real(r8), allocatable :: totalmmr(:,:) ! total mmr of the aerosol + real(r8), allocatable :: corefrac(:,:) ! mass fraction that is core + real(r8), allocatable :: bcdust(:,:) ! mass fraction of bc vs (bc + dust) + real(r8), allocatable :: kappa(:,:) ! hygroscopicity + real(r8), allocatable :: relh(:,:) ! relative humidity + + real(r8), pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) => null() ! short wave extinction table + real(r8), pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) => null() ! short wave single-scatter albedo table + real(r8), pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) => null() ! short wave asymmetry table + real(r8), pointer :: lw_hygro_coreshell_abs(:,:,:,:,:) => null() ! long wave absorption table + + real(r8), pointer :: tbl_corefrac(:) => null() ! core fraction dimension values + real(r8), pointer :: tbl_bcdust(:) => null() ! bc/(bc + dust) fraction dimension values + real(r8), pointer :: tbl_kap(:) => null() ! hygroscopicity dimension values + real(r8), pointer :: tbl_relh(:) => null() ! relative humidity dimension values + + integer :: nfrac = -1 ! core fraction dimension size + integer :: nbcdust = -1 ! bc/(bc + dust) fraction dimension size + integer :: nkap = -1 ! hygroscopicity dimension size + integer :: nrelh = -1 ! relative humidity dimension size + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type hygrocoreshell_aerosol_optics + + interface hygrocoreshell_aerosol_optics + procedure :: constructor + end interface hygrocoreshell_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ibin, ncol, nlev, relhum) result(newobj) + + class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object + class(aerosol_state),intent(in) :: aero_state ! aerosol_state object + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(in) :: relhum(ncol,nlev) ! relative humidity + + type(hygrocoreshell_aerosol_optics), pointer :: newobj + + integer :: ierr, nspec + integer :: ilev, ispec, icol + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + + real(r8) :: coremmr(ncol,nlev) + real(r8) :: coredustmmr(ncol,nlev) + real(r8) :: corebcmmr(ncol,nlev) + real(r8) :: shellmmr(ncol,nlev) + real(r8) :: bcdustmmr(ncol,nlev) + + character(len=32) :: spectype ! species type + character(len=32) :: specmorph + real(r8) :: specdens ! species density (kg/m3) + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%totalmmr(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%corefrac(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%bcdust(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%kappa(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%relh(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + nspec = aero_props%nspecies(ibin) + + coremmr(:,:) = 0._r8 + coredustmmr(:,:) = 0._r8 + corebcmmr(:,:) = 0._r8 + shellmmr(:,:) = 0._r8 + + do ispec = 1,nspec + + call aero_state%get_ambient_mmr(species_ndx=ispec,bin_ndx=ibin,mmr=specmmr) + + call aero_props%get(ibin, ispec, density=specdens, & + spectype=spectype, specmorph=specmorph) + + if (trim(specmorph) == 'core') then + if (trim(spectype) == 'dust') then + coredustmmr(:ncol,:nlev) = coredustmmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + end if + if (trim(spectype) == 'black-c') then + corebcmmr(:ncol,:nlev) = corebcmmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + end if + coremmr(:ncol,:nlev) = coremmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + else if (trim(specmorph) == 'shell') then + shellmmr(:ncol,:nlev) = shellmmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + else + nullify(newobj) + return + end if + + end do + + newobj%totalmmr(:,:) = coremmr(:,:) + shellmmr(:,:) + bcdustmmr(:,:) = corebcmmr(:,:) + coredustmmr(:,:) + + do ilev = 1, nlev + do icol = 1, ncol + + if (newobj%totalmmr(icol,ilev) > 0._r8) then + newobj%corefrac(icol,ilev) = coremmr(icol,ilev) / newobj%totalmmr(icol,ilev) + else + newobj%corefrac(icol,ilev) = 0._r8 + end if + newobj%corefrac(icol,ilev) = max(0._r8, min(1.0_r8, newobj%corefrac(icol,ilev))) + + if (bcdustmmr(icol,ilev) > 0._r8) then + newobj%bcdust(icol,ilev) = corebcmmr(icol,ilev) / bcdustmmr(icol,ilev) + else + newobj%bcdust(icol,ilev) = 0._r8 + end if + newobj%bcdust(icol,ilev) = max(0._r8, min(1.0_r8, newobj%bcdust(icol,ilev))) + + end do + end do + + call aero_state%hygroscopicity(ibin, newobj%kappa) + + call aero_props%optics_params(ibin, & + corefrac=newobj%tbl_corefrac, kap=newobj%tbl_kap, & + bcdust=newobj%tbl_bcdust, relh=newobj%tbl_relh, & + nfrac=newobj%nfrac, nbcdust=newobj%nbcdust, & + nkap=newobj%nkap, nrelh=newobj%nrelh) + + newobj%relh(:ncol,:) = relhum(:ncol,:) + + ! long wave optical properties table + call aero_props%optics_params(ibin, & + sw_hygro_coreshell_ext=newobj%sw_hygro_coreshell_ext, & + sw_hygro_coreshell_ssa=newobj%sw_hygro_coreshell_ssa, & + sw_hygro_coreshell_asm=newobj%sw_hygro_coreshell_asm, & + lw_hygro_coreshell_ext=newobj%lw_hygro_coreshell_abs) + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(hygrocoreshell_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + integer :: icol + + type(table_interp_wghts) :: rhwghts(ncol) + type(table_interp_wghts) :: cfwghts(ncol) + type(table_interp_wghts) :: bcwghts(ncol) + type(table_interp_wghts) :: kpwghts(ncol) + + rhwghts = table_interp_calcwghts( self%nrelh, self%tbl_relh, ncol, self%relh(:ncol,ilev) ) + cfwghts = table_interp_calcwghts( self%nfrac, self%tbl_corefrac, ncol, self%corefrac(:ncol,ilev) ) + bcwghts = table_interp_calcwghts( self%nbcdust, self%tbl_bcdust, ncol, self%bcdust(:ncol,ilev) ) + kpwghts = table_interp_calcwghts( self%nkap, self%tbl_kap, ncol, self%kappa(:ncol,ilev) ) + + pext = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_ext(:,iwav,:,:,:)) + pabs = (1._r8-table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_ssa(:,iwav,:,:,:)))*pext + pasm = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_asm(:,iwav,:,:,:)) + + do icol = 1, ncol + + pext(icol) = pext(icol)*self%totalmmr(icol,ilev) + pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev) + pabs(icol) = max(0._r8,pabs(icol)) + pabs(icol) = min(pext(icol),pabs(icol)) + + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(hygrocoreshell_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + integer :: icol + + type(table_interp_wghts) :: rhwghts(ncol) + type(table_interp_wghts) :: cfwghts(ncol) + type(table_interp_wghts) :: bcwghts(ncol) + type(table_interp_wghts) :: kpwghts(ncol) + + rhwghts = table_interp_calcwghts( self%nrelh, self%tbl_relh, ncol, self%relh(:ncol,ilev) ) + cfwghts = table_interp_calcwghts( self%nfrac, self%tbl_corefrac, ncol, self%corefrac(:ncol,ilev) ) + bcwghts = table_interp_calcwghts( self%nbcdust, self%tbl_bcdust, ncol, self%bcdust(:ncol,ilev) ) + kpwghts = table_interp_calcwghts( self%nkap, self%tbl_kap, ncol, self%kappa(:ncol,ilev) ) + + pabs = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%lw_hygro_coreshell_abs(:,iwav,:,:,:)) + + do icol = 1, ncol + pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev) + pabs(icol) = max(0._r8,pabs(icol)) + end do + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(hygrocoreshell_aerosol_optics), intent(inout) :: self + + deallocate(self%totalmmr) + deallocate(self%corefrac) + deallocate(self%bcdust) + deallocate(self%kappa) + deallocate(self%relh) + + nullify(self%tbl_corefrac) + nullify(self%tbl_bcdust) + nullify(self%tbl_kap) + nullify(self%tbl_relh) + nullify(self%sw_hygro_coreshell_ext) + nullify(self%sw_hygro_coreshell_ssa) + nullify(self%sw_hygro_coreshell_asm) + nullify(self%lw_hygro_coreshell_abs) + + end subroutine destructor + +end module hygrocoreshell_aerosol_optics_mod diff --git a/src/aerosol/hygroscopic_aerosol_optics_mod.F90 b/src/aerosol/hygroscopic_aerosol_optics_mod.F90 new file mode 100644 index 000000000..d1d9fd656 --- /dev/null +++ b/src/aerosol/hygroscopic_aerosol_optics_mod.F90 @@ -0,0 +1,164 @@ +!------------------------------------------------------------------------------- +! Short-wave and long-wave hygroscopic aerosol properties +!------------------------------------------------------------------------------- +module hygroscopic_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + use aerosol_optics_mod, only: aerosol_optics + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + + implicit none + + private + + public :: hygroscopic_aerosol_optics + + type, extends(aerosol_optics) :: hygroscopic_aerosol_optics + + ! aerosol optics properties tables (from physprops files) + real(r8), pointer :: ext_sw(:,:) => null() + real(r8), pointer :: ssa_sw(:,:) => null() + real(r8), pointer :: asm_sw(:,:) => null() + real(r8), pointer :: abs_lw(:,:) => null() + + ! from state + real(r8), allocatable :: wrh(:,:) ! (-) weighting on left side values ! (pcols,pver) + integer , allocatable :: krh(:,:) ! index into rh mesh + + ! aerosol mass mixing ratio + real(r8), pointer :: mmr(:,:) + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type hygroscopic_aerosol_optics + + interface hygroscopic_aerosol_optics + procedure :: constructor + end interface hygroscopic_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ibin, ncols, nlevs, numrh, relhum) & + result(newobj) + class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object + class(aerosol_state), intent(in) :: aero_state ! aerosol_state object + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncols, nlevs, numrh + real(r8),intent(in) :: relhum(ncols,nlevs) + + type(hygroscopic_aerosol_optics), pointer :: newobj + + real(r8) :: rhtrunc(ncols,nlevs) + integer :: ierr + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%wrh(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%krh(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + +! NOTE should try to use table_interp_mod utility !!! + rhtrunc(1:ncols,1:nlevs) = min(relhum(1:ncols,1:nlevs),1._r8) + newobj%krh(1:ncols,1:nlevs) = min(floor( rhtrunc(1:ncols,1:nlevs) * numrh ) + 1, numrh - 1) ! index into rh mesh + newobj%wrh(1:ncols,1:nlevs) = rhtrunc(1:ncols,1:nlevs) * numrh - newobj%krh(1:ncols,1:nlevs) ! (-) weighting on left side values + + ! optical properties tables + call aero_props%optics_params(ibin, & + sw_hygroscopic_ext=newobj%ext_sw, & + sw_hygroscopic_ssa=newobj%ssa_sw, & + sw_hygroscopic_asm=newobj%asm_sw, & + lw_hygroscopic_ext=newobj%abs_lw ) + + call aero_state%get_ambient_mmr(species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(hygroscopic_aerosol_optics), intent(in) :: self + + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + pext(icol) = (1._r8 + self%wrh(icol,ilev)) * self%ext_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%ext_sw(self%krh(icol,ilev), iwav) + palb(icol) = (1._r8 + self%wrh(icol,ilev)) * self%ssa_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%ssa_sw(self%krh(icol,ilev), iwav) + pasm(icol) = (1._r8 + self%wrh(icol,ilev)) * self%asm_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%asm_sw(self%krh(icol,ilev), iwav) + + pext(icol) = pext(icol) * self%mmr(icol,ilev) + + pabs(icol) = pext(icol) * ( 1._r8 - palb(icol) ) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(hygroscopic_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + pabs(icol) = (1._r8 + self%wrh(icol,ilev)) * self%abs_lw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%abs_lw(self%krh(icol,ilev), iwav) + + pabs(icol) = pabs(icol) * self%mmr(icol,ilev) + end do + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(hygroscopic_aerosol_optics), intent(inout) :: self + + deallocate(self%wrh) + deallocate(self%krh) + + end subroutine destructor + +end module hygroscopic_aerosol_optics_mod diff --git a/src/aerosol/hygrowghtpct_aerosol_optics_mod.F90 b/src/aerosol/hygrowghtpct_aerosol_optics_mod.F90 new file mode 100644 index 000000000..5f7ad9b7c --- /dev/null +++ b/src/aerosol/hygrowghtpct_aerosol_optics_mod.F90 @@ -0,0 +1,186 @@ +module hygrowghtpct_aerosol_optics_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_optics_mod, only: aerosol_optics + use aerosol_state_mod, only: aerosol_state + use aerosol_properties_mod, only: aerosol_properties + use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_calcwghts + + implicit none + + private + public :: hygrowghtpct_aerosol_optics + + !> hygrowghtpct_aerosol_optics + !! Table look up implementation of aerosol_optics to parameterize aerosol + !! radiative properties in terms of weight percent of H2SO4/H2O solution + type, extends(aerosol_optics) :: hygrowghtpct_aerosol_optics + + real(r8), allocatable :: totalmmr(:,:) ! total mmr of the aerosol + real(r8), allocatable :: wgtpct(:,:) ! weight percent of H2SO4/H2O solution + + real(r8), pointer :: sw_hygro_ext_wtp(:,:) ! short wave extinction table + real(r8), pointer :: sw_hygro_ssa_wtp(:,:) ! short wave single-scatter albedo table + real(r8), pointer :: sw_hygro_asm_wtp(:,:) ! short wave asymmetry table + real(r8), pointer :: lw_hygro_abs_wtp(:,:) ! long wave absorption table + + real(r8), pointer :: tbl_wgtpct(:) ! weight percent dimenstion values + + integer :: nwtp ! weight percent dimenstion size + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type hygrowghtpct_aerosol_optics + + interface hygrowghtpct_aerosol_optics + procedure :: constructor + end interface hygrowghtpct_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ibin, ncol, nlev, wgtpct_in) result(newobj) + + class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object + class(aerosol_state),intent(in) :: aero_state ! aerosol_state object + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(in) :: wgtpct_in(ncol,nlev) ! sulfate weight percent + + type(hygrowghtpct_aerosol_optics), pointer :: newobj + + integer :: ierr, nspec + integer :: ispec + integer :: i,k + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%totalmmr(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%wgtpct(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + ! weight percent of H2SO4/H2O solution + newobj%wgtpct(:ncol,:nlev) = wgtpct_in(:ncol,:nlev) + + call aero_props%optics_params(ibin, wgtpct=newobj%tbl_wgtpct, nwtp=newobj%nwtp) + + nspec = aero_props%nspecies(ibin) + + newobj%totalmmr(:,:) = 0._r8 + + do ispec = 1,nspec + + call aero_state%get_ambient_mmr(species_ndx=ispec,bin_ndx=ibin,mmr=specmmr) + newobj%totalmmr(:ncol,:nlev) = newobj%totalmmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + + end do + + call aero_props%optics_params(ibin, & + sw_hygro_ext_wtp=newobj%sw_hygro_ext_wtp, & + sw_hygro_ssa_wtp=newobj%sw_hygro_ssa_wtp, & + sw_hygro_asm_wtp=newobj%sw_hygro_asm_wtp, & + lw_hygro_ext_wtp=newobj%lw_hygro_abs_wtp) + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(hygrowghtpct_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized asymmetry factor + real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + + integer :: icol + type(table_interp_wghts) :: wghts(ncol) + + wghts = table_interp_calcwghts( self%nwtp, self%tbl_wgtpct, ncol, self%wgtpct(:ncol,ilev) ) + pext = table_interp( ncol, self%nwtp, wghts, self%sw_hygro_ext_wtp(:,iwav) ) + pabs = (1._r8 - table_interp( ncol, self%nwtp, wghts, self%sw_hygro_ssa_wtp(:,iwav)))*pext + pasm = table_interp( ncol, self%nwtp, wghts, self%sw_hygro_asm_wtp(:,iwav) ) + + do icol = 1, ncol + + pext(icol) = pext(icol)*self%totalmmr(icol,ilev) + pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev) + pabs(icol) = max(0._r8,pabs(icol)) + pabs(icol) = min(pext(icol),pabs(icol)) + + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(hygrowghtpct_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + integer :: icol + type(table_interp_wghts) :: wghts(ncol) + + wghts = table_interp_calcwghts( self%nwtp, self%tbl_wgtpct, ncol, self%wgtpct(:ncol,ilev) ) + + pabs = table_interp( ncol, self%nwtp, wghts, self%lw_hygro_abs_wtp(:,iwav) ) + + do icol = 1, ncol + + pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev) + pabs(icol) = max(0._r8,pabs(icol)) + + end do + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(hygrowghtpct_aerosol_optics), intent(inout) :: self + + deallocate(self%totalmmr) + deallocate(self%wgtpct) + + nullify(self%tbl_wgtpct) + nullify(self%sw_hygro_ext_wtp) + nullify(self%sw_hygro_ssa_wtp) + nullify(self%sw_hygro_asm_wtp) + nullify(self%lw_hygro_abs_wtp) + + end subroutine destructor + +end module hygrowghtpct_aerosol_optics_mod diff --git a/src/aerosol/insoluble_aerosol_optics_mod.F90 b/src/aerosol/insoluble_aerosol_optics_mod.F90 new file mode 100644 index 000000000..3b9f9228c --- /dev/null +++ b/src/aerosol/insoluble_aerosol_optics_mod.F90 @@ -0,0 +1,117 @@ +!------------------------------------------------------------------------------- +! Insoluble (non-hygroscopic) aerosol optical properties +!------------------------------------------------------------------------------- +module insoluble_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + use aerosol_optics_mod, only: aerosol_optics + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + + implicit none + + private + + public :: insoluble_aerosol_optics + + type, extends(aerosol_optics) :: insoluble_aerosol_optics + real(r8), pointer :: lw_abs(:) + real(r8), pointer :: sw_ext(:) + real(r8), pointer :: sw_ssa(:) + real(r8), pointer :: sw_asm(:) + + ! aerosol mass mixing ratio + real(r8), pointer :: mmr(:,:) + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type insoluble_aerosol_optics + + interface insoluble_aerosol_optics + procedure :: constructor + end interface insoluble_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ibin) result(newobj) + + class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object + class(aerosol_state), intent(in) :: aero_state ! aerosol_state object + integer, intent(in) :: ibin ! bin number + + type(insoluble_aerosol_optics), pointer :: newobj + + integer :: ierr + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + ! get mode properties + call aero_props%optics_params(ibin, & + sw_insoluble_ext=newobj%sw_ext, & + sw_insoluble_ssa=newobj%sw_ssa, & + sw_insoluble_asm=newobj%sw_asm, & + lw_insoluble_ext=newobj%lw_abs ) + + call aero_state%get_ambient_mmr(species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + + end function constructor + + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(insoluble_aerosol_optics), intent(inout) :: self + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(insoluble_aerosol_optics), intent(in) :: self + + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + pext(:ncol) = self%sw_ext(iwav) * self%mmr(:ncol,ilev) + palb(:ncol) = self%sw_ssa(iwav) + pasm(:ncol) = self%sw_asm(iwav) + + pabs(:ncol) = pext(:ncol) * ( 1._r8 - palb(:ncol) ) + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(insoluble_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + pabs(:ncol) = self%lw_abs(iwav) * self%mmr(:ncol,ilev) + + end subroutine lw_props + +end module insoluble_aerosol_optics_mod diff --git a/src/aerosol/modal_aerosol_properties_mod.F90 b/src/aerosol/modal_aerosol_properties_mod.F90 new file mode 100644 index 000000000..7d3147dd9 --- /dev/null +++ b/src/aerosol/modal_aerosol_properties_mod.F90 @@ -0,0 +1,963 @@ +module modal_aerosol_properties_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: pi + use aerosol_properties_mod, only: aerosol_properties, aero_name_len + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_mode_props, rad_aer_get_props + implicit none + + private + + public :: modal_aerosol_properties + + type, extends(aerosol_properties) :: modal_aerosol_properties + private + real(r8), allocatable :: exp45logsig_(:) + real(r8), allocatable :: voltonumblo_(:) + real(r8), allocatable :: voltonumbhi_(:) + integer, allocatable :: sulfate_mode_ndxs_(:) + integer, allocatable :: dust_mode_ndxs_(:) + integer, allocatable :: ssalt_mode_ndxs_(:) + integer, allocatable :: ammon_mode_ndxs_(:) + integer, allocatable :: nitrate_mode_ndxs_(:) + integer, allocatable :: msa_mode_ndxs_(:) + integer, allocatable :: bcarbon_mode_ndxs_(:,:) + integer, allocatable :: porganic_mode_ndxs_(:,:) + integer, allocatable :: sorganic_mode_ndxs_(:,:) + integer, allocatable :: mode_size_order_(:) + integer :: num_soa_ = 0 + integer :: num_poa_ = 0 + integer :: num_bc_ = 0 + contains + procedure :: number_transported + procedure :: get + procedure :: amcube + procedure :: actfracs + procedure :: num_names + procedure :: mmr_names + procedure :: amb_num_name + procedure :: amb_mmr_name + procedure :: species_type + procedure :: icenuc_updates_num + procedure :: icenuc_updates_mmr + procedure :: apply_number_limits + procedure :: hetfrz_species + procedure :: physprop_id + procedure :: soluble + procedure :: min_mass_mean_rad + procedure :: bin_name + procedure :: scav_diam + procedure :: resuspension_resize + procedure :: rebin_bulk_fluxes + procedure :: hydrophilic + procedure :: model_is + + final :: destructor + end type modal_aerosol_properties + + interface modal_aerosol_properties + procedure :: constructor + end interface modal_aerosol_properties + + logical, parameter :: debug = .false. + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(list_idx) result(newobj) + + integer, optional, intent(in) :: list_idx ! radiation list index (0=climate) + type(modal_aerosol_properties), pointer :: newobj + + integer :: l, m, nmodes, ncnst_tot, mm, itmp + integer :: list_idx_loc + real(r8) :: dgnumlo_val + real(r8) :: dgnumhi_val + real(r8) :: dgnum_val + real(r8) :: rhcrystal_val, rhdeliques_val + integer,allocatable :: nspecies(:) + real(r8),allocatable :: sigmag(:) + real(r8),allocatable :: alogsig(:) + real(r8),allocatable :: f1(:) + real(r8),allocatable :: f2(:) + real(r8),allocatable :: dgnum_arr(:) + real(r8),allocatable :: dgnumhi_arr(:) + real(r8),allocatable :: dgnumlo_arr(:) + real(r8),allocatable :: rhcrystal_arr(:) + real(r8),allocatable :: rhdeliques_arr(:) + integer :: ierr + + character(len=aero_name_len) :: spectype + + integer :: npoa, nsoa, nbc + + list_idx_loc = 0 + if (present(list_idx)) list_idx_loc = list_idx + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + call rad_aer_get_info(list_idx_loc, nmodes=nmodes) + + allocate(nspecies(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(alogsig(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( f1(nmodes),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( f2(nmodes),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + allocate(sigmag(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%exp45logsig_(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%voltonumblo_(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%voltonumbhi_(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(dgnum_arr(nmodes),dgnumhi_arr(nmodes),dgnumlo_arr(nmodes), & + rhcrystal_arr(nmodes),rhdeliques_arr(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%mode_size_order_(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + ncnst_tot = 0 + + do m = 1, nmodes + call rad_aer_get_info(list_idx_loc, m, nspec=nspecies(m)) + + ncnst_tot = ncnst_tot + nspecies(m) + 1 + + call rad_aer_get_mode_props(list_idx_loc, m, sigmag=sigmag(m), & + dgnum=dgnum_val, dgnumhi=dgnumhi_val, dgnumlo=dgnumlo_val, & + rhcrystal=rhcrystal_val, rhdeliques=rhdeliques_val) + + dgnum_arr(m) = dgnum_val + dgnumhi_arr(m) = dgnumhi_val + dgnumlo_arr(m) = dgnumlo_val + rhcrystal_arr(m) = rhcrystal_val + rhdeliques_arr(m) = rhdeliques_val + + alogsig(m) = log(sigmag(m)) + + newobj%exp45logsig_(m) = exp(4.5_r8*alogsig(m)*alogsig(m)) + + f1(m) = 0.5_r8*exp(2.5_r8*alogsig(m)*alogsig(m)) + f2(m) = 1._r8 + 0.25_r8*alogsig(m) + + newobj%voltonumblo_(m) = 1._r8 / ( (pi/6._r8)* & + (dgnumlo_val**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) + newobj%voltonumbhi_(m) = 1._r8 / ( (pi/6._r8)* & + (dgnumhi_val**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) + + end do + + ! compute mode_size_order_: indices sorted by dgnum_ descending (largest first) + do m = 1, nmodes + newobj%mode_size_order_(m) = m + end do + do m = 1, nmodes-1 + do l = m+1, nmodes + if (dgnum_arr(newobj%mode_size_order_(l)) > dgnum_arr(newobj%mode_size_order_(m))) then + itmp = newobj%mode_size_order_(m) + newobj%mode_size_order_(m) = newobj%mode_size_order_(l) + newobj%mode_size_order_(l) = itmp + end if + end do + end do + + call newobj%initialize(nmodes,ncnst_tot,nspecies,nspecies,alogsig,f1,f2,ierr,list_idx_loc, & + dgnum=dgnum_arr,dgnumhi=dgnumhi_arr,dgnumlo=dgnumlo_arr, & + rhcrystal=rhcrystal_arr,rhdeliques=rhdeliques_arr) + + npoa = 0 + nsoa = 0 + nbc = 0 + + m = 1 + do l = 1,newobj%nspecies(m) + mm = newobj%indexer(m,l) + call newobj%species_type(m, l, spectype) + select case ( trim(spectype) ) + case('p-organic') + npoa = npoa + 1 + case('s-organic') + nsoa = nsoa + 1 + case('black-c') + nbc = nbc + 1 + end select + end do + + newobj%num_soa_ = nsoa + newobj%num_poa_ = npoa + newobj%num_bc_ = nbc + + allocate(newobj%sulfate_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%dust_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%ssalt_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%ammon_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%nitrate_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%msa_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%sulfate_mode_ndxs_ = 0 + newobj%dust_mode_ndxs_ = 0 + newobj%ssalt_mode_ndxs_ = 0 + newobj%ammon_mode_ndxs_ = 0 + newobj%nitrate_mode_ndxs_ = 0 + newobj%msa_mode_ndxs_ = 0 + + allocate(newobj%porganic_mode_ndxs_(newobj%nbins(),npoa),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%sorganic_mode_ndxs_(newobj%nbins(),nsoa),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%bcarbon_mode_ndxs_(newobj%nbins(),nbc),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%porganic_mode_ndxs_ = 0._r8 + newobj%sorganic_mode_ndxs_ = 0._r8 + newobj%bcarbon_mode_ndxs_ = 0._r8 + + do m = 1,newobj%nbins() + npoa = 0 + nsoa = 0 + nbc = 0 + + do l = 1,newobj%nspecies(m) + mm = newobj%indexer(m,l) + call newobj%species_type(m, l, spectype) + + select case ( trim(spectype) ) + case('sulfate') + newobj%sulfate_mode_ndxs_(m) = mm + case('dust') + newobj%dust_mode_ndxs_(m) = mm + case('nitrate') + newobj%nitrate_mode_ndxs_(m) = mm + case('ammonium') + newobj%ammon_mode_ndxs_(m) = mm + case('seasalt') + newobj%ssalt_mode_ndxs_(m) = mm + case('msa') + newobj%msa_mode_ndxs_(m) = mm + case('p-organic') + npoa = npoa + 1 + newobj%porganic_mode_ndxs_(m,npoa) = mm + case('s-organic') + nsoa = nsoa + 1 + newobj%sorganic_mode_ndxs_(m,nsoa) = mm + case('black-c') + nbc = nbc + 1 + newobj%bcarbon_mode_ndxs_(m,nbc) = mm + end select + + end do + end do + + if( ierr /= 0 ) then + nullify(newobj) + return + end if + deallocate(nspecies) + deallocate(alogsig) + deallocate(sigmag) + deallocate(f1) + deallocate(f2) + deallocate(dgnum_arr) + deallocate(dgnumhi_arr) + deallocate(dgnumlo_arr) + deallocate(rhcrystal_arr) + deallocate(rhdeliques_arr) + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(modal_aerosol_properties), intent(inout) :: self + + if (allocated(self%exp45logsig_)) then + deallocate(self%exp45logsig_) + end if + if (allocated(self%voltonumblo_)) then + deallocate(self%voltonumblo_) + end if + if (allocated(self%voltonumbhi_)) then + deallocate(self%voltonumbhi_) + end if + if (allocated(self%mode_size_order_)) then + deallocate(self%mode_size_order_) + end if + + if (allocated(self%sulfate_mode_ndxs_)) then + deallocate(self%sulfate_mode_ndxs_) + end if + if (allocated(self%dust_mode_ndxs_)) then + deallocate(self%dust_mode_ndxs_) + end if + if (allocated(self%ssalt_mode_ndxs_)) then + deallocate(self%ssalt_mode_ndxs_) + end if + if (allocated(self%ammon_mode_ndxs_)) then + deallocate(self%ammon_mode_ndxs_) + end if + if (allocated(self%nitrate_mode_ndxs_)) then + deallocate(self%nitrate_mode_ndxs_) + end if + if (allocated(self%msa_mode_ndxs_)) then + deallocate(self%msa_mode_ndxs_) + end if + if (allocated(self%porganic_mode_ndxs_)) then + deallocate(self%porganic_mode_ndxs_) + end if + if (allocated(self%sorganic_mode_ndxs_)) then + deallocate(self%sorganic_mode_ndxs_) + end if + if (allocated(self%bcarbon_mode_ndxs_)) then + deallocate(self%bcarbon_mode_ndxs_) + end if + + call self%final() + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! returns number of transported aerosol constituents + !------------------------------------------------------------------------------ + integer function number_transported(self) + class(modal_aerosol_properties), intent(in) :: self + ! to be implemented later + number_transported = -1 + end function number_transported + + !------------------------------------------------------------------------ + ! returns aerosol properties: + ! density + ! hygroscopicity + ! species type + ! species name + ! short wave species refractive indices + ! long wave species refractive indices + ! species morphology + !------------------------------------------------------------------------ + subroutine get(self, bin_ndx, species_ndx, density, hygro, spec_mw, & + spectype, specname, specmorph, refindex_sw, refindex_lw, num_to_mass_aer, & + dryrad) + use cam_abortutils, only: endrun + + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: species_ndx ! species index + real(r8), optional, intent(out) :: density ! density (kg/m3) + real(r8), optional, intent(out) :: hygro ! hygroscopicity + real(r8), optional, intent(out) :: spec_mw ! species molecular weight + character(len=*), optional, intent(out) :: spectype ! species type + character(len=*), optional, intent(out) :: specname ! species name + character(len=*), optional, intent(out) :: specmorph ! species morphology + complex(r8), pointer, optional, intent(out) :: refindex_sw(:) ! short wave species refractive indices + complex(r8), pointer, optional, intent(out) :: refindex_lw(:) ! long wave species refractive indices + real(r8), optional, intent(out) :: num_to_mass_aer ! ratio of number to mass concentration + real(r8), optional, intent(out) :: dryrad ! dry radius (m) + + call rad_aer_get_props(self%list_idx_, bin_ndx, species_ndx, & + density_aer=density, hygro_aer=hygro, spectype=spectype, & + refindex_aer_sw=refindex_sw, refindex_aer_lw=refindex_lw) + + if (present(spec_mw)) then + call endrun('modal_aerosol_properties_mod%get: spec_mw not implemented (requires specmw_amode)') + end if + + if (present(specname)) then + call rad_aer_get_info(self%list_idx_, bin_ndx, species_ndx, spec_name=specname) + end if + + if (present(specmorph)) then + specmorph = 'UNKNOWN' + end if + + if (present(num_to_mass_aer)) then + ! num_to_mass_aer for modal aerosols should not be read from file + call endrun('modal_aerosol_properties_mod%get: num_to_mass_aer should not be read from file for modal aerosols') + end if + + if (present(dryrad)) then + ! dryrad for modal aerosols should not be read from file + call endrun('modal_aerosol_properties_mod%get: dryrad should not be read from file for modal aerosols') + end if + + end subroutine get + + !------------------------------------------------------------------------ + ! returns the physprop ID for a given bin (mode) index + !------------------------------------------------------------------------ + integer function physprop_id(self, bin_ndx) + use radiative_aerosol, only: rad_aer_mode_physprop_id + + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + + physprop_id = rad_aer_mode_physprop_id(self%list_idx_, bin_ndx) + + end function physprop_id + + !------------------------------------------------------------------------------ + ! returns radius^3 (m3) of a given bin number + !------------------------------------------------------------------------------ + pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) + + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(in) :: volconc ! volume conc (m3/m3) + real(r8), intent(in) :: numconc ! number conc (1/m3) + + amcube = (3._r8*volconc/(4._r8*pi*self%exp45logsig_(bin_ndx)*numconc)) + + end function amcube + + !------------------------------------------------------------------------------ + ! returns mass and number activation fractions + !------------------------------------------------------------------------------ + subroutine actfracs(self, bin_ndx, smc, smax, fn, fm ) + use shr_spfn_mod, only: erf => shr_spfn_erf + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8),intent(in) :: smc ! critical supersaturation for particles of bin radius + real(r8),intent(in) :: smax ! maximum supersaturation for multiple competing aerosols + real(r8),intent(out) :: fn ! activation fraction for aerosol number + real(r8),intent(out) :: fm ! activation fraction for aerosol mass + + real(r8) :: x,y + real(r8), parameter :: twothird = 2._r8/3._r8 + real(r8), parameter :: sq2 = sqrt(2._r8) + + x=twothird*(log(smc)-log(smax))/(sq2*self%alogsig(bin_ndx)) + y=x-1.5_r8*sq2*self%alogsig(bin_ndx) + + fn = 0.5_r8*(1._r8-erf(x)) + fm = 0.5_r8*(1._r8-erf(y)) + + end subroutine actfracs + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine num_names(self, bin_ndx, name_a, name_c) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol number dens + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol number dens + + call rad_aer_get_info(self%list_idx_,bin_ndx, num_name=name_a, num_name_cw=name_c) + end subroutine num_names + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol MMR + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol MMR + + call rad_aer_get_info(self%list_idx_, bin_ndx, species_ndx, spec_name=name_a, spec_name_cw=name_c) + end subroutine mmr_names + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine amb_num_name(self, bin_ndx, name) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens + + call rad_aer_get_info(self%list_idx_,bin_ndx, num_name=name) + + end subroutine amb_num_name + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine amb_mmr_name(self, bin_ndx, species_ndx, name) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR + + call rad_aer_get_info(self%list_idx_, bin_ndx, species_ndx, spec_name=name) + + end subroutine amb_mmr_name + + !------------------------------------------------------------------------ + ! returns species type + !------------------------------------------------------------------------ + subroutine species_type(self, bin_ndx, species_ndx, spectype) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: spectype ! species type + + call rad_aer_get_info(self%list_idx_, bin_ndx, species_ndx, spec_type=spectype) + + end subroutine species_type + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to given aerosol bin number + !------------------------------------------------------------------------------ + function icenuc_updates_num(self, bin_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + logical :: res + + character(len=aero_name_len) :: spectype + character(len=aero_name_len) :: modetype + integer :: spc_ndx + + res = .false. + + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=modetype) + if (.not.(modetype=='coarse' .or. modetype=='coarse_dust')) then + return + end if + + do spc_ndx = 1, self%nspecies(bin_ndx) + call self%species_type( bin_ndx, spc_ndx, spectype) + if (spectype=='dust') res = .true. + end do + + end function icenuc_updates_num + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to a given species within a bin + !------------------------------------------------------------------------------ + function icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + logical :: res + + character(len=32) :: spectype + character(len=32) :: modetype + + res = .false. + + if (species_ndx>0) then + + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=modetype) + if (.not.(modetype=='coarse' .or. modetype=='coarse_dust')) then + return + end if + + call self%species_type( bin_ndx, species_ndx, spectype) + if (spectype=='dust') res = .true. + end if + + end function icenuc_updates_mmr + + !------------------------------------------------------------------------------ + ! apply max / min to number concentration + !------------------------------------------------------------------------------ + subroutine apply_number_limits( self, naerosol, vaerosol, ncol, nlev, m ) + class(modal_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:,:) ! number conc (1/m3) + real(r8), intent(in) :: vaerosol(:,:) ! volume conc (m3/m3) + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vert levels + integer, intent(in) :: m ! mode or bin index + + integer :: i,k + + ! adjust number so that dgnumlo < dgnum < dgnumhi + ! -- the diameter falls within the lower and upper limits which are + ! represented by voltonumhi and voltonumblo values, respectively + do k = 1,nlev + do i = 1,ncol + naerosol(i,k) = max(naerosol(i,k), vaerosol(i,k)*self%voltonumbhi_(m)) + naerosol(i,k) = min(naerosol(i,k), vaerosol(i,k)*self%voltonumblo_(m)) + end do + end do + + end subroutine apply_number_limits + + !------------------------------------------------------------------------------ + ! returns TRUE if species `spc_ndx` in aerosol subset `bin_ndx` contributes to + ! the particles' ability to act as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_species(self, bin_ndx, spc_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: spc_ndx ! species number + + logical :: res + + character(len=aero_name_len) :: mode_name, species_type + + res = .false. + + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=mode_name) + + if ((trim(mode_name)/='aitken')) then + + call self%species_type(bin_ndx, spc_ndx, species_type) + + if ((trim(species_type)=='black-c').or.(trim(species_type)=='dust')) then + + res = .true. + + end if + + end if + + end function hetfrz_species + + !------------------------------------------------------------------------------ + ! returns TRUE if soluble + !------------------------------------------------------------------------------ + logical function soluble(self,bin_ndx) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + character(len=aero_name_len) :: mode_name + + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=mode_name) + + soluble = trim(mode_name)/='primary_carbon' + + end function soluble + + !------------------------------------------------------------------------------ + ! returns minimum mass mean radius (meters) + !------------------------------------------------------------------------------ + function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + real(r8) :: minrad ! meters + + integer :: nmodes + character(len=aero_name_len) :: species_type, mode_type + + call self%species_type(bin_ndx, species_ndx, spectype=species_type) + select case ( trim(species_type) ) + case('dust') + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=mode_type) + select case ( trim(mode_type) ) + case ('accum','fine_dust') + minrad = 0.258e-6_r8 + case ('coarse','coarse_dust') + minrad = 1.576e-6_r8 + case default + minrad = -huge(1._r8) + end select + case('black-c') + call rad_aer_get_info(self%list_idx_, nmodes=nmodes) + if (nmodes==3) then + minrad = 0.04e-6_r8 + else + minrad = 0.067e-6_r8 ! from emission size + endif + case default + minrad = -huge(1._r8) + end select + + end function min_mass_mean_rad + + !------------------------------------------------------------------------------ + ! returns name for a given aerosol bin + !------------------------------------------------------------------------------ + function bin_name(self, bin_ndx) result(name) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + character(len=32) :: name + + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=name) + + end function bin_name + + !------------------------------------------------------------------------------ + ! returns scavenging diameter (cm) for a given aerosol bin number + !------------------------------------------------------------------------------ + function scav_diam(self, bin_ndx) result(diam) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: diam + + diam = self%dgnum(bin_ndx) + + end function scav_diam + + !------------------------------------------------------------------------------ + ! adjust aerosol concentration tendencies to create larger sizes of aerosols + ! during resuspension + !------------------------------------------------------------------------------ + subroutine resuspension_resize(self, dcondt) + + class(modal_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + + integer :: i + character(len=4) :: spcstr + + call accumulate_to_larger_mode( 'SO4', self%sulfate_mode_ndxs_, dcondt ) + call accumulate_to_larger_mode( 'DUST',self%dust_mode_ndxs_,dcondt ) + call accumulate_to_larger_mode( 'NACL',self%ssalt_mode_ndxs_,dcondt ) + call accumulate_to_larger_mode( 'MSA', self%msa_mode_ndxs_, dcondt ) + call accumulate_to_larger_mode( 'NH4', self%ammon_mode_ndxs_, dcondt ) + call accumulate_to_larger_mode( 'NO3', self%nitrate_mode_ndxs_, dcondt ) + + spcstr = ' ' + do i = 1,self%num_soa_ + write(spcstr,'(i4)') i + call accumulate_to_larger_mode( 'SOA'//adjustl(spcstr), self%sorganic_mode_ndxs_(:,i), dcondt ) + enddo + spcstr = ' ' + do i = 1,self%num_poa_ + write(spcstr,'(i4)') i + call accumulate_to_larger_mode( 'POM'//adjustl(spcstr), self%porganic_mode_ndxs_(:,i), dcondt ) + enddo + spcstr = ' ' + do i = 1,self%num_bc_ + write(spcstr,'(i4)') i + call accumulate_to_larger_mode( 'BC'//adjustl(spcstr), self%bcarbon_mode_ndxs_(:,i), dcondt ) + enddo + + contains + + !------------------------------------------------------------------------------ + subroutine accumulate_to_larger_mode( spc_name, lptr, prevap ) + + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + + character(len=*), intent(in) :: spc_name + integer, intent(in) :: lptr(:) + real(r8), intent(inout) :: prevap(:) + + integer :: m,n, nl,ns + + logical, parameter :: debug = .false. + + ! find constituent index of the largest mode for the species + loop1: do m = 1,self%nbins()-1 + nl = lptr(self%mode_size_order_(m)) + if (nl>0) exit loop1 + end do loop1 + + if (.not. nl>0) return + + ! accumulate the smaller modes into the largest mode + do n = m+1,self%nbins() + ns = lptr(self%mode_size_order_(n)) + if (ns>0) then + prevap(nl) = prevap(nl) + prevap(ns) + prevap(ns) = 0._r8 + if (masterproc .and. debug) then + write(iulog,'(a,i3,a,i3)') trim(spc_name)//' mode number accumulate ',ns,'->',nl + endif + endif + end do + + end subroutine accumulate_to_larger_mode + !------------------------------------------------------------------------------ + + end subroutine resuspension_resize + + !------------------------------------------------------------------------------ + ! returns bulk deposition fluxes of the specified species type + ! rebinned to specified diameter limits + !------------------------------------------------------------------------------ + subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, & + error_code, error_string) + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + + class(modal_aerosol_properties), intent(in) :: self + character(len=*),intent(in) :: bulk_type ! aerosol type to rebin + real(r8), intent(in) :: dep_fluxes(:) ! kg/m2 + real(r8), intent(in) :: diam_edges(:) ! meters + real(r8), intent(out) :: bulk_fluxes(:) ! kg/m2 + integer, intent(out) :: error_code ! error code (0 if no error) + character(len=*), intent(out) :: error_string ! error string + + real(r8) :: dns_dst ! kg/m3 + real(r8) :: sigma_g, vmd, tmp, massfrac_bin(size(bulk_fluxes)) + real(r8) :: Ntype, Mtype, Mtotal, Ntot + integer :: k,l,m,mm, nbulk + logical :: has_type, type_not_found + + character(len=aero_name_len) :: spectype + character(len=aero_name_len) :: modetype + + real(r8), parameter :: sqrtwo = sqrt(2._r8) + real(r8), parameter :: onethrd = 1._r8/3._r8 + + error_code = 0 + error_string = ' ' + + type_not_found = .true. + + nbulk = size(bulk_fluxes) + + bulk_fluxes(:) = 0.0_r8 + + do m = 1,self%nbins() + Mtype = 0._r8 + Mtotal = 0._r8 + mm = self%indexer(m,0) + Ntot = dep_fluxes(mm) ! #/m2 + + has_type = .false. + + do l = 1,self%nspecies(m) + mm = self%indexer(m,l) + call self%get(m,l, spectype=spectype, density=dns_dst) ! kg/m3 + if (spectype==bulk_type) then + Mtype = dep_fluxes(mm) ! kg/m2 + has_type = .true. + type_not_found = .false. + end if + Mtotal = Mtotal + dep_fluxes(mm) ! kg/m2 + end do + mode_has_type: if (has_type) then + call rad_aer_get_info(self%list_idx_, m, mode_type=modetype) + if (Ntot>1.e-40_r8 .and. Mtype>1.e-40_r8 .and. Mtotal>1.e-40_r8) then + + call rad_aer_get_mode_props(self%list_idx_, m, sigmag=sigma_g) + tmp = sqrtwo*log(sigma_g) + + ! type number concentration + Ntype = Ntot * Mtype/Mtotal ! #/m2 + + ! volume median diameter (meters) + vmd = (6._r8*Mtype/(pi*Ntype*dns_dst))**onethrd * exp(1.5_r8*(log(sigma_g))**2) + + massfrac_bin = 0._r8 + + do k = 1,nbulk + massfrac_bin(k) = 0.5_r8*( erf((log(diam_edges(k+1)/vmd))/tmp) & + - erf((log(diam_edges(k )/vmd))/tmp) ) + bulk_fluxes(k) = bulk_fluxes(k) + massfrac_bin(k) * Mtype + end do + + if (debug) then + if (abs(1._r8-sum(massfrac_bin)) > 1.e-6_r8) then + write(*,*) 'rebin_bulk_fluxes WARNING mode-num, massfrac_bin, sum(massfrac_bin) = ', & + m, massfrac_bin, sum(massfrac_bin) + end if + end if + + end if + end if mode_has_type + end do + + if (type_not_found) then + bulk_fluxes(:) = nan + error_code = 1 + write(error_string,*) 'aerosol_properties::rebin_bulk_fluxes ERROR : ',trim(bulk_type),' not found' + end if + + end subroutine rebin_bulk_fluxes + + !------------------------------------------------------------------------------ + ! Returns TRUE if bin is hydrophilic, otherwise FALSE + !------------------------------------------------------------------------------ + logical function hydrophilic(self, bin_ndx) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + character(len=aero_name_len) :: modetype + + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=modetype) + + hydrophilic = (trim(modetype) == 'accum') + + end function hydrophilic + + !------------------------------------------------------------------------------ + ! returns TRUE if modal aerosol representation + !------------------------------------------------------------------------------ + pure logical function model_is(self, query) + class(modal_aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query + + if (trim(query) == 'MAM' .or. trim(query) == 'mam') then + model_is = .true. + else if (trim(query) == 'modal') then + model_is = .true. + else + model_is = .false. + end if + + end function model_is + +end module modal_aerosol_properties_mod diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 new file mode 100644 index 000000000..fa9c5d66f --- /dev/null +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -0,0 +1,787 @@ +module modal_aerosol_state_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_spfn_mod, only: erf => shr_spfn_erf + use aerosol_state_mod, only: aerosol_state, ptr2d_t + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_mode_props + use aerosol_mmr_host, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num, aero_host_binding_t + use aerosol_properties_mod, only: aerosol_properties, aero_name_len + use physconst, only: rhoh2o + use cam_abortutils, only: endrun + + implicit none + + private + + public :: modal_aerosol_state + + type, extends(aerosol_state) :: modal_aerosol_state + private + ! Opaque host-binding handle used to retrieve aerosol fields from + ! host model data; built by host-side wiring (aerosol_instances_mod) + type(aero_host_binding_t) :: host_ + contains + + procedure :: get_transported + procedure :: set_transported + procedure :: ambient_total_bin_mmr + procedure :: get_ambient_mmr + procedure :: get_cldbrne_mmr + procedure :: get_ambient_num + procedure :: get_cldbrne_num + procedure :: get_states + procedure :: icenuc_size_wght_arr + procedure :: icenuc_size_wght_val + procedure :: icenuc_type_wght + procedure :: update_bin + procedure :: hetfrz_size_wght + procedure :: hygroscopicity + procedure :: water_uptake + procedure :: dry_volume + procedure :: wet_volume + procedure :: water_volume + procedure :: wet_diameter + procedure :: convcld_actfrac + procedure :: wgtpct + procedure :: aqu_gain_binfraction + + final :: destructor + + end type modal_aerosol_state + + interface modal_aerosol_state + procedure :: constructor + end interface modal_aerosol_state + + real(r8), parameter :: rh2odens = 1._r8/rhoh2o + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(ncol, host, list_idx) result(newobj) + integer, intent(in) :: ncol + type(aero_host_binding_t), intent(in) :: host + integer, intent(in), optional :: list_idx + + type(modal_aerosol_state), pointer :: newobj + + integer :: ierr + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + call newobj%set_ncol(ncol) + newobj%host_ = host + + if (present(list_idx)) call newobj%set_list_idx(list_idx) + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(modal_aerosol_state), intent(inout) :: self + + ! disassociate the host binding (data referenced within is not owned here) + self%host_ = aero_host_binding_t() + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! sets transported components + ! This aerosol model with the state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine set_transported( self, transported_array ) + class(modal_aerosol_state), intent(inout) :: self + real(r8), intent(in) :: transported_array(:,:,:) + ! to be implemented later + end subroutine set_transported + + !------------------------------------------------------------------------------ + ! returns transported components + ! This returns to current state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine get_transported( self, transported_array ) + class(modal_aerosol_state), intent(in) :: self + real(r8), intent(out) :: transported_array(:,:,:) + ! to be implemented later + end subroutine get_transported + + !------------------------------------------------------------------------ + ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer) + !------------------------------------------------------------------------ + function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot) + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + + real(r8) :: mmr_tot ! mass mixing ratios totaled for all species + real(r8),pointer :: mmrptr(:,:) + integer :: spec_ndx + + mmr_tot = 0._r8 + + do spec_ndx=1,aero_props%nspecies(bin_ndx) + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, spec_ndx, 'a', self%host_, mmrptr) + mmr_tot = mmr_tot + mmrptr(col_ndx,lyr_ndx) + end do + + end function ambient_total_bin_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol mass mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, species_ndx, 'a', self%host_, mmr) + end subroutine get_ambient_mmr + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, species_ndx, 'c', self%host_, mmr) + end subroutine get_cldbrne_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_num(self, bin_ndx, num) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) ! number densities + + call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'a', self%host_, num) + end subroutine get_ambient_num + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_num(self, bin_ndx, num) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) + + call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'c', self%host_, num) + end subroutine get_cldbrne_num + + !------------------------------------------------------------------------------ + ! returns interstitial and cloud-borne aerosol states + !------------------------------------------------------------------------------ + subroutine get_states( self, aero_props, raer, qqcw ) + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + type(ptr2d_t), intent(out) :: raer(:) + type(ptr2d_t), intent(out) :: qqcw(:) + + integer :: ibin,ispc, indx + + do ibin = 1, aero_props%nbins() + indx = aero_props%indexer(ibin, 0) + call self%get_ambient_num(ibin, raer(indx)%fld) + call self%get_cldbrne_num(ibin, qqcw(indx)%fld) + do ispc = 1, aero_props%nspecies(ibin) + indx = aero_props%indexer(ibin, ispc) + call self%get_ambient_mmr(species_ndx=ispc, bin_ndx=ibin, mmr=raer(indx)%fld) + call self%get_cldbrne_mmr(species_ndx=ispc, bin_ndx=ibin, mmr=qqcw(indx)%fld) + end do + end do + + end subroutine get_states + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght) + use aerosol_properties_mod, only: aero_name_len + use cam_constituents, only: const_get_index + + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght(:,:) + + character(len=aero_name_len) :: modetype + real(r8) :: sigmag_aitken + integer :: i,k + integer :: idx_dgnum + character(len=64) :: cname + + if (self%list_idx_ /= 0) then + call endrun('modal_aerosol_state::icenuc_size_wght_arr: only valid for climate list (list_idx=0)') + end if + + call rad_aer_get_info(0, bin_ndx, mode_type=modetype) + + wght = 0._r8 + + select case ( trim(species_type) ) + case('dust') + if (modetype=='coarse' .or. modetype=='coarse_dust') then + wght(:ncol,:) = 1._r8 + end if + case('sulfate') + if (modetype=='aitken') then + if ( use_preexisting_ice ) then + wght(:ncol,:) = 1._r8 + else + ! The CAM DGNUM pbuf field (i,k,) is replaced by dgnum_m in SIMA. + ! It should be registered by the aerosol model. + ! If not found, the model will endrun when calling this subroutine. + call rad_aer_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) + write(cname, '(a,i2.2)') 'dgnum_m', bin_ndx + call const_get_index(trim(cname), idx_dgnum) + do k = 1, nlev + do i = 1, ncol + if (self%host_%constituents(i,k,idx_dgnum) > 0._r8) then + ! only allow so4 with D>0.1 um in ice nucleation + wght(i,k) = max(0._r8,(0.5_r8 - 0.5_r8* & + erf(log(0.1e-6_r8 / self%host_%constituents(i,k,idx_dgnum)) / & + (2._r8**0.5_r8*log(sigmag_aitken))) )) + end if + end do + end do + endif + endif + case('black-c') + if (modetype=='accum') then + wght(:ncol,:) = 1._r8 + endif + case('sulfate_strat') + if (modetype=='accum' .or. modetype=='coarse' .or. modetype=='coarse_strat') then + wght(:ncol,:) = 1._r8 + endif + end select + + end subroutine icenuc_size_wght_arr + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin, column and vertical layer + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght) + use aerosol_properties_mod, only: aero_name_len + use cam_constituents, only: const_get_index + + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght + + character(len=aero_name_len) :: modetype + real(r8) :: sigmag_aitken + integer :: idx_dgnum + character(len=64) :: cname + + if (self%list_idx_ /= 0) then + call endrun('modal_aerosol_state::icenuc_size_wght_val: only valid for climate list (list_idx=0)') + end if + + wght = 0._r8 + + call rad_aer_get_info(0, bin_ndx, mode_type=modetype) + + select case ( trim(species_type) ) + case('dust') + if (modetype=='coarse' .or. modetype=='coarse_dust') then + wght = 1._r8 + end if + case('sulfate') + if (modetype=='aitken') then + if ( use_preexisting_ice ) then + wght = 1._r8 + else + call rad_aer_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) + write(cname, '(a,i2.2)') 'dgnum_m', bin_ndx + call const_get_index(trim(cname), idx_dgnum) + + if (self%host_%constituents(col_ndx, lyr_ndx, idx_dgnum) > 0._r8) then + ! only allow so4 with D>0.1 um in ice nucleation + wght = max(0._r8,(0.5_r8 - 0.5_r8* & + erf(log(0.1e-6_r8 / self%host_%constituents(col_ndx, lyr_ndx, idx_dgnum)) / & + (2._r8**0.5_r8*log(sigmag_aitken))) )) + end if + endif + endif + case('black-c') + if (modetype=='accum') then + wght = 1._r8 + endif + case('sulfate_strat') + if (modetype=='accum' .or. modetype=='coarse' .or. modetype=='coarse_strat') then + wght = 1._r8 + endif + end select + + end subroutine icenuc_size_wght_val + + !------------------------------------------------------------------------------ + ! returns aerosol type weights for a given aerosol type and bin + !------------------------------------------------------------------------------ + subroutine icenuc_type_wght(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + + use aerosol_properties_mod, only: aerosol_properties + use aerosol_properties_mod, only: aero_name_len + + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: wght(:,:) ! type weights + logical, optional, intent(in) :: cloud_borne ! if TRUE cloud-borne aerosols are used + ! otherwise ambient aerosols are used + + character(len=aero_name_len) :: modetype + + if (self%list_idx_ /= 0) then + call endrun('modal_aerosol_state::icenuc_type_wght: only valid for climate list (list_idx=0)') + end if + + call rad_aer_get_info(0, bin_ndx, mode_type=modetype) + + wght = 0._r8 + + if (species_type == 'dust') then + if (modetype=='coarse_dust') then + wght(:ncol,:) = 1._r8 + else + call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + end if + else if (species_type == 'sulfate_strat') then + if (modetype=='accum') then + wght(:ncol,:) = 1._r8 + elseif ( modetype=='coarse' .or. modetype=='coarse_strat') then + call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + endif + else + wght(:ncol,:) = 1._r8 + end if + + end subroutine icenuc_type_wght + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend ) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + real(r8),intent(in) :: delmmr_sum ! mass mixing ratio change summed over all species in bin + real(r8),intent(in) :: delnum_sum ! number mixing ratio change summed over all species in bin + integer, intent(in) :: tnd_ndx ! tendency index + real(r8),intent(in) :: dtime ! time step size (sec) + real(r8),intent(inout) :: tend(:,:,:) ! tendency + + real(r8), pointer :: amb_num(:,:) + real(r8), pointer :: cld_num(:,:) + + call self%get_ambient_num(bin_ndx, amb_num) + call self%get_cldbrne_num(bin_ndx, cld_num) + + ! if there is no bin mass compute updates/tendencies for bin number + ! -- apply the total number change to bin number + if (tnd_ndx>0) then + tend(col_ndx,lyr_ndx,tnd_ndx) = -delnum_sum/dtime + else + amb_num(col_ndx,lyr_ndx) = amb_num(col_ndx,lyr_ndx) - delnum_sum + end if + + ! apply the total number change to bin number + cld_num(col_ndx,lyr_ndx) = cld_num(col_ndx,lyr_ndx) + delnum_sum + + end subroutine update_bin + + !------------------------------------------------------------------------------ + ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act + ! as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) + use aerosol_properties_mod, only: aero_name_len + + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: wght(ncol,nlev) + + character(len=aero_name_len) :: modetype + + if (self%list_idx_ /= 0) then + call endrun('modal_aerosol_state::hetfrz_size_wght: only valid for climate list (list_idx=0)') + end if + + wght(:,:) = 1._r8 + + call rad_aer_get_info(0, bin_ndx, mode_type=modetype) + + if (trim(modetype) == 'aitken') then + wght(:,:) = 0._r8 + end if + + end function hetfrz_size_wght + + !------------------------------------------------------------------------------ + ! returns hygroscopicity for a given radiation diagnostic list number and + ! bin number + !------------------------------------------------------------------------------ + subroutine hygroscopicity(self, bin_ndx, kappa) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) + + kappa = -huge(1._r8) + + end subroutine hygroscopicity + + !------------------------------------------------------------------------------ + ! returns aerosol wet diameter and aerosol water concentration for a given mode + ! + ! In CAM, the climate list (list_idx==0) retrieves pre-computed DGNUMWET + ! and QAERWAT from the physics buffer (third dimension is bin index); + ! diagnostic lists recompute via modal_aero_calcsize/wateruptake. + ! + ! CAM-SIMA: for the climate list, DGNUMWET and QAERWAT are retrieved from + ! non-advected CCPP constituents dgnumwet_m, qaerwat_m 0) .and. (nacl_ndx > 0)) then + call self%get_ambient_mmr(species_ndx=dust_ndx, bin_ndx=ibin, mmr=dust_mmr) + call self%get_ambient_mmr(species_ndx=nacl_ndx, bin_ndx=ibin, mmr=nacl_mmr) + do k = 1, nlev + do i = 1, ncol + tmpdust = max( 0.0_r8, dust_mmr(i,k) ) + tmpnacl = max( 0.0_r8, nacl_mmr(i,k) ) + if ((tmpdust+tmpnacl) > 1.0e-30_r8) then + f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust & + + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl) + end if + end do + end do + end if + end if + + if (trim(bin_type) == 'primary_carbon') then + frac = 0.0_r8 + else if ((trim(bin_type) == 'fine_dust') .or. (trim(bin_type) == 'coarse_dust')) then + frac = 0.4_r8 + else + frac = 0.8_r8 + end if + + ! set f_act_conv for interstitial (lphase=1) coarse mode species + ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt + ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt + ! number and sulfate are conceptually partitioned to the dust and seasalt + ! on a mass basis, so the f_act_conv for number and sulfate are + ! mass-weighted averages of the values used for dust/seasalt + if (trim(bin_type) == 'coarse') then + frac = f_act_conv_coarse + if (ispc>0) then + call aero_props%species_type(ibin, ispc, spectype) + if (trim(spectype) == 'dust') then + frac = f_act_conv_coarse_dust + else if (trim(spectype) == 'seasalt') then + frac = f_act_conv_coarse_nacl + end if + end if + end if + + end function convcld_actfrac + + !------------------------------------------------------------------------------ + ! aerosol weight percent of H2SO4/H2O solution + !------------------------------------------------------------------------------ + function wgtpct(self, ncol, nlev) result(wtp) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: ncol, nlev + real(r8) :: wtp(ncol,nlev) ! weight percent of H2SO4/H2O solution for given icol, ilev + + wtp(:,:) = -huge(1._r8) + + end function wgtpct + + !------------------------------------------------------------------------------ + ! aqueous chemistry partitioning -- used in sox_cldaero_update + !------------------------------------------------------------------------------ + subroutine aqu_gain_binfraction(self, aero_props, type, qcw, delso4_o3rxn, faqgain) + use vert_coord, only: pver + + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + character(len=*), intent(in) :: type ! aerosol species type + real(r8), intent(in) :: qcw(:,:,:) ! cloud-borne aerosol volume mixing ratio + real(r8), intent(in) :: delso4_o3rxn(:,:) ! sulfate concentration change due to oxidation + real(r8), intent(out) :: faqgain(:,:,:) ! fraction gain in each mode / bin + + character(len=aero_name_len) :: modetype, spectype + integer :: i,k,l,m,n,mm, ncol, nbins + integer :: accum_n + real(r8) :: sumf + real(r8), allocatable :: qnum_c(:) + + ncol = self%ncol() + nbins = aero_props%nbins() + + !------------------------------------------------------------------------- + ! compute factors for partitioning aerosol mass gains among modes. + ! The factors are proportional to the activated particle MR for each + ! mode, which is the MR of cloud drops "associated with" the mode + ! thus we are assuming the cloud drop size is independent of the + ! associated aerosol mode properties (i.e., drops associated with + ! Aitken and coarse sea-salt particles are same size) + ! + ! qnum_c(n) = activated particle number MR for mode n (these are just + ! used for partitioning among modes, so don't need to divide by cldfrc) + !------------------------------------------------------------------------- + + accum_n = -1 + do m = 1, nbins + call rad_aer_get_info(0, m, mode_type=modetype) + if (modetype=='accum') then + accum_n = m + end if + end do + + allocate(qnum_c(nbins)) + + faqgain = 0.0_r8 + + lev_loop: do k = 1,pver + col_loop: do i = 1,ncol + do m = 1, nbins + mm = aero_props%indexer(m,0) + qnum_c(m) = max( 0.0_r8, qcw(i,k,mm) ) + end do + + ! force qnum_c(n) to be positive for n=modeptr_accum or n=1 + n = accum_n + if (n <= 0) n = 1 + qnum_c(n) = max( 1.0e-10_r8, qnum_c(n) ) + + ! faqgain_so4(n) = fraction of total so4_c gain going to mode n + ! these are proportional to the activated particle MR for each mode + sumf = 0.0_r8 + do n = 1, nbins + do l = 1, aero_props%nspecies(n) + call aero_props%get(n,l, spectype=spectype) + if (trim(spectype) == trim(type)) then + faqgain(n,i,k) = qnum_c(n) + sumf = sumf + faqgain(n,i,k) + end if + end do + end do + + if (sumf > 0.0_r8) then + do n = 1, nbins + faqgain(n,i,k) = faqgain(n,i,k) / sumf + end do + end if + ! at this point (sumf <= 0.0) only when all the faqgain_so4 are zero + + end do col_loop + end do lev_loop + + deallocate(qnum_c) + + end subroutine aqu_gain_binfraction + +end module modal_aerosol_state_mod diff --git a/src/aerosol/radiative_aerosol.F90 b/src/aerosol/radiative_aerosol.F90 new file mode 100644 index 000000000..797a06f72 --- /dev/null +++ b/src/aerosol/radiative_aerosol.F90 @@ -0,0 +1,1405 @@ +module radiative_aerosol + +!------------------------------------------------------------------------------------------------ +! +! Facade module for aerosol definitions and queries. +! +! Provides query routines (rad_aer_get_info*, rad_aer_get_props*, etc.) and +! property-access routines that wrap phys_prop lookups. +! Init is via rad_aer_readnl (namelist) and rad_aer_init (physprop + CCPP indices). +! +!------------------------------------------------------------------------------------------------ + +implicit none +private + +! Generic interface for aerosol info queries. +interface rad_aer_get_info + module procedure rad_aer_get_info + module procedure rad_aer_get_info_by_mode + module procedure rad_aer_get_info_by_mode_spec + module procedure rad_aer_get_info_by_spectype +end interface + +interface rad_aer_get_props + module procedure rad_aer_get_props_by_idx + module procedure rad_aer_get_mam_props_by_idx +end interface + +! Public subroutines +! Formerly rad_cnst queries that are related to aerosol +! have been moved to the rad_aer prefix. +public :: rad_aer_get_info +public :: rad_aer_get_info_by_mode, rad_aer_get_info_by_mode_spec +public :: rad_aer_get_info_by_spectype +public :: rad_aer_get_info_by_bin, rad_aer_get_info_by_bin_spec +public :: rad_aer_get_mode_idx, rad_aer_get_spec_idx +public :: rad_aer_num_name +public :: rad_aer_get_mode_props +public :: rad_aer_get_props +public :: rad_aer_get_bin_props_by_idx +public :: rad_aer_get_idx +public :: print_aerosol_lists +public :: rad_aer_readnl +public :: rad_aer_init +public :: rad_aer_mode_physprop_id +public :: rad_aer_bulk_physprop_id +public :: rad_aer_bin_physprop_id + +!============================================================================== +contains +!============================================================================== + +function rad_aer_num_name(list_idx, spc_name_in, num_name_out, mode_out, spec_out ) result(found) + use radiative_aerosol_definitions, only: modelist_t, modal_aerosol_list, modes + + ! for a given species name spc_name_in return (optionals): + ! num_name_out -- corresponding number density species name + ! mode_out -- corresponding mode number + ! spec_out -- corresponding species number within the mode + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=*), intent(in) :: spc_name_in + character(len=*), intent(out) :: num_name_out + integer, optional, intent(out) :: mode_out + integer, optional, intent(out) :: spec_out + + logical :: found + + ! Local variables + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + integer :: n,m, mm + integer :: nmodes + integer :: nspecs + character(len= 32) :: spec_name + + found = .false. + + m_list => modal_aerosol_list(list_idx) + nmodes = m_list%nmodes + + do n = 1,nmodes + mm = m_list%idx(n) + nspecs = modes%comps(mm)%nspec + do m = 1,nspecs + spec_name = modes%comps(mm)%camname_mmr_a(m) + if (spc_name_in == spec_name) then + num_name_out = modes%comps(mm)%camname_num_a + found = .true. + if (present(mode_out)) then + mode_out = n + endif + if (present(spec_out)) then + spec_out = m + endif + return + endif + enddo + enddo + +end function rad_aer_num_name + +!================================================================================================ + +subroutine rad_aer_get_info(list_idx, aernames, naero, nmodes, nbins) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: aerlist_t, modelist_t, binlist_t, & + bulk_aerosol_list, modal_aerosol_list, sectional_aerosol_list + + ! Return info about aerosol lists (gas info handled in rad_constituents) + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=64), optional, intent(out) :: aernames(:) + integer, optional, intent(out) :: naero + integer, optional, intent(out) :: nmodes + integer, optional, intent(out) :: nbins + + ! Local variables + type(aerlist_t), pointer :: a_list ! local pointer to aerosol list of interest + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + type(binlist_t), pointer :: s_list ! local pointer to bin list of interest + + integer :: i + integer :: arrlen ! length of assumed shape array + + character(len=*), parameter :: subname = 'rad_aer_get_info' + !----------------------------------------------------------------------------- + + a_list => bulk_aerosol_list(list_idx) + m_list => modal_aerosol_list(list_idx) + s_list => sectional_aerosol_list(list_idx) + + ! number of bulk aerosols in list + if (present(naero)) then + naero = a_list%numaerosols + endif + + ! number of aerosol modes in list + if (present(nmodes)) then + nmodes = m_list%nmodes + endif + + ! number of aerosol bins in list + if (present(nbins)) then + nbins = s_list%nbins + endif + + ! names of aerosols in list + if (present(aernames)) then + + ! check that output array is long enough + arrlen = size(aernames) + if (arrlen < a_list%numaerosols) then + write(iulog,*) subname//': ERROR: naero=', a_list%numaerosols, ' arrlen=', arrlen + call endrun(subname//': ERROR: aernames too short') + end if + + do i = 1, a_list%numaerosols + aernames(i) = a_list%aer(i)%camname + end do + + end if + +end subroutine rad_aer_get_info + +!================================================================================================ + +subroutine rad_aer_get_info_by_mode(list_idx, m_idx, & + mode_type, num_name, num_name_cw, nspec) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: modelist_t, modal_aerosol_list, modes + + ! Return info about modal aerosol lists + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: m_idx ! index of mode in the specified list + character(len=32), optional, intent(out) :: mode_type ! type of mode (as used in MAM code) + character(len=32), optional, intent(out) :: num_name ! name of interstitial number mixing ratio + character(len=32), optional, intent(out) :: num_name_cw ! name of cloud borne number mixing ratio + integer, optional, intent(out) :: nspec ! number of species in the mode + + ! Local variables + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + + integer :: nmodes + integer :: mm + + character(len=*), parameter :: subname = 'rad_aer_get_info_by_mode' + !----------------------------------------------------------------------------- + + m_list => modal_aerosol_list(list_idx) + + ! check for valid mode index + nmodes = m_list%nmodes + if (m_idx < 1 .or. m_idx > nmodes) then + write(iulog,*) subname//': ERROR - invalid mode index: ', m_idx + call endrun(subname//': ERROR - invalid mode index') + end if + + ! get index into the mode definition object + mm = m_list%idx(m_idx) + + ! mode type + if (present(mode_type)) then + mode_type = modes%types(mm) + endif + + ! number of species in the mode + if (present(nspec)) then + nspec = modes%comps(mm)%nspec + endif + + ! name of interstitial number mixing ratio + if (present(num_name)) then + num_name = modes%comps(mm)%camname_num_a + endif + + ! name of cloud borne number mixing ratio + if (present(num_name_cw)) then + num_name_cw = modes%comps(mm)%camname_num_c + endif + +end subroutine rad_aer_get_info_by_mode + +!================================================================================================ + +subroutine rad_aer_get_info_by_bin(list_idx, m_idx, & + bin_name, num_name, num_name_cw, mmr_name, mmr_name_cw, nspec) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: binlist_t, sectional_aerosol_list, bins + + ! Return info about CARMA aerosol lists + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: m_idx ! index of bin in the specified list + character(len=*), optional, intent(out) :: bin_name + character(len=32), optional, intent(out) :: num_name ! name of interstitial number mixing ratio + character(len=32), optional, intent(out) :: num_name_cw ! name of cloud borne number mixing ratio + character(len=32), optional, intent(out) :: mmr_name ! name of interstitial mass mixing ratio + character(len=32), optional, intent(out) :: mmr_name_cw ! name of cloud borne mass mixing ratio + integer, optional, intent(out) :: nspec ! number of species in the mode + + ! Local variables + type(binlist_t), pointer :: s_list ! local pointer to mode list of interest + + integer :: nbins + integer :: mm + + character(len=*), parameter :: subname = 'rad_aer_get_info_by_bin' + !----------------------------------------------------------------------------- + + s_list => sectional_aerosol_list(list_idx) + + ! check for valid mode index + nbins = s_list%nbins + if (m_idx < 1 .or. m_idx > nbins) then + write(iulog,*) subname//': ERROR - invalid bin index: ', m_idx + call endrun(subname//': ERROR - invalid bin index') + end if + + ! get index into the mode definition object + mm = s_list%idx(m_idx) + + ! number of species in the mode + if (present(nspec)) then + nspec = bins%comps(mm)%nspec + endif + + ! bin name + if (present(bin_name)) then + bin_name = bins%names(m_idx) + end if + + ! name of interstitial number mixing ratio + if (present(num_name)) then + num_name = bins%comps(mm)%camname_num_a + endif + + ! name of cloud borne number mixing ratio + if (present(num_name_cw)) then + num_name_cw = bins%comps(mm)%camname_num_c + endif + + ! name of interstitial mass mixing ratio + if (present(mmr_name)) then + mmr_name = bins%comps(mm)%camname_mass_a + endif + + ! name of cloud borne mass mixing ratio + if (present(mmr_name_cw)) then + mmr_name_cw = bins%comps(mm)%camname_mass_c + endif + +end subroutine rad_aer_get_info_by_bin + +!================================================================================================ +subroutine rad_aer_get_info_by_bin_spec(list_idx, m_idx, s_idx, & + spec_type, spec_morph, spec_name, spec_name_cw) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: binlist_t, sectional_aerosol_list, bins + + ! Return info about CARMA aerosol lists + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: m_idx ! index of bin in the specified list + integer, intent(in) :: s_idx ! index of species in the specified mode + character(len=32), optional, intent(out) :: spec_type ! type of species + character(len=32), optional, intent(out) :: spec_morph ! type of species + character(len=32), optional, intent(out) :: spec_name ! name of interstitial species + character(len=32), optional, intent(out) :: spec_name_cw ! name of cloud borne species + + ! Local variables + type(binlist_t), pointer :: s_list ! local pointer to mode list of interest + integer :: nbins, nspec + integer :: mm + + character(len=*), parameter :: subname = 'rad_aer_get_info_by_bin_spec' + !----------------------------------------------------------------------------- + + s_list => sectional_aerosol_list(list_idx) + + ! check for valid mode index + nbins = s_list%nbins + if (m_idx < 1 .or. m_idx > nbins) then + write(iulog,*) subname//': ERROR - invalid bin index: ', m_idx + call endrun(subname//': ERROR - invalid bin index') + end if + + ! get index into the mode definition object + mm = s_list%idx(m_idx) + + ! check for valid species index + nspec = bins%comps(mm)%nspec + if (s_idx < 1 .or. s_idx > nspec) then + write(iulog,*) subname//': ERROR - invalid specie index: ', s_idx + call endrun(subname//': ERROR - invalid specie index') + end if + + if (present(spec_type)) then + spec_type = bins%comps(mm)%type(s_idx) + endif + if (present(spec_morph)) then + spec_morph = bins%comps(mm)%morph(s_idx) + endif + if (present(spec_name)) then + spec_name = bins%comps(mm)%camname_mmr_a(s_idx) + endif + if (present(spec_name_cw)) then + spec_name_cw = bins%comps(mm)%camname_mmr_c(s_idx) + endif + +end subroutine rad_aer_get_info_by_bin_spec + +!================================================================================================ +subroutine rad_aer_get_info_by_mode_spec(list_idx, m_idx, s_idx, & + spec_type, spec_name, spec_name_cw) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: modelist_t, modal_aerosol_list, modes + + ! Return info about modal aerosol lists + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: m_idx ! index of mode in the specified list + integer, intent(in) :: s_idx ! index of specie in the specified mode + character(len=32), optional, intent(out) :: spec_type ! type of specie + character(len=32), optional, intent(out) :: spec_name ! name of interstitial specie + character(len=32), optional, intent(out) :: spec_name_cw ! name of cloud borne specie + + ! Local variables + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + + integer :: nmodes + integer :: nspec + integer :: mm + + character(len=*), parameter :: subname = 'rad_aer_get_info_by_mode_spec' + !----------------------------------------------------------------------------- + + m_list => modal_aerosol_list(list_idx) + + ! check for valid mode index + nmodes = m_list%nmodes + if (m_idx < 1 .or. m_idx > nmodes) then + write(iulog,*) subname//': ERROR - invalid mode index: ', m_idx + call endrun(subname//': ERROR - invalid mode index') + end if + + ! get index into the mode definition object + mm = m_list%idx(m_idx) + + ! check for valid specie index + nspec = modes%comps(mm)%nspec + if (s_idx < 1 .or. s_idx > nspec) then + write(iulog,*) subname//': ERROR - invalid specie index: ', s_idx + call endrun(subname//': ERROR - invalid specie index') + end if + + ! specie type + if (present(spec_type)) then + spec_type = modes%comps(mm)%type(s_idx) + endif + + ! interstitial specie name + if (present(spec_name)) then + spec_name = modes%comps(mm)%camname_mmr_a(s_idx) + endif + + ! cloud borne specie name + if (present(spec_name_cw)) then + spec_name_cw = modes%comps(mm)%camname_mmr_c(s_idx) + endif + +end subroutine rad_aer_get_info_by_mode_spec + +!================================================================================================ + +subroutine rad_aer_get_info_by_spectype(list_idx, spectype, mode_idx, spec_idx) + use radiative_aerosol_definitions, only: modelist_t, modal_aerosol_list, modes + + ! Return info about modes in the specified climate/diagnostics list + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=*), intent(in) :: spectype ! species type + integer, optional, intent(out) :: mode_idx ! index of a mode that contains a specie of spectype + integer, optional, intent(out) :: spec_idx ! index of the species of spectype + + ! Local variables + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + + integer :: i, nmodes, m_idx, nspec, ispec + logical :: found_spectype + + character(len=*), parameter :: subname = 'rad_aer_get_info_by_spectype' + !----------------------------------------------------------------------------- + + m_list => modal_aerosol_list(list_idx) + + ! number of modes in specified list + nmodes = m_list%nmodes + + ! loop through modes in specified climate/diagnostic list + found_spectype = .false. + do i = 1, nmodes + + ! get index of the mode in the definition object + m_idx = m_list%idx(i) + + ! number of species in the mode + nspec = modes%comps(m_idx)%nspec + + ! loop through species looking for spectype + do ispec = 1, nspec + + if (trim(modes%comps(m_idx)%type(ispec)) == trim(spectype)) then + if (present(mode_idx)) mode_idx = i + if (present(spec_idx)) spec_idx = ispec + found_spectype = .true. + exit + end if + end do + + if (found_spectype) exit + end do + + if (.not. found_spectype) then + if (present(mode_idx)) mode_idx = -1 + if (present(spec_idx)) spec_idx = -1 + end if + +end subroutine rad_aer_get_info_by_spectype + +!================================================================================================ + +function rad_aer_get_mode_idx(list_idx, mode_type) result(mode_idx) + use radiative_aerosol_definitions, only: modelist_t, modal_aerosol_list, modes + + ! Return mode index of the specified type in the specified climate/diagnostics list. + ! Return -1 if not found. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=*), intent(in) :: mode_type ! mode type + + ! Return value + integer :: mode_idx ! mode index + + ! Local variables + type(modelist_t), pointer :: m_list + + integer :: i, nmodes, m_idx + + character(len=*), parameter :: subname = 'rad_aer_get_mode_idx' + !----------------------------------------------------------------------------- + + ! if mode type not found return -1 + mode_idx = -1 + + ! specified mode list + m_list => modal_aerosol_list(list_idx) + + ! number of modes in specified list + nmodes = m_list%nmodes + + ! loop through modes in specified climate/diagnostic list + do i = 1, nmodes + + ! get index of the mode in the definition object + m_idx = m_list%idx(i) + + ! look in mode definition object (modes) for the mode types + if (trim(modes%types(m_idx)) == trim(mode_type)) then + mode_idx = i + exit + end if + end do + +end function rad_aer_get_mode_idx + +!================================================================================================ + +function rad_aer_get_spec_idx(list_idx, mode_idx, spec_type) result(spec_idx) + use radiative_aerosol_definitions, only: modelist_t, mode_component_t, modal_aerosol_list, modes + + ! Return specie index of the specified type in the specified mode of the specified + ! climate/diagnostics list. Return -1 if not found. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + character(len=*), intent(in) :: spec_type ! specie type + + ! Return value + integer :: spec_idx ! specie index + + ! Local variables + type(modelist_t), pointer :: m_list + type(mode_component_t), pointer :: mode_comps + + integer :: i, m_idx, nspec + + character(len=*), parameter :: subname = 'rad_aer_get_spec_idx' + !----------------------------------------------------------------------------- + + ! if specie type not found return -1 + spec_idx = -1 + + ! modes in specified list + m_list => modal_aerosol_list(list_idx) + + ! get index of the specified mode in the definition object + m_idx = m_list%idx(mode_idx) + + ! object containing the components of the mode + mode_comps => modes%comps(m_idx) + + ! number of species in specified mode + nspec = mode_comps%nspec + + ! loop through species in specified mode + do i = 1, nspec + + ! look in mode definition object (modes) for the mode types + if (trim(mode_comps%type(i)) == trim(spec_type)) then + spec_idx = i + exit + end if + end do + +end function rad_aer_get_spec_idx + +!================================================================================================ + +integer function rad_aer_get_idx(list_idx, aer_name) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: N_DIAG, aerlist_t, bulk_aerosol_list + + ! Return the index of aerosol aer_name in the list specified by list_idx. + + ! Arguments + integer, intent(in) :: list_idx ! 0 for climate list, 1-N_DIAG for diagnostic lists + character(len=*), intent(in) :: aer_name ! aerosol name (in state or pbuf) + + ! Local variables + integer :: i, aer_idx + type(aerlist_t), pointer :: aerlist + character(len=*), parameter :: subname = "rad_aer_get_idx" + !------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + aerlist => bulk_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + ! Get index in aerosol list for requested name + aer_idx = -1 + do i = 1, aerlist%numaerosols + if (trim(aer_name) == trim(aerlist%aer(i)%camname)) then + aer_idx = i + exit + end if + end do + + if (aer_idx == -1) call endrun(subname//": ERROR - name not found") + + rad_aer_get_idx = aer_idx + +end function rad_aer_get_idx + +!================================================================================================ + +subroutine rad_aer_get_props_by_idx(list_idx, & + aer_idx, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, num_to_mass_aer) + use shr_kind_mod, only: r8 => shr_kind_r8 + use phys_prop, only: physprop_get, ot_length + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: N_DIAG, aerlist_t, bulk_aerosol_list + + ! Return requested properties for the aerosol from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: aer_idx ! index of the aerosol + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_ext(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + + ! Local variables + integer :: idx + character(len=*), parameter :: subname = 'rad_aer_get_props_by_idx' + type(aerlist_t), pointer :: aerlist + !------------------------------------------------------------------------------------ + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + aerlist => bulk_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + if (aer_idx < 1 .or. aer_idx > aerlist%numaerosols) then + write(iulog,*) subname//': aerosol list index out of range: ', aer_idx ,' list index: ',list_idx + call endrun(subname//': aer_idx out of range') + end if + + idx = aerlist%aer(aer_idx)%physprop_id + + if (present(opticstype)) call physprop_get(idx, opticstype=opticstype) + + if (present(sw_hygro_ext)) call physprop_get(idx, sw_hygro_ext=sw_hygro_ext) + if (present(sw_hygro_ssa)) call physprop_get(idx, sw_hygro_ssa=sw_hygro_ssa) + if (present(sw_hygro_asm)) call physprop_get(idx, sw_hygro_asm=sw_hygro_asm) + if (present(lw_hygro_ext)) call physprop_get(idx, lw_hygro_abs=lw_hygro_ext) + + if (present(sw_nonhygro_ext)) call physprop_get(idx, sw_nonhygro_ext=sw_nonhygro_ext) + if (present(sw_nonhygro_ssa)) call physprop_get(idx, sw_nonhygro_ssa=sw_nonhygro_ssa) + if (present(sw_nonhygro_asm)) call physprop_get(idx, sw_nonhygro_asm=sw_nonhygro_asm) + if (present(sw_nonhygro_scat)) call physprop_get(idx, sw_nonhygro_scat=sw_nonhygro_scat) + if (present(sw_nonhygro_ascat)) call physprop_get(idx, sw_nonhygro_ascat=sw_nonhygro_ascat) + if (present(lw_ext)) call physprop_get(idx, lw_abs=lw_ext) + + if (present(refindex_aer_sw)) call physprop_get(idx, refindex_aer_sw=refindex_aer_sw) + if (present(refindex_aer_lw)) call physprop_get(idx, refindex_aer_lw=refindex_aer_lw) + + if (present(aername)) call physprop_get(idx, aername=aername) + if (present(density_aer)) call physprop_get(idx, density_aer=density_aer) + if (present(hygro_aer)) call physprop_get(idx, hygro_aer=hygro_aer) + if (present(dryrad_aer)) call physprop_get(idx, dryrad_aer=dryrad_aer) + if (present(dispersion_aer)) call physprop_get(idx, dispersion_aer=dispersion_aer) + if (present(num_to_mass_aer)) call physprop_get(idx, num_to_mass_aer=num_to_mass_aer) + + if (present(r_lw_abs)) call physprop_get(idx, r_lw_abs=r_lw_abs) + if (present(r_sw_ext)) call physprop_get(idx, r_sw_ext=r_sw_ext) + if (present(r_sw_scat)) call physprop_get(idx, r_sw_scat=r_sw_scat) + if (present(r_sw_ascat)) call physprop_get(idx, r_sw_ascat=r_sw_ascat) + if (present(mu)) call physprop_get(idx, mu=mu) + +end subroutine rad_aer_get_props_by_idx + +!================================================================================================ + +subroutine rad_aer_get_mam_props_by_idx(list_idx, & + mode_idx, spec_idx, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & + num_to_mass_aer, spectype) + use shr_kind_mod, only: r8 => shr_kind_r8 + use phys_prop, only: physprop_get, ot_length + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: N_DIAG, modelist_t, modal_aerosol_list, modes + + ! Return requested properties for the aerosol from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_ext(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + character(len=32), optional, intent(out) :: spectype + + ! Local variables + integer :: m_idx, idx + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_aer_get_mam_props_by_idx' + !------------------------------------------------------------------------------------ + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => modal_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = mlist%idx(mode_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + idx = modes%comps(m_idx)%idx_props(spec_idx) + + if (present(opticstype)) call physprop_get(idx, opticstype=opticstype) + + if (present(sw_hygro_ext)) call physprop_get(idx, sw_hygro_ext=sw_hygro_ext) + if (present(sw_hygro_ssa)) call physprop_get(idx, sw_hygro_ssa=sw_hygro_ssa) + if (present(sw_hygro_asm)) call physprop_get(idx, sw_hygro_asm=sw_hygro_asm) + if (present(lw_hygro_ext)) call physprop_get(idx, lw_hygro_abs=lw_hygro_ext) + + if (present(sw_nonhygro_ext)) call physprop_get(idx, sw_nonhygro_ext=sw_nonhygro_ext) + if (present(sw_nonhygro_ssa)) call physprop_get(idx, sw_nonhygro_ssa=sw_nonhygro_ssa) + if (present(sw_nonhygro_asm)) call physprop_get(idx, sw_nonhygro_asm=sw_nonhygro_asm) + if (present(sw_nonhygro_scat)) call physprop_get(idx, sw_nonhygro_scat=sw_nonhygro_scat) + if (present(sw_nonhygro_ascat)) call physprop_get(idx, sw_nonhygro_ascat=sw_nonhygro_ascat) + if (present(lw_ext)) call physprop_get(idx, lw_abs=lw_ext) + + if (present(refindex_aer_sw)) call physprop_get(idx, refindex_aer_sw=refindex_aer_sw) + if (present(refindex_aer_lw)) call physprop_get(idx, refindex_aer_lw=refindex_aer_lw) + + if (present(r_lw_abs)) call physprop_get(idx, r_lw_abs=r_lw_abs) + if (present(r_sw_ext)) call physprop_get(idx, r_sw_ext=r_sw_ext) + if (present(r_sw_scat)) call physprop_get(idx, r_sw_scat=r_sw_scat) + if (present(r_sw_ascat)) call physprop_get(idx, r_sw_ascat=r_sw_ascat) + if (present(mu)) call physprop_get(idx, mu=mu) + + if (present(aername)) call physprop_get(idx, aername=aername) + if (present(density_aer)) call physprop_get(idx, density_aer=density_aer) + if (present(hygro_aer)) call physprop_get(idx, hygro_aer=hygro_aer) + if (present(dryrad_aer)) call physprop_get(idx, dryrad_aer=dryrad_aer) + if (present(dispersion_aer)) call physprop_get(idx, dispersion_aer=dispersion_aer) + if (present(num_to_mass_aer)) call physprop_get(idx, num_to_mass_aer=num_to_mass_aer) + + if (present(spectype)) spectype = modes%comps(m_idx)%type(spec_idx) + +end subroutine rad_aer_get_mam_props_by_idx + +!================================================================================================ + +subroutine rad_aer_get_bin_props_by_idx(list_idx, & + bin_idx, spec_idx, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & + num_to_mass_aer, spectype, specmorph) + use shr_kind_mod, only: r8 => shr_kind_r8 + use phys_prop, only: physprop_get, ot_length + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: N_DIAG, binlist_t, sectional_aerosol_list, bins + + ! Return requested properties for the aerosol from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: bin_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_ext(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + character(len=32), optional, intent(out) :: spectype + character(len=32), optional, intent(out) :: specmorph + + ! Local variables + integer :: m_idx, idx + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_aer_get_bin_props_by_idx' + !------------------------------------------------------------------------------------ + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + slist => sectional_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + ! Check for valid mode index + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = slist%idx(bin_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > bins%comps(m_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', bins%comps(m_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + idx = bins%comps(m_idx)%idx_props(spec_idx) + + if (present(opticstype)) call physprop_get(idx, opticstype=opticstype) + + if (present(sw_hygro_ext)) call physprop_get(idx, sw_hygro_ext=sw_hygro_ext) + if (present(sw_hygro_ssa)) call physprop_get(idx, sw_hygro_ssa=sw_hygro_ssa) + if (present(sw_hygro_asm)) call physprop_get(idx, sw_hygro_asm=sw_hygro_asm) + if (present(lw_hygro_ext)) call physprop_get(idx, lw_hygro_abs=lw_hygro_ext) + + if (present(sw_nonhygro_ext)) call physprop_get(idx, sw_nonhygro_ext=sw_nonhygro_ext) + if (present(sw_nonhygro_ssa)) call physprop_get(idx, sw_nonhygro_ssa=sw_nonhygro_ssa) + if (present(sw_nonhygro_asm)) call physprop_get(idx, sw_nonhygro_asm=sw_nonhygro_asm) + if (present(sw_nonhygro_scat)) call physprop_get(idx, sw_nonhygro_scat=sw_nonhygro_scat) + if (present(sw_nonhygro_ascat)) call physprop_get(idx, sw_nonhygro_ascat=sw_nonhygro_ascat) + if (present(lw_ext)) call physprop_get(idx, lw_abs=lw_ext) + + if (present(refindex_aer_sw)) call physprop_get(idx, refindex_aer_sw=refindex_aer_sw) + if (present(refindex_aer_lw)) call physprop_get(idx, refindex_aer_lw=refindex_aer_lw) + + if (present(r_lw_abs)) call physprop_get(idx, r_lw_abs=r_lw_abs) + if (present(r_sw_ext)) call physprop_get(idx, r_sw_ext=r_sw_ext) + if (present(r_sw_scat)) call physprop_get(idx, r_sw_scat=r_sw_scat) + if (present(r_sw_ascat)) call physprop_get(idx, r_sw_ascat=r_sw_ascat) + if (present(mu)) call physprop_get(idx, mu=mu) + + if (present(aername)) call physprop_get(idx, aername=aername) + if (present(density_aer)) call physprop_get(idx, density_aer=density_aer) + if (present(hygro_aer)) call physprop_get(idx, hygro_aer=hygro_aer) + if (present(dryrad_aer)) call physprop_get(idx, dryrad_aer=dryrad_aer) + if (present(dispersion_aer)) call physprop_get(idx, dispersion_aer=dispersion_aer) + if (present(num_to_mass_aer)) call physprop_get(idx, num_to_mass_aer=num_to_mass_aer) + + if (present(spectype)) spectype = bins%comps(m_idx)%type(spec_idx) + if (present(specmorph)) specmorph = bins%comps(m_idx)%morph(spec_idx) + +end subroutine rad_aer_get_bin_props_by_idx + +!================================================================================================ + +subroutine rad_aer_get_mode_props(list_idx, mode_idx, opticstype, & + extpsw, abspsw, asmpsw, absplw, refrtabsw, & + refitabsw, refrtablw, refitablw, ncoef, prefr, & + prefi, sigmag, dgnum, dgnumlo, dgnumhi, & + rhcrystal, rhdeliques) + + use shr_kind_mod, only: r8 => shr_kind_r8 + use phys_prop, only: physprop_get, ot_length + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: N_DIAG, modelist_t, modal_aerosol_list + + ! Return requested properties for the mode from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: extpsw(:,:,:,:) + real(r8), optional, pointer :: abspsw(:,:,:,:) + real(r8), optional, pointer :: asmpsw(:,:,:,:) + real(r8), optional, pointer :: absplw(:,:,:,:) + real(r8), optional, pointer :: refrtabsw(:,:) + real(r8), optional, pointer :: refitabsw(:,:) + real(r8), optional, pointer :: refrtablw(:,:) + real(r8), optional, pointer :: refitablw(:,:) + integer, optional, intent(out) :: ncoef + integer, optional, intent(out) :: prefr + integer, optional, intent(out) :: prefi + real(r8), optional, intent(out) :: sigmag + real(r8), optional, intent(out) :: dgnum + real(r8), optional, intent(out) :: dgnumlo + real(r8), optional, intent(out) :: dgnumhi + real(r8), optional, intent(out) :: rhcrystal + real(r8), optional, intent(out) :: rhdeliques + + ! Local variables + integer :: idx + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_aer_get_mode_props' + !------------------------------------------------------------------------------------ + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => modal_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the physprop index for the requested mode + idx = mlist%idx_props(mode_idx) + + if (present(opticstype)) call physprop_get(idx, opticstype=opticstype) + if (present(extpsw)) call physprop_get(idx, extpsw=extpsw) + if (present(abspsw)) call physprop_get(idx, abspsw=abspsw) + if (present(asmpsw)) call physprop_get(idx, asmpsw=asmpsw) + if (present(absplw)) call physprop_get(idx, absplw=absplw) + + if (present(refrtabsw)) call physprop_get(idx, refrtabsw=refrtabsw) + if (present(refitabsw)) call physprop_get(idx, refitabsw=refitabsw) + if (present(refrtablw)) call physprop_get(idx, refrtablw=refrtablw) + if (present(refitablw)) call physprop_get(idx, refitablw=refitablw) + + if (present(ncoef)) call physprop_get(idx, ncoef=ncoef) + if (present(prefr)) call physprop_get(idx, prefr=prefr) + if (present(prefi)) call physprop_get(idx, prefi=prefi) + if (present(sigmag)) call physprop_get(idx, sigmag=sigmag) + if (present(dgnum)) call physprop_get(idx, dgnum=dgnum) + if (present(dgnumlo)) call physprop_get(idx, dgnumlo=dgnumlo) + if (present(dgnumhi)) call physprop_get(idx, dgnumhi=dgnumhi) + if (present(rhcrystal)) call physprop_get(idx, rhcrystal=rhcrystal) + if (present(rhdeliques)) call physprop_get(idx, rhdeliques=rhdeliques) + +end subroutine rad_aer_get_mode_props + +!================================================================================================ + +subroutine print_aerosol_lists(aer_list, m_list, s_list) + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: newline, aerlist_t, modelist_t, binlist_t, modes, bins + + ! Print summary of bulk, modal, and bin aerosol lists. + + type(aerlist_t), intent(in) :: aer_list + type(modelist_t), intent(in) :: m_list + type(binlist_t), intent(in) :: s_list + + integer :: i, idx + + if (len_trim(aer_list%list_id) == 0) then + write(iulog,*) newline//' bulk aerosol list for climate calculations' + else + write(iulog,*) newline//' bulk aerosol list for diag'//aer_list%list_id//' calculations' + end if + + do i = 1, aer_list%numaerosols + write(iulog,*) ' '//trim(aer_list%aer(i)%source)//':'//trim(aer_list%aer(i)%camname)//& + ' optics and phys props in :'//trim(aer_list%aer(i)%physprop_file) + enddo + + if (len_trim(m_list%list_id) == 0) then + write(iulog,*) newline//' modal aerosol list for climate calculations' + else + write(iulog,*) newline//' modal aerosol list for diag'//m_list%list_id//' calculations' + end if + + do i = 1, m_list%nmodes + idx = m_list%idx(i) + write(iulog,*) ' '//trim(modes%names(idx)) + enddo + + if (len_trim(s_list%list_id) == 0) then + write(iulog,*) newline//' bin aerosol list for climate calculations' + else + write(iulog,*) newline//' bin aerosol list for diag'//s_list%list_id//' calculations' + end if + + do i = 1, s_list%nbins + idx = s_list%idx(i) + write(iulog,*) ' '//trim(bins%names(idx)) + enddo + +end subroutine print_aerosol_lists + +!================================================================================================ + +! Parse aerosol mode/bin definitions, accumulate physprop files, +! and initialize aerosol lists (phase 1). +! +! Called from rad_cnst_readnl after namelist I/O, broadcast, and +! parse_rad_specifier / active_calls have been set. +! +! In SIMA, this will read aerosol-specific namelists directly +! (rad_aerosol / rad_aer_diag_N instead of rad_climate / rad_diag_N). +subroutine rad_aer_readnl(nlfile) + use shr_nl_mod, only: find_group_name => shr_nl_find_group_name + use shr_kind_mod, only: shr_kind_cm + use mpi, only: mpi_character + use spmd_utils, only: mpicom + use phys_prop, only: physprop_accum_unique_files + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: & + verbose, N_DIAG, n_rad_cnst, n_mode_str, n_bin_str, & + modes, bins, & + active_calls, bulk_aerosol_list, modal_aerosol_list, sectional_aerosol_list, & + radcnst_namelist, parse_rad_specifier, parse_mode_defs, parse_bin_defs, & + list_populate, print_modes, print_bins + + ! Arguments + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: i, unitn, ierr + character(len=2) :: suffix + character(len=1), pointer :: ctype(:) + character(len=*), parameter :: subname = 'rad_aer_readnl' + character(len=shr_kind_cm) :: errmsg + + ! Namelist variables (matching XML: group rad_aer_nl) + character(len=256), dimension(n_mode_str) :: mode_defs = ' ' + character(len=256), dimension(n_bin_str) :: bin_defs = ' ' + character(len=256) :: rad_aer_climate(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_1(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_2(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_3(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_4(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_5(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_6(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_7(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_8(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_9(n_rad_cnst) = ' ' + character(len=256) :: rad_aer_diag_10(n_rad_cnst) = ' ' + + namelist /rad_aer_nl/ mode_defs, bin_defs, & + rad_aer_climate, & + rad_aer_diag_1, rad_aer_diag_2, rad_aer_diag_3, & + rad_aer_diag_4, rad_aer_diag_5, rad_aer_diag_6, & + rad_aer_diag_7, rad_aer_diag_8, rad_aer_diag_9, & + rad_aer_diag_10 + !----------------------------------------------------------------------------- + + errmsg = '' + + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'rad_aer_nl', status=ierr) + if (ierr == 0) then + read(unitn, rad_aer_nl, iostat=ierr, iomsg=errmsg) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist: ' // errmsg) + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(mode_defs, len(mode_defs(1))*n_mode_str, mpi_character, 0, mpicom, ierr) + call mpi_bcast(bin_defs, len(bin_defs(1))*n_bin_str, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_climate, len(rad_aer_climate(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_1, len(rad_aer_diag_1(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_2, len(rad_aer_diag_2(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_3, len(rad_aer_diag_3(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_4, len(rad_aer_diag_4(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_5, len(rad_aer_diag_5(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_6, len(rad_aer_diag_6(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_7, len(rad_aer_diag_7(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_8, len(rad_aer_diag_8(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_9, len(rad_aer_diag_9(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + call mpi_bcast(rad_aer_diag_10, len(rad_aer_diag_10(1))*n_rad_cnst, mpi_character, 0, mpicom, ierr) + + ! Parse the namelist input strings into radcnst_namelist + do i = 0, N_DIAG + select case (i) + case(0) + call parse_rad_specifier(rad_aer_climate, radcnst_namelist(i)) + case (1) + call parse_rad_specifier(rad_aer_diag_1, radcnst_namelist(i)) + case (2) + call parse_rad_specifier(rad_aer_diag_2, radcnst_namelist(i)) + case (3) + call parse_rad_specifier(rad_aer_diag_3, radcnst_namelist(i)) + case (4) + call parse_rad_specifier(rad_aer_diag_4, radcnst_namelist(i)) + case (5) + call parse_rad_specifier(rad_aer_diag_5, radcnst_namelist(i)) + case (6) + call parse_rad_specifier(rad_aer_diag_6, radcnst_namelist(i)) + case (7) + call parse_rad_specifier(rad_aer_diag_7, radcnst_namelist(i)) + case (8) + call parse_rad_specifier(rad_aer_diag_8, radcnst_namelist(i)) + case (9) + call parse_rad_specifier(rad_aer_diag_9, radcnst_namelist(i)) + case (10) + call parse_rad_specifier(rad_aer_diag_10, radcnst_namelist(i)) + end select + end do + + ! Were there any constituents specified for the nth diagnostic call? + active_calls(:) = (radcnst_namelist(:)%ncnst > 0) + + ! Parse mode definition strings + call parse_mode_defs(mode_defs, modes) + + ! Parse bin definition strings + call parse_bin_defs(bin_defs, bins) + + ! Set the list_id fields for aerosol lists + do i = 0, N_DIAG + if (active_calls(i)) then + if (i > 0) then + write(suffix, fmt = '(i2.2)') i + else + suffix=' ' + end if + bulk_aerosol_list(i)%list_id = suffix + modal_aerosol_list(i)%list_id = suffix + sectional_aerosol_list(i)%list_id = suffix + end if + end do + + ! Accumulate unique physprop files for bulk aerosol species + do i = 0, N_DIAG + if (active_calls(i)) then + call physprop_accum_unique_files(radcnst_namelist(i)%radname, radcnst_namelist(i)%type) + endif + enddo + + ! Accumulate physprop files for mode species + do i = 1, modes%nmodes + allocate(ctype(modes%comps(i)%nspec)) + ctype = 'A' + call physprop_accum_unique_files(modes%comps(i)%props, ctype) + deallocate(ctype) + end do + + ! Accumulate physprop files for bin species + do i = 1, bins%nbins + allocate(ctype(bins%comps(i)%nspec)) + ctype = 'A' + call physprop_accum_unique_files(bins%comps(i)%props, ctype) + deallocate(ctype) + end do + + ! Initialize aerosol lists (populate from namelist specifiers) + do i = 0, N_DIAG + if (active_calls(i)) then + ! has to be done at readnl phase as information on structure of the lists will be needed + ! in physics/chemistry initialization. + call list_populate(radcnst_namelist(i), bulk_aerosol_list(i), modal_aerosol_list(i), sectional_aerosol_list(i)) + + if (masterproc .and. verbose) then + call print_aerosol_lists(bulk_aerosol_list(i), modal_aerosol_list(i), sectional_aerosol_list(i)) + end if + end if + end do + + if (masterproc .and. verbose) call print_modes(modes) + if (masterproc .and. verbose) call print_bins(bins) + +end subroutine rad_aer_readnl + +!================================================================================================ + +! Complete aerosol initialization (phase 2). +! Reads physprop files, resolves constituent indices for modes/bins, +! finishes aerosol list init, and registers aerosol diagnostic fields. +subroutine rad_aer_init() + use phys_prop, only: physprop_init + use radiative_aerosol_definitions, only: & + N_DIAG, modes, bins, active_calls, & + bulk_aerosol_list, modal_aerosol_list, sectional_aerosol_list, list_resolve_physprops + + use aerosol_mmr_host, only: aerosol_mmr_init, & + resolve_mode_idx, resolve_bin_idx, resolve_bulk_idx, & + rad_aer_diag_init + + integer :: i + character(len=*), parameter :: subname = 'rad_aer_init' + !----------------------------------------------------------------------------- + + ! Initialize a zero target for the 'Z' type of aerosol MMR. + call aerosol_mmr_init() + + ! Read physical properties from data files + call physprop_init() + + ! Resolve host-specific CCPP constituent indices + call resolve_mode_idx(modes) + call resolve_bin_idx(bins) + + ! Resolve physprop indices for aerosol lists + do i = 0, N_DIAG + if (active_calls(i)) then + call resolve_bulk_idx(bulk_aerosol_list(i)) + call list_resolve_physprops(bulk_aerosol_list(i), modal_aerosol_list(i), sectional_aerosol_list(i)) + end if + end do + + ! Register aerosol diagnostic history fields + call rad_aer_diag_init(bulk_aerosol_list(0)) + +end subroutine rad_aer_init + +!================================================================================================ + +!------------------------------------------------------------------------ +! Return the physprop ID for a mode in the modal aerosol list +!------------------------------------------------------------------------ +integer function rad_aer_mode_physprop_id(list_idx, mode_idx) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: N_DIAG, modelist_t, modal_aerosol_list + + integer, intent(in) :: list_idx + integer, intent(in) :: mode_idx + + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_aer_mode_physprop_id' + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => modal_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + rad_aer_mode_physprop_id = mlist%idx_props(mode_idx) + +end function rad_aer_mode_physprop_id + +!------------------------------------------------------------------------ +! Return the physprop ID for an aerosol in the bulk aerosol list +!------------------------------------------------------------------------ +integer function rad_aer_bulk_physprop_id(list_idx, aer_idx) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: N_DIAG, aerlist_t, bulk_aerosol_list + + integer, intent(in) :: list_idx + integer, intent(in) :: aer_idx + + type(aerlist_t), pointer :: aerlist + character(len=*), parameter :: subname = 'rad_aer_bulk_physprop_id' + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + aerlist => bulk_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + if (aer_idx < 1 .or. aer_idx > aerlist%numaerosols) then + write(iulog,*) subname//': aer_idx= ', aer_idx, ' list index: ', list_idx + call endrun(subname//': aer_idx out of range') + end if + + rad_aer_bulk_physprop_id = aerlist%aer(aer_idx)%physprop_id + +end function rad_aer_bulk_physprop_id + +!------------------------------------------------------------------------ +! Return the physprop ID for a bin in the sectional (CARMA) aerosol list +!------------------------------------------------------------------------ +integer function rad_aer_bin_physprop_id(list_idx, bin_idx) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: N_DIAG, binlist_t, sectional_aerosol_list + + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_aer_bin_physprop_id' + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + slist => sectional_aerosol_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + rad_aer_bin_physprop_id = slist%idx_props(bin_idx) + +end function rad_aer_bin_physprop_id + +!================================================================================================ + +end module radiative_aerosol diff --git a/src/aerosol/radiative_aerosol_definitions.F90 b/src/aerosol/radiative_aerosol_definitions.F90 new file mode 100644 index 000000000..8ac81c57c --- /dev/null +++ b/src/aerosol/radiative_aerosol_definitions.F90 @@ -0,0 +1,1245 @@ +!----------------------------------------------------------------------------- +! Core aerosol definitions for radiative calculations: shared constants, +! types, data, parsing, and initialization routines for both modal and +! sectional (bin) aerosol representations. +! +! This module is the lowest-level shared module in the aerosol hierarchy. +! It will be shared with CAM-SIMA. +!----------------------------------------------------------------------------- +module radiative_aerosol_definitions + + implicit none + private + save + + public :: parse_mode_defs, parse_bin_defs ! parse mode and bin definitions for aerosol. + public :: parse_rad_specifier ! parse rad_climate and rad_diag_N specifiers into rad_cnst_namelist_t. + public :: list_populate ! populate aerosol list structures from parsed namelist (run before register) + public :: list_resolve_physprops ! resolve physprop indices into aerosol list structures + public :: print_modes, print_bins + + !=========================== + ! Named constants for mode/species/morph validation + ! These categories and definitions are used throughout the aerosol models, + ! not just in radiative_aerosol. + !=========================== + integer, public, parameter :: num_mode_types = 9 + integer, public, parameter :: num_spec_types = 8 + character(len=14), public, parameter :: mode_type_names(num_mode_types) = (/ & + 'accum ', 'aitken ', 'primary_carbon', 'fine_seasalt ', & + 'fine_dust ', 'coarse ', 'coarse_seasalt', 'coarse_dust ', & + 'coarse_strat ' /) + character(len=9), public, parameter :: spec_type_names(num_spec_types) = (/ & + 'sulfate ', 'ammonium ', 'nitrate ', 'p-organic', & + 's-organic', 'black-c ', 'seasalt ', 'dust '/) + + integer, public, parameter :: num_bin_morphs = 2 + character(len=8), public, parameter :: bin_morph_names(num_bin_morphs) = & + (/ 'shell ', 'core ' /) + + !=========================== + ! Shared constants (shared with rad_constituents for gases) part 1. + !=========================== + logical, public, parameter :: verbose = .true. + character(len=1), public, parameter :: newline = achar(10) + + !=========================== + ! Types + !=========================== +!! \section arg_table_rad_cnst_namelist_t +!! \htmlinclude rad_cnst_namelist_t.html + ! type to provide access to the data parsed from the rad_climate and rad_diag_* strings + type, public :: rad_cnst_namelist_t + integer :: ncnst + character(len= 1), pointer :: source(:) ! 'A' for state (advected), 'N' for pbuf (non-advected), + ! 'M' for mode, 'Z' for zero + character(len= 64), pointer :: camname(:) ! name registered in pbuf or constituents + character(len=256), pointer :: radname(:) ! radname is the name as identfied in radiation, + ! must be one of (rgaslist if a gas) or + ! (/fullpath/filename.nc if an aerosol) + character(len= 1), pointer :: type(:) ! 'A' if aerosol, 'G' if gas, 'M' if mode + end type rad_cnst_namelist_t + +!! \section arg_table_mode_component_t +!! \htmlinclude mode_component_t.html + ! type to provide access to the components of a mode + type, public :: mode_component_t + integer :: nspec + ! For "source" variables below, value is: + ! 'N' if in pbuf (non-advected) + ! 'A' if in state (advected) + + ! source of interstitial number conc field + character(len= 1) :: source_num_a + ! name registered in pbuf or constituents for number mixing ratio of interstitial species + character(len= 32) :: camname_num_a + ! source of cloud borne number conc field + character(len= 1) :: source_num_c + ! name registered in pbuf or constituents for number mixing ratio of cloud borne species + character(len= 32) :: camname_num_c + ! source of interstitial specie mmr fields + character(len= 1), pointer :: source_mmr_a(:) + ! name registered in pbuf or constituents for mmr of interstitial components + character(len= 32), pointer :: camname_mmr_a(:) + ! source of cloud borne specie mmr fields + character(len= 1), pointer :: source_mmr_c(:) + ! name registered in pbuf or constituents for mmr of cloud borne components + character(len= 32), pointer :: camname_mmr_c(:) + ! specie type (as used in MAM code) + character(len= 32), pointer :: type(:) + ! file containing specie properties + character(len=256), pointer :: props(:) + + ! index in pbuf or constituents for number mixing ratio of interstitial species + integer :: idx_num_a + ! index in pbuf for number mixing ratio of interstitial species + integer :: idx_num_c + ! index in pbuf or constituents for mmr of interstitial species + integer, pointer :: idx_mmr_a(:) + ! index in pbuf for mmr of interstitial species + integer, pointer :: idx_mmr_c(:) + ! ID used to access physical properties of mode species from phys_prop module + integer, pointer :: idx_props(:) + end type mode_component_t + +!! \section arg_table_modes_t +!! \htmlinclude modes_t.html + ! type to provide access to all modes + type, public :: modes_t + integer :: nmodes + character(len= 32), pointer :: names(:) ! names used to identify a mode in the climate/diag lists + character(len= 32), pointer :: types(:) ! type of mode (as used in MAM code) + type(mode_component_t), pointer :: comps(:) ! components which define the mode + end type modes_t + +!! \section arg_table_bin_component_t +!! \htmlinclude bin_component_t.html + ! type to provide access to the components of a bin + type, public :: bin_component_t + integer :: nspec + ! For "source" variables below, value is: + ! 'N' if in pbuf (non-advected) + ! 'A' if in state (advected) + character(len= 1) :: source_num_a ! source of interstitial number conc field + character(len= 32) :: camname_num_a ! name registered in pbuf or constituents for number mixing ratio of interstitial species + character(len= 1) :: source_num_c ! source of cloud borne number conc field + character(len= 32) :: camname_num_c ! name registered in pbuf or constituents for number mixing ratio of cloud borne species + + character(len= 1) :: source_mass_a ! source of interstitial number conc field + character(len= 32) :: camname_mass_a ! name registered in pbuf or constituents for number mixing ratio of interstitial species + character(len= 1) :: source_mass_c ! source of cloud borne number conc field + character(len= 32) :: camname_mass_c ! name registered in pbuf or constituents for number mixing ratio of cloud borne species + + ! source of interstitial mmr field + character(len= 1), pointer :: source_mmr_a(:) + ! name registered in pbuf or constituents for mmr species + character(len= 32), pointer :: camname_mmr_a(:) + ! source of cloud borne specie mmr fields + character(len= 1), pointer :: source_mmr_c(:) + ! name registered in pbuf or constituents for mmr of cloud borne components + character(len= 32), pointer :: camname_mmr_c(:) + ! species type + character(len= 32), pointer :: type(:) + ! species morphology + character(len= 32), pointer :: morph(:) + ! file containing specie properties + character(len=256), pointer :: props(:) + + ! index in pbuf or constituents for number mixing ratio of interstitial species + integer :: idx_num_a + ! index in pbuf for number mixing ratio of cloud-borne species + integer :: idx_num_c + ! index in pbuf or constituents for mass mixing ratio of interstitial species + integer :: idx_mass_a + ! index in pbuf for mass mixing ratio of cloud-borne species + integer :: idx_mass_c + + ! index in pbuf or constituents for mmr of interstitial species + integer, pointer :: idx_mmr_a(:) + ! index in pbuf or constituents for mmr of cloud-borne species + integer, pointer :: idx_mmr_c(:) + ! ID used to access physical properties of mode species from phys_prop module + integer, pointer :: idx_props(:) + end type bin_component_t + +!! \section arg_table_bins_t +!! \htmlinclude bins_t.html + ! type to provide access to all bins + type, public :: bins_t + integer :: nbins + character(len= 32), pointer :: names(:) ! names used to identify a mode in the climate/diag lists + type(bin_component_t), pointer :: comps(:) ! components which define the mode + end type bins_t + +!! \section arg_table_aerosol_t +!! \htmlinclude aerosol_t.html + ! Storage for bulk aerosol components in the climate/diagnostic lists + type, public :: aerosol_t + character(len=1) :: source ! A for state (advected), N for pbuf (non-advected), Z for zero + character(len=64) :: camname ! name of constituent in physics state or buffer + character(len=256) :: physprop_file ! physprop filename + character(len=32) :: mass_name ! name for mass per layer field in history output + integer :: idx ! index of constituent in physics state or buffer + integer :: physprop_id ! ID used to access physical properties from phys_prop module + end type aerosol_t + +!! \section arg_table_aerlist_t +!! \htmlinclude aerlist_t.html + type, public :: aerlist_t + integer :: numaerosols = 0 ! number of aerosols + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + type(aerosol_t), pointer :: aer(:) => null() ! dimension(numaerosols) + end type aerlist_t + +!! \section arg_table_modelist_t +!! \htmlinclude modelist_t.html + ! storage for modal aerosol components in the climate/diagnostic lists + type, public :: modelist_t + ! number of modes + integer :: nmodes = 0 + + ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + ! used to construct history field names and descriptions + character(len=2) :: list_id + + ! index of the mode in the mode definition object + integer, pointer :: idx(:) => null() + ! physprop filename + character(len=256), pointer :: physprop_files(:) => null() + ! index of the mode properties in the physprop object + integer, pointer :: idx_props(:) => null() + end type modelist_t + +!! \section arg_table_binlist_t +!! \htmlinclude binlist_t.html + ! storage for bin aerosol components in the climate/diagnostic lists + type, public :: binlist_t + ! number of bins + integer :: nbins = 0 + + ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + ! used to construct history field names and descriptions + character(len=2) :: list_id + + ! index of the bin in the bin definition object + integer, pointer :: idx(:) => null() + ! physprop filename + character(len=256), pointer :: physprop_files(:) => null() + ! index of the bin properties in the physprop object + integer, pointer :: idx_props(:) => null() + end type binlist_t + + ! max number of strings in mode definitions + integer, public, parameter :: n_mode_str = 120 + + ! max number of strings in bin definitions + integer, public, parameter :: n_bin_str = 640 + + !=========================== + ! Shared constants (shared with rad_constituents for gases) + ! These have CCPP framework metadata attached to them as + ! physics/chemistry CCPP schemes make use of these quantities. + !=========================== +!> \section arg_table_radiative_aerosol_definitions Argument Table +!! \htmlinclude radiative_aerosol_definitions.html + ! maximum number of diagnostic lists + integer, public, parameter :: N_DIAG = 10 + + ! max number of externally mixed entities in the climate/diag lists + integer, public, parameter :: n_rad_cnst = 80 + + ! climate list identifier (to keep CCPP framework happy) + integer, public, parameter :: id_climate = 0 + + !=========================== + ! Aerosol-specific module data. + !=========================== + ! namelist data container per climate/diagnostic list. + type(rad_cnst_namelist_t), public :: radcnst_namelist(id_climate:N_DIAG) + + ! flag for whether diagnostic lists are active + logical, public :: active_calls(id_climate:N_DIAG) = .false. + + type(modes_t), public, target :: modes ! mode definitions + type(bins_t), public, target :: bins ! bin definitions + + ! list of bulk aerosols used in climate/diagnostic calculations + type(aerlist_t), public, target :: bulk_aerosol_list(id_climate:N_DIAG) + + ! list of aerosol modes used in climate/diagnostic calculations + type(modelist_t), public, target :: modal_aerosol_list(id_climate:N_DIAG) + + ! list of aerosol bins used in climate/diagnostic calcs + type(binlist_t), public, target :: sectional_aerosol_list(id_climate:N_DIAG) + +!============================================================================== +contains +!============================================================================== + +subroutine list_populate(namelist, aerlist, modal_aerosol_list, sectional_aerosol_list) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + + ! Populate aerosol list structures from parsed namelist specifiers. + ! IMPORTANT: Must run at readnl time (before phys_register), because + ! phys_register routines (e.g., modal_aero_data_reg) query + ! modal_aerosol_list(0)%nmodes via rad_aer_get_info. + ! Do NOT merge with list_resolve_physprops. + ! + ! Gas initialization is handled in rad_constituents. + type(rad_cnst_namelist_t), intent(in) :: namelist ! parsed namelist input for climate or diagnostic lists + + type(aerlist_t), intent(inout) :: aerlist + type(modelist_t), intent(inout) :: modal_aerosol_list + type(binlist_t), intent(inout) :: sectional_aerosol_list + + ! Local variables + integer :: ii, m, naero, nmodes, nbins + integer :: ba_idx, ma_idx, sa_idx + integer :: istat + character(len=*), parameter :: subname = 'list_populate' + !----------------------------------------------------------------------------- + + ! Determine the number of bulk aerosols and aerosol modes in the list + naero = 0 + nmodes = 0 + nbins = 0 + do ii = 1, namelist%ncnst + if (trim(namelist%type(ii)) == 'A') naero = naero + 1 + if (trim(namelist%type(ii)) == 'M') nmodes = nmodes + 1 + if (trim(namelist%type(ii)) == 'B') nbins = nbins + 1 + end do + aerlist%numaerosols = naero + modal_aerosol_list%nmodes = nmodes + sectional_aerosol_list%nbins = nbins + + ! allocate storage for the aerosol and mode lists + allocate( & + aerlist%aer(aerlist%numaerosols), & + modal_aerosol_list%idx(modal_aerosol_list%nmodes), & + modal_aerosol_list%physprop_files(modal_aerosol_list%nmodes), & + modal_aerosol_list%idx_props(modal_aerosol_list%nmodes), & + sectional_aerosol_list%idx(sectional_aerosol_list%nbins), & + sectional_aerosol_list%physprop_files(sectional_aerosol_list%nbins), & + sectional_aerosol_list%idx_props(sectional_aerosol_list%nbins), & + stat=istat) + if (istat /= 0) call endrun(subname//': allocate ERROR; aero list components') + + if (masterproc .and. verbose) then + if (len_trim(aerlist%list_id) == 0) then + write(iulog,*) newline//' '//subname//': namelist input for climate list' + else + write(iulog,*) newline//' '//subname//': namelist input for diagnostic list:'//aerlist%list_id + end if + end if + + ! Loop over the radiatively active components specified in the namelist + ba_idx = 0 + ma_idx = 0 + sa_idx = 0 + do ii = 1, namelist%ncnst + + ! Skip gas entries (handled in rad_constituents) + if (namelist%type(ii) == 'G') cycle + + if (masterproc .and. verbose) & + write(iulog,*) " rad namelist spec: "// trim(namelist%source(ii)) & + //":"//trim(namelist%camname(ii))//":"//trim(namelist%radname(ii)) + + ! Check that the source specifier is legal. + if (namelist%source(ii) /= 'A' .and. namelist%source(ii) /= 'M' .and. & + namelist%source(ii) /= 'N' .and. namelist%source(ii) /= 'Z' .and. & + namelist%source(ii) /= 'B' ) then + call endrun(subname//": source must either be A, B, M, N or Z:"//& + " illegal specifier in namelist input: "//namelist%source(ii)) + end if + + ! Add component to appropriate list (modal or bulk aerosol) + if (namelist%type(ii) == 'A') then + + ! Add to bulk aerosol list + ba_idx = ba_idx + 1 + + aerlist%aer(ba_idx)%source = namelist%source(ii) + aerlist%aer(ba_idx)%camname = namelist%camname(ii) + aerlist%aer(ba_idx)%physprop_file = namelist%radname(ii) + + else if (namelist%type(ii) == 'M') then + + ! Add to modal aerosol list + ma_idx = ma_idx + 1 + + ! Look through the mode definitions for the name of the specified mode. The + ! index into the modes object all the information relevent to the mode definition. + modal_aerosol_list%idx(ma_idx) = -1 + do m = 1, modes%nmodes + if (trim(namelist%camname(ii)) == trim(modes%names(m))) then + modal_aerosol_list%idx(ma_idx) = m + exit + end if + end do + if (modal_aerosol_list%idx(ma_idx) == -1) & + call endrun(subname//' ERROR cannot find mode name '//trim(namelist%camname(ii))) + + ! Also save the name of the physprop file + modal_aerosol_list%physprop_files(ma_idx) = namelist%radname(ii) + + else if (namelist%type(ii) == 'B') then + + ! Add to bin aerosol list + sa_idx = sa_idx + 1 + + ! Look through the bin definitions for the name of the specified bin. The + ! index into the bins object all the information relevent to the bin definition. + sectional_aerosol_list%idx(sa_idx) = -1 + do m = 1, bins%nbins + if (trim(namelist%camname(ii)) == trim(bins%names(m))) then + sectional_aerosol_list%idx(sa_idx) = m + exit + end if + end do + if (sectional_aerosol_list%idx(sa_idx) == -1) & + call endrun(subname//' ERROR cannot find bin name '//trim(namelist%camname(ii))) + + ! Also save the name of the physprop file + sectional_aerosol_list%physprop_files(sa_idx) = namelist%radname(ii) + + end if + end do + +end subroutine list_populate + +!=========================== + +subroutine list_resolve_physprops(aerlist, modal_aerosol_list, sectional_aerosol_list) + + ! Resolve physprop indices for bulk aerosols, modes, and bins. + ! IMPORTANT: Must run at init time (after physprop_init), because + ! physprop_get_id requires physprop files to have been read. + ! Do NOT merge with list_populate. + ! + ! Host-specific index resolution (get_cam_idx) is handled + ! separately by the host module (e.g. aerosol_mmr_cam). + + use phys_prop, only: physprop_get_id + + type(aerlist_t), intent(inout) :: aerlist + type(modelist_t), intent(inout) :: modal_aerosol_list + type(binlist_t), intent(inout) :: sectional_aerosol_list + + ! Local variables + integer :: i + character(len=*), parameter :: subname = 'list_resolve_physprops' + !----------------------------------------------------------------------------- + + ! Loop over bulk aerosols + do i = 1, aerlist%numaerosols + + ! get the physprop_id from the phys_prop module + aerlist%aer(i)%physprop_id = physprop_get_id(aerlist%aer(i)%physprop_file) + + end do + + ! Loop over modes + do i = 1, modal_aerosol_list%nmodes + + ! get the physprop_id from the phys_prop module + modal_aerosol_list%idx_props(i) = physprop_get_id(modal_aerosol_list%physprop_files(i)) + + end do + + ! Loop over bins + do i = 1, sectional_aerosol_list%nbins + + ! get the physprop_id from the phys_prop module + sectional_aerosol_list%idx_props(i) = physprop_get_id(sectional_aerosol_list%physprop_files(i)) + + end do + +end subroutine list_resolve_physprops + +!=========================== + +subroutine parse_mode_defs(nl_in, modes) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + ! Parse the mode definition specifiers. The specifiers are of the form: + ! + ! 'mode_name:mode_type:=', + ! 'source_num_a:camname_num_a:source_num_c:camname_num_c:num_mr:+', + ! 'source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file[:+]'[,] + ! ['source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file][:+]['] + + + character(len=*), intent(inout) :: nl_in(:) ! namelist input (blanks are removed on output) + type(modes_t), intent(inout) :: modes ! structure containing parsed input + + ! Local variables + integer :: m + integer :: istat + integer :: nmodes, nstr + integer :: mbeg, mcur + integer :: nspec, ispec + integer :: strlen, iend, ipos + logical :: num_mr_found + character(len=*), parameter :: subname = 'parse_mode_defs' + character(len=len(nl_in(1))) :: tmpstr + character(len=1) :: tmp_src_a + character(len=32) :: tmp_name_a + character(len=1) :: tmp_src_c + character(len=32) :: tmp_name_c + character(len=32) :: tmp_type + !------------------------------------------------------------------------- + + ! Determine number of modes defined by counting number of strings that are + ! terminated by ':=' + ! (algorithm stops counting at first blank element). + nmodes = 0 + nstr = 0 + do m = 1, n_mode_str + + if (len_trim(nl_in(m)) == 0) exit + nstr = nstr + 1 + + ! There are no fields in the input strings in which a blank character is allowed. + ! To simplify the parsing go through the input strings and remove blanks. + tmpstr = adjustl(nl_in(m)) + nl_in(m) = tmpstr + do + strlen = len_trim(nl_in(m)) + ipos = index(nl_in(m), ' ') + if (ipos == 0 .or. ipos > strlen) exit + tmpstr = nl_in(m)(:ipos-1) // nl_in(m)(ipos+1:strlen) + nl_in(m) = tmpstr + end do + ! count strings with ':=' terminator + if (nl_in(m)(strlen-1:strlen) == ':=') nmodes = nmodes + 1 + + end do + modes%nmodes = nmodes + + ! return if no modes defined + if (nmodes == 0) return + + ! allocate components that depend on nmodes + allocate( & + modes%names(nmodes), & + modes%types(nmodes), & + modes%comps(nmodes), & + stat=istat ) + if (istat > 0) then + write(iulog,*) subname//': ERROR: cannot allocate storage for modes. nmodes=', nmodes + call endrun(subname//': ERROR allocating storage for modes') + end if + + mcur = 1 ! index of current string being processed + + ! loop over modes + do m = 1, nmodes + + mbeg = mcur ! remember the first string of a mode + + ! check that first string in mode definition is ':=' terminated + iend = len_trim(nl_in(mcur)) + if (nl_in(mcur)(iend-1:iend) /= ':=') call parse_error('= not found', nl_in(mcur)) + + ! count species in mode definition. definition will contain 1 string with + ! with a ':+' terminator for each specie + nspec = 0 + mcur = mcur + 1 + do + iend = len_trim(nl_in(mcur)) + if (nl_in(mcur)(iend-1:iend) /= ':+') exit + nspec = nspec + 1 + mcur = mcur + 1 + end do + + ! a mode must have at least one specie + if (nspec == 0) call parse_error('mode must have at least one specie', nl_in(mbeg)) + + ! allocate components that depend on number of species + allocate( & + modes%comps(m)%source_mmr_a(nspec), & + modes%comps(m)%camname_mmr_a(nspec), & + modes%comps(m)%source_mmr_c(nspec), & + modes%comps(m)%camname_mmr_c(nspec), & + modes%comps(m)%type(nspec), & + modes%comps(m)%props(nspec), & + stat=istat) + + if (istat > 0) then + write(iulog,*) subname//': ERROR: cannot allocate storage for species. nspec=', nspec + call endrun(subname//': ERROR allocating storage for species') + end if + + ! initialize components + modes%comps(m)%nspec = nspec + modes%comps(m)%source_num_a = ' ' + modes%comps(m)%camname_num_a = ' ' + modes%comps(m)%source_num_c = ' ' + modes%comps(m)%camname_num_c = ' ' + do ispec = 1, nspec + modes%comps(m)%source_mmr_a(ispec) = ' ' + modes%comps(m)%camname_mmr_a(ispec) = ' ' + modes%comps(m)%source_mmr_c(ispec) = ' ' + modes%comps(m)%camname_mmr_c(ispec) = ' ' + modes%comps(m)%type(ispec) = ' ' + modes%comps(m)%props(ispec) = ' ' + end do + + ! return to first string in mode definition + mcur = mbeg + tmpstr = nl_in(mcur) + + ! mode name + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('mode name not found', tmpstr) + modes%names(m) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! mode type + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('mode type not found', tmpstr) + ! check for valid mode type + call check_mode_type(tmpstr, 1, ipos-1) + modes%types(m) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! mode type must be followed by '=' + if (tmpstr(1:1) /= '=') call parse_error('= not found', tmpstr) + + ! move to next string + mcur = mcur + 1 + tmpstr = nl_in(mcur) + + ! process mode component strings + num_mr_found = .false. ! keep track of whether number mixing ratio component is found + ispec = 0 ! keep track of the number of species found + do + + ! source of interstitial component + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('expect to find source field first', tmpstr) + ! check for valid source + if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') & + call parse_error('source must be A, N or Z', tmpstr) + tmp_src_a = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! name of interstitial component + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + tmp_name_a = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! source of cloud borne component + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('expect to find a source field', tmpstr) + ! check for valid source + if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') & + call parse_error('source must be A, N or Z', tmpstr) + tmp_src_c = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! name of cloud borne component + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + tmp_name_c = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! component type + ipos = scan(tmpstr, ': ') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + + if (tmpstr(:ipos-1) == 'num_mr') then + + ! there can only be one number mixing ratio component + if (num_mr_found) call parse_error('more than 1 number component', nl_in(mcur)) + + num_mr_found = .true. + modes%comps(m)%source_num_a = tmp_src_a + modes%comps(m)%camname_num_a = tmp_name_a + modes%comps(m)%source_num_c = tmp_src_c + modes%comps(m)%camname_num_c = tmp_name_c + tmpstr = tmpstr(ipos+1:) + + else + + ! check for valid specie type + call check_specie_type(tmpstr, 1, ipos-1) + tmp_type = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! get the properties file + ipos = scan(tmpstr, ': ') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + ! check for valid filename -- must have .nc extension + if (tmpstr(ipos-3:ipos-1) /= '.nc') & + call parse_error('filename not valid', tmpstr) + + ispec = ispec + 1 + modes%comps(m)%source_mmr_a(ispec) = tmp_src_a + modes%comps(m)%camname_mmr_a(ispec) = tmp_name_a + modes%comps(m)%source_mmr_c(ispec) = tmp_src_c + modes%comps(m)%camname_mmr_c(ispec) = tmp_name_c + modes%comps(m)%type(ispec) = tmp_type + modes%comps(m)%props(ispec) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + end if + + ! check if there are more components. either the current character is + ! a ' ' which means this string is the final mode component, or the character + ! is a '+' which means there are more components + if (tmpstr(1:1) == ' ') exit + + if (tmpstr(1:1) /= '+') & + call parse_error('+ field not found', tmpstr) + + ! continue to next component... + mcur = mcur + 1 + tmpstr = nl_in(mcur) + end do + + ! check that a number component was found + if (.not. num_mr_found) call parse_error('number component not found', nl_in(mbeg)) + + ! check that the right number of species were found + if (ispec /= nspec) call parse_error('component parsing got wrong number of species', nl_in(mbeg)) + + ! continue to next mode... + mcur = mcur + 1 + tmpstr = nl_in(mcur) + end do + + !------------------------------------------------------------------------------------------------ + contains + !------------------------------------------------------------------------------------------------ + + subroutine parse_error(msg, str) + + character(len=*), intent(in) :: msg + character(len=*), intent(in) :: str + + write(iulog,*) subname//': ERROR: '//msg + write(iulog,*) ' input string: '//trim(str) + call endrun(subname//': ERROR: '//msg) + + end subroutine parse_error + + !------------------------------------------------------------------------------------------------ + + subroutine check_specie_type(str, ib, ie) + + character(len=*), intent(in) :: str + integer, intent(in) :: ib, ie + + integer :: i + + do i = 1, num_spec_types + if (str(ib:ie) == trim(spec_type_names(i))) return + end do + + call parse_error('specie type not valid', str(ib:ie)) + + end subroutine check_specie_type + + !------------------------------------------------------------------------------------------------ + + subroutine check_mode_type(str, ib, ie) + + character(len=*), intent(in) :: str + integer, intent(in) :: ib, ie ! begin, end character of mode type substring + + integer :: i + + do i = 1, num_mode_types + if (str(ib:ie) == trim(mode_type_names(i))) return + end do + + call parse_error('mode type not valid', str(ib:ie)) + + end subroutine check_mode_type + + !------------------------------------------------------------------------------------------------ + +end subroutine parse_mode_defs + +!=========================== + +subroutine parse_bin_defs(nl_in, bins) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + ! Parse the bin definition specifiers. + + character(len=*), intent(inout) :: nl_in(:) ! namelist input (blanks are removed on output) + type(bins_t), intent(inout) :: bins ! structure containing parsed input + + ! Local variables + logical :: num_mr_found, mass_mr_found + integer :: m + integer :: istat + integer :: nbins, nstr + integer :: mbeg, mcur + integer :: nspec, ispec + integer :: strlen, iend, ipos + character(len=*), parameter :: subname = 'parse_bin_defs' + character(len=len(nl_in(1))) :: tmpstr + character(len=1) :: tmp_src_a + character(len=32) :: tmp_name_a + character(len=1) :: tmp_src_c + character(len=32) :: tmp_name_c + character(len=32) :: tmp_type + character(len=32) :: tmp_morph + !------------------------------------------------------------------------- + + ! Determine number of bins defined by counting number of strings that are + ! terminated by ':=' + ! (algorithm stops counting at first blank element). + nbins = 0 + nstr = 0 + do m = 1, n_bin_str + + if (len_trim(nl_in(m)) == 0) exit + nstr = nstr + 1 + + ! There are no fields in the input strings in which a blank character is allowed. + ! To simplify the parsing go through the input strings and remove blanks. + tmpstr = adjustl(nl_in(m)) + nl_in(m) = tmpstr + do + strlen = len_trim(nl_in(m)) + ipos = index(nl_in(m), ' ') + if (ipos == 0 .or. ipos > strlen) exit + tmpstr = nl_in(m)(:ipos-1) // nl_in(m)(ipos+1:strlen) + nl_in(m) = tmpstr + end do + ! count strings with ':=' terminator + if (nl_in(m)(strlen-1:strlen) == ':=') nbins = nbins + 1 + + end do + bins%nbins = nbins + + ! return if no bins defined + if (nbins == 0) return + + ! allocate components that depend on nmodes + allocate( & + bins%names(nbins), & + bins%comps(nbins), & + stat=istat ) + if (istat > 0) then + write(iulog,*) subname//': ERROR: cannot allocate storage for bins. nbins=', nbins + call endrun(subname//': ERROR allocating storage for bins') + end if + + mcur = 1 ! index of current string being processed + + ! loop over bins + bins_loop: do m = 1, nbins + + mbeg = mcur ! remember the first string of a bin + + ! check that first string in bin definition is ':=' terminated + iend = len_trim(nl_in(mcur)) + if (nl_in(mcur)(iend-1:iend) /= ':=') call parse_error('= not found', nl_in(mcur)) + + ! count species in bin definition. definition will contain 1 string with + ! with a ':+' terminator for each specie + nspec = 0 + mcur = mcur + 1 + do + iend = len_trim(nl_in(mcur)) + if (nl_in(mcur)(iend-1:iend) /= ':+') exit + if (nl_in(mcur)(iend-4:iend) /= 'mmr:+') nspec = nspec + 1 + mcur = mcur + 1 + end do + + ! a bin must have at least one specie + if (nspec == 0) call parse_error('bin must have at least one specie', nl_in(mbeg)) + + ! allocate components that depend on number of species + allocate( & + bins%comps(m)%source_mmr_a(nspec), & + bins%comps(m)%camname_mmr_a(nspec), & + bins%comps(m)%source_mmr_c(nspec), & + bins%comps(m)%camname_mmr_c(nspec), & + bins%comps(m)%type(nspec), & + bins%comps(m)%morph(nspec), & + bins%comps(m)%props(nspec), & + stat=istat) + + if (istat > 0) then + write(iulog,*) subname//': ERROR: cannot allocate storage for species. nspec=', nspec + call endrun(subname//': ERROR allocating storage for species') + end if + + ! initialize components + bins%comps(m)%nspec = nspec + bins%comps(m)%source_num_a = ' ' + bins%comps(m)%camname_num_a = ' ' + bins%comps(m)%source_num_c = ' ' + bins%comps(m)%camname_num_c = ' ' + bins%comps(m)%source_mass_a = 'NOTSET' + bins%comps(m)%camname_mass_a = 'NOTSET' + bins%comps(m)%source_mass_c = 'NOTSET' + bins%comps(m)%camname_mass_c = 'NOTSET' + do ispec = 1, nspec + bins%comps(m)%source_mmr_a(ispec) = ' ' + bins%comps(m)%camname_mmr_a(ispec) = ' ' + bins%comps(m)%source_mmr_c(ispec) = ' ' + bins%comps(m)%camname_mmr_c(ispec) = ' ' + bins%comps(m)%type(ispec) = ' ' + bins%comps(m)%props(ispec) = ' ' + end do + + ! return to first string in mode definition + mcur = mbeg + tmpstr = nl_in(mcur) + + ! bin name + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('bin name not found', tmpstr) + bins%names(m) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! bin name must be followed by '=' + if (tmpstr(1:1) /= '=') call parse_error('= not found', tmpstr) + + ! move to next string + mcur = mcur + 1 + tmpstr = nl_in(mcur) + + ! process bin component strings + num_mr_found = .false. ! keep track of whether number mixing ratio component is found + mass_mr_found = .false. ! keep track of whether number mixing ratio component is found + ispec = 0 ! keep track of the number of species found + comps_loop: do + + ! source of interstitial component + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('expect to find source field first', tmpstr) + ! check for valid source + if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') & + call parse_error('source must be A, N or Z', tmpstr) + tmp_src_a = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! name of interstitial component + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + tmp_name_a = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! source of cloud borne component + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('expect to find a source field', tmpstr) + ! check for valid source + if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') & + call parse_error('source must be A, N or Z', tmpstr) + tmp_src_c = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! name of cloud borne component + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + tmp_name_c = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! component type + ipos = scan(tmpstr, ': ') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + + if (tmpstr(:ipos-1) == 'num') then + + ! there can only be one number mixing ratio component + if (num_mr_found) call parse_error('more than 1 number component', nl_in(mcur)) + + num_mr_found = .true. + bins%comps(m)%source_num_a = tmp_src_a + bins%comps(m)%camname_num_a = tmp_name_a + bins%comps(m)%source_num_c = tmp_src_c + bins%comps(m)%camname_num_c = tmp_name_c + tmpstr = tmpstr(ipos+1:) + + else if (tmpstr(:ipos-1) == 'mmr') then + + ! there can only be one number mixing ratio component + if (mass_mr_found) call parse_error('more than 1 mass mixing ratio component', nl_in(mcur)) + + mass_mr_found = .true. + bins%comps(m)%source_mass_a = tmp_src_a + bins%comps(m)%camname_mass_a = tmp_name_a + bins%comps(m)%source_mass_c = tmp_src_c + bins%comps(m)%camname_mass_c = tmp_name_c + tmpstr = tmpstr(ipos+1:) + + else + + ! check for valid species type + call check_bin_type(tmpstr, 1, ipos-1) + tmp_type = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + + ! check for valid species type + call check_bin_morph(tmpstr, 1, ipos-1) + tmp_morph = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! get the properties file + ipos = scan(tmpstr, ': ') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + + ! check for valid filename -- must have .nc extension + if (tmpstr(ipos-3:ipos-1) /= '.nc') & + call parse_error('filename not valid', tmpstr) + + ispec = ispec + 1 + + bins%comps(m)%source_mmr_a(ispec) = tmp_src_a + bins%comps(m)%camname_mmr_a(ispec) = tmp_name_a + bins%comps(m)%source_mmr_c(ispec) = tmp_src_c + bins%comps(m)%camname_mmr_c(ispec) = tmp_name_c + bins%comps(m)%type(ispec) = tmp_type + bins%comps(m)%morph(ispec) = tmp_morph + + bins%comps(m)%props(ispec) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + endif + + ! check if there are more components. either the current character is + ! a ' ' which means this string is the final mode component, or the character + ! is a '+' which means there are more components + if (tmpstr(1:1) == ' ') then + exit comps_loop + endif + + if (tmpstr(1:1) /= '+') & + call parse_error('+ field not found', tmpstr) + + ! continue to next component... + mcur = mcur + 1 + tmpstr = nl_in(mcur) + end do comps_loop + + + ! check that a number component was found + if (.not. num_mr_found) call parse_error('number component not found', nl_in(mbeg)) + + ! check that the right number of species were found + if (ispec /= nspec) then + write(*,*) 'ispec, nspec = ',ispec, nspec + call parse_error('component parsing got wrong number of species', nl_in(mbeg)) + endif + + ! continue to next bin... + mcur = mcur + 1 + tmpstr = nl_in(mcur) + end do bins_loop + + !------------------------------------------------------------------------------------------------ + contains + !------------------------------------------------------------------------------------------------ + + subroutine parse_error(msg, str) + + character(len=*), intent(in) :: msg + character(len=*), intent(in) :: str + + write(iulog,*) subname//': ERROR: '//msg + write(iulog,*) ' input string: '//trim(str) + call endrun(subname//': ERROR: '//msg) + + end subroutine parse_error + + !------------------------------------------------------------------------------------------------ + + subroutine check_bin_morph(str, ib, ie) + + character(len=*), intent(in) :: str + integer, intent(in) :: ib, ie + + integer :: i + + do i = 1, num_bin_morphs + if (str(ib:ie) == trim(bin_morph_names(i))) return + end do + + call parse_error('bin morph not valid', str(ib:ie)) + + end subroutine check_bin_morph + + !------------------------------------------------------------------------------------------------ + subroutine check_bin_type(str, ib, ie) + + character(len=*), intent(in) :: str + integer, intent(in) :: ib, ie ! begin, end character of mode type substring + + integer :: i + + do i = 1, num_spec_types + if (str(ib:ie) == trim(spec_type_names(i))) return + end do + + call parse_error('bin species type not valid', str(ib:ie)) + + end subroutine check_bin_type + + !------------------------------------------------------------------------------------------------ + +end subroutine parse_bin_defs + +!=========================== + +subroutine parse_rad_specifier(specifier, namelist_data) + use cam_abortutils, only: endrun + +!----------------------------------------------------------------------------- +! Parse the radiation namelist specifiers. +!----------------------------------------------------------------------------- + + character(len=*), dimension(:), intent(in) :: specifier + type(rad_cnst_namelist_t), intent(inout) :: namelist_data + + ! Local variables + integer :: number, i, j + integer :: ipos, strlen + integer :: astat + character(len=256) :: tmpstr + character(len=1) :: source(n_rad_cnst) + character(len=64) :: camname(n_rad_cnst) + character(len=256) :: radname(n_rad_cnst) + character(len=1) :: type(n_rad_cnst) + !------------------------------------------------------------------------- + + number = 0 + + parse_loop: do i = 1, n_rad_cnst + if ( len_trim(specifier(i)) == 0 ) then + exit parse_loop + endif + + ! There are no fields in the input strings in which a blank character is allowed. + ! To simplify the parsing go through the input strings and remove blanks. + tmpstr = adjustl(specifier(i)) + do + strlen = len_trim(tmpstr) + ipos = index(tmpstr, ' ') + if (ipos == 0 .or. ipos > strlen) exit + tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen) + end do + + ! Locate the ':' separating source from camname. + j = index(tmpstr, ':') + source(i) = tmpstr(:j-1) + tmpstr = tmpstr(j+1:) + + ! locate the ':' separating camname from radname + j = scan(tmpstr, ':') + + camname(i) = tmpstr(:j-1) + radname(i) = tmpstr(j+1:) + + ! determine the type of constituent + if (source(i) == 'M') then + type(i) = 'M' + else if (source(i) == 'B') then + type(i) = 'B' + else if(index(radname(i),".nc") .gt. 0) then + type(i) = 'A' + else + type(i) = 'G' + end if + + number = number+1 + end do parse_loop + + namelist_data%ncnst = number + + if (number == 0) return + + allocate(namelist_data%source (number), stat=astat) + if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%source') + allocate(namelist_data%camname(number), stat=astat) + if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%camname') + allocate(namelist_data%radname(number), stat=astat) + if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%radname') + allocate(namelist_data%type(number), stat=astat) + if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%type') + + namelist_data%source(:namelist_data%ncnst) = source (:namelist_data%ncnst) + namelist_data%camname(:namelist_data%ncnst) = camname(:namelist_data%ncnst) + namelist_data%radname(:namelist_data%ncnst) = radname(:namelist_data%ncnst) + namelist_data%type(:namelist_data%ncnst) = type(:namelist_data%ncnst) + +end subroutine parse_rad_specifier + +!=========================== + +subroutine print_modes(modes) + use cam_logfile, only: iulog + + type(modes_t), intent(inout) :: modes + + integer :: i, m + !--------------------------------------------------------------------------------------------- + + write(iulog,*)' Mode Definitions' + + do m = 1, modes%nmodes + + write(iulog,*) newline//' name=',trim(modes%names(m)),' type=',trim(modes%types(m)) + write(iulog,*) ' src_a=',trim(modes%comps(m)%source_num_a),' num_a=',trim(modes%comps(m)%camname_num_a), & + ' src_c=',trim(modes%comps(m)%source_num_c),' num_c=',trim(modes%comps(m)%camname_num_c) + + do i = 1, modes%comps(m)%nspec + + write(iulog,*) ' src_a=',trim(modes%comps(m)%source_mmr_a(i)), ' mmr_a=',trim(modes%comps(m)%camname_mmr_a(i)), & + ' src_c=',trim(modes%comps(m)%source_mmr_c(i)), ' mmr_c=',trim(modes%comps(m)%camname_mmr_c(i)), & + ' type=',trim(modes%comps(m)%type(i)) + write(iulog,*) ' prop file=', trim(modes%comps(m)%props(i)) + end do + + end do + +end subroutine print_modes + +!=========================== + +subroutine print_bins(bins) + use cam_logfile, only: iulog + + type(bins_t), intent(inout) :: bins + + integer :: i, m + !--------------------------------------------------------------------------------------------- + + write(iulog,*)' Bin Definitions' + + do m = 1, bins%nbins + + write(iulog,*) newline//' name=',trim(bins%names(m)) + + do i = 1, bins%comps(m)%nspec + + write(iulog,*) ' src_a=',trim(bins%comps(m)%source_mmr_a(i)), ' mmr_a=',trim(bins%comps(m)%camname_mmr_a(i)), & + ' type=',trim(bins%comps(m)%type(i)) + write(iulog,*) ' prop file=', trim(bins%comps(m)%props(i)) + end do + + end do + +end subroutine print_bins + +!=========================== + +end module radiative_aerosol_definitions diff --git a/src/aerosol/radiative_aerosol_definitions.meta b/src/aerosol/radiative_aerosol_definitions.meta new file mode 100644 index 000000000..562288d47 --- /dev/null +++ b/src/aerosol/radiative_aerosol_definitions.meta @@ -0,0 +1,130 @@ +[ccpp-table-properties] + name = rad_cnst_namelist_t + type = ddt + +[ccpp-arg-table] + name = rad_cnst_namelist_t + type = ddt + +[ccpp-table-properties] + name = mode_component_t + type = ddt + +[ccpp-arg-table] + name = mode_component_t + type = ddt + +[ccpp-table-properties] + name = modes_t + type = ddt + +[ccpp-arg-table] + name = modes_t + type = ddt + +[ccpp-table-properties] + name = bin_component_t + type = ddt + +[ccpp-arg-table] + name = bin_component_t + type = ddt + +[ccpp-table-properties] + name = bins_t + type = ddt + +[ccpp-arg-table] + name = bins_t + type = ddt + +[ccpp-table-properties] + name = aerosol_t + type = ddt + +[ccpp-arg-table] + name = aerosol_t + type = ddt + +[ccpp-table-properties] + name = aerlist_t + type = ddt + +[ccpp-arg-table] + name = aerlist_t + type = ddt + +[ccpp-table-properties] + name = modelist_t + type = ddt + +[ccpp-arg-table] + name = modelist_t + type = ddt + +[ccpp-table-properties] + name = binlist_t + type = ddt + +[ccpp-arg-table] + name = binlist_t + type = ddt + +[ccpp-table-properties] + name = radiative_aerosol_definitions + type = module + +[ccpp-arg-table] + name = radiative_aerosol_definitions + type = module +[ N_DIAG ] + standard_name = number_of_radiative_aerosol_diagnostic_lists + units = count + type = integer + dimensions = () +[ n_rad_cnst ] + standard_name = maximum_number_of_radiative_constituents + units = count + type = integer + dimensions = () +[ id_climate ] + standard_name = index_of_climate_radiative_aerosol_list + units = none + type = integer + dimensions = () +[ radcnst_namelist ] + standard_name = radiative_constituent_namelist_data + units = none + type = rad_cnst_namelist_t + dimensions = (index_of_climate_radiative_aerosol_list:number_of_radiative_aerosol_diagnostic_lists) +[ active_calls ] + standard_name = flag_for_active_radiative_aerosol_diagnostic_list + units = flag + type = logical + dimensions = (index_of_climate_radiative_aerosol_list:number_of_radiative_aerosol_diagnostic_lists) +[ modes ] + standard_name = modal_aerosol_mode_definitions + units = none + type = modes_t + dimensions = () +[ bins ] + standard_name = sectional_aerosol_bin_definitions + units = none + type = bins_t + dimensions = () +[ bulk_aerosol_list ] + standard_name = bulk_aerosol_list_for_radiative_calculations + units = none + type = aerlist_t + dimensions = (index_of_climate_radiative_aerosol_list:number_of_radiative_aerosol_diagnostic_lists) +[ modal_aerosol_list ] + standard_name = modal_aerosol_list_for_radiative_calculations + units = none + type = modelist_t + dimensions = (index_of_climate_radiative_aerosol_list:number_of_radiative_aerosol_diagnostic_lists) +[ sectional_aerosol_list ] + standard_name = sectional_aerosol_list_for_radiative_calculations + units = none + type = binlist_t + dimensions = (index_of_climate_radiative_aerosol_list:number_of_radiative_aerosol_diagnostic_lists) + diff --git a/src/aerosol/refractive_aerosol_optics_mod.F90 b/src/aerosol/refractive_aerosol_optics_mod.F90 new file mode 100644 index 000000000..e96fa0c59 --- /dev/null +++ b/src/aerosol/refractive_aerosol_optics_mod.F90 @@ -0,0 +1,382 @@ +module refractive_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_optics_mod, only: aerosol_optics + use physconst, only: rhoh2o + use aerosol_state_mod, only: aerosol_state + use aerosol_properties_mod, only: aerosol_properties + + use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_calcwghts + + implicit none + + private + public :: refractive_aerosol_optics + + !> refractive_aerosol_optics + !! Table look up implementation of aerosol_optics to parameterize aerosol radiative properties in terms of + !! surface mode wet radius and wet refractive index using chebychev polynomials + type, extends(aerosol_optics) :: refractive_aerosol_optics + + integer :: ibin + class(aerosol_state), pointer :: aero_state ! aerosol_state object + class(aerosol_properties), pointer :: aero_props ! aerosol_properties object + + real(r8), allocatable :: watervol(:,:) ! volume concentration of water in each mode (m3/kg) + real(r8), allocatable :: wetvol(:,:) ! volume concentration of wet mode (m3/kg) + real(r8), allocatable :: cheb(:,:,:) ! chebychev polynomials + real(r8), allocatable :: radsurf(:,:) ! aerosol surface mode radius + real(r8), allocatable :: logradsurf(:,:) ! log(aerosol surface mode radius) + + ! refractive index for water read in read_water_refindex + complex(r8), allocatable :: crefwsw(:) ! complex refractive index for water visible + complex(r8), allocatable :: crefwlw(:) ! complex refractive index for water infrared + + real(r8), pointer :: extpsw(:,:,:,:) => null() ! specific extinction + real(r8), pointer :: abspsw(:,:,:,:) => null() ! specific absorption + real(r8), pointer :: asmpsw(:,:,:,:) => null() ! asymmetry factor + real(r8), pointer :: absplw(:,:,:,:) => null() ! specific absorption + + real(r8), pointer :: refrtabsw(:,:) => null() ! table of real refractive indices for aerosols + real(r8), pointer :: refitabsw(:,:) => null() ! table of imag refractive indices for aerosols + real(r8), pointer :: refrtablw(:,:) => null() ! table of real refractive indices for aerosols + real(r8), pointer :: refitablw(:,:) => null() ! table of imag refractive indices for aerosols + + ! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties + ! in terms of refractive index and wet radius + integer :: ncoef = -1 ! number of chebychev coeficients + integer :: prefr = -1 ! number of real refractive indices + integer :: prefi = -1 ! number of imaginary refractive indices + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type refractive_aerosol_optics + + interface refractive_aerosol_optics + procedure :: constructor + end interface refractive_aerosol_optics + + ! radius limits (m) + real(r8), parameter :: radmin = 0.01e-6_r8 ! min aerosol surface mode radius (m) + real(r8), parameter :: radmax = 25.e-6_r8 ! max aerosol surface mode radius (m) + real(r8), parameter :: xrmin=log(radmin) ! min log(aerosol surface mode radius) + real(r8), parameter :: xrmax=log(radmax) ! max log(aerosol surface mode radius) + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ibin, ncol, nlev, nsw, nlw, crefwsw, crefwlw) & + result(newobj) + + class(aerosol_properties),intent(in), target :: aero_props ! aerosol_properties object + class(aerosol_state),intent(in), target :: aero_state ! aerosol_state object + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + integer, intent(in) :: nsw ! number of short wave lengths + integer, intent(in) :: nlw ! number of long wave lengths + complex(r8), intent(in) :: crefwsw(nsw) ! complex refractive index for water visible + complex(r8), intent(in) :: crefwlw(nlw) ! complex refractive index for water infrared + + type(refractive_aerosol_optics), pointer :: newobj + + integer :: ierr, icol, ilev, ispec, nspec + real(r8) :: vol(ncol) ! volume concentration of aerosol species (m3/kg) + real(r8) :: dryvol(ncol) ! volume concentration of aerosol mode (m3/kg) + real(r8) :: specdens ! species density (kg/m3) + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + real(r8) :: logsigma ! geometric standard deviation of number distribution + + real(r8) :: dgnumwet(ncol,nlev) ! aerosol wet number mode diameter (m) + real(r8) :: qaerwat(ncol,nlev) ! aerosol water (g/g) + + real(r8), parameter :: rh2odens = 1._r8/rhoh2o + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + ! get mode properties + call aero_props%optics_params(ibin, & + refrtabsw=newobj%refrtabsw, refitabsw=newobj%refitabsw, & + refrtablw=newobj%refrtablw, refitablw=newobj%refitablw,& + extpsw=newobj%extpsw, abspsw=newobj%abspsw, asmpsw=newobj%asmpsw, & + absplw=newobj%absplw, ncoef=newobj%ncoef, prefr=newobj%prefr, prefi=newobj%prefi) + + allocate(newobj%watervol(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%wetvol(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%cheb(newobj%ncoef,ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%radsurf(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%logradsurf(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%crefwlw(nlw),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + newobj%crefwlw(:) = crefwlw(:) + + allocate(newobj%crefwsw(nsw),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + newobj%crefwsw(:) = crefwsw(:) + + call aero_state%water_uptake(aero_props, ibin, ncol, nlev, dgnumwet, qaerwat) + + nspec = aero_props%nspecies(ibin) + + logsigma=aero_props%alogsig(ibin) + + ! calc size parameter for all columns + call modal_size_parameters(newobj%ncoef, ncol, nlev, logsigma, dgnumwet, & + newobj%radsurf, newobj%logradsurf, newobj%cheb) + + do ilev = 1, nlev + dryvol(:ncol) = 0._r8 + do ispec = 1, nspec + call aero_state%get_ambient_mmr(species_ndx=ispec,bin_ndx=ibin,mmr=specmmr) + call aero_props%get(ibin, ispec, density=specdens) + + do icol = 1, ncol + vol(icol) = specmmr(icol,ilev)/specdens + dryvol(icol) = dryvol(icol) + vol(icol) + + newobj%watervol(icol,ilev) = qaerwat(icol,ilev)*rh2odens + newobj%wetvol(icol,ilev) = newobj%watervol(icol,ilev) + dryvol(icol) + if (newobj%watervol(icol,ilev) < 0._r8) then + newobj%watervol(icol,ilev) = 0._r8 + newobj%wetvol(icol,ilev) = dryvol(icol) + end if + end do + end do + end do + + newobj%aero_state => aero_state + newobj%aero_props => aero_props + newobj%ibin = ibin + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(refractive_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized asymmetry factor + real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + + real(r8) :: refr(ncol) ! real part of refractive index + real(r8) :: refi(ncol) ! imaginary part of refractive index + real(r8) :: cext(self%ncoef,ncol), cabs(self%ncoef,ncol), casm(self%ncoef,ncol) + + complex(r8) :: crefin(ncol) ! complex refractive index + integer :: icol,icoef + + type(table_interp_wghts) :: wghtsr(ncol) + type(table_interp_wghts) :: wghtsi(ncol) + + crefin(:ncol) = self%aero_state%refractive_index_sw(ncol, ilev, self%ibin, iwav, self%aero_props) + + do icol = 1, ncol + crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwsw(iwav) + crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev),1.e-60_r8) + refr(icol) = real(crefin(icol)) + refi(icol) = abs(aimag(crefin(icol))) + end do + + ! interpolate coefficients linear in refractive index + + wghtsr = table_interp_calcwghts( self%prefr, self%refrtabsw(:,iwav), ncol, refr(:ncol) ) + wghtsi = table_interp_calcwghts( self%prefi, self%refitabsw(:,iwav), ncol, refi(:ncol) ) + + cext(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%extpsw(:,:,:,iwav)) + cabs(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%abspsw(:,:,:,iwav)) + casm(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%asmpsw(:,:,:,iwav)) + + do icol = 1,ncol + + if (self%logradsurf(icol,ilev) <= xrmax) then + pext(icol) = 0.5_r8*cext(1,icol) + do icoef = 2, self%ncoef + pext(icol) = pext(icol) + self%cheb(icoef,icol,ilev)*cext(icoef,icol) + enddo + pext(icol) = exp(pext(icol)) + else + pext(icol) = 1.5_r8/(self%radsurf(icol,ilev)*rhoh2o) ! geometric optics + endif + + ! convert from m2/kg water to m2/kg aerosol + pext(icol) = pext(icol)*self%wetvol(icol,ilev)*rhoh2o + pabs(icol) = 0.5_r8*cabs(1,icol) + pasm(icol) = 0.5_r8*casm(1,icol) + do icoef = 2, self%ncoef + pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icoef,icol) + pasm(icol) = pasm(icol) + self%cheb(icoef,icol,ilev)*casm(icoef,icol) + enddo + pabs(icol) = pabs(icol)*self%wetvol(icol,ilev)*rhoh2o + pabs(icol) = max(0._r8,pabs(icol)) + pabs(icol) = min(pext(icol),pabs(icol)) + + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(refractive_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + real(r8) :: refr(ncol) ! real part of refractive index + real(r8) :: refi(ncol) ! imaginary part of refractive index + real(r8) :: cabs(self%ncoef,ncol) + + complex(r8) :: crefin(ncol) ! complex refractive index + integer :: icol, icoef + + type(table_interp_wghts) :: wghtsr(ncol) + type(table_interp_wghts) :: wghtsi(ncol) + + crefin(:ncol) = self%aero_state%refractive_index_lw(ncol, ilev, self%ibin, iwav, self%aero_props) + + do icol = 1, ncol + crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwlw(iwav) + crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev), 1.e-40_r8) + + refr(icol) = real(crefin(icol)) + refi(icol) = aimag(crefin(icol)) + + end do + + ! interpolate coefficients linear in refractive index + + wghtsr = table_interp_calcwghts( self%prefr, self%refrtablw(:,iwav), ncol, refr(:ncol) ) + wghtsi = table_interp_calcwghts( self%prefi, self%refitablw(:,iwav), ncol, refi(:ncol) ) + + cabs(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%absplw(:,:,:,iwav)) + + do icol = 1,ncol + pabs(icol) = 0.5_r8*cabs(1,icol) + do icoef = 2, self%ncoef + pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icoef,icol) + end do + pabs(icol) = pabs(icol)*self%wetvol(icol,ilev)*rhoh2o + pabs(icol) = max(0._r8,pabs(icol)) + end do + + end subroutine lw_props + + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(refractive_aerosol_optics), intent(inout) :: self + + deallocate(self%watervol) + deallocate(self%wetvol) + deallocate(self%cheb) + deallocate(self%radsurf) + deallocate(self%logradsurf) + deallocate(self%crefwsw) + deallocate(self%crefwlw) + + nullify(self%aero_state) + nullify(self%aero_props) + nullify(self%extpsw) + nullify(self%abspsw) + nullify(self%asmpsw) + nullify(self%absplw) + nullify(self%refrtabsw) + nullify(self%refitabsw) + nullify(self%refrtablw) + nullify(self%refitablw) + + end subroutine destructor + + + ! Private routines + !=============================================================================== + + !=============================================================================== + + subroutine modal_size_parameters(ncoef,ncol,nlev, alnsg_amode, dgnumwet, radsurf, logradsurf, cheb) + + integer, intent(in) :: ncoef,ncol,nlev + real(r8), intent(in) :: alnsg_amode ! geometric standard deviation of number distribution + real(r8), intent(in) :: dgnumwet(:,:) ! aerosol wet number mode diameter (m) + real(r8), intent(out) :: radsurf(:,:) ! aerosol surface mode radius + real(r8), intent(out) :: logradsurf(:,:) ! log(aerosol surface mode radius) + real(r8), intent(out) :: cheb(:,:,:) + + integer :: i, k, nc + real(r8) :: explnsigma + real(r8) :: xrad(ncol) ! normalized aerosol radius + + !------------------------------------------------------------------------------- + + explnsigma = exp(2.0_r8*alnsg_amode*alnsg_amode) + + do k = 1, nlev + do i = 1, ncol + ! convert from number mode diameter to surface area + radsurf(i,k) = max(0.5_r8*dgnumwet(i,k)*explnsigma,radmin) + logradsurf(i,k) = log(radsurf(i,k)) + ! normalize size parameter + xrad(i) = max(logradsurf(i,k),xrmin) + xrad(i) = min(xrad(i),xrmax) + xrad(i) = (2._r8*xrad(i)-xrmax-xrmin)/(xrmax-xrmin) + ! chebyshev polynomials + cheb(1,i,k) = 1._r8 + cheb(2,i,k) = xrad(i) + do nc = 3, ncoef + cheb(nc,i,k) = 2._r8*xrad(i)*cheb(nc-1,i,k)-cheb(nc-2,i,k) + end do + end do + end do + + end subroutine modal_size_parameters + +end module refractive_aerosol_optics_mod diff --git a/src/aerosol/volcrad_aerosol_optics_mod.F90 b/src/aerosol/volcrad_aerosol_optics_mod.F90 new file mode 100644 index 000000000..58059706a --- /dev/null +++ b/src/aerosol/volcrad_aerosol_optics_mod.F90 @@ -0,0 +1,201 @@ +!------------------------------------------------------------------------------- +! Geometric mean radius parameterized optical properties for volcanic +! stratospheric aerosols +!------------------------------------------------------------------------------- +module volcrad_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + use aerosol_optics_mod, only: aerosol_optics + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + + implicit none + + private + + public :: volcrad_aerosol_optics + + type, extends(aerosol_optics) :: volcrad_aerosol_optics + + ! aerosol optics properties tables (from physprops files) + real(r8), pointer :: r_sw_ext(:,:) => null() + real(r8), pointer :: r_sw_scat(:,:) => null() + real(r8), pointer :: r_sw_ascat(:,:) => null() + real(r8), pointer :: r_lw_abs(:,:) => null() + real(r8), pointer :: r_mu(:) + + ! from state + real(r8), allocatable :: wmu(:,:) ! (-) weighting on left side values ! (pcols,pver) + integer , allocatable :: kmu(:,:) ! index into rh mesh + + ! aerosol mass mixing ratio + real(r8), pointer :: mmr(:,:) + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type volcrad_aerosol_optics + + interface volcrad_aerosol_optics + procedure :: constructor + end interface volcrad_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ibin, ncols, nlevs, geometric_radius) & + result(newobj) + class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object + class(aerosol_state), intent(in) :: aero_state ! aerosol_state object + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncols, nlevs + real(r8),intent(in) :: geometric_radius(:,:) + + type(volcrad_aerosol_optics), pointer :: newobj + + integer :: ierr, nmu, i, k + real(r8) :: r_mu_min, r_mu_max, mutrunc, mu + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%wmu(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%kmu(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + ! optical properties tables + call aero_props%optics_params(ibin, & + r_sw_ext=newobj%r_sw_ext, & + r_sw_scat=newobj%r_sw_scat, & + r_sw_ascat=newobj%r_sw_ascat, & + r_lw_abs=newobj%r_lw_abs, & + r_mu=newobj%r_mu ) + + call aero_state%get_ambient_mmr(species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + + +! NOTE should try to use table_interp_mod utility !!! + + nmu = size(newobj%r_mu) + r_mu_max = newobj%r_mu(nmu) + r_mu_min = newobj%r_mu(1) + + do i = 1, ncols + do k = 1, nlevs + if(geometric_radius(i,k) > 0._r8) then + mu = log(geometric_radius(i,k)) + else + mu = 0._r8 + endif + + ASSOCIATE ( kmu=>newobj%kmu(i,k), wmu=>newobj%wmu(i,k), r_mu=>newobj%r_mu ) + + mutrunc = max(min(mu,r_mu_max),r_mu_min) + kmu = max(min(1 + (mutrunc-r_mu_min)/(r_mu_max-r_mu_min)*(nmu-1),nmu-1._r8),1._r8) + wmu = max(min( (mutrunc -r_mu(kmu)) / (r_mu(kmu+1) - r_mu(kmu)) ,1._r8),0._r8) + + END ASSOCIATE + + end do + end do + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(volcrad_aerosol_optics), intent(in) :: self + + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + real(r8) :: scat(ncol) + real(r8) :: ascat(ncol) + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + + pext(icol) = ((1._r8 - self%wmu(icol,ilev)) * self%r_sw_ext(iwav, self%kmu(icol,ilev) ) + & + (self%wmu(icol,ilev)) * self%r_sw_ext(iwav, self%kmu(icol,ilev)+1)) + + scat(icol) = ((1._r8 - self%wmu(icol,ilev)) * self%r_sw_scat(iwav, self%kmu(icol,ilev) ) + & + (self%wmu(icol,ilev)) * self%r_sw_scat(iwav, self%kmu(icol,ilev)+1)) + + ascat(icol) = ((1._r8 - self%wmu(icol,ilev)) * self%r_sw_ascat(iwav, self%kmu(icol,ilev) ) + & + (self%wmu(icol,ilev)) * self%r_sw_ascat(iwav, self%kmu(icol,ilev)+1)) + + + palb(icol) = scat(icol) / pext(icol) + + if (scat(icol)>0._r8) then + pasm(icol) = ascat(icol) / scat(icol) + else + pasm(icol) = 0._r8 + end if + + pext(icol) = pext(icol) * self%mmr(icol,ilev) + + pabs(icol) = pext(icol) * ( 1._r8 - palb(icol) ) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(volcrad_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + pabs(icol) = ((1._r8 - self%wmu(icol,ilev)) * self%r_lw_abs(iwav, self%kmu(icol,ilev) ) + & + (self%wmu(icol,ilev)) * self%r_lw_abs(iwav, self%kmu(icol,ilev)+1)) + pabs(icol) = pabs(icol) * self%mmr(icol,ilev) + end do + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(volcrad_aerosol_optics), intent(inout) :: self + + deallocate(self%wmu) + deallocate(self%kmu) + + end subroutine destructor + +end module volcrad_aerosol_optics_mod diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 186299fc1..6d4532a99 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -269,6 +269,11 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & ! Initialize orbital data call orbital_data_init(columns_on_task) + ! Aerosol optics infrastructure init: + ! physics init phases will already query aerosol objects so this should + ! be run before phys_init (hplin, 4/20/26) + call rad_aer_init_all() + call phys_init() !!XXgoldyXX: v need to import this @@ -652,7 +657,7 @@ subroutine cam_register_constituents(cam_runtime_opts) ! Register the constituents so they can be advected: call host_constituents(1)%instantiate( & std_name=wv_stdname, & - long_name="water vapor mixing ratio w.r.t moist air and condensed_water", & + long_name=wv_stdname, & units="kg kg-1", & default_value=0._kind_phys, & vertical_dim="vertical_layer_dimension", & @@ -712,6 +717,43 @@ subroutine cam_register_constituents(cam_runtime_opts) end subroutine cam_register_constituents +!----------------------------------------------------------------------- + + subroutine rad_aer_init_all() + ! Initialize aerosol optics infrastructure. + ! Called after phys_init and before history_init_files. + use radiative_aerosol, only: rad_aer_init + use aerosol_instances_mod, only: aerosol_instances_init, aerosol_instances_init_states + use cam_ccpp_cap, only: cam_constituents_array + use ccpp_kinds, only: kind_phys + use phys_vars_init_check, only: mark_as_initialized + + real(kind_phys), pointer :: constituents(:,:,:) + + ! Phase 2 init: read physprop, resolve CCPP constituent indices + call rad_aer_init() + + ! Create aerosol properties objects + call aerosol_instances_init() + + ! Wire constituents pointer into aerosol state objects + constituents => cam_constituents_array() + call aerosol_instances_init_states(constituents) + + ! Mark module vars part of radiative_aerosol_definitions as initialized. + call mark_as_initialized('number_of_radiative_aerosol_diagnostic_lists') + call mark_as_initialized('maximum_number_of_radiative_constituents') + call mark_as_initialized('index_of_climate_radiative_aerosol_list') + call mark_as_initialized('radiative_constituent_namelist_data') + call mark_as_initialized('flag_for_active_radiative_aerosol_diagnostic_list') + call mark_as_initialized('modal_aerosol_mode_definitions') + call mark_as_initialized('sectional_aerosol_bin_definitions') + call mark_as_initialized('bulk_aerosol_list_for_radiative_calculations') + call mark_as_initialized('modal_aerosol_list_for_radiative_calculations') + call mark_as_initialized('sectional_aerosol_list_for_radiative_calculations') + + end subroutine rad_aer_init_all + !----------------------------------------------------------------------- end module cam_comp diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 43323f7ed..4fcef744f 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -41,6 +41,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use tropopause_climo_read, only: tropopause_climo_readnl use radiation_namelist, only: radiation_readnl + use radiative_aerosol, only: rad_aer_readnl use gravity_wave_drag_ridge_read, only: gravity_wave_drag_ridge_read_readnl use dyn_comp, only: dyn_readnl @@ -89,6 +90,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call analytic_ic_readnl(nlfilename) call tropopause_climo_readnl(nlfilename) call radiation_readnl(nlfilename) + call rad_aer_readnl(nlfilename) call gravity_wave_drag_ridge_read_readnl(nlfilename) call dyn_readnl(nlfilename) call stream_ndep_readnl(nlfilename) diff --git a/src/data/registry.xml b/src/data/registry.xml index fd9a8aa0c..e79db10f6 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -24,6 +24,7 @@ $SRCROOT/src/physics/utils/cam_constituents.meta $SRCROOT/src/physics/utils/tropopause_climo_read.meta $SRCROOT/src/physics/utils/gravity_wave_drag_ridge_read.meta + $SRCROOT/src/aerosol/radiative_aerosol_definitions.meta $SRCROOT/src/data/air_composition.meta $SRCROOT/src/data/cam_thermo.meta $SRCROOT/src/data/cam_thermo_formula.meta @@ -617,6 +618,20 @@ horizontal_dimension vertical_layer_dimension CLDICE cnst_CLDICE + + Cloud liquid number with respect to moist air plus all airborne condensates + horizontal_dimension vertical_layer_dimension + NUMLIQ cnst_NUMLIQ + + + Cloud ice number with respect to moist air plus all airborne condensates + horizontal_dimension vertical_layer_dimension + NUMICE cnst_NUMICE + @@ -1477,6 +1492,14 @@ 273.15_kind_phys tpert pbuf_tpert + + horizontal_dimension vertical_interface_dimension + 0.0_kind_phys + pbuf_WP2_nadv + pbuf_VPWP_CLUBB_GW + + + horizontal_dimension vertical_layer_dimension + 0.0_kind_phys + pbuf_QSATFAC + + + horizontal_dimension vertical_layer_dimension + 0.0_kind_phys + pbuf_AIST + + + + + flag indicating whether prognostic modal aerosols are present in the run + .false. + + + + number of dust size bins used in aerosol model + 4 + + + + + horizontal_dimension vertical_interface_dimension + 0.0_kind_phys + pbuf_tke + 0.0_kind_phys pbuf_kvh - VOLC_RAD_GEOM pbuf_VOLC_RAD_GEOM + + + horizontal_dimension vertical_layer_dimension + 0.0_kind_phys + pbuf_NAAI + + + horizontal_dimension vertical_layer_dimension + 0.0_kind_phys + pbuf_NAAI_HOM + + + horizontal_dimension vertical_layer_dimension + 0.0_kind_phys + pbuf_NPCCN + + + + horizontal_dimension vertical_layer_dimension dust_size_bin_dimension + 0.0_kind_phys + pbuf_NACON + + + horizontal_dimension vertical_layer_dimension dust_size_bin_dimension + 0.0_kind_phys + pbuf_RNDST + shr_kind_r8 + + implicit none + + private + public :: table_interp + public :: table_interp_wghts + public :: table_interp_calcwghts + + ! overload the interpolation routines + interface table_interp + module procedure interp1d + module procedure interp2d + module procedure interp4d + end interface table_interp + + ! interpolation weights and indices + type :: table_interp_wghts + real(r8) :: wt1 + real(r8) :: wt2 + integer :: ix1 + integer :: ix2 + end type table_interp_wghts + +contains + + !-------------------------------------------------------------------------- + ! 1-D interpolation + !-------------------------------------------------------------------------- + pure function interp1d( ncol, nxs, xwghts, tbl ) result(res) + + integer, intent(in) :: ncol ! number of model columns + integer, intent(in) :: nxs ! table size + real(r8), intent(in) :: tbl(nxs) ! table values to be interpolated + type(table_interp_wghts), intent(in) :: xwghts(ncol) ! interpolation weights and indices + + real(r8) :: res(ncol) + + integer :: i + + do i = 1,ncol + + res(i) = xwghts(i)%wt1*tbl(xwghts(i)%ix1) & + + xwghts(i)%wt2*tbl(xwghts(i)%ix2) + + end do + + end function interp1d + + !-------------------------------------------------------------------------- + ! 2-D interpolation + !-------------------------------------------------------------------------- + pure function interp2d( ncoef, ncol, nxs, nys, xwghts, ywghts, tbl ) result(res) + + integer, intent(in) :: ncoef ! number chebyshev coefficients + integer, intent(in) :: ncol ! number of model columns + integer, intent(in) :: nxs ! table x-dimension size + integer, intent(in) :: nys ! table y-dimension size + real(r8), intent(in) :: tbl(ncoef,nxs,nys) ! table values to be interpolated + type(table_interp_wghts), intent(in) :: xwghts(ncol) ! x interpolation weights and indices + type(table_interp_wghts), intent(in) :: ywghts(ncol) ! y interpolation weights and indices + + real(r8) :: res(ncoef,ncol) + + real(r8) :: fx(ncoef,2) + + integer :: i + + do i = 1,ncol + + ! interp x dir + fx(:,1) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix1) & ! @ y1 + + xwghts(i)%wt2*tbl(:,xwghts(i)%ix2,ywghts(i)%ix1) + fx(:,2) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix2) & ! @ y2 + + xwghts(i)%wt2*tbl(:,xwghts(i)%ix2,ywghts(i)%ix2) + + ! interp y dir + res(:,i) = ywghts(i)%wt1*fx(:,1) + ywghts(i)%wt2*fx(:,2) + + end do + + end function interp2d + + !-------------------------------------------------------------------------- + ! 4-D interpolation + !-------------------------------------------------------------------------- + pure function interp4d( ncol, nxs, nys, nzs, nts, xwghts, ywghts, zwghts, twghts, tbl ) result(res) + + integer, intent(in) :: ncol ! number of model columns + integer, intent(in) :: nxs ! table x-dimension size + integer, intent(in) :: nys ! table y-dimension size + integer, intent(in) :: nzs ! table z-dimension size + integer, intent(in) :: nts ! table t-dimension size + real(r8), intent(in) :: tbl(nxs,nys,nzs,nts) ! table values to be interpolated + type(table_interp_wghts), intent(in) :: xwghts(ncol) ! x interpolation weights and indices + type(table_interp_wghts), intent(in) :: ywghts(ncol) ! y interpolation weights and indices + type(table_interp_wghts), intent(in) :: zwghts(ncol) ! z interpolation weights and indices + type(table_interp_wghts), intent(in) :: twghts(ncol) ! t interpolation weights and indices + + real(r8) :: res(ncol) + + real(r8) :: fx(8) + real(r8) :: fy(4) + real(r8) :: fz(2) + + integer :: i + + do i = 1,ncol + + ! interp x dir + fx(1) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix1) & ! @ y1, z1, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix1) + fx(2) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix1) & ! @ y2, z1, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix1) + + fx(3) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix1) & ! @ y1, z2, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix1) + fx(4) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix1) & ! @ y2, z2, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix1) + + fx(5) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix2) & ! @ y1, z1, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix2) + fx(6) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix2) & ! @ y2, z1, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix2) + + fx(7) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix2) & ! @ y1, z2, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix2) + fx(8) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix2) & ! @ y2, z2, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix2) + + ! interp y dir + fy(1) = ywghts(i)%wt1*fx(1) + ywghts(i)%wt2*fx(2) ! @ z1, t1 + fy(2) = ywghts(i)%wt1*fx(3) + ywghts(i)%wt2*fx(4) ! @ z2, t1 + fy(3) = ywghts(i)%wt1*fx(5) + ywghts(i)%wt2*fx(6) ! @ z1, t2 + fy(4) = ywghts(i)%wt1*fx(7) + ywghts(i)%wt2*fx(8) ! @ z2, t2 + + ! interp z dir + fz(1) = zwghts(i)%wt1*fy(1) + zwghts(i)%wt2*fy(2) ! @ t1 + fz(2) = zwghts(i)%wt1*fy(3) + zwghts(i)%wt2*fy(4) ! @ t2 + + ! interp t dir + res(i) = twghts(i)%wt1*fz(1) + twghts(i)%wt2*fz(2) + + end do + + end function interp4d + + !-------------------------------------------------------------------------- + ! determines interpolation weights and indices for given values at the model columns + !-------------------------------------------------------------------------- + pure function table_interp_calcwghts( ngrid, xgrid, ncols, xcols ) result(wghts) + + integer, intent(in) :: ngrid ! number of grid point values + real(r8), intent(in) :: xgrid(ngrid) ! grid point values + integer, intent(in) :: ncols ! number of model columns + real(r8), intent(in) :: xcols(ncols) ! values at the model columns + + type(table_interp_wghts) :: wghts(ncols) ! interpolations weights at the model columns + + integer :: i + real(r8) :: xs(ncols) + + xs(:) = xcols(:) + + ! do not extrapolate beyond the edges of the table + where(xs < xgrid(1)) + xs = xgrid(1) + end where + where(xs > xgrid(ngrid)) + xs = xgrid(ngrid) + end where + + do i = 1,ncols + wghts(i)%ix2 = find_index(ngrid,xgrid,xs(i)) + wghts(i)%ix1 = wghts(i)%ix2 - 1 + wghts(i)%wt1 = (xgrid(wghts(i)%ix2)-xs(i)) & + /(xgrid(wghts(i)%ix2)-xgrid(wghts(i)%ix1)) + wghts(i)%wt2 = 1._r8 - wghts(i)%wt1 + end do + + end function table_interp_calcwghts + + ! private methods + !-------------------------------------------------------------------------- + !-------------------------------------------------------------------------- + ! determines last index of grid vals of which is greater then or equal to + ! value vx + !-------------------------------------------------------------------------- + pure function find_index( nvals, vals, vx ) result(res) + integer, intent(in) :: nvals + real(r8), intent(in) :: vals(nvals) + real(r8), intent(in) :: vx + integer :: res + + integer :: ndx + + res = -1 + + find_ndx: do ndx = 2, nvals + if (vals(ndx)>=vx) then + res = ndx + exit find_ndx + end if + end do find_ndx + + end function find_index + +end module table_interp_mod diff --git a/test/unit/fortran/CMakeLists.txt b/test/unit/fortran/CMakeLists.txt index 91af5b8f7..2acfca3fb 100644 --- a/test/unit/fortran/CMakeLists.txt +++ b/test/unit/fortran/CMakeLists.txt @@ -32,6 +32,7 @@ if(CAM_SIMA_ENABLE_TESTS OR CAM_SIMA_ENABLE_CODE_COVERAGE OR CAM_SIMA_ENABLE_IO_ if(CAM_SIMA_ENABLE_TESTS) add_subdirectory(src/core_utils) + add_subdirectory(src/aerosol) endif() if(CAM_SIMA_ENABLE_IO_TESTS) list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/cmake") diff --git a/test/unit/fortran/src/aerosol/CMakeLists.txt b/test/unit/fortran/src/aerosol/CMakeLists.txt new file mode 100644 index 000000000..f835179a7 --- /dev/null +++ b/test/unit/fortran/src/aerosol/CMakeLists.txt @@ -0,0 +1,130 @@ +# Unit tests for aerosol modules +# +# Organized by dependency complexity: +# Tier 1: Pure functions (table_interp): no mocking needed +# Tier 2: Parsing/definitions (parse_rad_specifier, list_populate): minimal mocking +# Tier 3: Concrete BAM implementations: mock at radiative_aerosol facade level +# Tier 4: Concrete optics types: uses Tier 3 infrastructure end-to-end +# +# Libraries are structured to avoid duplicate compilation: +# aerosol_test_mocks - CAM infrastructure stubs (cam_abortutils, etc.) +# table_interp_testlib - Tier 1 (pure functions, no mock deps) +# rad_aer_defs_testlib - Tier 2 (radiative_aerosol_definitions parsing) +# bulk_aero_testlib - Tier 3 (BAM properties + state + all their deps) +# insoluble_optics_testlib - Tier 4 (adds optics module on top of Tier 3) + +set(AEROSOL_SRC ${CMAKE_SOURCE_DIR}/../../../src/aerosol) +set(UTILS_SRC ${CMAKE_SOURCE_DIR}/../../../src/utils) +set(CORE_UTILS ${CMAKE_SOURCE_DIR}/../../../src/core_utils) +# ccpp_kinds.F90 stub. When CAM_SIMA_ENABLE_IO_TESTS is also ON, the +# ccpp_framework target is built separately. We compile our own copy to +# avoid depending on that target being present. +set(CCPP_STUB ${CMAKE_SOURCE_DIR}/ccpp_framework_stub/ccpp_kinds.F90) + +# ======================================================================== +# Mock library: lightweight stubs for CAM infrastructure modules +# ======================================================================== +add_library(aerosol_test_mocks + shr_kind_mod.F90 + mock_cam_abortutils.F90 + mock_cam_logfile.F90 + mock_spmd_utils.F90 + mock_physconst.F90 + mock_shr_infnan_mod.F90 + mock_shr_string_mod.F90 + mock_shr_spfn_mod.F90 + mock_cam_constituents.F90 + mock_vert_coord.F90 +) +target_compile_options(aerosol_test_mocks PRIVATE -ffree-line-length-none) +target_include_directories(aerosol_test_mocks PUBLIC ${CMAKE_CURRENT_BINARY_DIR}) + +# ======================================================================== +# Tier 1: table_interp: pure interpolation functions +# ======================================================================== +add_library(table_interp_testlib + ${UTILS_SRC}/table_interp_mod.F90 +) +target_link_libraries(table_interp_testlib PUBLIC aerosol_test_mocks) +target_compile_options(table_interp_testlib PRIVATE -ffree-line-length-none) + +add_pfunit_ctest(test_table_interp + TEST_SOURCES test_table_interp.pf + LINK_LIBRARIES table_interp_testlib) + +# ======================================================================== +# Tier 2: radiative_aerosol_definitions parsing and list population +# ======================================================================== +add_library(rad_aer_defs_testlib + mock_phys_prop.F90 + ${AEROSOL_SRC}/radiative_aerosol_definitions.F90 +) +target_link_libraries(rad_aer_defs_testlib PUBLIC aerosol_test_mocks) +target_compile_options(rad_aer_defs_testlib PRIVATE -ffree-line-length-none) + +add_pfunit_ctest(test_parse_rad_specifier + TEST_SOURCES test_parse_rad_specifier.pf + LINK_LIBRARIES rad_aer_defs_testlib) + +add_pfunit_ctest(test_list_populate + TEST_SOURCES test_list_populate.pf + LINK_LIBRARIES rad_aer_defs_testlib) + +# ======================================================================== +# Tier 3: Shared library for BAM properties + state + mocks +# ======================================================================== +add_library(bulk_aero_testlib + ${AEROSOL_SRC}/aerosol_properties_mod.F90 + ${AEROSOL_SRC}/aerosol_state_mod.F90 + ${AEROSOL_SRC}/bulk_aerosol_properties_mod.F90 + ${AEROSOL_SRC}/bulk_aerosol_state_mod.F90 + ${UTILS_SRC}/string_utils.F90 + ${CORE_UTILS}/string_core_utils.F90 + mock_phys_prop.F90 + mock_radiative_aerosol.F90 + mock_aerosol_mmr_host.F90 + ${CCPP_STUB} +) +target_link_libraries(bulk_aero_testlib PUBLIC aerosol_test_mocks) +target_compile_options(bulk_aero_testlib PRIVATE -ffree-line-length-none) + +add_pfunit_ctest(test_bulk_aerosol_properties + TEST_SOURCES test_bulk_aerosol_properties.pf + LINK_LIBRARIES bulk_aero_testlib) + +add_pfunit_ctest(test_bulk_aerosol_state + TEST_SOURCES test_bulk_aerosol_state.pf + LINK_LIBRARIES bulk_aero_testlib) + +# ======================================================================== +# Tier 4: insoluble_aerosol_optics end-to-end with real BAM objects +# ======================================================================== +add_library(insoluble_optics_testlib + ${AEROSOL_SRC}/aerosol_optics_mod.F90 + ${AEROSOL_SRC}/insoluble_aerosol_optics_mod.F90 +) +target_link_libraries(insoluble_optics_testlib PUBLIC bulk_aero_testlib) +target_compile_options(insoluble_optics_testlib PRIVATE -ffree-line-length-none) + +add_pfunit_ctest(test_insoluble_aerosol_optics + TEST_SOURCES test_insoluble_aerosol_optics.pf + LINK_LIBRARIES insoluble_optics_testlib) + +# ======================================================================== +# Tier 3b: Modal aerosol properties + state + mocks +# ======================================================================== +add_library(modal_aero_testlib + ${AEROSOL_SRC}/modal_aerosol_properties_mod.F90 + ${AEROSOL_SRC}/modal_aerosol_state_mod.F90 + modal_test_helpers.F90 +) +target_link_libraries(modal_aero_testlib PUBLIC bulk_aero_testlib) +target_compile_options(modal_aero_testlib PRIVATE -ffree-line-length-none) + +add_pfunit_ctest(test_modal_aerosol_properties + TEST_SOURCES test_modal_aerosol_properties.pf + LINK_LIBRARIES modal_aero_testlib) + +add_pfunit_ctest(test_modal_aerosol_state + TEST_SOURCES test_modal_aerosol_state.pf + LINK_LIBRARIES modal_aero_testlib) diff --git a/test/unit/fortran/src/aerosol/mock_aerosol_mmr_host.F90 b/test/unit/fortran/src/aerosol/mock_aerosol_mmr_host.F90 new file mode 100644 index 000000000..3aa732adf --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_aerosol_mmr_host.F90 @@ -0,0 +1,153 @@ +!----------------------------------------------------------------------- +! Mock aerosol_mmr_host module for unit testing bulk_aerosol_state. +! +! The real module retrieves aerosol mixing ratios from the CCPP +! constituents array by looking up indices that were resolved during +! initialization. This mock bypasses the index resolution and directly +! returns constituents(:,:,aer_idx) for a given aerosol index. +! +! This means the test constituents array should be set up so that +! constituents(:,:,i) contains the MMR for aerosol i. +! +! Mirrors the real module's host-binding handle surface: states hold an +! opaque aero_host_binding_t built from the constituents array. +!----------------------------------------------------------------------- +module aerosol_mmr_host + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + + implicit none + private + + ! Opaque host-binding handle matching the real module + type :: aero_host_binding_t + real(kind_phys), pointer :: constituents(:,:,:) => null() + end type aero_host_binding_t + + ! Generic interface matching the real module + interface rad_cnst_get_aer_mmr + module procedure rad_cnst_get_aer_mmr_by_idx + module procedure rad_cnst_get_mam_mmr_by_idx + module procedure rad_cnst_get_aer_mmr_by_idx_host + module procedure rad_cnst_get_mam_mmr_by_idx_host + end interface + + interface rad_cnst_get_mode_num + module procedure rad_cnst_get_mode_num_ccpp + module procedure rad_cnst_get_mode_num_host + end interface + + public :: aero_host_binding_t + public :: aero_host_binding + public :: rad_cnst_get_aer_mmr + public :: rad_cnst_get_mode_num + +contains + + !----------------------------------------------------------------------- + ! Build a host-binding handle from the test constituents array. + !----------------------------------------------------------------------- + function aero_host_binding(constituents) result(host) + real(kind_phys), pointer, intent(in) :: constituents(:,:,:) + type(aero_host_binding_t) :: host + + host%constituents => constituents + end function aero_host_binding + + !----------------------------------------------------------------------- + ! Mock rad_cnst_get_aer_mmr (bulk): directly index into constituents(:,:,aer_idx). + !----------------------------------------------------------------------- + subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, constituents, mmr) + integer, intent(in) :: list_idx + integer, intent(in) :: aer_idx + real(kind_phys), target, intent(in) :: constituents(:,:,:) + real(r8), pointer :: mmr(:,:) + + mmr => constituents(:, :, aer_idx) + end subroutine rad_cnst_get_aer_mmr_by_idx + + subroutine rad_cnst_get_aer_mmr_by_idx_host(list_idx, aer_idx, host, mmr) + integer, intent(in) :: list_idx + integer, intent(in) :: aer_idx + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: mmr(:,:) + + call rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, host%constituents, mmr) + end subroutine rad_cnst_get_aer_mmr_by_idx_host + + !----------------------------------------------------------------------- + ! Mock rad_cnst_get_mam_mmr_by_idx (modal): compute flat index from + ! mode_idx and spec_idx, return constituents(:,:,flat_idx). + ! + ! Flat layout: for each mode m, offset(m) = 1 + sum_{i constituents(:, :, flat_idx) + end subroutine rad_cnst_get_mam_mmr_by_idx + + subroutine rad_cnst_get_mam_mmr_by_idx_host(list_idx, mode_idx, spec_idx, phase, host, mmr) + integer, intent(in) :: list_idx + integer, intent(in) :: mode_idx + integer, intent(in) :: spec_idx + character(len=1), intent(in) :: phase + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: mmr(:,:) + + call rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, host%constituents, mmr) + end subroutine rad_cnst_get_mam_mmr_by_idx_host + + !----------------------------------------------------------------------- + ! Mock rad_cnst_get_mode_num (modal): return number mixing ratio for mode. + ! Number is at the start of each mode's block in the flat layout. + !----------------------------------------------------------------------- + subroutine rad_cnst_get_mode_num_ccpp(list_idx, mode_idx, phase, constituents, num) + use radiative_aerosol, only: mock_nmodes, mock_nspec + + integer, intent(in) :: list_idx + integer, intent(in) :: mode_idx + character(len=1), intent(in) :: phase + real(kind_phys), target, intent(in) :: constituents(:,:,:) + real(r8), pointer :: num(:,:) + + integer :: flat_idx, m + + flat_idx = 1 + do m = 1, mode_idx - 1 + flat_idx = flat_idx + mock_nspec(m) + 1 + end do + + num => constituents(:, :, flat_idx) + end subroutine rad_cnst_get_mode_num_ccpp + + subroutine rad_cnst_get_mode_num_host(list_idx, mode_idx, phase, host, num) + integer, intent(in) :: list_idx + integer, intent(in) :: mode_idx + character(len=1), intent(in) :: phase + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: num(:,:) + + call rad_cnst_get_mode_num_ccpp(list_idx, mode_idx, phase, host%constituents, num) + end subroutine rad_cnst_get_mode_num_host + +end module aerosol_mmr_host diff --git a/test/unit/fortran/src/aerosol/mock_cam_abortutils.F90 b/test/unit/fortran/src/aerosol/mock_cam_abortutils.F90 new file mode 100644 index 000000000..db4334171 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_cam_abortutils.F90 @@ -0,0 +1,26 @@ +!----------------------------------------------------------------------- +! Mock cam_abortutils for unit testing. +! Provides endrun that prints a message and calls error stop. +!----------------------------------------------------------------------- +module cam_abortutils + + implicit none + private + + public :: endrun + +contains + + subroutine endrun(msg, file, line) + character(len=*), intent(in) :: msg + character(len=*), intent(in), optional :: file + integer, intent(in), optional :: line + if (present(file) .and. present(line)) then + write(*,*) 'MOCK endrun: ', trim(msg), ' at ', trim(file), ':', line + else + write(*,*) 'MOCK endrun: ', trim(msg) + end if + error stop 1 + end subroutine endrun + +end module cam_abortutils diff --git a/test/unit/fortran/src/aerosol/mock_cam_constituents.F90 b/test/unit/fortran/src/aerosol/mock_cam_constituents.F90 new file mode 100644 index 000000000..ae82efd50 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_cam_constituents.F90 @@ -0,0 +1,23 @@ +!----------------------------------------------------------------------- +! Mock cam_constituents for unit testing. +! Provides const_get_index as a no-op stub (returns idx = -1). +! Required by modal_aerosol_state_mod procedure-level use statements. +!----------------------------------------------------------------------- +module cam_constituents + + implicit none + private + + public :: const_get_index + +contains + + subroutine const_get_index(name, idx, abort) + character(len=*), intent(in) :: name + integer, intent(out) :: idx + logical, intent(in), optional :: abort + + idx = -1 + end subroutine const_get_index + +end module cam_constituents diff --git a/test/unit/fortran/src/aerosol/mock_cam_logfile.F90 b/test/unit/fortran/src/aerosol/mock_cam_logfile.F90 new file mode 100644 index 000000000..c6cea9992 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_cam_logfile.F90 @@ -0,0 +1,11 @@ +!----------------------------------------------------------------------- +! Mock cam_logfile for unit testing. +! Provides iulog pointing to stdout (unit 6). +!----------------------------------------------------------------------- +module cam_logfile + + implicit none + + integer, public :: iulog = 6 + +end module cam_logfile diff --git a/test/unit/fortran/src/aerosol/mock_phys_prop.F90 b/test/unit/fortran/src/aerosol/mock_phys_prop.F90 new file mode 100644 index 000000000..b2108b50e --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_phys_prop.F90 @@ -0,0 +1,199 @@ +module phys_prop + ! Mock stub for unit tests. + ! Provides physprop_get_id (returns a deterministic index) + ! and physprop_get that returns mock optics data when configured. + ! + ! For tests that need optics data (e.g. insoluble_aerosol_optics), + ! call setup_mock_physprop_optics() before constructing optics objects. + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + private + + integer, parameter, public :: ot_length = 32 + + public :: physprop_get_id + public :: physprop_get + public :: setup_mock_physprop_optics + public :: cleanup_mock_physprop + + integer, save :: next_id = 0 + + ! Mock optics data storage, indexed as (nwavbands, naero). + ! The id passed to physprop_get is used as the aerosol index. + integer, save :: mock_nswbands = 0 + integer, save :: mock_nlwbands = 0 + real(r8), allocatable, target, save :: mock_sw_nonhygro_ext(:,:) + real(r8), allocatable, target, save :: mock_sw_nonhygro_ssa(:,:) + real(r8), allocatable, target, save :: mock_sw_nonhygro_asm(:,:) + real(r8), allocatable, target, save :: mock_lw_abs(:,:) + +contains + + !----------------------------------------------------------------------- + ! Configure mock optics tables for physprop_get to return. + ! Arrays are dimensioned (nbands, naero). + !----------------------------------------------------------------------- + subroutine setup_mock_physprop_optics(nswbands, nlwbands, naero, & + sw_ext, sw_ssa, sw_asm, lw_abs) + integer, intent(in) :: nswbands, nlwbands, naero + real(r8), intent(in), optional :: sw_ext(:,:) + real(r8), intent(in), optional :: sw_ssa(:,:) + real(r8), intent(in), optional :: sw_asm(:,:) + real(r8), intent(in), optional :: lw_abs(:,:) + + call cleanup_mock_physprop() + mock_nswbands = nswbands + mock_nlwbands = nlwbands + + allocate(mock_sw_nonhygro_ext(nswbands, naero)) + allocate(mock_sw_nonhygro_ssa(nswbands, naero)) + allocate(mock_sw_nonhygro_asm(nswbands, naero)) + allocate(mock_lw_abs(nlwbands, naero)) + mock_sw_nonhygro_ext = 0._r8 + mock_sw_nonhygro_ssa = 0._r8 + mock_sw_nonhygro_asm = 0._r8 + mock_lw_abs = 0._r8 + + if (present(sw_ext)) mock_sw_nonhygro_ext(:, 1:naero) = sw_ext + if (present(sw_ssa)) mock_sw_nonhygro_ssa(:, 1:naero) = sw_ssa + if (present(sw_asm)) mock_sw_nonhygro_asm(:, 1:naero) = sw_asm + if (present(lw_abs)) mock_lw_abs(:, 1:naero) = lw_abs + end subroutine setup_mock_physprop_optics + + !----------------------------------------------------------------------- + ! Clean up mock optics data. + !----------------------------------------------------------------------- + subroutine cleanup_mock_physprop() + if (allocated(mock_sw_nonhygro_ext)) deallocate(mock_sw_nonhygro_ext) + if (allocated(mock_sw_nonhygro_ssa)) deallocate(mock_sw_nonhygro_ssa) + if (allocated(mock_sw_nonhygro_asm)) deallocate(mock_sw_nonhygro_asm) + if (allocated(mock_lw_abs)) deallocate(mock_lw_abs) + mock_nswbands = 0 + mock_nlwbands = 0 + end subroutine cleanup_mock_physprop + + integer function physprop_get_id(filename) + character(len=*), intent(in) :: filename + next_id = next_id + 1 + physprop_get_id = next_id + end function physprop_get_id + + subroutine physprop_get(id, sourcefile, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_abs, & + sw_hygro_ext_wtp, sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_abs_wtp, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_abs, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + extpsw, abspsw, asmpsw, absplw, refrtabsw, & + refitabsw, refrtablw, refitablw, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & + num_to_mass_aer, ncoef, prefr, prefi, sigmag, & + dgnum, dgnumlo, dgnumhi, rhcrystal, rhdeliques, & + extpsw2, abspsw2, asmpsw2, absplw2, corefrac, nfrac, & + wgtpct, bcdust, kap, relh, & + nkap, nwtp, nbcdust, nrelh, & + sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, & + sw_hygro_coreshell_asm, lw_hygro_coreshell_abs) + ! No-op stub: all optional arguments are simply ignored. + ! Tests that need real optics data should mock at the radiative_aerosol level. + integer, intent(in) :: id + character(len=256), optional, intent(out) :: sourcefile + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_abs(:,:) + real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:) + real(r8), optional, pointer :: sw_hygro_ssa_wtp(:,:) + real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:) + real(r8), optional, pointer :: lw_hygro_abs_wtp(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_abs(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + real(r8), optional, pointer :: extpsw(:,:,:,:) + real(r8), optional, pointer :: abspsw(:,:,:,:) + real(r8), optional, pointer :: asmpsw(:,:,:,:) + real(r8), optional, pointer :: absplw(:,:,:,:) + real(r8), optional, pointer :: refrtabsw(:,:) + real(r8), optional, pointer :: refitabsw(:,:) + real(r8), optional, pointer :: refrtablw(:,:) + real(r8), optional, pointer :: refitablw(:,:) + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + integer, optional, intent(out) :: ncoef + integer, optional, intent(out) :: prefr + integer, optional, intent(out) :: prefi + real(r8), optional, intent(out) :: sigmag + real(r8), optional, intent(out) :: dgnum + real(r8), optional, intent(out) :: dgnumlo + real(r8), optional, intent(out) :: dgnumhi + real(r8), optional, intent(out) :: rhcrystal + real(r8), optional, intent(out) :: rhdeliques + real(r8), optional, pointer :: extpsw2(:,:,:,:) + real(r8), optional, pointer :: abspsw2(:,:,:,:) + real(r8), optional, pointer :: asmpsw2(:,:,:,:) + real(r8), optional, pointer :: absplw2(:,:,:,:) + real(r8), optional, pointer :: corefrac(:) + integer, optional, intent(out) :: nfrac + real(r8), optional, pointer :: wgtpct(:) + real(r8), optional, pointer :: bcdust(:) + real(r8), optional, pointer :: kap(:) + real(r8), optional, pointer :: relh(:) + integer, optional, intent(out) :: nkap + integer, optional, intent(out) :: nwtp + integer, optional, intent(out) :: nbcdust + integer, optional, intent(out) :: nrelh + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) + real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) + real(r8), optional, pointer :: lw_hygro_coreshell_abs(:,:,:,:,:) + + ! Return mock optics data when available. + ! The id maps to the aerosol index (1-based). + if (present(sw_nonhygro_ext)) then + if (allocated(mock_sw_nonhygro_ext)) then + sw_nonhygro_ext => mock_sw_nonhygro_ext(:, id) + else + nullify(sw_nonhygro_ext) + end if + end if + if (present(sw_nonhygro_ssa)) then + if (allocated(mock_sw_nonhygro_ssa)) then + sw_nonhygro_ssa => mock_sw_nonhygro_ssa(:, id) + else + nullify(sw_nonhygro_ssa) + end if + end if + if (present(sw_nonhygro_asm)) then + if (allocated(mock_sw_nonhygro_asm)) then + sw_nonhygro_asm => mock_sw_nonhygro_asm(:, id) + else + nullify(sw_nonhygro_asm) + end if + end if + if (present(lw_abs)) then + if (allocated(mock_lw_abs)) then + lw_abs => mock_lw_abs(:, id) + else + nullify(lw_abs) + end if + end if + end subroutine physprop_get + +end module phys_prop diff --git a/test/unit/fortran/src/aerosol/mock_physconst.F90 b/test/unit/fortran/src/aerosol/mock_physconst.F90 new file mode 100644 index 000000000..7d9f42521 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_physconst.F90 @@ -0,0 +1,15 @@ +!----------------------------------------------------------------------- +! Mock physconst for unit testing. +! Provides physical constants used by aerosol modules. +!----------------------------------------------------------------------- +module physconst + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + real(r8), public, parameter :: pi = 3.14159265358979323846_r8 + real(r8), public, parameter :: rga = 1._r8 / 9.80616_r8 + real(r8), public, parameter :: rhoh2o = 1000._r8 + +end module physconst diff --git a/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 b/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 new file mode 100644 index 000000000..b24474c90 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 @@ -0,0 +1,551 @@ +!----------------------------------------------------------------------- +! Mock radiative_aerosol module for unit testing aerosol properties. +! +! This mock replaces the real radiative_aerosol facade module. The real +! module delegates to phys_prop (which reads NetCDF +! physprop files via PIO). This mock provides configurable in-memory data +! via setup_mock_rad_aer() / setup_mock_modal_rad_aer(), +! removing all file I/O dependencies. +! +! Supported interfaces (matching the real module's generic interfaces): +! rad_aer_get_info(list_idx, naero=...) +! rad_aer_get_info(list_idx, m_idx, mode_type=..., nspec=...) +! rad_aer_get_info(list_idx, m_idx, s_idx, spec_type=...) +! rad_aer_get_props(list_idx, aer_idx, density_aer=..., hygro_aer=..., ...) +! rad_aer_get_props(list_idx, mode_idx, spec_idx, density_aer=..., ...) +!----------------------------------------------------------------------- +module radiative_aerosol + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + private + + ! Maximum number of mock aerosols + integer, parameter :: max_mock_aero = 10 + integer, parameter :: max_mock_modes = 10 + integer, parameter :: max_mock_spec = 10 + + ! Mock data storage for bulk aerosols (populated by setup_mock_rad_aer) + integer :: mock_naero = 0 + real(r8) :: mock_density(max_mock_aero) = 0._r8 + real(r8) :: mock_hygro(max_mock_aero) = 0._r8 + real(r8) :: mock_dispersion(max_mock_aero) = 1._r8 + real(r8) :: mock_dryrad(max_mock_aero) = 0._r8 + real(r8) :: mock_num_to_mass(max_mock_aero) = 0._r8 + character(len=20) :: mock_aername(max_mock_aero) = '' + character(len=32) :: mock_opticstype(max_mock_aero) = '' + + ! Mock optics table storage (non-hygroscopic / insoluble) + real(r8), allocatable, target :: mock_sw_nonhygro_ext(:,:) ! (nswbands, max_mock_aero) + real(r8), allocatable, target :: mock_sw_nonhygro_ssa(:,:) + real(r8), allocatable, target :: mock_sw_nonhygro_asm(:,:) + real(r8), allocatable, target :: mock_lw_ext(:,:) ! (nlwbands, max_mock_aero) + + ! Mock optics table storage (hygroscopic) + real(r8), allocatable, target :: mock_sw_hygro_ext(:,:,:) ! (nrh, nswbands, max_mock_aero) + real(r8), allocatable, target :: mock_sw_hygro_ssa(:,:,:) + real(r8), allocatable, target :: mock_sw_hygro_asm(:,:,:) + real(r8), allocatable, target :: mock_lw_hygro_ext(:,:,:) + + ! Mock refractive index storage + complex(r8), allocatable, target :: mock_refindex_sw(:,:) ! (nswbands, max_mock_aero) + complex(r8), allocatable, target :: mock_refindex_lw(:,:) ! (nlwbands, max_mock_aero) + + ! Mock data storage for modal aerosols (populated by setup_mock_modal_rad_aer) + integer, public :: mock_nmodes = 0 + integer, public :: mock_nspec(max_mock_modes) = 0 + character(len=32) :: mock_mode_type(max_mock_modes) = '' + character(len=32) :: mock_num_name(max_mock_modes) = '' + character(len=32) :: mock_num_name_cw(max_mock_modes) = '' + real(r8) :: mock_sigmag(max_mock_modes) = 0._r8 + real(r8) :: mock_dgnum(max_mock_modes) = 0._r8 + real(r8) :: mock_dgnumlo(max_mock_modes) = 0._r8 + real(r8) :: mock_dgnumhi(max_mock_modes) = 0._r8 + real(r8) :: mock_rhcrystal(max_mock_modes) = 0._r8 + real(r8) :: mock_rhdeliques(max_mock_modes) = 0._r8 + character(len=32) :: mock_spec_type(max_mock_modes, max_mock_spec) = '' + character(len=32) :: mock_spec_name(max_mock_modes, max_mock_spec) = '' + character(len=32) :: mock_spec_name_cw(max_mock_modes, max_mock_spec) = '' + real(r8) :: mock_spec_density(max_mock_modes, max_mock_spec) = 0._r8 + real(r8) :: mock_spec_hygro(max_mock_modes, max_mock_spec) = 0._r8 + + ! Generic interfaces matching the real module + interface rad_aer_get_info + module procedure rad_aer_get_info_basic + module procedure rad_aer_get_info_by_mode + module procedure rad_aer_get_info_by_mode_spec + end interface + + interface rad_aer_get_props + module procedure rad_aer_get_props_by_idx + module procedure rad_aer_get_mam_props_by_idx + end interface + + public :: rad_aer_get_info + public :: rad_aer_get_props + public :: setup_mock_rad_aer + public :: setup_mock_modal_rad_aer + public :: setup_mock_optics_tables + public :: cleanup_mock_rad_aer + public :: rad_aer_bulk_physprop_id + public :: rad_aer_get_mode_props + public :: rad_aer_mode_physprop_id + +contains + + !----------------------------------------------------------------------- + ! Configure mock data for a set of bulk aerosols. + ! Call this from your test before constructing bulk_aerosol_properties. + !----------------------------------------------------------------------- + subroutine setup_mock_rad_aer(naero, density, hygro, dispersion, aername, opticstype, & + dryrad, num_to_mass) + integer, intent(in) :: naero + real(r8), intent(in) :: density(:) + real(r8), intent(in) :: hygro(:) + real(r8), intent(in) :: dispersion(:) + character(len=*), intent(in) :: aername(:) + character(len=*), intent(in) :: opticstype(:) + real(r8), intent(in), optional :: dryrad(:) + real(r8), intent(in), optional :: num_to_mass(:) + + mock_naero = naero + mock_density(1:naero) = density(1:naero) + mock_hygro(1:naero) = hygro(1:naero) + mock_dispersion(1:naero) = dispersion(1:naero) + mock_aername(1:naero) = aername(1:naero) + mock_opticstype(1:naero) = opticstype(1:naero) + if (present(dryrad)) mock_dryrad(1:naero) = dryrad(1:naero) + if (present(num_to_mass)) mock_num_to_mass(1:naero) = num_to_mass(1:naero) + end subroutine setup_mock_rad_aer + + !----------------------------------------------------------------------- + ! Configure mock optics tables for non-hygroscopic aerosols. + ! Arrays are (nbands, naero). + !----------------------------------------------------------------------- + subroutine setup_mock_optics_tables(nswbands, nlwbands, & + sw_ext, sw_ssa, sw_asm, lw_abs) + integer, intent(in) :: nswbands, nlwbands + real(r8), intent(in), optional :: sw_ext(:,:) ! (nswbands, naero) + real(r8), intent(in), optional :: sw_ssa(:,:) + real(r8), intent(in), optional :: sw_asm(:,:) + real(r8), intent(in), optional :: lw_abs(:,:) ! (nlwbands, naero) + + if (allocated(mock_sw_nonhygro_ext)) deallocate(mock_sw_nonhygro_ext) + if (allocated(mock_sw_nonhygro_ssa)) deallocate(mock_sw_nonhygro_ssa) + if (allocated(mock_sw_nonhygro_asm)) deallocate(mock_sw_nonhygro_asm) + if (allocated(mock_lw_ext)) deallocate(mock_lw_ext) + + allocate(mock_sw_nonhygro_ext(nswbands, max_mock_aero)) + allocate(mock_sw_nonhygro_ssa(nswbands, max_mock_aero)) + allocate(mock_sw_nonhygro_asm(nswbands, max_mock_aero)) + allocate(mock_lw_ext(nlwbands, max_mock_aero)) + mock_sw_nonhygro_ext = 0._r8 + mock_sw_nonhygro_ssa = 0._r8 + mock_sw_nonhygro_asm = 0._r8 + mock_lw_ext = 0._r8 + + if (present(sw_ext)) mock_sw_nonhygro_ext(:, 1:mock_naero) = sw_ext + if (present(sw_ssa)) mock_sw_nonhygro_ssa(:, 1:mock_naero) = sw_ssa + if (present(sw_asm)) mock_sw_nonhygro_asm(:, 1:mock_naero) = sw_asm + if (present(lw_abs)) mock_lw_ext(:, 1:mock_naero) = lw_abs + end subroutine setup_mock_optics_tables + + !----------------------------------------------------------------------- + ! Configure mock data for modal aerosols. + !----------------------------------------------------------------------- + subroutine setup_mock_modal_rad_aer(nmodes, nspec, mode_type, & + num_name, num_name_cw, sigmag, dgnum, dgnumlo, dgnumhi, & + rhcrystal, rhdeliques, spec_type, spec_name, spec_name_cw, & + spec_density, spec_hygro) + integer, intent(in) :: nmodes + integer, intent(in) :: nspec(:) + character(len=*), intent(in) :: mode_type(:) + character(len=*), intent(in) :: num_name(:) + character(len=*), intent(in) :: num_name_cw(:) + real(r8), intent(in) :: sigmag(:) + real(r8), intent(in) :: dgnum(:) + real(r8), intent(in) :: dgnumlo(:) + real(r8), intent(in) :: dgnumhi(:) + real(r8), intent(in) :: rhcrystal(:) + real(r8), intent(in) :: rhdeliques(:) + character(len=*), intent(in) :: spec_type(:,:) + character(len=*), intent(in) :: spec_name(:,:) + character(len=*), intent(in) :: spec_name_cw(:,:) + real(r8), intent(in) :: spec_density(:,:) + real(r8), intent(in) :: spec_hygro(:,:) + + integer :: m, s + + mock_nmodes = nmodes + mock_nspec(1:nmodes) = nspec(1:nmodes) + mock_mode_type(1:nmodes) = mode_type(1:nmodes) + mock_num_name(1:nmodes) = num_name(1:nmodes) + mock_num_name_cw(1:nmodes) = num_name_cw(1:nmodes) + mock_sigmag(1:nmodes) = sigmag(1:nmodes) + mock_dgnum(1:nmodes) = dgnum(1:nmodes) + mock_dgnumlo(1:nmodes) = dgnumlo(1:nmodes) + mock_dgnumhi(1:nmodes) = dgnumhi(1:nmodes) + mock_rhcrystal(1:nmodes) = rhcrystal(1:nmodes) + mock_rhdeliques(1:nmodes) = rhdeliques(1:nmodes) + do m = 1, nmodes + do s = 1, nspec(m) + mock_spec_type(m, s) = spec_type(m, s) + mock_spec_name(m, s) = spec_name(m, s) + mock_spec_name_cw(m, s) = spec_name_cw(m, s) + mock_spec_density(m, s) = spec_density(m, s) + mock_spec_hygro(m, s) = spec_hygro(m, s) + end do + end do + end subroutine setup_mock_modal_rad_aer + + !----------------------------------------------------------------------- + ! Mock rad_aer_get_info_by_mode: return mode-level info. + !----------------------------------------------------------------------- + subroutine rad_aer_get_info_by_mode(list_idx, m_idx, mode_type, num_name, num_name_cw, nspec) + integer, intent(in) :: list_idx + integer, intent(in) :: m_idx + character(len=32), optional, intent(out) :: mode_type + character(len=32), optional, intent(out) :: num_name + character(len=32), optional, intent(out) :: num_name_cw + integer, optional, intent(out) :: nspec + + if (present(mode_type)) mode_type = mock_mode_type(m_idx) + if (present(num_name)) num_name = mock_num_name(m_idx) + if (present(num_name_cw)) num_name_cw = mock_num_name_cw(m_idx) + if (present(nspec)) nspec = mock_nspec(m_idx) + end subroutine rad_aer_get_info_by_mode + + !----------------------------------------------------------------------- + ! Mock rad_aer_get_info_by_mode_spec: return species-level info. + !----------------------------------------------------------------------- + subroutine rad_aer_get_info_by_mode_spec(list_idx, m_idx, s_idx, & + spec_type, spec_name, spec_name_cw) + integer, intent(in) :: list_idx + integer, intent(in) :: m_idx + integer, intent(in) :: s_idx + character(len=32), optional, intent(out) :: spec_type + character(len=32), optional, intent(out) :: spec_name + character(len=32), optional, intent(out) :: spec_name_cw + + if (present(spec_type)) spec_type = mock_spec_type(m_idx, s_idx) + if (present(spec_name)) spec_name = mock_spec_name(m_idx, s_idx) + if (present(spec_name_cw)) spec_name_cw = mock_spec_name_cw(m_idx, s_idx) + end subroutine rad_aer_get_info_by_mode_spec + + !----------------------------------------------------------------------- + ! Mock rad_aer_get_mam_props_by_idx: return per-species modal properties. + !----------------------------------------------------------------------- + subroutine rad_aer_get_mam_props_by_idx(list_idx, mode_idx, spec_idx, & + opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & + num_to_mass_aer, spectype) + use phys_prop, only: ot_length + + integer, intent(in) :: list_idx + integer, intent(in) :: mode_idx + integer, intent(in) :: spec_idx + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_ext(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + character(len=32), optional, intent(out) :: spectype + + if (present(density_aer)) density_aer = mock_spec_density(mode_idx, spec_idx) + if (present(hygro_aer)) hygro_aer = mock_spec_hygro(mode_idx, spec_idx) + if (present(spectype)) spectype = mock_spec_type(mode_idx, spec_idx) + + ! Optics pointers not yet mocked for modal - nullify + if (present(sw_hygro_ext)) nullify(sw_hygro_ext) + if (present(sw_hygro_ssa)) nullify(sw_hygro_ssa) + if (present(sw_hygro_asm)) nullify(sw_hygro_asm) + if (present(lw_hygro_ext)) nullify(lw_hygro_ext) + if (present(sw_nonhygro_ext)) nullify(sw_nonhygro_ext) + if (present(sw_nonhygro_ssa)) nullify(sw_nonhygro_ssa) + if (present(sw_nonhygro_asm)) nullify(sw_nonhygro_asm) + if (present(sw_nonhygro_scat)) nullify(sw_nonhygro_scat) + if (present(sw_nonhygro_ascat)) nullify(sw_nonhygro_ascat) + if (present(lw_ext)) nullify(lw_ext) + if (present(refindex_aer_sw)) nullify(refindex_aer_sw) + if (present(refindex_aer_lw)) nullify(refindex_aer_lw) + if (present(r_sw_ext)) nullify(r_sw_ext) + if (present(r_sw_scat)) nullify(r_sw_scat) + if (present(r_sw_ascat)) nullify(r_sw_ascat) + if (present(r_lw_abs)) nullify(r_lw_abs) + if (present(mu)) nullify(mu) + end subroutine rad_aer_get_mam_props_by_idx + + !----------------------------------------------------------------------- + ! Mock rad_aer_get_mode_props: return mode-level physical properties. + !----------------------------------------------------------------------- + subroutine rad_aer_get_mode_props(list_idx, mode_idx, opticstype, & + extpsw, abspsw, asmpsw, absplw, refrtabsw, & + refitabsw, refrtablw, refitablw, ncoef, prefr, & + prefi, sigmag, dgnum, dgnumlo, dgnumhi, & + rhcrystal, rhdeliques) + use phys_prop, only: ot_length + + integer, intent(in) :: list_idx + integer, intent(in) :: mode_idx + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: extpsw(:,:,:,:) + real(r8), optional, pointer :: abspsw(:,:,:,:) + real(r8), optional, pointer :: asmpsw(:,:,:,:) + real(r8), optional, pointer :: absplw(:,:,:,:) + real(r8), optional, pointer :: refrtabsw(:,:) + real(r8), optional, pointer :: refitabsw(:,:) + real(r8), optional, pointer :: refrtablw(:,:) + real(r8), optional, pointer :: refitablw(:,:) + integer, optional, intent(out) :: ncoef + integer, optional, intent(out) :: prefr + integer, optional, intent(out) :: prefi + real(r8), optional, intent(out) :: sigmag + real(r8), optional, intent(out) :: dgnum + real(r8), optional, intent(out) :: dgnumlo + real(r8), optional, intent(out) :: dgnumhi + real(r8), optional, intent(out) :: rhcrystal + real(r8), optional, intent(out) :: rhdeliques + + if (present(sigmag)) sigmag = mock_sigmag(mode_idx) + if (present(dgnum)) dgnum = mock_dgnum(mode_idx) + if (present(dgnumlo)) dgnumlo = mock_dgnumlo(mode_idx) + if (present(dgnumhi)) dgnumhi = mock_dgnumhi(mode_idx) + if (present(rhcrystal)) rhcrystal = mock_rhcrystal(mode_idx) + if (present(rhdeliques)) rhdeliques = mock_rhdeliques(mode_idx) + + ! Pointer/optics arguments not yet mocked - nullify + if (present(extpsw)) nullify(extpsw) + if (present(abspsw)) nullify(abspsw) + if (present(asmpsw)) nullify(asmpsw) + if (present(absplw)) nullify(absplw) + if (present(refrtabsw)) nullify(refrtabsw) + if (present(refitabsw)) nullify(refitabsw) + if (present(refrtablw)) nullify(refrtablw) + if (present(refitablw)) nullify(refitablw) + end subroutine rad_aer_get_mode_props + + !----------------------------------------------------------------------- + ! Mock rad_aer_mode_physprop_id: return mode_idx as the physprop ID. + !----------------------------------------------------------------------- + integer function rad_aer_mode_physprop_id(list_idx, mode_idx) + integer, intent(in) :: list_idx + integer, intent(in) :: mode_idx + + rad_aer_mode_physprop_id = mode_idx + end function rad_aer_mode_physprop_id + + !----------------------------------------------------------------------- + ! Clean up mock data. + !----------------------------------------------------------------------- + subroutine cleanup_mock_rad_aer() + mock_naero = 0 + mock_nmodes = 0 + mock_nspec(:) = 0 + if (allocated(mock_sw_nonhygro_ext)) deallocate(mock_sw_nonhygro_ext) + if (allocated(mock_sw_nonhygro_ssa)) deallocate(mock_sw_nonhygro_ssa) + if (allocated(mock_sw_nonhygro_asm)) deallocate(mock_sw_nonhygro_asm) + if (allocated(mock_lw_ext)) deallocate(mock_lw_ext) + if (allocated(mock_sw_hygro_ext)) deallocate(mock_sw_hygro_ext) + if (allocated(mock_sw_hygro_ssa)) deallocate(mock_sw_hygro_ssa) + if (allocated(mock_sw_hygro_asm)) deallocate(mock_sw_hygro_asm) + if (allocated(mock_lw_hygro_ext)) deallocate(mock_lw_hygro_ext) + if (allocated(mock_refindex_sw)) deallocate(mock_refindex_sw) + if (allocated(mock_refindex_lw)) deallocate(mock_refindex_lw) + end subroutine cleanup_mock_rad_aer + + !----------------------------------------------------------------------- + ! Mock rad_aer_get_info: return number of aerosols. + !----------------------------------------------------------------------- + subroutine rad_aer_get_info_basic(list_idx, aernames, naero, nmodes, nbins) + integer, intent(in) :: list_idx + character(len=64), optional, intent(out) :: aernames(:) + integer, optional, intent(out) :: naero + integer, optional, intent(out) :: nmodes + integer, optional, intent(out) :: nbins + + integer :: i + + if (present(naero)) naero = mock_naero + if (present(nmodes)) nmodes = mock_nmodes + if (present(nbins)) nbins = 0 + if (present(aernames)) then + do i = 1, mock_naero + aernames(i) = mock_aername(i) + end do + end if + end subroutine rad_aer_get_info_basic + + !----------------------------------------------------------------------- + ! Mock rad_aer_get_props: return per-aerosol properties from mock data. + ! Matches the interface of rad_aer_get_props_by_idx in the real module. + !----------------------------------------------------------------------- + subroutine rad_aer_get_props_by_idx(list_idx, & + aer_idx, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, num_to_mass_aer) + + integer, intent(in) :: list_idx + integer, intent(in) :: aer_idx + character(len=*), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_ext(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + + if (present(opticstype)) opticstype = trim(mock_opticstype(aer_idx)) + if (present(aername)) aername = mock_aername(aer_idx) + if (present(density_aer)) density_aer = mock_density(aer_idx) + if (present(hygro_aer)) hygro_aer = mock_hygro(aer_idx) + if (present(dryrad_aer)) dryrad_aer = mock_dryrad(aer_idx) + if (present(dispersion_aer)) dispersion_aer = mock_dispersion(aer_idx) + if (present(num_to_mass_aer)) num_to_mass_aer = mock_num_to_mass(aer_idx) + + ! Non-hygroscopic optics tables + if (present(sw_nonhygro_ext)) then + if (allocated(mock_sw_nonhygro_ext)) then + sw_nonhygro_ext => mock_sw_nonhygro_ext(:, aer_idx) + else + nullify(sw_nonhygro_ext) + end if + end if + if (present(sw_nonhygro_ssa)) then + if (allocated(mock_sw_nonhygro_ssa)) then + sw_nonhygro_ssa => mock_sw_nonhygro_ssa(:, aer_idx) + else + nullify(sw_nonhygro_ssa) + end if + end if + if (present(sw_nonhygro_asm)) then + if (allocated(mock_sw_nonhygro_asm)) then + sw_nonhygro_asm => mock_sw_nonhygro_asm(:, aer_idx) + else + nullify(sw_nonhygro_asm) + end if + end if + if (present(lw_ext)) then + if (allocated(mock_lw_ext)) then + lw_ext => mock_lw_ext(:, aer_idx) + else + nullify(lw_ext) + end if + end if + + ! Hygroscopic optics tables + if (present(sw_hygro_ext)) then + if (allocated(mock_sw_hygro_ext)) then + sw_hygro_ext => mock_sw_hygro_ext(:, :, aer_idx) + else + nullify(sw_hygro_ext) + end if + end if + if (present(sw_hygro_ssa)) then + if (allocated(mock_sw_hygro_ssa)) then + sw_hygro_ssa => mock_sw_hygro_ssa(:, :, aer_idx) + else + nullify(sw_hygro_ssa) + end if + end if + if (present(sw_hygro_asm)) then + if (allocated(mock_sw_hygro_asm)) then + sw_hygro_asm => mock_sw_hygro_asm(:, :, aer_idx) + else + nullify(sw_hygro_asm) + end if + end if + if (present(lw_hygro_ext)) then + if (allocated(mock_lw_hygro_ext)) then + lw_hygro_ext => mock_lw_hygro_ext(:, :, aer_idx) + else + nullify(lw_hygro_ext) + end if + end if + + ! Refractive indices + if (present(refindex_aer_sw)) then + if (allocated(mock_refindex_sw)) then + refindex_aer_sw => mock_refindex_sw(:, aer_idx) + else + nullify(refindex_aer_sw) + end if + end if + if (present(refindex_aer_lw)) then + if (allocated(mock_refindex_lw)) then + refindex_aer_lw => mock_refindex_lw(:, aer_idx) + else + nullify(refindex_aer_lw) + end if + end if + + ! Volcanic radius tables are not yet mocked, nullify + if (present(r_sw_ext)) nullify(r_sw_ext) + if (present(r_sw_scat)) nullify(r_sw_scat) + if (present(r_sw_ascat)) nullify(r_sw_ascat) + if (present(r_lw_abs)) nullify(r_lw_abs) + if (present(mu)) nullify(mu) + + ! Derived non-hygro tables + if (present(sw_nonhygro_scat)) nullify(sw_nonhygro_scat) + if (present(sw_nonhygro_ascat)) nullify(sw_nonhygro_ascat) + + end subroutine rad_aer_get_props_by_idx + + !----------------------------------------------------------------------- + ! Mock rad_aer_bulk_physprop_id: return the aer_idx as the physprop ID. + ! In the real module this looks up the physprop index from the bin list. + !----------------------------------------------------------------------- + integer function rad_aer_bulk_physprop_id(list_idx, aer_idx) + integer, intent(in) :: list_idx + integer, intent(in) :: aer_idx + + rad_aer_bulk_physprop_id = aer_idx + end function rad_aer_bulk_physprop_id + +end module radiative_aerosol diff --git a/test/unit/fortran/src/aerosol/mock_shr_infnan_mod.F90 b/test/unit/fortran/src/aerosol/mock_shr_infnan_mod.F90 new file mode 100644 index 000000000..7cc77022e --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_shr_infnan_mod.F90 @@ -0,0 +1,34 @@ +!----------------------------------------------------------------------- +! Mock shr_infnan_mod for unit testing. +! Provides shr_infnan_nan and assignment(=) interface for NaN values. +!----------------------------------------------------------------------- +module shr_infnan_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use, intrinsic :: ieee_arithmetic, only: ieee_value, ieee_quiet_nan + + implicit none + private + + ! Type to represent a NaN assignment source + type, public :: shr_infnan_nan_type + integer :: unused = 0 + end type shr_infnan_nan_type + + type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = shr_infnan_nan_type(0) + + public :: assignment(=) + + interface assignment(=) + module procedure assign_nan_r8 + end interface + +contains + + elemental subroutine assign_nan_r8(output, input) + real(r8), intent(out) :: output + type(shr_infnan_nan_type), intent(in) :: input + output = ieee_value(output, ieee_quiet_nan) + end subroutine assign_nan_r8 + +end module shr_infnan_mod diff --git a/test/unit/fortran/src/aerosol/mock_shr_spfn_mod.F90 b/test/unit/fortran/src/aerosol/mock_shr_spfn_mod.F90 new file mode 100644 index 000000000..02a92bfc5 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_shr_spfn_mod.F90 @@ -0,0 +1,21 @@ +!----------------------------------------------------------------------- +! Mock shr_spfn_mod for unit testing. +! Provides shr_spfn_erf wrapping the Fortran intrinsic erf. +!----------------------------------------------------------------------- +module shr_spfn_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + private + + public :: shr_spfn_erf + +contains + + elemental real(r8) function shr_spfn_erf(x) + real(r8), intent(in) :: x + shr_spfn_erf = erf(x) + end function shr_spfn_erf + +end module shr_spfn_mod diff --git a/test/unit/fortran/src/aerosol/mock_shr_string_mod.F90 b/test/unit/fortran/src/aerosol/mock_shr_string_mod.F90 new file mode 100644 index 000000000..ec333b17a --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_shr_string_mod.F90 @@ -0,0 +1,41 @@ +!----------------------------------------------------------------------- +! Mock shr_string_mod for unit testing. +! Provides shr_string_toUpper and shr_string_toLower. +!----------------------------------------------------------------------- +module shr_string_mod + + implicit none + private + + public :: shr_string_toUpper + public :: shr_string_toLower + +contains + + function shr_string_toUpper(str) result(upper) + character(len=*), intent(in) :: str + character(len=len(str)) :: upper + integer :: i, ic + upper = str + do i = 1, len_trim(str) + ic = iachar(str(i:i)) + if (ic >= iachar('a') .and. ic <= iachar('z')) then + upper(i:i) = achar(ic - 32) + end if + end do + end function shr_string_toUpper + + function shr_string_toLower(str) result(lower) + character(len=*), intent(in) :: str + character(len=len(str)) :: lower + integer :: i, ic + lower = str + do i = 1, len_trim(str) + ic = iachar(str(i:i)) + if (ic >= iachar('A') .and. ic <= iachar('Z')) then + lower(i:i) = achar(ic + 32) + end if + end do + end function shr_string_toLower + +end module shr_string_mod diff --git a/test/unit/fortran/src/aerosol/mock_spmd_utils.F90 b/test/unit/fortran/src/aerosol/mock_spmd_utils.F90 new file mode 100644 index 000000000..76554a904 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_spmd_utils.F90 @@ -0,0 +1,12 @@ +!----------------------------------------------------------------------- +! Mock spmd_utils for unit testing. +! Provides masterproc = .true. (single-process test environment). +!----------------------------------------------------------------------- +module spmd_utils + + implicit none + + logical, public :: masterproc = .true. + integer, public :: mpicom = 0 + +end module spmd_utils diff --git a/test/unit/fortran/src/aerosol/mock_vert_coord.F90 b/test/unit/fortran/src/aerosol/mock_vert_coord.F90 new file mode 100644 index 000000000..c4f0f1603 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_vert_coord.F90 @@ -0,0 +1,12 @@ +!----------------------------------------------------------------------- +! Mock vert_coord for unit testing. +! Provides pver = 30 (CAM5 default vertical levels). +!----------------------------------------------------------------------- +module vert_coord + + implicit none + + integer, parameter, public :: pver = 30 + integer, parameter, public :: pverp = 31 + +end module vert_coord diff --git a/test/unit/fortran/src/aerosol/modal_test_helpers.F90 b/test/unit/fortran/src/aerosol/modal_test_helpers.F90 new file mode 100644 index 000000000..d9f89fb4c --- /dev/null +++ b/test/unit/fortran/src/aerosol/modal_test_helpers.F90 @@ -0,0 +1,68 @@ +!----------------------------------------------------------------------- +! Helper module to set up and tear down the 2-mode mock config +! for modal aerosol unit tests. +! +! Mode 1 "accum": 2 species (sulfate, black-c) +! Mode 2 "coarse": 1 species (dust) +!----------------------------------------------------------------------- +module modal_test_helpers + use shr_kind_mod, only: r8 => shr_kind_r8 + use radiative_aerosol, only: setup_mock_modal_rad_aer, cleanup_mock_rad_aer + implicit none + + ! Mode properties + real(r8), parameter :: sigmag_accum = 1.8_r8 + real(r8), parameter :: sigmag_coarse = 2.0_r8 + real(r8), parameter :: dgnum_accum = 0.11e-6_r8 + real(r8), parameter :: dgnum_coarse = 2.0e-6_r8 + + ! Species densities + real(r8), parameter :: dens_sulfate = 1770._r8 + real(r8), parameter :: dens_bc = 1700._r8 + real(r8), parameter :: dens_dust = 2600._r8 + + ! Species hygroscopicities + real(r8), parameter :: hygro_sulfate = 0.507_r8 + real(r8), parameter :: hygro_bc = 1.0e-10_r8 + real(r8), parameter :: hygro_dust = 0.14_r8 + +contains + + subroutine setup_2mode_mock() + character(len=32) :: spec_type(2,2), spec_name(2,2), spec_name_cw(2,2) + real(r8) :: spec_density(2,2), spec_hygro(2,2) + + spec_type(1,1) = 'sulfate'; spec_type(1,2) = 'black-c' + spec_type(2,1) = 'dust'; spec_type(2,2) = '' + + spec_name(1,1) = 'so4_a1'; spec_name(1,2) = 'bc_a1' + spec_name(2,1) = 'dst_a2'; spec_name(2,2) = '' + spec_name_cw(1,1) = 'so4_c1'; spec_name_cw(1,2) = 'bc_c1' + spec_name_cw(2,1) = 'dst_c2'; spec_name_cw(2,2) = '' + + spec_density(1,1) = dens_sulfate; spec_density(1,2) = dens_bc + spec_density(2,1) = dens_dust; spec_density(2,2) = 0._r8 + + spec_hygro(1,1) = hygro_sulfate; spec_hygro(1,2) = hygro_bc + spec_hygro(2,1) = hygro_dust; spec_hygro(2,2) = 0._r8 + + call setup_mock_modal_rad_aer( & + nmodes = 2, & + nspec = [2, 1], & + mode_type = [character(len=32) :: 'accum', 'coarse'], & + num_name = [character(len=32) :: 'num_a1', 'num_a2'], & + num_name_cw = [character(len=32) :: 'num_c1', 'num_c2'], & + sigmag = [sigmag_accum, sigmag_coarse], & + dgnum = [dgnum_accum, dgnum_coarse], & + dgnumlo = [dgnum_accum * 0.1_r8, dgnum_coarse * 0.1_r8], & + dgnumhi = [dgnum_accum * 10._r8, dgnum_coarse * 10._r8], & + rhcrystal = [0.35_r8, 0.35_r8], & + rhdeliques = [0.80_r8, 0.80_r8], & + spec_type = spec_type, & + spec_name = spec_name, & + spec_name_cw = spec_name_cw, & + spec_density = spec_density, & + spec_hygro = spec_hygro ) + end subroutine setup_2mode_mock + +end module modal_test_helpers diff --git a/test/unit/fortran/src/aerosol/shr_kind_mod.F90 b/test/unit/fortran/src/aerosol/shr_kind_mod.F90 new file mode 100644 index 000000000..9806b5ebb --- /dev/null +++ b/test/unit/fortran/src/aerosol/shr_kind_mod.F90 @@ -0,0 +1,18 @@ +!----------------------------------------------------------------------- +! Local shr_kind_mod stub for unit testing. +! Provides the same kind parameters as CESM share/src/shr_kind_mod.F90 +! so tests can build without checking out the share submodule. +!----------------------------------------------------------------------- +module shr_kind_mod + + use ISO_FORTRAN_ENV, only: shr_kind_r8 => REAL64 + + implicit none + private + + public :: shr_kind_r8 + public :: shr_kind_cl + + integer, parameter :: shr_kind_cl = 256 + +end module shr_kind_mod diff --git a/test/unit/fortran/src/aerosol/test_bulk_aerosol_properties.pf b/test/unit/fortran/src/aerosol/test_bulk_aerosol_properties.pf new file mode 100644 index 000000000..38af7f98e --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_bulk_aerosol_properties.pf @@ -0,0 +1,179 @@ +!----------------------------------------------------------------------- +! pFUnit tests for bulk_aerosol_properties_mod. +! +! Tests the bulk aerosol properties type, which extends abstract +! aerosol_properties. The radiative_aerosol module is mocked to +! provide configurable in-memory data (no file I/O). +! +! Mock boundary: radiative_aerosol (rad_aer_get_info, rad_aer_get_props) +!----------------------------------------------------------------------- + +@test +subroutine test_constructor_nbins() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use radiative_aerosol, only: setup_mock_rad_aer, cleanup_mock_rad_aer + + type(bulk_aerosol_properties), pointer :: props + + ! Set up 3 mock aerosols + call setup_mock_rad_aer( & + naero = 3, & + density = [1000._r8, 1700._r8, 2600._r8], & + hygro = [0.1_r8, 0.5_r8, 0.0_r8], & + dispersion = [2.0_r8, 1.6_r8, 1.8_r8], & + aername = [character(len=20) :: 'dust1', 'sulfate', 'bcphi'], & + opticstype = [character(len=32) :: 'nonhygro', 'hygro', 'nonhygro'] ) + + props => bulk_aerosol_properties() + + @assertTrue(associated(props)) + @assertEqual(3, props%nbins()) + ! Bulk: 1 species per bin + @assertEqual(1, props%nspecies(1)) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_constructor_nbins + +@test +subroutine test_get_density() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use radiative_aerosol, only: setup_mock_rad_aer, cleanup_mock_rad_aer + + type(bulk_aerosol_properties), pointer :: props + real(r8) :: dens + + call setup_mock_rad_aer( & + naero = 2, & + density = [1000._r8, 1700._r8], & + hygro = [0.1_r8, 0.5_r8], & + dispersion = [2.0_r8, 1.6_r8], & + aername = [character(len=20) :: 'dust1', 'sulfate'], & + opticstype = [character(len=32) :: 'nonhygro', 'hygro'] ) + + props => bulk_aerosol_properties() + + call props%get(bin_ndx=1, species_ndx=1, density=dens) + @assertEqual(1000._r8, dens, 1.0e-14_r8) + + call props%get(bin_ndx=2, species_ndx=1, density=dens) + @assertEqual(1700._r8, dens, 1.0e-14_r8) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_get_density + +@test +subroutine test_get_hygro() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use radiative_aerosol, only: setup_mock_rad_aer, cleanup_mock_rad_aer + + type(bulk_aerosol_properties), pointer :: props + real(r8) :: hygro + + call setup_mock_rad_aer( & + naero = 1, & + density = [1700._r8], & + hygro = [0.65_r8], & + dispersion = [1.6_r8], & + aername = [character(len=20) :: 'sulfate'], & + opticstype = [character(len=32) :: 'hygro'] ) + + props => bulk_aerosol_properties() + + call props%get(bin_ndx=1, species_ndx=1, hygro=hygro) + @assertEqual(0.65_r8, hygro, 1.0e-14_r8) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_get_hygro + +@test +subroutine test_species_type_dust() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use radiative_aerosol, only: setup_mock_rad_aer, cleanup_mock_rad_aer + + type(bulk_aerosol_properties), pointer :: props + character(len=32) :: spectype + + ! spectype is determined by aername(:4) 'dust' -> 'dust' + call setup_mock_rad_aer( & + naero = 1, & + density = [2600._r8], & + hygro = [0.0_r8], & + dispersion = [2.0_r8], & + aername = [character(len=20) :: 'dust1'], & + opticstype = [character(len=32) :: 'nonhygro'] ) + + props => bulk_aerosol_properties() + + call props%get(bin_ndx=1, species_ndx=1, spectype=spectype) + @assertEqual('dust', trim(spectype)) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_species_type_dust + +@test +subroutine test_species_type_sulfate() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use radiative_aerosol, only: setup_mock_rad_aer, cleanup_mock_rad_aer + + type(bulk_aerosol_properties), pointer :: props + character(len=32) :: spectype + + ! spectype is determined by aername(:4) 'sulf' -> 'sulfate' + call setup_mock_rad_aer( & + naero = 1, & + density = [1700._r8], & + hygro = [0.5_r8], & + dispersion = [1.6_r8], & + aername = [character(len=20) :: 'sulfate'], & + opticstype = [character(len=32) :: 'hygro'] ) + + props => bulk_aerosol_properties() + + call props%get(bin_ndx=1, species_ndx=1, spectype=spectype) + @assertEqual('sulfate', trim(spectype)) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_species_type_sulfate + +@test +subroutine test_model_is() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use radiative_aerosol, only: setup_mock_rad_aer, cleanup_mock_rad_aer + + type(bulk_aerosol_properties), pointer :: props + + call setup_mock_rad_aer( & + naero = 1, & + density = [1000._r8], & + hygro = [0.0_r8], & + dispersion = [2.0_r8], & + aername = [character(len=20) :: 'dust1'], & + opticstype = [character(len=32) :: 'nonhygro'] ) + + props => bulk_aerosol_properties() + + @assertTrue(props%model_is('BAM')) + @assertTrue(props%model_is('bam')) + @assertTrue(props%model_is('bulk_model')) + @assertFalse(props%model_is('MAM')) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_model_is diff --git a/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf b/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf new file mode 100644 index 000000000..895b8640b --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf @@ -0,0 +1,162 @@ +!----------------------------------------------------------------------- +! pFUnit tests for bulk_aerosol_state_mod. +! +! Tests the bulk aerosol state type, which extends abstract aerosol_state. +! Uses real bulk_aerosol_properties (via mock radiative_aerosol) to test +! the interaction between properties and state: +! mocking is done at the external dependency boundary (to avoid PIO at +! phys_prop) +! +! Mock boundaries: +! - radiative_aerosol (rad_aer_get_info, rad_aer_get_props) for properties +! - aerosol_mmr_host (rad_cnst_get_aer_mmr) for state MMR retrieval +!----------------------------------------------------------------------- + +@test +subroutine test_constructor() + use funit + use ccpp_kinds, only: kind_phys + use bulk_aerosol_state_mod, only: bulk_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + + type(bulk_aerosol_state), pointer :: state + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + + allocate(constituents(2, 3, 1)) + constituents = 1.0e-6_kind_phys + cptr => constituents + + state => bulk_aerosol_state(2, aero_host_binding(cptr)) + + @assertTrue(associated(state)) + + deallocate(state) + deallocate(constituents) +end subroutine test_constructor + +@test +subroutine test_get_ambient_mmr() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + use bulk_aerosol_state_mod, only: bulk_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + + type(bulk_aerosol_state), pointer :: state + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + real(r8), pointer :: mmr(:,:) + integer, parameter :: ncol = 2, nlev = 3, naero = 2 + + allocate(constituents(ncol, nlev, naero)) + constituents(:, :, 1) = 1.0e-6_kind_phys ! dust + constituents(:, :, 2) = 2.0e-6_kind_phys ! sulfate + cptr => constituents + + state => bulk_aerosol_state(ncol, aero_host_binding(cptr)) + + ! Get MMR for aerosol 1 (dust) + call state%get_ambient_mmr(species_ndx=1, bin_ndx=1, mmr=mmr) + @assertTrue(associated(mmr)) + @assertEqual(1.0e-6_r8, mmr(1, 1), 1.0e-20_r8) + + ! Get MMR for aerosol 2 (sulfate) + call state%get_ambient_mmr(species_ndx=1, bin_ndx=2, mmr=mmr) + @assertEqual(2.0e-6_r8, mmr(1, 1), 1.0e-20_r8) + + deallocate(state) + deallocate(constituents) +end subroutine test_get_ambient_mmr + +@test +subroutine test_dry_volume() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + use bulk_aerosol_state_mod, only: bulk_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use radiative_aerosol, only: setup_mock_rad_aer, cleanup_mock_rad_aer + + type(bulk_aerosol_state), pointer :: state + type(bulk_aerosol_properties), pointer :: props + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + real(r8) :: vol(1, 1) + integer, parameter :: ncol = 1, nlev = 1, naero = 1 + + ! Set up mock aerosol: density = 2000 kg/m3 + call setup_mock_rad_aer( & + naero = naero, & + density = [2000._r8], & + hygro = [0.0_r8], & + dispersion = [2.0_r8], & + aername = [character(len=20) :: 'dust1'], & + opticstype = [character(len=32) :: 'nonhygro'] ) + + props => bulk_aerosol_properties() + + ! Constituents: MMR = 1.0e-6 kg/kg + allocate(constituents(ncol, nlev, naero)) + constituents(:, :, 1) = 1.0e-6_kind_phys + cptr => constituents + + state => bulk_aerosol_state(ncol, aero_host_binding(cptr)) + + ! dry_volume = mmr / density = 1e-6 / 2000 = 5e-10 m3/kg + vol = state%dry_volume(props, bin_idx=1, ncol=ncol, nlev=nlev) + @assertEqual(5.0e-10_r8, vol(1,1), 1.0e-24_r8) + + deallocate(state) + deallocate(props) + deallocate(constituents) + call cleanup_mock_rad_aer() +end subroutine test_dry_volume + +@test +subroutine test_ambient_total_bin_mmr() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + use bulk_aerosol_state_mod, only: bulk_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use radiative_aerosol, only: setup_mock_rad_aer, cleanup_mock_rad_aer + + type(bulk_aerosol_state), pointer :: state + type(bulk_aerosol_properties), pointer :: props + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + real(r8) :: mmr_tot + integer, parameter :: ncol = 2, nlev = 3, naero = 2 + + call setup_mock_rad_aer( & + naero = naero, & + density = [1000._r8, 1700._r8], & + hygro = [0.0_r8, 0.5_r8], & + dispersion = [2.0_r8, 1.6_r8], & + aername = [character(len=20) :: 'dust1', 'sulfate'], & + opticstype = [character(len=32) :: 'nonhygro', 'hygro'] ) + + props => bulk_aerosol_properties() + + allocate(constituents(ncol, nlev, naero)) + constituents(:, :, 1) = 3.0e-6_kind_phys + constituents(:, :, 2) = 7.0e-6_kind_phys + cptr => constituents + + state => bulk_aerosol_state(ncol, aero_host_binding(cptr)) + + ! For bulk aerosols, each bin has 1 species, so total = that species + mmr_tot = state%ambient_total_bin_mmr(props, bin_ndx=1, col_ndx=1, lyr_ndx=1) + @assertEqual(3.0e-6_r8, mmr_tot, 1.0e-20_r8) + + mmr_tot = state%ambient_total_bin_mmr(props, bin_ndx=2, col_ndx=1, lyr_ndx=1) + @assertEqual(7.0e-6_r8, mmr_tot, 1.0e-20_r8) + + deallocate(state) + deallocate(props) + deallocate(constituents) + call cleanup_mock_rad_aer() +end subroutine test_ambient_total_bin_mmr diff --git a/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf b/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf new file mode 100644 index 000000000..c5cb5f9c2 --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf @@ -0,0 +1,160 @@ +!----------------------------------------------------------------------- +! pFUnit tests for insoluble_aerosol_optics_mod. +! +! Tests the insoluble (non-hygroscopic) aerosol optics, which is the +! simplest optics type (no RH dependence). Uses real bulk_aerosol_properties +! and bulk_aerosol_state with mock radiative_aerosol providing canned +! optics tables. +! +! The insoluble optics computes: +! sw_props: pext = ext(iwav) * mmr, palb = ssa(iwav), pasm = asm(iwav) +! pabs = pext * (1 - palb) +! lw_props: pabs = abs(iwav) * mmr +!----------------------------------------------------------------------- + +@test +subroutine test_sw_props() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + use insoluble_aerosol_optics_mod, only: insoluble_aerosol_optics + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use bulk_aerosol_state_mod, only: bulk_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + use aerosol_optics_mod, only: aerosol_optics + use radiative_aerosol, only: setup_mock_rad_aer, setup_mock_optics_tables, cleanup_mock_rad_aer + use phys_prop, only: setup_mock_physprop_optics, cleanup_mock_physprop + + type(bulk_aerosol_properties), pointer :: props + type(bulk_aerosol_state), pointer :: state + class(aerosol_optics), pointer :: optics + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + real(r8) :: pext(1), pabs(1), palb(1), pasm(1) + + integer, parameter :: ncol = 1, nlev = 1, naero = 1 + integer, parameter :: nswbands = 2, nlwbands = 1 + + real(r8) :: sw_ext(nswbands, naero), sw_ssa(nswbands, naero), sw_asm(nswbands, naero) + real(r8) :: lw_abs(nlwbands, naero) + + ! Set up mock aerosol + call setup_mock_rad_aer( & + naero = naero, & + density = [2600._r8], & + hygro = [0.0_r8], & + dispersion = [2.0_r8], & + aername = [character(len=20) :: 'dust1'], & + opticstype = [character(len=32) :: 'nonhygro'] ) + + ! Set up mock optics tables + sw_ext(:, 1) = [100._r8, 200._r8] ! extinction at 2 SW bands + sw_ssa(:, 1) = [0.9_r8, 0.8_r8] ! single-scatter albedo + sw_asm(:, 1) = [0.7_r8, 0.6_r8] ! asymmetry + lw_abs(:, 1) = [50._r8] ! LW absorption + call setup_mock_optics_tables(nswbands, nlwbands, & + sw_ext=sw_ext, sw_ssa=sw_ssa, sw_asm=sw_asm, lw_abs=lw_abs) + call setup_mock_physprop_optics(nswbands, nlwbands, naero, & + sw_ext=sw_ext, sw_ssa=sw_ssa, sw_asm=sw_asm, lw_abs=lw_abs) + + ! Create properties and state + props => bulk_aerosol_properties() + + allocate(constituents(ncol, nlev, naero)) + constituents(:, :, 1) = 1.0e-6_kind_phys ! MMR = 1e-6 kg/kg + cptr => constituents + state => bulk_aerosol_state(ncol, aero_host_binding(cptr)) + + ! Create insoluble optics object + optics => insoluble_aerosol_optics(props, state, ibin=1) + @assertTrue(associated(optics)) + + ! Test SW band 1: pext = 100 * 1e-6 = 1e-4 + call optics%sw_props(ncol=1, ilev=1, iwav=1, pext=pext, pabs=pabs, palb=palb, pasm=pasm) + @assertEqual(1.0e-4_r8, pext(1), 1.0e-18_r8) + @assertEqual(0.9_r8, palb(1), 1.0e-14_r8) + @assertEqual(0.7_r8, pasm(1), 1.0e-14_r8) + ! pabs = pext * (1 - palb) = 1e-4 * 0.1 = 1e-5 + @assertEqual(1.0e-5_r8, pabs(1), 1.0e-19_r8) + + ! Test SW band 2: pext = 200 * 1e-6 = 2e-4 + call optics%sw_props(ncol=1, ilev=1, iwav=2, pext=pext, pabs=pabs, palb=palb, pasm=pasm) + @assertEqual(2.0e-4_r8, pext(1), 1.0e-18_r8) + @assertEqual(0.8_r8, palb(1), 1.0e-14_r8) + @assertEqual(0.6_r8, pasm(1), 1.0e-14_r8) + + deallocate(optics) + deallocate(state) + deallocate(props) + deallocate(constituents) + call cleanup_mock_physprop() + call cleanup_mock_rad_aer() +end subroutine test_sw_props + +@test +subroutine test_lw_props() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + use insoluble_aerosol_optics_mod, only: insoluble_aerosol_optics + use bulk_aerosol_properties_mod, only: bulk_aerosol_properties + use bulk_aerosol_state_mod, only: bulk_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + use aerosol_optics_mod, only: aerosol_optics + use radiative_aerosol, only: setup_mock_rad_aer, setup_mock_optics_tables, cleanup_mock_rad_aer + use phys_prop, only: setup_mock_physprop_optics, cleanup_mock_physprop + + type(bulk_aerosol_properties), pointer :: props + type(bulk_aerosol_state), pointer :: state + class(aerosol_optics), pointer :: optics + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + real(r8) :: pabs(1) + + integer, parameter :: ncol = 1, nlev = 1, naero = 1 + integer, parameter :: nswbands = 1, nlwbands = 2 + + real(r8) :: sw_ext(nswbands, naero), sw_ssa(nswbands, naero), sw_asm(nswbands, naero) + real(r8) :: lw_abs(nlwbands, naero) + + call setup_mock_rad_aer( & + naero = naero, & + density = [2600._r8], & + hygro = [0.0_r8], & + dispersion = [2.0_r8], & + aername = [character(len=20) :: 'dust1'], & + opticstype = [character(len=32) :: 'nonhygro'] ) + + sw_ext(:, 1) = [100._r8] + sw_ssa(:, 1) = [0.9_r8] + sw_asm(:, 1) = [0.7_r8] + lw_abs(:, 1) = [30._r8, 60._r8] ! LW absorption at 2 bands + call setup_mock_optics_tables(nswbands, nlwbands, & + sw_ext=sw_ext, sw_ssa=sw_ssa, sw_asm=sw_asm, lw_abs=lw_abs) + call setup_mock_physprop_optics(nswbands, nlwbands, naero, & + sw_ext=sw_ext, sw_ssa=sw_ssa, sw_asm=sw_asm, lw_abs=lw_abs) + + props => bulk_aerosol_properties() + + allocate(constituents(ncol, nlev, naero)) + constituents(:, :, 1) = 2.0e-6_kind_phys ! MMR = 2e-6 + cptr => constituents + state => bulk_aerosol_state(ncol, aero_host_binding(cptr)) + + optics => insoluble_aerosol_optics(props, state, ibin=1) + + ! LW band 1: pabs = 30 * 2e-6 = 6e-5 + call optics%lw_props(ncol=1, ilev=1, iwav=1, pabs=pabs) + @assertEqual(6.0e-5_r8, pabs(1), 1.0e-19_r8) + + ! LW band 2: pabs = 60 * 2e-6 = 1.2e-4 + call optics%lw_props(ncol=1, ilev=1, iwav=2, pabs=pabs) + @assertEqual(1.2e-4_r8, pabs(1), 1.0e-18_r8) + + deallocate(optics) + deallocate(state) + deallocate(props) + deallocate(constituents) + call cleanup_mock_physprop() + call cleanup_mock_rad_aer() +end subroutine test_lw_props diff --git a/test/unit/fortran/src/aerosol/test_list_populate.pf b/test/unit/fortran/src/aerosol/test_list_populate.pf new file mode 100644 index 000000000..a452e15b3 --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_list_populate.pf @@ -0,0 +1,119 @@ +!----------------------------------------------------------------------- +! pFUnit tests for list_populate in radiative_aerosol_definitions. +! +! Tests population of aerosol list structures from parsed namelist data. +! list_populate takes a rad_cnst_namelist_t and fills aerlist_t (bulk), +! modelist_t (modal), and binlist_t (sectional) structures. +! +! Note: Tests here focus on bulk aerosol entries (type='A'), which do not +! require the module-level modes/bins definitions to be initialized. +! Modal/bin tests would need those set up, which is more complex. +!----------------------------------------------------------------------- + +@test +subroutine test_populate_bulk_only() + use funit + use radiative_aerosol_definitions, only: list_populate, & + rad_cnst_namelist_t, aerlist_t, modelist_t, binlist_t + + type(rad_cnst_namelist_t) :: nml_data + type(aerlist_t) :: aerlist + type(modelist_t) :: modal_list + type(binlist_t) :: sectional_list + + ! Set up parsed namelist with 2 bulk aerosols + nml_data%ncnst = 2 + allocate(nml_data%source(2), nml_data%camname(2), nml_data%radname(2), nml_data%type(2)) + nml_data%source(1) = 'A' + nml_data%camname(1) = 'dust1' + nml_data%radname(1) = '/path/to/dust.nc' + nml_data%type(1) = 'A' + nml_data%source(2) = 'A' + nml_data%camname(2) = 'sulfate' + nml_data%radname(2) = '/path/to/sulfate.nc' + nml_data%type(2) = 'A' + + aerlist%list_id = ' ' + + call list_populate(nml_data, aerlist, modal_list, sectional_list) + + @assertEqual(2, aerlist%numaerosols) + @assertEqual(0, modal_list%nmodes) + @assertEqual(0, sectional_list%nbins) + @assertEqual('dust1', trim(aerlist%aer(1)%camname)) + @assertEqual('/path/to/dust.nc', trim(aerlist%aer(1)%physprop_file)) + @assertEqual('A', aerlist%aer(1)%source) + @assertEqual('sulfate', trim(aerlist%aer(2)%camname)) + + deallocate(nml_data%source, nml_data%camname, nml_data%radname, nml_data%type) + deallocate(aerlist%aer) + deallocate(modal_list%idx, modal_list%physprop_files, modal_list%idx_props) + deallocate(sectional_list%idx, sectional_list%physprop_files, sectional_list%idx_props) +end subroutine test_populate_bulk_only + +@test +subroutine test_populate_mixed_with_gas() + use funit + use radiative_aerosol_definitions, only: list_populate, & + rad_cnst_namelist_t, aerlist_t, modelist_t, binlist_t + + type(rad_cnst_namelist_t) :: nml_data + type(aerlist_t) :: aerlist + type(modelist_t) :: modal_list + type(binlist_t) :: sectional_list + + ! Set up: 1 gas + 1 aerosol; gas entries should be skipped + nml_data%ncnst = 2 + allocate(nml_data%source(2), nml_data%camname(2), nml_data%radname(2), nml_data%type(2)) + nml_data%source(1) = 'A' + nml_data%camname(1) = 'H2O' + nml_data%radname(1) = 'H2O' + nml_data%type(1) = 'G' + nml_data%source(2) = 'A' + nml_data%camname(2) = 'dust1' + nml_data%radname(2) = '/path/dust.nc' + nml_data%type(2) = 'A' + + aerlist%list_id = ' ' + + call list_populate(nml_data, aerlist, modal_list, sectional_list) + + ! Only the aerosol should be counted; gas is skipped + @assertEqual(1, aerlist%numaerosols) + @assertEqual(0, modal_list%nmodes) + @assertEqual('dust1', trim(aerlist%aer(1)%camname)) + + deallocate(nml_data%source, nml_data%camname, nml_data%radname, nml_data%type) + deallocate(aerlist%aer) + deallocate(modal_list%idx, modal_list%physprop_files, modal_list%idx_props) + deallocate(sectional_list%idx, sectional_list%physprop_files, sectional_list%idx_props) +end subroutine test_populate_mixed_with_gas + +@test +subroutine test_populate_empty() + use funit + use radiative_aerosol_definitions, only: list_populate, & + rad_cnst_namelist_t, aerlist_t, modelist_t, binlist_t + + type(rad_cnst_namelist_t) :: nml_data + type(aerlist_t) :: aerlist + type(modelist_t) :: modal_list + type(binlist_t) :: sectional_list + + ! Empty namelist + nml_data%ncnst = 0 + allocate(nml_data%source(0), nml_data%camname(0), nml_data%radname(0), nml_data%type(0)) + + aerlist%list_id = ' ' + + call list_populate(nml_data, aerlist, modal_list, sectional_list) + + @assertEqual(0, aerlist%numaerosols) + @assertEqual(0, modal_list%nmodes) + @assertEqual(0, sectional_list%nbins) + + deallocate(nml_data%source, nml_data%camname, nml_data%radname, nml_data%type) + deallocate(aerlist%aer) + deallocate(modal_list%idx, modal_list%physprop_files, modal_list%idx_props) + deallocate(sectional_list%idx, sectional_list%physprop_files, sectional_list%idx_props) +end subroutine test_populate_empty diff --git a/test/unit/fortran/src/aerosol/test_modal_aerosol_properties.pf b/test/unit/fortran/src/aerosol/test_modal_aerosol_properties.pf new file mode 100644 index 000000000..726d0382e --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_modal_aerosol_properties.pf @@ -0,0 +1,210 @@ +!----------------------------------------------------------------------- +! pFUnit tests for modal_aerosol_properties_mod. +! +! Tests the modal aerosol properties type using a minimal 2-mode MAM config: +! Mode 1 "accum": 2 species (sulfate, black-c) +! Mode 2 "coarse": 1 species (dust) +! +! Mock boundary: radiative_aerosol (modal mock interfaces) +! Helper module: modal_test_helpers (compiled separately) +!----------------------------------------------------------------------- + +@test +subroutine test_constructor_and_sizes() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock + + type(modal_aerosol_properties), pointer :: props + + call setup_2mode_mock() + props => modal_aerosol_properties() + + @assertTrue(associated(props)) + @assertEqual(2, props%nbins()) + @assertEqual(2, props%nspecies(1)) + @assertEqual(1, props%nspecies(2)) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_constructor_and_sizes + +@test +subroutine test_model_is() + use funit + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock + + type(modal_aerosol_properties), pointer :: props + + call setup_2mode_mock() + props => modal_aerosol_properties() + + @assertTrue(props%model_is('MAM')) + @assertTrue(props%model_is('mam')) + @assertTrue(props%model_is('modal')) + @assertFalse(props%model_is('bulk')) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_model_is + +@test +subroutine test_amcube() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: pi + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock, sigmag_accum + + type(modal_aerosol_properties), pointer :: props + real(r8) :: volconc, numconc, result, expected + real(r8) :: alogsig, exp45 + + call setup_2mode_mock() + props => modal_aerosol_properties() + + ! Test amcube: R^3 = 3*V / (4*pi*exp45logsig*N) + volconc = 1.0e-15_r8 ! m3/m3 + numconc = 1.0e9_r8 ! 1/m3 + + alogsig = log(sigmag_accum) + exp45 = exp(4.5_r8 * alogsig * alogsig) + expected = 3._r8 * volconc / (4._r8 * pi * exp45 * numconc) + + result = props%amcube(1, volconc, numconc) + + @assertEqual(expected, result, abs(expected) * 1.0e-12_r8) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_amcube + +@test +subroutine test_species_type() + use funit + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock + + type(modal_aerosol_properties), pointer :: props + character(len=32) :: stype + + call setup_2mode_mock() + props => modal_aerosol_properties() + + call props%species_type(1, 1, stype) + @assertEqual('sulfate', trim(stype)) + + call props%species_type(1, 2, stype) + @assertEqual('black-c', trim(stype)) + + call props%species_type(2, 1, stype) + @assertEqual('dust', trim(stype)) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_species_type + +@test +subroutine test_soluble() + use funit + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock + + type(modal_aerosol_properties), pointer :: props + + call setup_2mode_mock() + props => modal_aerosol_properties() + + ! accum and coarse are both soluble (not 'primary_carbon') + @assertTrue(props%soluble(1)) + @assertTrue(props%soluble(2)) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_soluble + +@test +subroutine test_bin_name() + use funit + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock + + type(modal_aerosol_properties), pointer :: props + character(len=32) :: bname + + call setup_2mode_mock() + props => modal_aerosol_properties() + + bname = props%bin_name(1) + @assertEqual('accum', trim(bname)) + + bname = props%bin_name(2) + @assertEqual('coarse', trim(bname)) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_bin_name + +@test +subroutine test_num_names() + use funit + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock + + type(modal_aerosol_properties), pointer :: props + character(len=32) :: name_a, name_c + + call setup_2mode_mock() + props => modal_aerosol_properties() + + call props%num_names(1, name_a, name_c) + @assertEqual('num_a1', trim(name_a)) + @assertEqual('num_c1', trim(name_c)) + + call props%num_names(2, name_a, name_c) + @assertEqual('num_a2', trim(name_a)) + @assertEqual('num_c2', trim(name_c)) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_num_names + +@test +subroutine test_get_density_hygro() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock, dens_sulfate, hygro_sulfate, & + dens_bc, hygro_bc, dens_dust, hygro_dust + + type(modal_aerosol_properties), pointer :: props + real(r8) :: d, h + + call setup_2mode_mock() + props => modal_aerosol_properties() + + call props%get(1, 1, density=d, hygro=h) + @assertEqual(dens_sulfate, d, 1.0e-10_r8) + @assertEqual(hygro_sulfate, h, 1.0e-10_r8) + + call props%get(1, 2, density=d, hygro=h) + @assertEqual(dens_bc, d, 1.0e-10_r8) + @assertEqual(hygro_bc, h, 1.0e-10_r8) + + call props%get(2, 1, density=d, hygro=h) + @assertEqual(dens_dust, d, 1.0e-10_r8) + @assertEqual(hygro_dust, h, 1.0e-10_r8) + + deallocate(props) + call cleanup_mock_rad_aer() +end subroutine test_get_density_hygro diff --git a/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf b/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf new file mode 100644 index 000000000..3bb54ae66 --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf @@ -0,0 +1,197 @@ +!----------------------------------------------------------------------- +! pFUnit tests for modal_aerosol_state_mod. +! +! Uses the same 2-mode MAM config as modal_aerosol_properties tests: +! Mode 1 "accum": 2 species (sulfate, black-c) +! Mode 2 "coarse": 1 species (dust) +! +! Constituent flat layout (5 entries): +! Index 1: num_a1 (mode 1 number) +! Index 2: so4_a1 (mode 1 sulfate MMR) +! Index 3: bc_a1 (mode 1 black-c MMR) +! Index 4: num_a2 (mode 2 number) +! Index 5: dst_a2 (mode 2 dust MMR) +! +! Mock boundaries: +! - radiative_aerosol (modal mock interfaces) for properties +! - aerosol_mmr_host (modal overloads) for state MMR retrieval +!----------------------------------------------------------------------- + +@test +subroutine test_get_ambient_mmr() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + use modal_aerosol_state_mod, only: modal_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock + + type(modal_aerosol_state), pointer :: state + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + real(r8), pointer :: mmr(:,:) + integer, parameter :: ncol = 2, nlev = 3, ncnst = 5 + + call setup_2mode_mock() + + allocate(constituents(ncol, nlev, ncnst)) + constituents = 0._kind_phys + ! Index 2: so4_a1 (mode 1, species 1) + constituents(:, :, 2) = 1.0e-9_kind_phys + ! Index 3: bc_a1 (mode 1, species 2) + constituents(:, :, 3) = 2.0e-9_kind_phys + ! Index 5: dst_a2 (mode 2, species 1) + constituents(:, :, 5) = 5.0e-9_kind_phys + cptr => constituents + + state => modal_aerosol_state(ncol, aero_host_binding(cptr)) + + ! get_ambient_mmr(species_ndx=1, bin_ndx=1) -> so4_a1 at index 2 + call state%get_ambient_mmr(species_ndx=1, bin_ndx=1, mmr=mmr) + @assertTrue(associated(mmr)) + @assertEqual(1.0e-9_r8, mmr(1, 1), 1.0e-20_r8) + + ! get_ambient_mmr(species_ndx=2, bin_ndx=1) -> bc_a1 at index 3 + call state%get_ambient_mmr(species_ndx=2, bin_ndx=1, mmr=mmr) + @assertEqual(2.0e-9_r8, mmr(1, 1), 1.0e-20_r8) + + ! get_ambient_mmr(species_ndx=1, bin_ndx=2) -> dst_a2 at index 5 + call state%get_ambient_mmr(species_ndx=1, bin_ndx=2, mmr=mmr) + @assertEqual(5.0e-9_r8, mmr(1, 1), 1.0e-20_r8) + + deallocate(state) + deallocate(constituents) + call cleanup_mock_rad_aer() +end subroutine test_get_ambient_mmr + +@test +subroutine test_get_ambient_num() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + use modal_aerosol_state_mod, only: modal_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock + + type(modal_aerosol_state), pointer :: state + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + real(r8), pointer :: num(:,:) + integer, parameter :: ncol = 2, nlev = 3, ncnst = 5 + + call setup_2mode_mock() + + allocate(constituents(ncol, nlev, ncnst)) + constituents = 0._kind_phys + ! Index 1: num_a1 (mode 1 number) + constituents(:, :, 1) = 1.0e8_kind_phys + ! Index 4: num_a2 (mode 2 number) + constituents(:, :, 4) = 5.0e6_kind_phys + cptr => constituents + + state => modal_aerosol_state(ncol, aero_host_binding(cptr)) + + ! get_ambient_num(bin_ndx=1) -> index 1 + call state%get_ambient_num(bin_ndx=1, num=num) + @assertTrue(associated(num)) + @assertEqual(1.0e8_r8, num(1, 1), 1.0e-5_r8) + + ! get_ambient_num(bin_ndx=2) -> index 4 + call state%get_ambient_num(bin_ndx=2, num=num) + @assertEqual(5.0e6_r8, num(1, 1), 1.0e-5_r8) + + deallocate(state) + deallocate(constituents) + call cleanup_mock_rad_aer() +end subroutine test_get_ambient_num + +@test +subroutine test_ambient_total_bin_mmr() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + use modal_aerosol_state_mod, only: modal_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock + + type(modal_aerosol_state), pointer :: state + type(modal_aerosol_properties), pointer :: props + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + real(r8) :: mmr_tot + integer, parameter :: ncol = 2, nlev = 3, ncnst = 5 + + call setup_2mode_mock() + + allocate(constituents(ncol, nlev, ncnst)) + constituents = 0._kind_phys + ! Mode 1: so4_a1 = 1e-9, bc_a1 = 2e-9 + constituents(:, :, 2) = 1.0e-9_kind_phys + constituents(:, :, 3) = 2.0e-9_kind_phys + cptr => constituents + + props => modal_aerosol_properties() + state => modal_aerosol_state(ncol, aero_host_binding(cptr)) + + ! Total for mode 1 at (col=1, lyr=1): so4 + bc = 3e-9 + mmr_tot = state%ambient_total_bin_mmr(props, bin_ndx=1, col_ndx=1, lyr_ndx=1) + @assertEqual(3.0e-9_r8, mmr_tot, 1.0e-20_r8) + + deallocate(state) + deallocate(props) + deallocate(constituents) + call cleanup_mock_rad_aer() +end subroutine test_ambient_total_bin_mmr + +@test +subroutine test_dry_volume() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + use modal_aerosol_state_mod, only: modal_aerosol_state + use aerosol_mmr_host, only: aero_host_binding + use modal_aerosol_properties_mod, only: modal_aerosol_properties + use radiative_aerosol, only: cleanup_mock_rad_aer + use modal_test_helpers, only: setup_2mode_mock, dens_sulfate, dens_bc + + type(modal_aerosol_state), pointer :: state + type(modal_aerosol_properties), pointer :: props + real(kind_phys), allocatable, target :: constituents(:,:,:) + real(kind_phys), pointer :: cptr(:,:,:) + real(r8), allocatable :: vol(:,:) + real(r8) :: expected + real(r8) :: mmr_so4, mmr_bc + integer, parameter :: ncol = 2, nlev = 3, ncnst = 5 + + call setup_2mode_mock() + + mmr_so4 = 1.0e-9_r8 + mmr_bc = 2.0e-9_r8 + + allocate(constituents(ncol, nlev, ncnst)) + constituents = 0._kind_phys + constituents(:, :, 2) = real(mmr_so4, kind_phys) + constituents(:, :, 3) = real(mmr_bc, kind_phys) + cptr => constituents + + props => modal_aerosol_properties() + state => modal_aerosol_state(ncol, aero_host_binding(cptr)) + + ! dry_volume for mode 1 = sum(mmr_i / density_i) + expected = mmr_so4 / dens_sulfate + mmr_bc / dens_bc + + allocate(vol(ncol, nlev)) + vol = state%dry_volume(props, bin_idx=1, ncol=ncol, nlev=nlev) + + @assertEqual(expected, vol(1, 1), abs(expected) * 1.0e-12_r8) + + deallocate(vol) + deallocate(state) + deallocate(props) + deallocate(constituents) + call cleanup_mock_rad_aer() +end subroutine test_dry_volume diff --git a/test/unit/fortran/src/aerosol/test_parse_rad_specifier.pf b/test/unit/fortran/src/aerosol/test_parse_rad_specifier.pf new file mode 100644 index 000000000..43b3ea53d --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_parse_rad_specifier.pf @@ -0,0 +1,141 @@ +!----------------------------------------------------------------------- +! pFUnit tests for parse_rad_specifier in radiative_aerosol_definitions. +! +! Tests parsing of radiation namelist specifier strings into the +! rad_cnst_namelist_t structure. The specifier format is: +! "source:camname:radname" +! where source is A (advected), N (non-advected), M (mode), B (bin), Z (zero). +! Type is determined by source and radname extension: +! 'M' if source='M', 'B' if source='B', 'A' if radname has .nc, else 'G' +!----------------------------------------------------------------------- + +@test +subroutine test_parse_bulk_aerosol() + use funit + use radiative_aerosol_definitions, only: parse_rad_specifier, rad_cnst_namelist_t, n_rad_cnst + + type(rad_cnst_namelist_t) :: nml_data + character(len=256) :: specifier(n_rad_cnst) + + specifier = '' + specifier(1) = 'A:dust1:/path/to/dust.nc' + + call parse_rad_specifier(specifier, nml_data) + + @assertEqual(1, nml_data%ncnst) + @assertEqual('A', nml_data%source(1)) + @assertEqual('dust1', trim(nml_data%camname(1))) + @assertEqual('/path/to/dust.nc', trim(nml_data%radname(1))) + @assertEqual('A', nml_data%type(1)) + + deallocate(nml_data%source, nml_data%camname, nml_data%radname, nml_data%type) +end subroutine test_parse_bulk_aerosol + +@test +subroutine test_parse_mode() + use funit + use radiative_aerosol_definitions, only: parse_rad_specifier, rad_cnst_namelist_t, n_rad_cnst + + type(rad_cnst_namelist_t) :: nml_data + character(len=256) :: specifier(n_rad_cnst) + + specifier = '' + specifier(1) = 'M:accum:accum_mode' + + call parse_rad_specifier(specifier, nml_data) + + @assertEqual(1, nml_data%ncnst) + @assertEqual('M', nml_data%source(1)) + @assertEqual('accum', trim(nml_data%camname(1))) + @assertEqual('accum_mode', trim(nml_data%radname(1))) + @assertEqual('M', nml_data%type(1)) + + deallocate(nml_data%source, nml_data%camname, nml_data%radname, nml_data%type) +end subroutine test_parse_mode + +@test +subroutine test_parse_bin() + use funit + use radiative_aerosol_definitions, only: parse_rad_specifier, rad_cnst_namelist_t, n_rad_cnst + + type(rad_cnst_namelist_t) :: nml_data + character(len=256) :: specifier(n_rad_cnst) + + specifier = '' + specifier(1) = 'B:bin1:bin1_mode' + + call parse_rad_specifier(specifier, nml_data) + + @assertEqual(1, nml_data%ncnst) + @assertEqual('B', nml_data%source(1)) + @assertEqual('bin1', trim(nml_data%camname(1))) + @assertEqual('bin1_mode', trim(nml_data%radname(1))) + @assertEqual('B', nml_data%type(1)) + + deallocate(nml_data%source, nml_data%camname, nml_data%radname, nml_data%type) +end subroutine test_parse_bin + +@test +subroutine test_parse_multiple() + use funit + use radiative_aerosol_definitions, only: parse_rad_specifier, rad_cnst_namelist_t, n_rad_cnst + + type(rad_cnst_namelist_t) :: nml_data + character(len=256) :: specifier(n_rad_cnst) + + specifier = '' + ! note: even though gases are not parsed in radiative_aerosol in CAM-SIMA + ! 'G' type could be recognized so the namelist entries are skipped + ! (see radiative_aerosol_definitions.F90::list_populate) + ! + ! when CAM is retired we can remove the 'G' parsing logic. + specifier(1) = 'A:H2O:H2O' + specifier(2) = 'A:dust1:/path/dust.nc' + specifier(3) = 'M:accum:accum_mode' + + call parse_rad_specifier(specifier, nml_data) + + @assertEqual(3, nml_data%ncnst) + @assertEqual('G', nml_data%type(1)) + @assertEqual('A', nml_data%type(2)) + @assertEqual('M', nml_data%type(3)) + + deallocate(nml_data%source, nml_data%camname, nml_data%radname, nml_data%type) +end subroutine test_parse_multiple + +@test +subroutine test_parse_empty() + use funit + use radiative_aerosol_definitions, only: parse_rad_specifier, rad_cnst_namelist_t, n_rad_cnst + + type(rad_cnst_namelist_t) :: nml_data + character(len=256) :: specifier(n_rad_cnst) + + specifier = '' + + call parse_rad_specifier(specifier, nml_data) + + @assertEqual(0, nml_data%ncnst) +end subroutine test_parse_empty + +@test +subroutine test_parse_strips_spaces() + use funit + use radiative_aerosol_definitions, only: parse_rad_specifier, rad_cnst_namelist_t, n_rad_cnst + + type(rad_cnst_namelist_t) :: nml_data + character(len=256) :: specifier(n_rad_cnst) + + specifier = '' + specifier(1) = 'A : dust1 : /path/to/dust.nc' + + call parse_rad_specifier(specifier, nml_data) + + @assertEqual(1, nml_data%ncnst) + @assertEqual('A', nml_data%source(1)) + @assertEqual('dust1', trim(nml_data%camname(1))) + @assertEqual('/path/to/dust.nc', trim(nml_data%radname(1))) + @assertEqual('A', nml_data%type(1)) + + deallocate(nml_data%source, nml_data%camname, nml_data%radname, nml_data%type) +end subroutine test_parse_strips_spaces diff --git a/test/unit/fortran/src/aerosol/test_table_interp.pf b/test/unit/fortran/src/aerosol/test_table_interp.pf new file mode 100644 index 000000000..b849b15b7 --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_table_interp.pf @@ -0,0 +1,236 @@ +!----------------------------------------------------------------------- +! pFUnit tests for table_interp_mod +! +! Tests the pure interpolation functions: table_interp_calcwghts, +! interp1d (via table_interp), interp2d, and interp4d. +!----------------------------------------------------------------------- + +@test +subroutine test_calcwghts_midpoint() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use table_interp_mod, only: table_interp_calcwghts, table_interp_wghts + + ! Grid: [0.0, 1.0, 2.0], column value at 0.5 (midpoint of first interval) + integer, parameter :: ngrid = 3, ncols = 1 + real(r8) :: xgrid(ngrid), xcols(ncols) + type(table_interp_wghts) :: wghts(ncols) + + xgrid = [0.0_r8, 1.0_r8, 2.0_r8] + xcols = [0.5_r8] + + wghts = table_interp_calcwghts(ngrid, xgrid, ncols, xcols) + + @assertEqual(1, wghts(1)%ix1) + @assertEqual(2, wghts(1)%ix2) + @assertEqual(0.5_r8, wghts(1)%wt1, 1.0e-14_r8) + @assertEqual(0.5_r8, wghts(1)%wt2, 1.0e-14_r8) +end subroutine test_calcwghts_midpoint + +@test +subroutine test_calcwghts_at_node() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use table_interp_mod, only: table_interp_calcwghts, table_interp_wghts + + ! Grid: [0.0, 1.0, 2.0], column value exactly at node 1.0 + integer, parameter :: ngrid = 3, ncols = 1 + real(r8) :: xgrid(ngrid), xcols(ncols) + type(table_interp_wghts) :: wghts(ncols) + + xgrid = [0.0_r8, 1.0_r8, 2.0_r8] + xcols = [1.0_r8] + + wghts = table_interp_calcwghts(ngrid, xgrid, ncols, xcols) + + ! At node 1.0: ix2=2 (the node), wt1=0.0 (weight on left), wt2=1.0 (weight on right=node) + @assertEqual(1, wghts(1)%ix1) + @assertEqual(2, wghts(1)%ix2) + @assertEqual(0.0_r8, wghts(1)%wt1, 1.0e-14_r8) + @assertEqual(1.0_r8, wghts(1)%wt2, 1.0e-14_r8) +end subroutine test_calcwghts_at_node + +@test +subroutine test_calcwghts_clamped_below() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use table_interp_mod, only: table_interp_calcwghts, table_interp_wghts + + ! Grid: [1.0, 2.0, 3.0], column value -1.0 (below grid range) + integer, parameter :: ngrid = 3, ncols = 1 + real(r8) :: xgrid(ngrid), xcols(ncols) + type(table_interp_wghts) :: wghts(ncols) + + xgrid = [1.0_r8, 2.0_r8, 3.0_r8] + xcols = [-1.0_r8] + + wghts = table_interp_calcwghts(ngrid, xgrid, ncols, xcols) + + ! Should be clamped to first node: ix1=1, ix2=2, wt2=0 (all weight on left edge) + @assertEqual(1, wghts(1)%ix1) + @assertEqual(2, wghts(1)%ix2) + @assertEqual(1.0_r8, wghts(1)%wt1, 1.0e-14_r8) + @assertEqual(0.0_r8, wghts(1)%wt2, 1.0e-14_r8) +end subroutine test_calcwghts_clamped_below + +@test +subroutine test_calcwghts_clamped_above() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use table_interp_mod, only: table_interp_calcwghts, table_interp_wghts + + ! Grid: [1.0, 2.0, 3.0], column value 99.0 (above grid range) + integer, parameter :: ngrid = 3, ncols = 1 + real(r8) :: xgrid(ngrid), xcols(ncols) + type(table_interp_wghts) :: wghts(ncols) + + xgrid = [1.0_r8, 2.0_r8, 3.0_r8] + xcols = [99.0_r8] + + wghts = table_interp_calcwghts(ngrid, xgrid, ncols, xcols) + + ! Should be clamped to last node: ix1=2, ix2=3, wt1=0, wt2=1 (all weight on right edge) + @assertEqual(2, wghts(1)%ix1) + @assertEqual(3, wghts(1)%ix2) + @assertEqual(0.0_r8, wghts(1)%wt1, 1.0e-14_r8) + @assertEqual(1.0_r8, wghts(1)%wt2, 1.0e-14_r8) +end subroutine test_calcwghts_clamped_above + +@test +subroutine test_interp1d_midpoint() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use table_interp_mod, only: table_interp, table_interp_calcwghts, table_interp_wghts + + ! Table: [10.0, 20.0, 30.0], interpolate at midpoint of interval [10, 20] -> expect 15 + integer, parameter :: nxs = 3, ncol = 1 + real(r8) :: xgrid(nxs), xcols(ncol), tbl(nxs), res(ncol) + type(table_interp_wghts) :: wghts(ncol) + + xgrid = [0.0_r8, 1.0_r8, 2.0_r8] + xcols = [0.5_r8] + tbl = [10.0_r8, 20.0_r8, 30.0_r8] + + wghts = table_interp_calcwghts(nxs, xgrid, ncol, xcols) + res = table_interp(ncol, nxs, wghts, tbl) + + @assertEqual(15.0_r8, res(1), 1.0e-14_r8) +end subroutine test_interp1d_midpoint + +@test +subroutine test_interp1d_at_node() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use table_interp_mod, only: table_interp, table_interp_calcwghts, table_interp_wghts + + ! Table: [10.0, 20.0, 30.0], interpolate exactly at second node -> expect 20 + integer, parameter :: nxs = 3, ncol = 1 + real(r8) :: xgrid(nxs), xcols(ncol), tbl(nxs), res(ncol) + type(table_interp_wghts) :: wghts(ncol) + + xgrid = [0.0_r8, 1.0_r8, 2.0_r8] + xcols = [1.0_r8] + tbl = [10.0_r8, 20.0_r8, 30.0_r8] + + wghts = table_interp_calcwghts(nxs, xgrid, ncol, xcols) + res = table_interp(ncol, nxs, wghts, tbl) + + @assertEqual(20.0_r8, res(1), 1.0e-14_r8) +end subroutine test_interp1d_at_node + +@test +subroutine test_interp2d_bilinear() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use table_interp_mod, only: table_interp, table_interp_calcwghts, table_interp_wghts + + ! 2D table (ncoef=1, nx=2, ny=2), bilinear interpolation at center + ! tbl(1, 1:2, 1:2) = [[1, 3], [2, 4]] + ! At center (0.5, 0.5): result = 0.25*(1+2+3+4) = 2.5 + integer, parameter :: ncoef = 1, ncol = 1, nxs = 2, nys = 2 + real(r8) :: xgrid(nxs), ygrid(nys), xcols(ncol), ycols(ncol) + real(r8) :: tbl(ncoef, nxs, nys), res(ncoef, ncol) + type(table_interp_wghts) :: xwghts(ncol), ywghts(ncol) + + xgrid = [0.0_r8, 1.0_r8] + ygrid = [0.0_r8, 1.0_r8] + xcols = [0.5_r8] + ycols = [0.5_r8] + + tbl(1, 1, 1) = 1.0_r8 ! x=0, y=0 + tbl(1, 2, 1) = 2.0_r8 ! x=1, y=0 + tbl(1, 1, 2) = 3.0_r8 ! x=0, y=1 + tbl(1, 2, 2) = 4.0_r8 ! x=1, y=1 + + xwghts = table_interp_calcwghts(nxs, xgrid, ncol, xcols) + ywghts = table_interp_calcwghts(nys, ygrid, ncol, ycols) + + res = table_interp(ncoef, ncol, nxs, nys, xwghts, ywghts, tbl) + + @assertEqual(2.5_r8, res(1, 1), 1.0e-14_r8) +end subroutine test_interp2d_bilinear + +@test +subroutine test_interp4d_corner() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use table_interp_mod, only: table_interp, table_interp_calcwghts, table_interp_wghts + + ! 4D table (2x2x2x2), interpolate at exact corner (0,0,0,0) + ! All table values = 0 except tbl(1,1,1,1) = 42.0 + ! At corner (0,0,0,0) with all wt2=1 on ix2=2 at node 0.0: + ! Actually, weights at node 0.0: ix1=1, ix2=2, wt1=0, wt2=1 -> picks tbl(ix2,...) + ! Let's use a different approach: set all entries, interpolate at center + ! Simpler: just set tbl to known value at the lower-left corner + integer, parameter :: ncol = 1, nxs = 2, nys = 2, nzs = 2, nts = 2 + real(r8) :: xgrid(nxs), ygrid(nys), zgrid(nzs), tgrid(nts) + real(r8) :: xcols(ncol), ycols(ncol), zcols(ncol), tcols(ncol) + real(r8) :: tbl(nxs, nys, nzs, nts), res(ncol) + type(table_interp_wghts) :: xw(ncol), yw(ncol), zw(ncol), tw(ncol) + + xgrid = [0.0_r8, 1.0_r8] + ygrid = [0.0_r8, 1.0_r8] + zgrid = [0.0_r8, 1.0_r8] + tgrid = [0.0_r8, 1.0_r8] + + ! Interpolate at (0.5, 0.5, 0.5, 0.5): center of 4D hypercube + ! Set all 16 corner values to same value -> result must equal that value + xcols = [0.5_r8] + ycols = [0.5_r8] + zcols = [0.5_r8] + tcols = [0.5_r8] + + tbl = 7.0_r8 ! All corners = 7.0 + + xw = table_interp_calcwghts(nxs, xgrid, ncol, xcols) + yw = table_interp_calcwghts(nys, ygrid, ncol, ycols) + zw = table_interp_calcwghts(nzs, zgrid, ncol, zcols) + tw = table_interp_calcwghts(nts, tgrid, ncol, tcols) + + res = table_interp(ncol, nxs, nys, nzs, nts, xw, yw, zw, tw, tbl) + + @assertEqual(7.0_r8, res(1), 1.0e-14_r8) +end subroutine test_interp4d_corner + +@test +subroutine test_interp1d_multiple_columns() + use funit + use shr_kind_mod, only: r8 => shr_kind_r8 + use table_interp_mod, only: table_interp, table_interp_calcwghts, table_interp_wghts + + ! Test with multiple columns simultaneously + integer, parameter :: nxs = 3, ncol = 3 + real(r8) :: xgrid(nxs), xcols(ncol), tbl(nxs), res(ncol) + type(table_interp_wghts) :: wghts(ncol) + + xgrid = [0.0_r8, 1.0_r8, 2.0_r8] + xcols = [0.0_r8, 1.0_r8, 1.5_r8] ! at left edge, at middle node, at 3/4 point + tbl = [10.0_r8, 20.0_r8, 30.0_r8] + + wghts = table_interp_calcwghts(nxs, xgrid, ncol, xcols) + res = table_interp(ncol, nxs, wghts, tbl) + + @assertEqual(10.0_r8, res(1), 1.0e-14_r8) + @assertEqual(20.0_r8, res(2), 1.0e-14_r8) + @assertEqual(25.0_r8, res(3), 1.0e-14_r8) +end subroutine test_interp1d_multiple_columns