From d80792bc646801f67d04efb93c593ced2ff48d19 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 12 Mar 2026 23:33:51 -0400 Subject: [PATCH 01/46] Base (move iswbands/ilwbands to radiation_namelist); fix solar_parms_data; add src/aerosol to dir --- cime_config/buildlib | 1 + cime_config/namelist_definition_cam.xml | 189 ++++++++++++++++++++++++ src/physics/utils/solar_parms_data.F90 | 4 +- 3 files changed, 192 insertions(+), 2 deletions(-) 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..664245b21 100644 --- a/cime_config/namelist_definition_cam.xml +++ b/cime_config/namelist_definition_cam.xml @@ -403,6 +403,195 @@ + + + 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 + + + + + + char*256 + radiation + aerosol_optics_nl + none + + Full pathname of dataset for water refractive indices used in modal aerosol optics. + + + ${DIN_LOC_ROOT}/atm/cam/physprops/water_refindex_rrtmg_c080910.nc + + + diff --git a/src/physics/utils/solar_parms_data.F90 b/src/physics/utils/solar_parms_data.F90 index 75de80ae3..218d15f74 100644 --- a/src/physics/utils/solar_parms_data.F90 +++ b/src/physics/utils/solar_parms_data.F90 @@ -1,4 +1,4 @@ -!------------------------------------------------------------------------------- +src/physics/utils/radiation_namelist.meta!------------------------------------------------------------------------------- ! solar variability parameters -- space weather indices !------------------------------------------------------------------------------- module solar_parms_data @@ -87,7 +87,7 @@ subroutine solar_parms_init(filepath, fixed, fixed_ymd, fixed_tod) ! ... readin the solar parms dataset !----------------------------------------------------------------------- - call getfil(filepath, locfn, 0) + call cam_get_file(filepath, locfn) call cam_pio_openfile(ncid, locfn, PIO_NOWRITE) call time_coord_prev%initialize(filepath, fixed=fixed, & From 8774c100dc32f4b21e47b3349e0dfd681d1fd82f Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 12 Mar 2026 23:34:07 -0400 Subject: [PATCH 02/46] Add unmodified files from CAM (for diff) --- src/aerosol/aerosol_instances_mod.F90 | 344 +++++ src/aerosol/aerosol_optics_core.F90 | 405 +++++ src/aerosol/aerosol_properties_mod.F90 | 848 +++++++++++ src/aerosol/aerosol_state_mod.F90 | 954 ++++++++++++ src/aerosol/bulk_aerosol_properties_mod.F90 | 692 +++++++++ src/aerosol/bulk_aerosol_state_mod.F90 | 416 ++++++ src/aerosol/hygro_aerosol_optics_mod.F90 | 159 ++ .../hygrocoreshell_aerosol_optics_mod.F90 | 290 ++++ .../hygroscopic_aerosol_optics_mod.F90 | 164 ++ .../hygrowghtpct_aerosol_optics_mod.F90 | 186 +++ src/aerosol/insoluble_aerosol_optics_mod.F90 | 117 ++ src/aerosol/radiative_aerosol.F90 | 1326 +++++++++++++++++ src/aerosol/radiative_aerosol_definitions.F90 | 1175 +++++++++++++++ src/aerosol/refractive_aerosol_optics_mod.F90 | 382 +++++ src/aerosol/volcrad_aerosol_optics_mod.F90 | 201 +++ 15 files changed, 7659 insertions(+) create mode 100644 src/aerosol/aerosol_instances_mod.F90 create mode 100644 src/aerosol/aerosol_optics_core.F90 create mode 100644 src/aerosol/aerosol_properties_mod.F90 create mode 100644 src/aerosol/aerosol_state_mod.F90 create mode 100644 src/aerosol/bulk_aerosol_properties_mod.F90 create mode 100644 src/aerosol/bulk_aerosol_state_mod.F90 create mode 100644 src/aerosol/hygro_aerosol_optics_mod.F90 create mode 100644 src/aerosol/hygrocoreshell_aerosol_optics_mod.F90 create mode 100644 src/aerosol/hygroscopic_aerosol_optics_mod.F90 create mode 100644 src/aerosol/hygrowghtpct_aerosol_optics_mod.F90 create mode 100644 src/aerosol/insoluble_aerosol_optics_mod.F90 create mode 100644 src/aerosol/radiative_aerosol.F90 create mode 100644 src/aerosol/radiative_aerosol_definitions.F90 create mode 100644 src/aerosol/refractive_aerosol_optics_mod.F90 create mode 100644 src/aerosol/volcrad_aerosol_optics_mod.F90 diff --git a/src/aerosol/aerosol_instances_mod.F90 b/src/aerosol/aerosol_instances_mod.F90 new file mode 100644 index 000000000..f0527d6c7 --- /dev/null +++ b/src/aerosol/aerosol_instances_mod.F90 @@ -0,0 +1,344 @@ +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 (CAM host model example): + ! 1. aerosol_instances_init() -- called once during phys_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 phys_init, after + ! aerosol_instances_init(). Creates persistent aerosol_state objects + ! for each (aerosol_model, list_idx, chunk) triple. States store + ! pointers to phys_state(c) and pbuf, which persist 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, chunk). + ! 5. aerosol_instances_final() -- deallocates all objects at shutdown. + ! + ! For transient state (e.g., bound to a local copy of physics_state), + ! aerosol_instances_create_states / destroy_states provide a per-call factory, + ! but is expected to be removed in the future. + ! + ! The init, get_props, get_state, and final routines are portable. + ! The create/destroy_states factory and init_states are host-model specific + ! as they point to host-model specific data structures for aerosol state info. + + 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 :: aerosol_instances_create_states + public :: aerosol_instances_destroy_states + 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 per-chunk aerosol state objects, dimensioned (iaermod, 0:N_DIAG, begchunk:endchunk). + ! States store pointers to phys_state(c) and pbuf which persist 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, or creating states from + ! aerosol_instances_create_states, 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() + use ppgrid, only: begchunk, endchunk + integer :: iaermod, ilist, c + + ! Deallocate persistent state objects + if (allocated(aero_states_all)) then + do c = begchunk, endchunk + do ilist = 0, N_DIAG + do iaermod = 1, num_aero_models_ + if (associated(aero_states_all(iaermod, ilist, c)%obj)) then + deallocate(aero_states_all(iaermod, ilist, c)%obj) + nullify(aero_states_all(iaermod, ilist, c)%obj) + end if + end do + 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 per-chunk aerosol state objects for all active lists + ! and all active aerosol models. + ! + ! Called once at init time, after aerosol_instances_init(). + ! States store pointers to phys_state(c) and pbuf which persist for the + ! entire run. + subroutine aerosol_instances_init_states(phys_state, pbuf2d) + 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 physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk + use ppgrid, only: begchunk, endchunk + use cam_abortutils, only: endrun + + type(physics_state), intent(in), target :: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: iaermod, ilist, lchnk, istat + type(physics_buffer_desc), pointer :: pbuf(:) + character(len=*), parameter :: subname = 'aerosol_instances_init_states: ' + + if (num_aero_models_ < 1) return + + allocate(aero_states_all(num_aero_models_, 0:N_DIAG, begchunk:endchunk), stat=istat) + if (istat /= 0) then + call endrun(subname//'allocation error: aero_states_all') + end if + + do ilist = 0, N_DIAG + if (.not. active_calls(ilist)) cycle + + do lchnk = begchunk, endchunk + pbuf => pbuf_get_chunk(pbuf2d, lchnk) + + iaermod = 0 + if (modal_active_) then + iaermod = iaermod + 1 + if (associated(aero_props_all(iaermod, ilist)%obj)) then + aero_states_all(iaermod, ilist, lchnk)%obj => & + modal_aerosol_state(phys_state(lchnk), pbuf, 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, lchnk)%obj => & + carma_aerosol_state(phys_state(lchnk), pbuf, 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, lchnk)%obj => & + bulk_aerosol_state(phys_state(lchnk), pbuf, ilist) + end if + end if + end do + end do + + end subroutine aerosol_instances_init_states + + function aerosol_instances_get_state(iaermod, list_idx, lchnk) result(astate) + integer, intent(in) :: iaermod + integer, intent(in) :: list_idx + integer, intent(in) :: lchnk + class(aerosol_state), pointer :: astate + + astate => aero_states_all(iaermod, list_idx, lchnk)%obj + + end function aerosol_instances_get_state + + ! Create aerosol state objects for all active aerosol models. + ! + ! This per-call factory is still needed for cases where the state is bound + ! to a local copy of physics_state (e.g., microp_aero_run uses state1). + ! + !REMOVECAM: no longer need this factory pattern once CAM is retired as cases + ! where physics/chemistry uses state1 would be split off into separate physics + ! schemes with tendency updaters in-between. + subroutine aerosol_instances_create_states(list_idx, state, pbuf, aero_states, nstates) + 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 physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc + use cam_abortutils, only: endrun + + integer, intent(in) :: list_idx + type(physics_state), intent(in), target :: state + type(physics_buffer_desc), pointer :: pbuf(:) + type(aero_state_entry_t), intent(out), allocatable :: aero_states(:) ! aerosol state objects + integer, intent(out) :: nstates ! number of aerosol states created + + integer :: iaermod, istat + character(len=*), parameter :: subname = 'aerosol_instances_create_states: ' + + nstates = num_aero_models_ + if (nstates < 1) return + + allocate(aero_states(nstates), stat=istat) + if (istat /= 0) then + call endrun(subname//'allocation error: aero_states') + end if + + iaermod = 0 + if (modal_active_) then + iaermod = iaermod + 1 + aero_states(iaermod)%obj => modal_aerosol_state(state, pbuf, list_idx) + end if + if (carma_active_) then + iaermod = iaermod + 1 + aero_states(iaermod)%obj => carma_aerosol_state(state, pbuf, list_idx) + end if + if (bulk_active_) then + iaermod = iaermod + 1 + aero_states(iaermod)%obj => bulk_aerosol_state(state, pbuf, list_idx) + end if + + end subroutine aerosol_instances_create_states + !REMOVECAM_END + + subroutine aerosol_instances_destroy_states(aero_states) + type(aero_state_entry_t), allocatable, intent(inout) :: aero_states(:) + integer :: i + + if (.not. allocated(aero_states)) return + + do i = 1, size(aero_states) + if (associated(aero_states(i)%obj)) then + deallocate(aero_states(i)%obj) + nullify(aero_states(i)%obj) + end if + end do + + deallocate(aero_states) + + end subroutine aerosol_instances_destroy_states + +end module aerosol_instances_mod diff --git a/src/aerosol/aerosol_optics_core.F90 b/src/aerosol/aerosol_optics_core.F90 new file mode 100644 index 000000000..391dc1379 --- /dev/null +++ b/src/aerosol/aerosol_optics_core.F90 @@ -0,0 +1,405 @@ +!------------------------------------------------------------------------------- +! 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, target :: 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 + aero_optics => volcrad_aerosol_optics(aeroprops, aerostate, & + ibin, ncol, nlev, geometric_radius) + 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, target :: 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' + 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, target :: 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' + 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_properties_mod.F90 b/src/aerosol/aerosol_properties_mod.F90 new file mode 100644 index 000000000..eb1d89d6f --- /dev/null +++ b/src/aerosol/aerosol_properties_mod.F90 @@ -0,0 +1,848 @@ +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(aero_optics_params), deferred :: optics_params + 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, & + 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 + 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 optics type and table parameters + !------------------------------------------------------------------------ + subroutine aero_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 ) + + import :: aerosol_properties, r8 + + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! 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 precent of H2SO4/H2O solution + integer, optional, intent(out) :: nwtp ! number of weight precent 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(:,:) + + end subroutine aero_optics_params + + !------------------------------------------------------------------------ + ! 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, istart, istop, 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) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + 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 + allocate(self%dgnum_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%dgnumhi_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%dgnumlo_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%rhcrystal_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%rhdeliques_(nbin),stat=ierr) + if( ierr /= 0 ) then + 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(:) + else + self%dgnum_(:) = 0._r8 + end if + if (present(dgnumhi)) then + self%dgnumhi_(:) = dgnumhi(:) + else + self%dgnumhi_(:) = 0._r8 + end if + if (present(dgnumlo)) then + self%dgnumlo_(:) = dgnumlo(:) + else + self%dgnumlo_(:) = 0._r8 + end if + if (present(rhcrystal)) then + self%rhcrystal_(:) = rhcrystal(:) + else + self%rhcrystal_(:) = 0._r8 + end if + if (present(rhdeliques)) then + self%rhdeliques_(:) = rhdeliques(:) + else + self%rhdeliques_(:) = 0._r8 + 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 + + get_dgnum = self%dgnum_(bin_ndx) + 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 + + get_dgnumhi = self%dgnumhi_(bin_ndx) + 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 + + get_dgnumlo = self%dgnumlo_(bin_ndx) + 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 + + get_rhcrystal = self%rhcrystal_(bin_ndx) + 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 + + get_rhdeliques = self%rhdeliques_(bin_ndx) + 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 + +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..367aee96d --- /dev/null +++ b/src/aerosol/aerosol_state_mod.F90 @@ -0,0 +1,954 @@ +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 + contains + procedure :: list_idx => get_list_idx + procedure :: set_list_idx + 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 + 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 precent 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 precent 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 + + 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 aerosol number, volume concentrations, and bulk hygroscopicity + !------------------------------------------------------------------------------ + subroutine loadaer( self, aero_props, istart, istop, k, 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) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + integer, intent(in) :: k ! level index + 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(istart:istop) ! aerosol volume mixing ratio + integer :: i, l + !------------------------------------------------------------------------------- + errnum = 0 + + do i = istart, istop + vaerosol(i) = 0._r8 + hygro(i) = 0._r8 + end do + + 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(l,m, 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 + do i = istart, istop + vol(i) = max(raer(i,k) + qqcw(i,k), 0._r8)/specdens + end do + else if (phase == 2) then + do i = istart, istop + vol(i) = max(qqcw(i,k), 0._r8)/specdens + end do + else if (phase == 1) then + do i = istart, istop + vol(i) = max(raer(i,k), 0._r8)/specdens + end do + else + errnum = -1 + write(errstr,*)'phase = ',phase,' in aerosol_state::loadaer not recognized' + return + end if + + do i = istart, istop + vaerosol(i) = vaerosol(i) + vol(i) + hygro(i) = hygro(i) + vol(i)*spechygro + end do + + end do + + do i = istart, istop + if (vaerosol(i) > 1.0e-30_r8) then + hygro(i) = hygro(i)/(vaerosol(i)) + vaerosol(i) = vaerosol(i)*cs(i,k) + else + hygro(i) = 0.0_r8 + vaerosol(i) = 0.0_r8 + end if + end do + + ! aerosol number mixing ratios (#/kg) + call self%get_ambient_num(m, raer) + call self%get_cldbrne_num(m, qqcw) + if (phase == 3) then + do i = istart, istop + naerosol(i) = (raer(i,k) + qqcw(i,k))*cs(i,k) ! #/kg -> #/m3 + end do + else if (phase == 2) then + do i = istart, istop + naerosol(i) = qqcw(i,k)*cs(i,k) + end do + else + do i = istart, istop + naerosol(i) = raer(i,k)*cs(i,k) + end do + end if + + ! adjust number + call aero_props%apply_number_limits( naerosol, vaerosol, istart, istop, 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(ispc, bin_ndx, 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, ibin, ispc, ncol, nlev) result(frac) + + class(aerosol_state), intent(in) :: self + 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..efa6b43b0 --- /dev/null +++ b/src/aerosol/bulk_aerosol_properties_mod.F90 @@ -0,0 +1,692 @@ +!-------------------------------------------------------------------------------- +! 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, aero_name_len + + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_props + use infnan, only: 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 :: optics_params + 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, & + 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 + 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 + + end subroutine get + + !------------------------------------------------------------------------ + ! returns optics type and table parameters + !------------------------------------------------------------------------ + 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 ) + + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! 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 precent of H2SO4/H2O solution + integer, optional, intent(out) :: nwtp ! number of weight precent 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(:,:) + + ! refactive index table parameters + call rad_aer_get_props( & + list_idx=self%list_idx_, & + aer_idx=bin_ndx, & + opticstype=opticstype, & + sw_hygro_ext=sw_hygroscopic_ext, & + sw_hygro_ssa=sw_hygroscopic_ssa, & + sw_hygro_asm=sw_hygroscopic_asm, & + lw_hygro_ext=lw_hygroscopic_ext, & + sw_nonhygro_ext=sw_insoluble_ext, & + sw_nonhygro_ssa=sw_insoluble_ssa, & + sw_nonhygro_asm=sw_insoluble_asm, & + lw_ext=lw_insoluble_ext, & + 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 ) + + if (present(extpsw)) then + nullify(extpsw) + endif + + if (present(abspsw)) then + nullify(abspsw) + endif + if (present(asmpsw)) then + nullify(asmpsw) + endif + if (present(absplw)) then + nullify(absplw) + endif + if (present(refrtabsw)) then + nullify(refrtabsw) + endif + if (present(refitabsw)) then + nullify(refitabsw) + endif + if (present(refrtablw)) then + nullify(refrtablw) + endif + if (present(refitablw)) then + nullify(refitablw) + endif + if (present(ncoef)) then + ncoef = -huge(1) + endif + if (present(prefr)) then + prefr = -huge(1) + endif + if (present(prefi)) then + prefi = -huge(1) + endif + if (present(sw_hygro_ext_wtp)) then + nullify(sw_hygro_ext_wtp) + endif + if (present(sw_hygro_ssa_wtp)) then + nullify(sw_hygro_ssa_wtp) + endif + if (present(sw_hygro_asm_wtp)) then + nullify(sw_hygro_asm_wtp) + endif + if (present(lw_hygro_ext_wtp)) then + nullify(lw_hygro_ext_wtp) + endif + if (present(wgtpct)) then + nullify(wgtpct) + endif + if (present(nwtp)) then + nwtp = -huge(1) + endif + + if (present(sw_hygro_coreshell_ext)) then + nullify(sw_hygro_coreshell_ext) + endif + if (present(sw_hygro_coreshell_ssa)) then + nullify(sw_hygro_coreshell_ssa) + endif + if (present(sw_hygro_coreshell_asm)) then + nullify(sw_hygro_coreshell_asm) + endif + if (present(lw_hygro_coreshell_ext)) then + nullify(lw_hygro_coreshell_ext) + endif + if (present(corefrac)) then + nullify(corefrac) + endif + if (present(bcdust)) then + nullify(bcdust) + endif + if (present(kap)) then + nullify(kap) + endif + if (present(relh)) then + nullify(relh) + endif + + if (present(nfrac)) then + nfrac = -huge(1) + endif + if (present(nbcdust)) then + nbcdust = -huge(1) + endif + if (present(nkap)) then + nkap = -huge(1) + endif + if (present(nrelh)) then + nrelh = -huge(1) + endif + + end subroutine optics_params + + !------------------------------------------------------------------------------ + ! 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, istart, istop, 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) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + integer, intent(in) :: m ! mode or bin index + + call endrun('ERROR: bulk_aerosol_properties_mod%apply_number_limits not yet implemented') + + 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) + 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..55a5e369a --- /dev/null +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -0,0 +1,416 @@ +module bulk_aerosol_state_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + !REMOVECAM + use aerosol_mmr_cam, only: rad_cnst_get_aer_mmr + !REMOVECAM_END + use cam_abortutils, only: endrun + + !REMOVECAM: no longer need pbuf and state after CAM is retired + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + !REMOVECAM_END + + use aerosol_state_mod, only: aerosol_state, ptr2d_t + use aerosol_properties_mod, only: aerosol_properties + + implicit none + + type, extends(aerosol_state) :: bulk_aerosol_state + private + + !REMOVECAM: state and pbuf will be replaced by SIMA MMR API + type(physics_state), pointer :: state => null() + type(physics_buffer_desc), pointer :: pbuf(:) => null() + !REMOVECAM_END + + 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 + + final :: destructor + + end type bulk_aerosol_state + + interface bulk_aerosol_state + procedure :: constructor + end interface bulk_aerosol_state + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(state,pbuf,list_idx) result(newobj) + type(physics_state), target :: state + type(physics_buffer_desc), pointer :: pbuf(:) + 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%state => state + newobj%pbuf => pbuf + + if (present(list_idx)) call newobj%set_list_idx(list_idx) + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(bulk_aerosol_state), intent(inout) :: self + + nullify(self%state) + nullify(self%pbuf) + + 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%state, self%pbuf, 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) + + call endrun('ERROR: bulk_aerosol_state_mod%get_cldbrne_mmr not yet implemented') + + 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 + + nullify(num) + + call endrun('ERROR: bulk_aerosol_state_mod%get_ambient_num not yet implemented') + + 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(:,:) + + nullify(num) + + call endrun('ERROR: bulk_aerosol_state_mod%get_cldbrne_num not yet implemented') + + 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(:,:) + + call endrun('ERROR: bulk_aerosol_state_mod%icenuc_size_wght_arr not yet implemented') + + 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 + + call endrun('ERROR: bulk_aerosol_state_mod%icenuc_size_wght_val not yet implemented') + + 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 + + call endrun('ERROR: bulk_aerosol_state_mod%icenuc_type_wght not yet implemented') + + 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 + + call endrun('ERROR: bulk_aerosol_state_mod%update_bin not yet implemented') + + 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 + + vol = -huge(1._r8) + + 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 = -huge(1._r8) + + 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 = -huge(1._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, ibin, ispc, ncol, nlev) result(frac) + + class(bulk_aerosol_state), intent(in) :: self + 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 precent 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 precent of H2SO4/H2O solution for given icol, ilev + + wtp = -huge(1._r8) + + end function wgtpct + +end module bulk_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..617f0d81b --- /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 precent 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 precent 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 precent dimenstion values + + integer :: nwtp ! weight precent 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 precent 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/radiative_aerosol.F90 b/src/aerosol/radiative_aerosol.F90 new file mode 100644 index 000000000..aa233c428 --- /dev/null +++ b/src/aerosol/radiative_aerosol.F90 @@ -0,0 +1,1326 @@ +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_init (uses host-specific module aerosol_mmr_cam). +! +!------------------------------------------------------------------------------------------------ + +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 routines — aerosol queries (rad_aer_* naming) +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_bin_props +public :: rad_aer_get_idx +public :: print_aerosol_lists +public :: rad_aer_readnl +public :: rad_aer_init + +!============================================================================== +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 rad_aer_get_bin_props(list_idx, bin_idx, opticstype, & + extpsw, abspsw, asmpsw, absplw, corefrac, nfrac, & + wgtpct, nwtp, bcdust, nbcdust, kap, nkap, relh, nrelh, & + sw_hygro_ext_wtp, sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, & + sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, dryrad ) + 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 + + ! Return requested properties for the bin 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 + + 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 :: corefrac(:) + integer, optional, intent(out) :: nfrac + + 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_ext_wtp(:,:) + 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_ext(:,:,:,:,:) + real(r8), optional, pointer :: wgtpct(:) + real(r8), optional, pointer :: bcdust(:) + real(r8), optional, pointer :: kap(:) + real(r8), optional, pointer :: relh(:) + integer, optional, intent(out) :: nwtp + integer, optional, intent(out) :: nbcdust + integer, optional, intent(out) :: nkap + integer, optional, intent(out) :: nrelh + real(r8), optional, intent(out) :: dryrad + + ! Local variables + integer :: idx + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_aer_get_bin_props' + !------------------------------------------------------------------------------------ + + 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 physprop index for the requested bin + idx = slist%idx_props(bin_idx) + + if (present(opticstype)) call physprop_get(idx, opticstype=opticstype) + if (present(extpsw)) call physprop_get(idx, extpsw2=extpsw) + if (present(abspsw)) call physprop_get(idx, abspsw2=abspsw) + if (present(asmpsw)) call physprop_get(idx, asmpsw2=asmpsw) + if (present(absplw)) call physprop_get(idx, absplw2=absplw) + if (present(corefrac)) call physprop_get(idx, corefrac=corefrac) + if (present(nfrac)) call physprop_get(idx, nfrac=nfrac) + + if (present(sw_hygro_ext_wtp)) call physprop_get(idx, sw_hygro_ext_wtp=sw_hygro_ext_wtp) + if (present(sw_hygro_ssa_wtp)) call physprop_get(idx, sw_hygro_ssa_wtp=sw_hygro_ssa_wtp) + if (present(sw_hygro_asm_wtp)) call physprop_get(idx, sw_hygro_asm_wtp=sw_hygro_asm_wtp) + if (present(lw_hygro_ext_wtp)) call physprop_get(idx, lw_hygro_abs_wtp=lw_hygro_ext_wtp) + if (present(sw_hygro_coreshell_ext)) call physprop_get(idx, sw_hygro_coreshell_ext=sw_hygro_coreshell_ext) + if (present(sw_hygro_coreshell_ssa)) call physprop_get(idx, sw_hygro_coreshell_ssa=sw_hygro_coreshell_ssa) + if (present(sw_hygro_coreshell_asm)) call physprop_get(idx, sw_hygro_coreshell_asm=sw_hygro_coreshell_asm) + if (present(lw_hygro_coreshell_ext)) call physprop_get(idx, lw_hygro_coreshell_abs=lw_hygro_coreshell_ext) + if (present(wgtpct)) call physprop_get(idx, wgtpct=wgtpct) + if (present(bcdust)) call physprop_get(idx, bcdust=bcdust) + if (present(kap)) call physprop_get(idx, kap=kap) + if (present(relh)) call physprop_get(idx, relh=relh) + if (present(nwtp)) call physprop_get(idx, nwtp=nwtp) + if (present(nbcdust)) call physprop_get(idx, nbcdust=nbcdust) + if (present(nkap)) call physprop_get(idx, nkap=nkap) + if (present(nrelh)) call physprop_get(idx, nrelh=nrelh) + if (present(dryrad)) call physprop_get(idx, dryrad_aer=dryrad) + +end subroutine rad_aer_get_bin_props + +!================================================================================================ + +subroutine print_aerosol_lists(aer_list, m_list, s_list) + use cam_logfile, only: iulog + use radiative_aerosol_definitions, only: nl, 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,*) nl//' bulk aerosol list for climate calculations' + else + write(iulog,*) nl//' 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,*) nl//' modal aerosol list for climate calculations' + else + write(iulog,*) nl//' 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,*) nl//' bin aerosol list for climate calculations' + else + write(iulog,*) nl//' 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(mode_defs, bin_defs) + use phys_prop, only: physprop_accum_unique_files + use spmd_utils, only: masterproc + use radiative_aerosol_definitions, only: & + cs1, verbose, N_DIAG, modes, bins, & + active_calls, bulk_aerosol_list, modal_aerosol_list, sectional_aerosol_list, & + radcnst_namelist, parse_mode_defs, parse_bin_defs, & + list_populate, print_modes, print_bins + + ! Arguments + character(len=cs1), intent(inout) :: mode_defs(:) + character(len=cs1), intent(inout) :: bin_defs(:) + + ! Local variables + integer :: i + character(len=2) :: suffix + character(len=1), pointer :: ctype(:) + character(len=*), parameter :: subname = 'rad_aer_readnl' + !----------------------------------------------------------------------------- + + ! 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 — 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. +! +! Called from physpkg before rad_cnst_init (gas init). +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 + + !REMOVECAM: aerosol_mmr_cam handles CAM-specific index resolution + use aerosol_mmr_cam, only: aerosol_mmr_init, & + resolve_mode_idx, resolve_bin_idx, resolve_bulk_idx, & + rad_aer_diag_init + !REMOVECAM_END + + 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() + + !REMOVECAM: resolve host-specific indices (CAM uses pbuf and state) + call resolve_mode_idx(modes) + call resolve_bin_idx(bins) + !REMOVECAM_END + + ! Resolve physprop indices for aerosol lists + do i = 0, N_DIAG + if (active_calls(i)) then + !REMOVECAM: resolve host-specific indices (CAM uses pbuf and state) + call resolve_bulk_idx(bulk_aerosol_list(i)) + !REMOVECAM_END + call list_resolve_physprops(bulk_aerosol_list(i), modal_aerosol_list(i), sectional_aerosol_list(i)) + end if + end do + + !REMOVECAM: history add calls for radiative aerosol diagnostics. + call rad_aer_diag_init(bulk_aerosol_list(0)) + !REMOVECAM_END + +end subroutine rad_aer_init + +!================================================================================================ + +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..a9812978d --- /dev/null +++ b/src/aerosol/radiative_aerosol_definitions.F90 @@ -0,0 +1,1175 @@ +module radiative_aerosol_definitions + +!----------------------------------------------------------------------------- +! +! 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. +! +!----------------------------------------------------------------------------- + +implicit none +private +save + +!=========================== +! Shared constants (shared with rad_constituents for gases) +!=========================== + +integer, public, parameter :: cs1 = 256 +integer, public, parameter :: N_DIAG = 10 + +logical, public :: verbose = .true. +character(len=1), public, parameter :: nl = achar(10) + +! max number of externally mixed entities in the climate/diag lists +integer, public, parameter :: n_rad_cnst = N_RAD_CNST + +!=========================== +! Types +!=========================== + +! 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=cs1), 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 + +! 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 + +! 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) + 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), pointer :: source_mmr_a(:) ! source of interstitial specie mmr fields + character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr of interstitial components + character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields + character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components + character(len= 32), pointer :: type(:) ! specie type (as used in MAM code) + character(len=cs1), pointer :: props(:) ! file containing specie properties + integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species + integer :: idx_num_c ! index in pbuf for number mixing ratio of interstitial species + integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species + integer, pointer :: idx_mmr_c(:) ! index in pbuf for mmr of interstitial species + integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module +end type mode_component_t + +! 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 + +! 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 + + character(len= 1), pointer :: source_mmr_a(:) ! source of interstitial mmr field + character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr species + character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields + character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components + character(len= 32), pointer :: type(:) ! species type + character(len= 32), pointer :: morph(:) ! species morphology + character(len=cs1), pointer :: props(:) ! file containing specie properties + + integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species + integer :: idx_num_c ! index in pbuf for number mixing ratio of cloud-borne species + integer :: idx_mass_a ! index in pbuf or constituents for mass mixing ratio of interstitial species + integer :: idx_mass_c ! index in pbuf for mass mixing ratio of cloud-borne species + + integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species + integer, pointer :: idx_mmr_c(:) ! index in pbuf or constituents for mmr of cloud-borne species + integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module +end type bin_component_t + +! 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 + +! 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=cs1) :: 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 + +type, public :: aerlist_t + integer :: numaerosols ! 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(:) ! dimension(numaerosols) +end type aerlist_t + +! storage for modal aerosol components in the climate/diagnostic lists + +type, public :: modelist_t + integer :: nmodes ! number of modes + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + integer, pointer :: idx(:) ! index of the mode in the mode definition object + character(len=cs1), pointer :: physprop_files(:) ! physprop filename + integer, pointer :: idx_props(:) ! index of the mode properties in the physprop object +end type modelist_t + +! storage for bin aerosol components in the climate/diagnostic lists + +type, public :: binlist_t + integer :: nbins ! number of bins + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + integer, pointer :: idx(:) ! index of the bin in the bin definition object + character(len=cs1), pointer :: physprop_files(:) ! physprop filename + integer, pointer :: idx_props(:) ! index of the bin properties in the physprop object +end type binlist_t + +!=========================== +! Module data +!=========================== + +type(rad_cnst_namelist_t), public :: radcnst_namelist(0:N_DIAG) + +logical, public :: active_calls(0:N_DIAG) = .false. + +type(modes_t), public, target :: modes ! mode definitions +type(bins_t), public, target :: bins ! bin definitions + +type(aerlist_t), public, target :: bulk_aerosol_list(0:N_DIAG) ! list of aerosols used in climate/diagnostic calcs +type(modelist_t), public, target :: modal_aerosol_list(0:N_DIAG) ! list of aerosol modes used in climate/diagnostic calcs +type(binlist_t), public, target :: sectional_aerosol_list(0:N_DIAG) ! list of aerosol bins used in climate/diagnostic calcs + +!=========================== +! Named constants for mode/species/morph validation +!=========================== + +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 ' /) + +!=========================== +! Public routines +!=========================== + +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 + +!============================================================================== +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,*) nl//' '//subname//': namelist input for climate list' + else + write(iulog,*) nl//' '//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=cs1) :: tmpstr + character(len=1) :: source(n_rad_cnst) + character(len=64) :: camname(n_rad_cnst) + character(len=cs1) :: 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,*) nl//' 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,*) nl//' 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/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..2ae41a5bc --- /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(ncols,nlevs) + + 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 From a6521f7b14d74932c24003107910ccfaa85a5ef9 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 13 Mar 2026 15:30:03 -0400 Subject: [PATCH 03/46] Initial push for BAM aerosols (chem none) with prescribed source and aerosol optics initial attempt. Misc build fixes Fix bugs in read_water_refindex Fix mark_as_initialized in host side src/aerosol/read_water_refindex.F90 Try metadata for radiative_aerosol_definitions Add mark_as_initialized for aerosol definitions --- src/aerosol/aerosol_instances_mod.F90 | 183 +- src/aerosol/aerosol_mmr_ccpp.F90 | 849 +++++++++ src/aerosol/aerosol_optics_core.F90 | 4 +- src/aerosol/aerosol_optics_mod.F90 | 58 + src/aerosol/aerosol_physical_properties.F90 | 1669 +++++++++++++++++ src/aerosol/bulk_aerosol_properties_mod.F90 | 2 +- src/aerosol/bulk_aerosol_state_mod.F90 | 28 +- src/aerosol/carma_aerosol_properties_mod.F90 | 240 +++ src/aerosol/carma_aerosol_state_mod.F90 | 201 ++ src/aerosol/modal_aerosol_properties_mod.F90 | 240 +++ src/aerosol/modal_aerosol_state_mod.F90 | 201 ++ src/aerosol/radiative_aerosol.F90 | 130 +- src/aerosol/radiative_aerosol_definitions.F90 | 420 +++-- .../radiative_aerosol_definitions.meta | 130 ++ src/aerosol/read_water_refindex.F90 | 189 ++ src/aerosol/read_water_refindex.meta | 17 + src/control/cam_comp.F90 | 44 + src/control/runtime_opts.F90 | 4 + src/data/registry.xml | 2 + src/physics/utils/solar_parms_data.F90 | 2 +- src/utils/table_interp_mod.F90 | 214 +++ 21 files changed, 4445 insertions(+), 382 deletions(-) create mode 100644 src/aerosol/aerosol_mmr_ccpp.F90 create mode 100644 src/aerosol/aerosol_optics_mod.F90 create mode 100644 src/aerosol/aerosol_physical_properties.F90 create mode 100644 src/aerosol/carma_aerosol_properties_mod.F90 create mode 100644 src/aerosol/carma_aerosol_state_mod.F90 create mode 100644 src/aerosol/modal_aerosol_properties_mod.F90 create mode 100644 src/aerosol/modal_aerosol_state_mod.F90 create mode 100644 src/aerosol/radiative_aerosol_definitions.meta create mode 100644 src/aerosol/read_water_refindex.F90 create mode 100644 src/aerosol/read_water_refindex.meta create mode 100644 src/utils/table_interp_mod.F90 diff --git a/src/aerosol/aerosol_instances_mod.F90 b/src/aerosol/aerosol_instances_mod.F90 index f0527d6c7..30ccbf908 100644 --- a/src/aerosol/aerosol_instances_mod.F90 +++ b/src/aerosol/aerosol_instances_mod.F90 @@ -3,27 +3,19 @@ module aerosol_instances_mod ! aerosol_state objects for every active aerosol model (modal, CARMA, bulk) ! and every radiation list (climate + diagnostics). ! - ! Lifecycle (CAM host model example): - ! 1. aerosol_instances_init() -- called once during phys_init, after + ! 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 phys_init, after + ! 2. aerosol_instances_init_states() -- called once during init, after ! aerosol_instances_init(). Creates persistent aerosol_state objects - ! for each (aerosol_model, list_idx, chunk) triple. States store - ! pointers to phys_state(c) and pbuf, which persist for the run. + ! 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, chunk). + ! object for a given (aerosol_model, list_idx). ! 5. aerosol_instances_final() -- deallocates all objects at shutdown. - ! - ! For transient state (e.g., bound to a local copy of physics_state), - ! aerosol_instances_create_states / destroy_states provide a per-call factory, - ! but is expected to be removed in the future. - ! - ! The init, get_props, get_state, and final routines are portable. - ! The create/destroy_states factory and init_states are host-model specific - ! as they point to host-model specific data structures for aerosol state info. use aerosol_properties_mod, only: aerosol_properties use aerosol_state_mod, only: aerosol_state @@ -39,8 +31,6 @@ module aerosol_instances_mod public :: aerosol_instances_get_num_models public :: aerosol_instances_is_active public :: aerosol_instances_final - public :: aerosol_instances_create_states - public :: aerosol_instances_destroy_states public :: aero_state_entry_t type :: aero_props_entry_t @@ -54,14 +44,14 @@ module aerosol_instances_mod ! Module holds aerosol properties objects, dimensioned (iaermod, 0:N_DIAG). type(aero_props_entry_t), allocatable, target :: aero_props_all(:,:) - ! Persistent per-chunk aerosol state objects, dimensioned (iaermod, 0:N_DIAG, begchunk:endchunk). - ! States store pointers to phys_state(c) and pbuf which persist for the run. - type(aero_state_entry_t), allocatable, target :: aero_states_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, or creating states from - ! aerosol_instances_create_states, ensure that the aerosol model matches what is needed (e.g., aero_props%model_is('MAM') == .true.) + ! 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. @@ -166,19 +156,16 @@ logical function aerosol_instances_is_active(model_name) end function aerosol_instances_is_active subroutine aerosol_instances_final() - use ppgrid, only: begchunk, endchunk - integer :: iaermod, ilist, c + integer :: iaermod, ilist ! Deallocate persistent state objects if (allocated(aero_states_all)) then - do c = begchunk, endchunk - do ilist = 0, N_DIAG - do iaermod = 1, num_aero_models_ - if (associated(aero_states_all(iaermod, ilist, c)%obj)) then - deallocate(aero_states_all(iaermod, ilist, c)%obj) - nullify(aero_states_all(iaermod, ilist, c)%obj) - end if - end do + 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) @@ -201,32 +188,28 @@ subroutine aerosol_instances_final() end subroutine aerosol_instances_final - ! Initialize persistent per-chunk aerosol state objects for all active lists + ! 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 pointers to phys_state(c) and pbuf which persist for the - ! entire run. - subroutine aerosol_instances_init_states(phys_state, pbuf2d) + ! 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 physics_types, only: physics_state - use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk - use ppgrid, only: begchunk, endchunk + use ccpp_kinds, only: kind_phys use cam_abortutils, only: endrun - type(physics_state), intent(in), target :: phys_state(begchunk:endchunk) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) + real(kind_phys), pointer, intent(in) :: constituents(:,:,:) - integer :: iaermod, ilist, lchnk, istat - type(physics_buffer_desc), pointer :: pbuf(:) + integer :: iaermod, ilist, istat character(len=*), parameter :: subname = 'aerosol_instances_init_states: ' if (num_aero_models_ < 1) return - allocate(aero_states_all(num_aero_models_, 0:N_DIAG, begchunk:endchunk), stat=istat) + 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 @@ -234,111 +217,39 @@ subroutine aerosol_instances_init_states(phys_state, pbuf2d) do ilist = 0, N_DIAG if (.not. active_calls(ilist)) cycle - do lchnk = begchunk, endchunk - pbuf => pbuf_get_chunk(pbuf2d, lchnk) - - iaermod = 0 - if (modal_active_) then - iaermod = iaermod + 1 - if (associated(aero_props_all(iaermod, ilist)%obj)) then - aero_states_all(iaermod, ilist, lchnk)%obj => & - modal_aerosol_state(phys_state(lchnk), pbuf, ilist) - end if + 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(constituents, ilist) end if - if (carma_active_) then - iaermod = iaermod + 1 - if (associated(aero_props_all(iaermod, ilist)%obj)) then - aero_states_all(iaermod, ilist, lchnk)%obj => & - carma_aerosol_state(phys_state(lchnk), pbuf, 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(constituents, ilist) end if - if (bulk_active_) then - iaermod = iaermod + 1 - if (associated(aero_props_all(iaermod, ilist)%obj)) then - aero_states_all(iaermod, ilist, lchnk)%obj => & - bulk_aerosol_state(phys_state(lchnk), pbuf, 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(constituents, ilist) end if - end do + end if end do end subroutine aerosol_instances_init_states - function aerosol_instances_get_state(iaermod, list_idx, lchnk) result(astate) + function aerosol_instances_get_state(iaermod, list_idx) result(astate) integer, intent(in) :: iaermod integer, intent(in) :: list_idx - integer, intent(in) :: lchnk class(aerosol_state), pointer :: astate - astate => aero_states_all(iaermod, list_idx, lchnk)%obj + astate => aero_states_all(iaermod, list_idx)%obj end function aerosol_instances_get_state - ! Create aerosol state objects for all active aerosol models. - ! - ! This per-call factory is still needed for cases where the state is bound - ! to a local copy of physics_state (e.g., microp_aero_run uses state1). - ! - !REMOVECAM: no longer need this factory pattern once CAM is retired as cases - ! where physics/chemistry uses state1 would be split off into separate physics - ! schemes with tendency updaters in-between. - subroutine aerosol_instances_create_states(list_idx, state, pbuf, aero_states, nstates) - 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 physics_types, only: physics_state - use physics_buffer, only: physics_buffer_desc - use cam_abortutils, only: endrun - - integer, intent(in) :: list_idx - type(physics_state), intent(in), target :: state - type(physics_buffer_desc), pointer :: pbuf(:) - type(aero_state_entry_t), intent(out), allocatable :: aero_states(:) ! aerosol state objects - integer, intent(out) :: nstates ! number of aerosol states created - - integer :: iaermod, istat - character(len=*), parameter :: subname = 'aerosol_instances_create_states: ' - - nstates = num_aero_models_ - if (nstates < 1) return - - allocate(aero_states(nstates), stat=istat) - if (istat /= 0) then - call endrun(subname//'allocation error: aero_states') - end if - - iaermod = 0 - if (modal_active_) then - iaermod = iaermod + 1 - aero_states(iaermod)%obj => modal_aerosol_state(state, pbuf, list_idx) - end if - if (carma_active_) then - iaermod = iaermod + 1 - aero_states(iaermod)%obj => carma_aerosol_state(state, pbuf, list_idx) - end if - if (bulk_active_) then - iaermod = iaermod + 1 - aero_states(iaermod)%obj => bulk_aerosol_state(state, pbuf, list_idx) - end if - - end subroutine aerosol_instances_create_states - !REMOVECAM_END - - subroutine aerosol_instances_destroy_states(aero_states) - type(aero_state_entry_t), allocatable, intent(inout) :: aero_states(:) - integer :: i - - if (.not. allocated(aero_states)) return - - do i = 1, size(aero_states) - if (associated(aero_states(i)%obj)) then - deallocate(aero_states(i)%obj) - nullify(aero_states(i)%obj) - end if - end do - - deallocate(aero_states) - - end subroutine aerosol_instances_destroy_states - end module aerosol_instances_mod diff --git a/src/aerosol/aerosol_mmr_ccpp.F90 b/src/aerosol/aerosol_mmr_ccpp.F90 new file mode 100644 index 000000000..15f98f6e2 --- /dev/null +++ b/src/aerosol/aerosol_mmr_ccpp.F90 @@ -0,0 +1,849 @@ +module aerosol_mmr_ccpp + +!------------------------------------------------------------------------------------------------ +! +! CAM-SIMA (CCPP) aerosol MMR retrieval routines. These routines use +! the CCPP constituents array to return mixing ratio pointers. +! +! Ported from aerosol_mmr_cam — 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 + +! 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 +end interface + +! values for constituents with requested value of zero +real(r8), allocatable, target :: zero_cols(:,:) + +public :: aerosol_mmr_init ! allocate zero_cols +public :: get_ccpp_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 + +!================================================================================================ + +integer function get_ccpp_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_ccpp_idx = idx + +end function get_ccpp_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 aerosol_physical_properties, 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_ccpp_idx(modes%comps(m)%source_num_a, modes%comps(m)%camname_num_a, routine) + modes%comps(m)%idx_num_c = get_ccpp_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_ccpp_idx(modes%comps(m)%source_mmr_a(ispec), & + modes%comps(m)%camname_mmr_a(ispec), routine) + modes%comps(m)%idx_mmr_c(ispec) = get_ccpp_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 aerosol_physical_properties, 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_ccpp_idx(bins%comps(m)%source_num_a, bins%comps(m)%camname_num_a, routine) + bins%comps(m)%idx_num_c = get_ccpp_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_ccpp_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_ccpp_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_ccpp_idx(bins%comps(m)%source_mmr_a(ispec), & + bins%comps(m)%camname_mmr_a(ispec), routine) + bins%comps(m)%idx_mmr_c(ispec) = get_ccpp_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_ccpp_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_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_bin_mmr_by_idx(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 + +!================================================================================================ + +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(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 + +!================================================================================================ + +subroutine rad_cnst_get_bin_num(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 + +!================================================================================================ + +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_ccpp diff --git a/src/aerosol/aerosol_optics_core.F90 b/src/aerosol/aerosol_optics_core.F90 index 391dc1379..a0ab4b927 100644 --- a/src/aerosol/aerosol_optics_core.F90 +++ b/src/aerosol/aerosol_optics_core.F90 @@ -30,7 +30,7 @@ function create_aerosol_optics_object(aeroprops, aerostate, ibin, & relh, sulfwtpct, crefwsw, crefwlw, & geometric_radius) result(aero_optics) - use phys_prop, only: ot_length + use aerosol_physical_properties, only: ot_length use aerosol_properties_mod, only: aerosol_properties use aerosol_state_mod, only: aerosol_state @@ -186,6 +186,7 @@ subroutine aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & 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) @@ -385,6 +386,7 @@ subroutine aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & if (.not. associated(aero_optics)) then errflg = 1 errmsg = 'unrecognized aerosol optics type, could not create object' + return end if do iwav = 1, nlwbands diff --git a/src/aerosol/aerosol_optics_mod.F90 b/src/aerosol/aerosol_optics_mod.F90 new file mode 100644 index 000000000..ae2a04bfb --- /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 asymmetry factor + real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + + 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..e9f3c3a3a --- /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 aerosol_physical_properties + 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 aerosol_physical_properties diff --git a/src/aerosol/bulk_aerosol_properties_mod.F90 b/src/aerosol/bulk_aerosol_properties_mod.F90 index efa6b43b0..f4213d6b6 100644 --- a/src/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/aerosol/bulk_aerosol_properties_mod.F90 @@ -10,7 +10,7 @@ module bulk_aerosol_properties_mod use aerosol_properties_mod, only: aerosol_properties, aero_name_len use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_props - use infnan, only: nan, assignment(=) + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) implicit none diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index 55a5e369a..082a4d6bc 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -1,14 +1,8 @@ module bulk_aerosol_state_mod use shr_kind_mod, only: r8 => shr_kind_r8 - !REMOVECAM - use aerosol_mmr_cam, only: rad_cnst_get_aer_mmr - !REMOVECAM_END + use ccpp_kinds, only: kind_phys + use aerosol_mmr_ccpp, only: rad_cnst_get_aer_mmr use cam_abortutils, only: endrun - - !REMOVECAM: no longer need pbuf and state after CAM is retired - use physics_buffer, only: physics_buffer_desc - use physics_types, only: physics_state - !REMOVECAM_END use aerosol_state_mod, only: aerosol_state, ptr2d_t use aerosol_properties_mod, only: aerosol_properties @@ -18,10 +12,7 @@ module bulk_aerosol_state_mod type, extends(aerosol_state) :: bulk_aerosol_state private - !REMOVECAM: state and pbuf will be replaced by SIMA MMR API - type(physics_state), pointer :: state => null() - type(physics_buffer_desc), pointer :: pbuf(:) => null() - !REMOVECAM_END + real(kind_phys), pointer :: constituents(:,:,:) => null() contains @@ -59,9 +50,8 @@ module bulk_aerosol_state_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(state,pbuf,list_idx) result(newobj) - type(physics_state), target :: state - type(physics_buffer_desc), pointer :: pbuf(:) + function constructor(constituents, list_idx) result(newobj) + real(kind_phys), pointer, intent(in) :: constituents(:,:,:) integer, intent(in), optional :: list_idx type(bulk_aerosol_state), pointer :: newobj @@ -73,8 +63,7 @@ function constructor(state,pbuf,list_idx) result(newobj) return end if - newobj%state => state - newobj%pbuf => pbuf + newobj%constituents => constituents if (present(list_idx)) call newobj%set_list_idx(list_idx) @@ -85,8 +74,7 @@ end function constructor subroutine destructor(self) type(bulk_aerosol_state), intent(inout) :: self - nullify(self%state) - nullify(self%pbuf) + nullify(self%constituents) end subroutine destructor @@ -142,7 +130,7 @@ subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) ! 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%state, self%pbuf, mmr) + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, self%constituents, mmr) end subroutine get_ambient_mmr diff --git a/src/aerosol/carma_aerosol_properties_mod.F90 b/src/aerosol/carma_aerosol_properties_mod.F90 new file mode 100644 index 000000000..9fc75650a --- /dev/null +++ b/src/aerosol/carma_aerosol_properties_mod.F90 @@ -0,0 +1,240 @@ +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 :: optics_params + 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, & + 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 + 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, istart, istop, m) + class(carma_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:) + real(r8), intent(in) :: vaerosol(:) + integer, intent(in) :: istart, istop, 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 + + 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) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + character(len=*), optional, intent(out) :: opticstype + real(r8), optional, pointer :: extpsw(:,:,:,:), abspsw(:,:,:,:), asmpsw(:,:,:,:), absplw(:,:,:,:) + real(r8), optional, pointer :: refrtabsw(:,:), refitabsw(:,:), refrtablw(:,:), refitablw(:,:) + integer, optional, intent(out) :: ncoef, prefr, prefi + real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:), sw_hygro_ssa_wtp(:,:) + real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:), lw_hygro_ext_wtp(:,:) + real(r8), optional, pointer :: wgtpct(:) + integer, optional, intent(out) :: nwtp + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:), sw_hygro_coreshell_ssa(:,:,:,:,:) + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:), lw_hygro_coreshell_ext(:,:,:,:,:) + real(r8), optional, pointer :: corefrac(:), bcdust(:), kap(:), relh(:) + integer, optional, intent(out) :: nfrac, nbcdust, nkap, nrelh + real(r8), optional, pointer :: sw_hygroscopic_ext(:,:), sw_hygroscopic_ssa(:,:) + real(r8), optional, pointer :: sw_hygroscopic_asm(:,:), lw_hygroscopic_ext(:,:) + real(r8), optional, pointer :: sw_insoluble_ext(:), sw_insoluble_ssa(:) + real(r8), optional, pointer :: sw_insoluble_asm(:), lw_insoluble_ext(:) + real(r8), optional, pointer :: r_sw_ext(:,:), r_sw_scat(:,:), r_sw_ascat(:,:) + real(r8), optional, pointer :: r_mu(:), r_lw_abs(:,:) + call endrun('carma_aerosol_properties%optics_params: not implemented') + end subroutine optics_params + + 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..272768230 --- /dev/null +++ b/src/aerosol/carma_aerosol_state_mod.F90 @@ -0,0 +1,201 @@ +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 ccpp_kinds, only: kind_phys + use cam_abortutils, only: endrun + 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 :: wgtpct + end type carma_aerosol_state + + interface carma_aerosol_state + procedure :: constructor + end interface carma_aerosol_state + +contains + + function constructor(constituents, list_idx) result(newobj) + real(kind_phys), pointer, intent(in) :: constituents(:,:,:) + 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 + +end module carma_aerosol_state_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..4caab1037 --- /dev/null +++ b/src/aerosol/modal_aerosol_properties_mod.F90 @@ -0,0 +1,240 @@ +module modal_aerosol_properties_mod + !----------------------------------------------------------------------------- + ! Stub module for modal 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 :: modal_aerosol_properties + + type, extends(aerosol_properties) :: modal_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 :: optics_params + 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 modal_aerosol_properties + + interface modal_aerosol_properties + procedure :: constructor + end interface modal_aerosol_properties + +contains + + function constructor(list_idx) result(newobj) + integer, optional, intent(in) :: list_idx + type(modal_aerosol_properties), pointer :: newobj + nullify(newobj) + call endrun('modal_aerosol_properties: not implemented in CAM-SIMA') + end function constructor + + integer function number_transported(self) + class(modal_aerosol_properties), intent(in) :: self + number_transported = -1 + call endrun('modal_aerosol_properties%number_transported: not implemented') + end function number_transported + + subroutine get(self, bin_ndx, species_ndx, density, hygro, & + spectype, specname, specmorph, refindex_sw, refindex_lw, num_to_mass_aer, dryrad) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + real(r8), optional, intent(out) :: density, hygro + 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('modal_aerosol_properties%get: not implemented') + end subroutine get + + pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) + class(modal_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(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8), intent(in) :: smc, smax + real(r8), intent(out) :: fn, fm + call endrun('modal_aerosol_properties%actfracs: not implemented') + end subroutine actfracs + + subroutine num_names(self, bin_ndx, name_a, name_c) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + character(len=*), intent(out) :: name_a, name_c + call endrun('modal_aerosol_properties%num_names: not implemented') + end subroutine num_names + + subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + character(len=*), intent(out) :: name_a, name_c + call endrun('modal_aerosol_properties%mmr_names: not implemented') + end subroutine mmr_names + + subroutine amb_num_name(self, bin_ndx, name) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + character(len=*), intent(out) :: name + call endrun('modal_aerosol_properties%amb_num_name: not implemented') + end subroutine amb_num_name + + subroutine amb_mmr_name(self, bin_ndx, species_ndx, name) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + character(len=*), intent(out) :: name + call endrun('modal_aerosol_properties%amb_mmr_name: not implemented') + end subroutine amb_mmr_name + + subroutine species_type(self, bin_ndx, species_ndx, spectype) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, species_ndx + character(len=*), intent(out) :: spectype + call endrun('modal_aerosol_properties%species_type: not implemented') + end subroutine species_type + + function icenuc_updates_num(self, bin_ndx) result(res) + class(modal_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(modal_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, istart, istop, m) + class(modal_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:) + real(r8), intent(in) :: vaerosol(:) + integer, intent(in) :: istart, istop, m + call endrun('modal_aerosol_properties%apply_number_limits: not implemented') + end subroutine apply_number_limits + + function hetfrz_species(self, bin_ndx, spc_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx, spc_ndx + logical :: res + res = .false. + end function hetfrz_species + + 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) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + character(len=*), optional, intent(out) :: opticstype + real(r8), optional, pointer :: extpsw(:,:,:,:), abspsw(:,:,:,:), asmpsw(:,:,:,:), absplw(:,:,:,:) + real(r8), optional, pointer :: refrtabsw(:,:), refitabsw(:,:), refrtablw(:,:), refitablw(:,:) + integer, optional, intent(out) :: ncoef, prefr, prefi + real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:), sw_hygro_ssa_wtp(:,:) + real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:), lw_hygro_ext_wtp(:,:) + real(r8), optional, pointer :: wgtpct(:) + integer, optional, intent(out) :: nwtp + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:), sw_hygro_coreshell_ssa(:,:,:,:,:) + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:), lw_hygro_coreshell_ext(:,:,:,:,:) + real(r8), optional, pointer :: corefrac(:), bcdust(:), kap(:), relh(:) + integer, optional, intent(out) :: nfrac, nbcdust, nkap, nrelh + real(r8), optional, pointer :: sw_hygroscopic_ext(:,:), sw_hygroscopic_ssa(:,:) + real(r8), optional, pointer :: sw_hygroscopic_asm(:,:), lw_hygroscopic_ext(:,:) + real(r8), optional, pointer :: sw_insoluble_ext(:), sw_insoluble_ssa(:) + real(r8), optional, pointer :: sw_insoluble_asm(:), lw_insoluble_ext(:) + real(r8), optional, pointer :: r_sw_ext(:,:), r_sw_scat(:,:), r_sw_ascat(:,:) + real(r8), optional, pointer :: r_mu(:), r_lw_abs(:,:) + call endrun('modal_aerosol_properties%optics_params: not implemented') + end subroutine optics_params + + logical function soluble(self, bin_ndx) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + soluble = .false. + call endrun('modal_aerosol_properties%soluble: not implemented') + end function soluble + + function min_mass_mean_rad(self, bin_ndx, species_ndx) result(minrad) + class(modal_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(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + character(len=aero_name_len) :: name + name = '' + call endrun('modal_aerosol_properties%bin_name: not implemented') + end function bin_name + + function scav_diam(self, bin_ndx) result(diam) + class(modal_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(modal_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + call endrun('modal_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(modal_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('modal_aerosol_properties%rebin_bulk_fluxes: not implemented') + end subroutine rebin_bulk_fluxes + + logical function hydrophilic(self, bin_ndx) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx + hydrophilic = .false. + end function hydrophilic + + pure logical function model_is(self, query) + class(modal_aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query + model_is = (trim(query) == 'MAM' .or. trim(query) == 'mam') + 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..ee2bbf879 --- /dev/null +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -0,0 +1,201 @@ +module modal_aerosol_state_mod + !----------------------------------------------------------------------------- + ! Stub module for modal 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 ccpp_kinds, only: kind_phys + use cam_abortutils, only: endrun + use aerosol_state_mod, only: aerosol_state, ptr2d_t + use aerosol_properties_mod, only: aerosol_properties + + implicit none + private + + public :: modal_aerosol_state + + type, extends(aerosol_state) :: modal_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 :: wgtpct + end type modal_aerosol_state + + interface modal_aerosol_state + procedure :: constructor + end interface modal_aerosol_state + +contains + + function constructor(constituents, list_idx) result(newobj) + real(kind_phys), pointer, intent(in) :: constituents(:,:,:) + integer, intent(in), optional :: list_idx + type(modal_aerosol_state), pointer :: newobj + nullify(newobj) + call endrun('modal_aerosol_state: not implemented in CAM-SIMA') + end function constructor + + subroutine set_transported(self, transported_array) + class(modal_aerosol_state), intent(inout) :: self + real(r8), intent(in) :: transported_array(:,:,:) + call endrun('modal_aerosol_state%set_transported: not implemented') + end subroutine set_transported + + subroutine get_transported(self, transported_array) + class(modal_aerosol_state), intent(in) :: self + real(r8), intent(out) :: transported_array(:,:,:) + call endrun('modal_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(modal_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('modal_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(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx, bin_ndx + real(r8), pointer :: mmr(:,:) + nullify(mmr) + call endrun('modal_aerosol_state%get_ambient_mmr: not implemented') + end subroutine get_ambient_mmr + + subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx, bin_ndx + real(r8), pointer :: mmr(:,:) + nullify(mmr) + call endrun('modal_aerosol_state%get_cldbrne_mmr: not implemented') + end subroutine get_cldbrne_mmr + + subroutine get_ambient_num(self, bin_ndx, num) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8), pointer :: num(:,:) + nullify(num) + call endrun('modal_aerosol_state%get_ambient_num: not implemented') + end subroutine get_ambient_num + + subroutine get_cldbrne_num(self, bin_ndx, num) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8), pointer :: num(:,:) + nullify(num) + call endrun('modal_aerosol_state%get_cldbrne_num: not implemented') + end subroutine get_cldbrne_num + + 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(:), qqcw(:) + call endrun('modal_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(modal_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('modal_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(modal_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('modal_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(modal_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('modal_aerosol_state%update_bin: not implemented') + end subroutine update_bin + + function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx, ncol, nlev + real(r8) :: wght(ncol,nlev) + call endrun('modal_aerosol_state%hetfrz_size_wght: not implemented') + end function hetfrz_size_wght + + subroutine hygroscopicity(self, bin_ndx, kappa) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx + real(r8), intent(out) :: kappa(:,:) + call endrun('modal_aerosol_state%hygroscopicity: not implemented') + end subroutine hygroscopicity + + subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) + class(modal_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('modal_aerosol_state%water_uptake: not implemented') + end subroutine water_uptake + + function dry_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) + class(modal_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(modal_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(modal_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(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx, ncol, nlev + real(r8) :: diam(ncol,nlev) + call endrun('modal_aerosol_state%wet_diameter: not implemented') + end function wet_diameter + + function wgtpct(self, ncol, nlev) result(wtp) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: ncol, nlev + real(r8) :: wtp(ncol,nlev) + wtp = -huge(1._r8) + end function wgtpct + +end module modal_aerosol_state_mod diff --git a/src/aerosol/radiative_aerosol.F90 b/src/aerosol/radiative_aerosol.F90 index aa233c428..204911696 100644 --- a/src/aerosol/radiative_aerosol.F90 +++ b/src/aerosol/radiative_aerosol.F90 @@ -6,7 +6,7 @@ module radiative_aerosol ! ! 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_init (uses host-specific module aerosol_mmr_cam). +! Init is via rad_aer_readnl (namelist) and rad_aer_init (physprop + CCPP indices). ! !------------------------------------------------------------------------------------------------ @@ -626,7 +626,7 @@ subroutine rad_aer_get_props_by_idx(list_idx, & 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 aerosol_physical_properties, 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 @@ -727,7 +727,7 @@ subroutine rad_aer_get_mam_props_by_idx(list_idx, & 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 aerosol_physical_properties, 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 @@ -843,7 +843,7 @@ subroutine rad_aer_get_bin_props_by_idx(list_idx, & 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 aerosol_physical_properties, 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 @@ -958,7 +958,7 @@ subroutine rad_aer_get_mode_props(list_idx, mode_idx, opticstype, & rhcrystal, rhdeliques) use shr_kind_mod, only: r8 => shr_kind_r8 - use phys_prop, only: physprop_get, ot_length + use aerosol_physical_properties, 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 @@ -1042,7 +1042,7 @@ subroutine rad_aer_get_bin_props(list_idx, bin_idx, opticstype, & sw_hygro_ext_wtp, sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, & sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, dryrad ) use shr_kind_mod, only: r8 => shr_kind_r8 - use phys_prop, only: physprop_get, ot_length + use aerosol_physical_properties, 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 @@ -1190,26 +1190,114 @@ end subroutine print_aerosol_lists ! ! 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(mode_defs, bin_defs) - use phys_prop, only: physprop_accum_unique_files +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 aerosol_physical_properties, only: physprop_accum_unique_files use spmd_utils, only: masterproc + use cam_abortutils, only: endrun use radiative_aerosol_definitions, only: & - cs1, verbose, N_DIAG, modes, bins, & + cs1, 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_mode_defs, parse_bin_defs, & + radcnst_namelist, parse_rad_specifier, parse_mode_defs, parse_bin_defs, & list_populate, print_modes, print_bins ! Arguments - character(len=cs1), intent(inout) :: mode_defs(:) - character(len=cs1), intent(inout) :: bin_defs(:) + character(len=*), intent(in) :: nlfile ! Local variables - integer :: i + 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=cs1), dimension(n_mode_str) :: mode_defs = ' ' + character(len=cs1), dimension(n_bin_str) :: bin_defs = ' ' + character(len=cs1) :: rad_aer_climate(n_rad_cnst) = ' ' + character(len=cs1) :: rad_aer_diag_1(n_rad_cnst) = ' ' + character(len=cs1) :: rad_aer_diag_2(n_rad_cnst) = ' ' + character(len=cs1) :: rad_aer_diag_3(n_rad_cnst) = ' ' + character(len=cs1) :: rad_aer_diag_4(n_rad_cnst) = ' ' + character(len=cs1) :: rad_aer_diag_5(n_rad_cnst) = ' ' + character(len=cs1) :: rad_aer_diag_6(n_rad_cnst) = ' ' + character(len=cs1) :: rad_aer_diag_7(n_rad_cnst) = ' ' + character(len=cs1) :: rad_aer_diag_8(n_rad_cnst) = ' ' + character(len=cs1) :: rad_aer_diag_9(n_rad_cnst) = ' ' + character(len=cs1) :: 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) @@ -1276,19 +1364,15 @@ 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. -! -! Called from physpkg before rad_cnst_init (gas init). subroutine rad_aer_init() - use phys_prop, only: physprop_init + use aerosol_physical_properties, 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 - !REMOVECAM: aerosol_mmr_cam handles CAM-specific index resolution - use aerosol_mmr_cam, only: aerosol_mmr_init, & + use aerosol_mmr_ccpp, only: aerosol_mmr_init, & resolve_mode_idx, resolve_bin_idx, resolve_bulk_idx, & rad_aer_diag_init - !REMOVECAM_END integer :: i character(len=*), parameter :: subname = 'rad_aer_init' @@ -1300,24 +1384,20 @@ subroutine rad_aer_init() ! Read physical properties from data files call physprop_init() - !REMOVECAM: resolve host-specific indices (CAM uses pbuf and state) + ! Resolve host-specific CCPP constituent indices call resolve_mode_idx(modes) call resolve_bin_idx(bins) - !REMOVECAM_END ! Resolve physprop indices for aerosol lists do i = 0, N_DIAG if (active_calls(i)) then - !REMOVECAM: resolve host-specific indices (CAM uses pbuf and state) call resolve_bulk_idx(bulk_aerosol_list(i)) - !REMOVECAM_END call list_resolve_physprops(bulk_aerosol_list(i), modal_aerosol_list(i), sectional_aerosol_list(i)) end if end do - !REMOVECAM: history add calls for radiative aerosol diagnostics. + ! Register aerosol diagnostic history fields call rad_aer_diag_init(bulk_aerosol_list(0)) - !REMOVECAM_END end subroutine rad_aer_init diff --git a/src/aerosol/radiative_aerosol_definitions.F90 b/src/aerosol/radiative_aerosol_definitions.F90 index a9812978d..485cb6a72 100644 --- a/src/aerosol/radiative_aerosol_definitions.F90 +++ b/src/aerosol/radiative_aerosol_definitions.F90 @@ -1,208 +1,233 @@ -module radiative_aerosol_definitions - !----------------------------------------------------------------------------- -! ! 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 - -!=========================== -! Shared constants (shared with rad_constituents for gases) -!=========================== - -integer, public, parameter :: cs1 = 256 -integer, public, parameter :: N_DIAG = 10 - -logical, public :: verbose = .true. -character(len=1), public, parameter :: nl = achar(10) - -! max number of externally mixed entities in the climate/diag lists -integer, public, parameter :: n_rad_cnst = N_RAD_CNST - -!=========================== -! Types -!=========================== - -! 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=cs1), 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 - -! 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 - -! 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) - 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), pointer :: source_mmr_a(:) ! source of interstitial specie mmr fields - character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr of interstitial components - character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields - character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components - character(len= 32), pointer :: type(:) ! specie type (as used in MAM code) - character(len=cs1), pointer :: props(:) ! file containing specie properties - integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species - integer :: idx_num_c ! index in pbuf for number mixing ratio of interstitial species - integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species - integer, pointer :: idx_mmr_c(:) ! index in pbuf for mmr of interstitial species - integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module -end type mode_component_t - -! 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 - -! 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 - - character(len= 1), pointer :: source_mmr_a(:) ! source of interstitial mmr field - character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr species - character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields - character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components - character(len= 32), pointer :: type(:) ! species type - character(len= 32), pointer :: morph(:) ! species morphology - character(len=cs1), pointer :: props(:) ! file containing specie properties - - integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species - integer :: idx_num_c ! index in pbuf for number mixing ratio of cloud-borne species - integer :: idx_mass_a ! index in pbuf or constituents for mass mixing ratio of interstitial species - integer :: idx_mass_c ! index in pbuf for mass mixing ratio of cloud-borne species - - integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species - integer, pointer :: idx_mmr_c(:) ! index in pbuf or constituents for mmr of cloud-borne species - integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module -end type bin_component_t - -! 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 - -! 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=cs1) :: 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 - -type, public :: aerlist_t - integer :: numaerosols ! 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(:) ! dimension(numaerosols) -end type aerlist_t - -! storage for modal aerosol components in the climate/diagnostic lists - -type, public :: modelist_t - integer :: nmodes ! number of modes - character(len=2) :: list_id ! set to " " for climate list, or two character integer - ! (include leading zero) to identify diagnostic list - integer, pointer :: idx(:) ! index of the mode in the mode definition object - character(len=cs1), pointer :: physprop_files(:) ! physprop filename - integer, pointer :: idx_props(:) ! index of the mode properties in the physprop object -end type modelist_t - -! storage for bin aerosol components in the climate/diagnostic lists - -type, public :: binlist_t - integer :: nbins ! number of bins - character(len=2) :: list_id ! set to " " for climate list, or two character integer - ! (include leading zero) to identify diagnostic list - integer, pointer :: idx(:) ! index of the bin in the bin definition object - character(len=cs1), pointer :: physprop_files(:) ! physprop filename - integer, pointer :: idx_props(:) ! index of the bin properties in the physprop object -end type binlist_t - -!=========================== -! Module data -!=========================== - -type(rad_cnst_namelist_t), public :: radcnst_namelist(0:N_DIAG) - -logical, public :: active_calls(0:N_DIAG) = .false. - -type(modes_t), public, target :: modes ! mode definitions -type(bins_t), public, target :: bins ! bin definitions - -type(aerlist_t), public, target :: bulk_aerosol_list(0:N_DIAG) ! list of aerosols used in climate/diagnostic calcs -type(modelist_t), public, target :: modal_aerosol_list(0:N_DIAG) ! list of aerosol modes used in climate/diagnostic calcs -type(binlist_t), public, target :: sectional_aerosol_list(0:N_DIAG) ! list of aerosol bins used in climate/diagnostic calcs - -!=========================== -! Named constants for mode/species/morph validation -!=========================== - -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 ' /) - -!=========================== -! Public routines -!=========================== - -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 + 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. + !=========================== + integer, public, parameter :: cs1 = 256 + logical, public :: verbose = .true. + character(len=1), public, parameter :: nl = 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=cs1), 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) + 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), pointer :: source_mmr_a(:) ! source of interstitial specie mmr fields + character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr of interstitial components + character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields + character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components + character(len= 32), pointer :: type(:) ! specie type (as used in MAM code) + character(len=cs1), pointer :: props(:) ! file containing specie properties + integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species + integer :: idx_num_c ! index in pbuf for number mixing ratio of interstitial species + integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species + integer, pointer :: idx_mmr_c(:) ! index in pbuf for mmr of interstitial species + integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module + 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 + + character(len= 1), pointer :: source_mmr_a(:) ! source of interstitial mmr field + character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr species + character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields + character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components + character(len= 32), pointer :: type(:) ! species type + character(len= 32), pointer :: morph(:) ! species morphology + character(len=cs1), pointer :: props(:) ! file containing specie properties + + integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species + integer :: idx_num_c ! index in pbuf for number mixing ratio of cloud-borne species + integer :: idx_mass_a ! index in pbuf or constituents for mass mixing ratio of interstitial species + integer :: idx_mass_c ! index in pbuf for mass mixing ratio of cloud-borne species + + integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species + integer, pointer :: idx_mmr_c(:) ! index in pbuf or constituents for mmr of cloud-borne species + integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module + 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=cs1) :: 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 ! 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(:) ! 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 + integer :: nmodes ! number of modes + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + integer, pointer :: idx(:) ! index of the mode in the mode definition object + character(len=cs1), pointer :: physprop_files(:) ! physprop filename + integer, pointer :: idx_props(:) ! index of the mode properties in the physprop object + 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 + integer :: nbins ! number of bins + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + integer, pointer :: idx(:) ! index of the bin in the bin definition object + character(len=cs1), pointer :: physprop_files(:) ! physprop filename + integer, pointer :: idx_props(:) ! index of the bin properties in the physprop object + 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 @@ -220,7 +245,6 @@ subroutine list_populate(namelist, aerlist, modal_aerosol_list, sectional_aeroso ! 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 @@ -355,7 +379,7 @@ subroutine list_resolve_physprops(aerlist, modal_aerosol_list, sectional_aerosol ! 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 + use aerosol_physical_properties, only: physprop_get_id type(aerlist_t), intent(inout) :: aerlist type(modelist_t), intent(inout) :: modal_aerosol_list 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/read_water_refindex.F90 b/src/aerosol/read_water_refindex.F90 new file mode 100644 index 000000000..3c88c56e2 --- /dev/null +++ b/src/aerosol/read_water_refindex.F90 @@ -0,0 +1,189 @@ +!------------------------------------------------------------------- +! Read water refractive indices for modal aerosol optics. +!------------------------------------------------------------------- +! Note (hplin 3/14/26): I suppose this could be a ccpp scheme or +! collapsed into the aerosol_optics scheme init phase and use the +! CCPP i/o reader instead. +module read_water_refindex + use ccpp_kinds, only: kind_phys + use shr_kind_mod, only: shr_kind_cl + use runtime_obj, only: unset_str + + implicit none + private + + public :: read_water_refindex_readnl + public :: read_water_refindex_file + + ! Private module data + character(len=shr_kind_cl) :: water_refindex_file = unset_str + +!> \section arg_table_read_water_refindex Argument Table +!! \htmlinclude read_water_refindex.html + ! Complex refractive indices for water (shortwave and longwave) + complex(kind_phys), public, allocatable, target :: crefwsw(:) ! dimension(nswbands) + complex(kind_phys), public, allocatable, target :: crefwlw(:) ! dimension(nlwbands) + +contains + + subroutine read_water_refindex_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 cam_logfile, only: iulog + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + + character(len=*), intent(in) :: nlfile + + integer :: unitn, ierr + character(len=*), parameter :: subname = 'read_water_refindex_readnl' + character(len=shr_kind_cm) :: errmsg + + namelist /aerosol_optics_nl/ water_refindex_file + + errmsg = '' + + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'aerosol_optics_nl', status=ierr) + if (ierr == 0) then + read(unitn, aerosol_optics_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(water_refindex_file, len(water_refindex_file), mpi_character, 0, mpicom, ierr) + + if (masterproc) then + write(iulog,*) subname, ' options:' + write(iulog,*) ' Water refindex file: ', trim(water_refindex_file) + end if + + end subroutine read_water_refindex_readnl + + subroutine read_water_refindex_file() + !------------------------------------------------------------------ + ! Read water refractive index dataset. + ! File contains real and imaginary parts of the refractive index + ! for shortwave and longwave bands. + !------------------------------------------------------------------ + use cam_logfile, only: iulog + use cam_abortutils, only: endrun, check_allocate + use spmd_utils, only: masterproc + use ioFileMod, only: cam_get_file + use cam_pio_utils, only: cam_pio_openfile + use pio, only: file_desc_t, var_desc_t, pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var, pio_closefile, pio_nowrite + use radiation_namelist, only: nswbands, nlwbands + use phys_vars_init_check, only: mark_as_initialized + + ! Local variables + integer :: ierr + type(file_desc_t) :: pio_id + integer :: dimid, nsw_file, nlw_file + type(var_desc_t) :: vid + real(kind_phys), allocatable :: refr(:), refi(:) + character(len=shr_kind_cl) :: locfn + character(len=*), parameter :: subname = 'read_water_refindex_file' + character(len=256) :: errmsg + + ! Guard: skip if no file specified + if (trim(water_refindex_file) == trim(unset_str) .or. & + trim(water_refindex_file) == 'UNSET_PATH') then + if (masterproc) then + write(iulog,*) subname, ': no water refindex file specified, skipping' + end if + return + end if + + !----------------------------------------------------------------------- + ! Open file + !----------------------------------------------------------------------- + call cam_get_file(water_refindex_file, locfn, allow_fail=.false.) + call cam_pio_openfile(pio_id, trim(locfn), PIO_NOWRITE) + + !----------------------------------------------------------------------- + ! Validate shortwave dimension + !----------------------------------------------------------------------- + ierr = pio_inq_dimid(pio_id, 'sw_band', dimid) + ierr = pio_inq_dimlen(pio_id, dimid, nsw_file) + if (nsw_file /= nswbands) then + write(iulog,*) subname, ': nswbands mismatch: file=', nsw_file, ' expected=', nswbands + call endrun(subname//': nswbands mismatch in water refindex file') + end if + + !----------------------------------------------------------------------- + ! Validate longwave dimension + !----------------------------------------------------------------------- + ierr = pio_inq_dimid(pio_id, 'lw_band', dimid) + ierr = pio_inq_dimlen(pio_id, dimid, nlw_file) + if (nlw_file /= nlwbands) then + write(iulog,*) subname, ': nlwbands mismatch: file=', nlw_file, ' expected=', nlwbands + call endrun(subname//': nlwbands mismatch in water refindex file') + end if + + !----------------------------------------------------------------------- + ! Read shortwave refractive indices + !----------------------------------------------------------------------- + allocate(refr(nswbands), refi(nswbands), stat=ierr, errmsg=errmsg) + call check_allocate(ierr, subname, 'refr(nswbands), refi(nswbands)', errmsg=errmsg, & + file=__FILE__, line=__LINE__) + + ierr = pio_inq_varid(pio_id, 'refindex_real_water_sw', vid) + ierr = pio_get_var(pio_id, vid, refr) + + ierr = pio_inq_varid(pio_id, 'refindex_im_water_sw', vid) + ierr = pio_get_var(pio_id, vid, refi) + + allocate(crefwsw(nswbands), stat=ierr, errmsg=errmsg) + call check_allocate(ierr, subname, 'crefwsw(nswbands)', errmsg=errmsg, & + file=__FILE__, line=__LINE__) + crefwsw(:) = cmplx(refr(:), refi(:), kind=kind_phys) + + deallocate(refr, refi) + + !----------------------------------------------------------------------- + ! Read longwave refractive indices + !----------------------------------------------------------------------- + allocate(refr(nlwbands), refi(nlwbands), stat=ierr, errmsg=errmsg) + call check_allocate(ierr, subname, 'refr(nlwbands), refi(nlwbands)', errmsg=errmsg, & + file=__FILE__, line=__LINE__) + + ierr = pio_inq_varid(pio_id, 'refindex_real_water_lw', vid) + ierr = pio_get_var(pio_id, vid, refr) + + ierr = pio_inq_varid(pio_id, 'refindex_im_water_lw', vid) + ierr = pio_get_var(pio_id, vid, refi) + + allocate(crefwlw(nlwbands), stat=ierr, errmsg=errmsg) + call check_allocate(ierr, subname, 'crefwlw(nlwbands)', errmsg=errmsg, & + file=__FILE__, line=__LINE__) + crefwlw(:) = cmplx(refr(:), refi(:), kind=kind_phys) + + deallocate(refr, refi) + + !----------------------------------------------------------------------- + ! Close file + !----------------------------------------------------------------------- + call pio_closefile(pio_id) + + if (masterproc) then + write(iulog,*) subname, ': successfully read water refractive indices' + write(iulog,*) ' nswbands=', nswbands, ' nlwbands=', nlwbands + end if + + !-------------------------------------------------------- + ! Mark variables as initialized so they are not read from initial conditions + !-------------------------------------------------------- + call mark_as_initialized('water_refractive_index_for_shortwave_radiation') + call mark_as_initialized('water_refractive_index_for_longwave_radiation') + + end subroutine read_water_refindex_file + +end module read_water_refindex diff --git a/src/aerosol/read_water_refindex.meta b/src/aerosol/read_water_refindex.meta new file mode 100644 index 000000000..53d8fe4c1 --- /dev/null +++ b/src/aerosol/read_water_refindex.meta @@ -0,0 +1,17 @@ +[ccpp-table-properties] + name = read_water_refindex + type = module + +[ccpp-arg-table] + name = read_water_refindex + type = module +[ crefwsw ] + standard_name = water_refractive_index_for_shortwave_radiation + units = 1 + type = complex | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation) +[ crefwlw ] + standard_name = water_refractive_index_for_longwave_radiation + units = 1 + type = complex | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation) diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 186299fc1..c0c8c9c7c 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -277,6 +277,9 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & call stepon_init(cam_runtime_opts, dyn_in, dyn_out) + ! Aerosol optics infrastructure init (after phys_init, before history_init_files) + call rad_aer_init_all() + ! if (single_column) then ! call scm_intht() ! end if @@ -712,6 +715,47 @@ 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 read_water_refindex, only: read_water_refindex_file + 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() + + ! Read water refractive index data + call read_water_refindex_file() + + ! 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..9c504970c 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -41,6 +41,8 @@ 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 read_water_refindex, only: read_water_refindex_readnl use gravity_wave_drag_ridge_read, only: gravity_wave_drag_ridge_read_readnl use dyn_comp, only: dyn_readnl @@ -89,6 +91,8 @@ 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 read_water_refindex_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 6bb132330..95e671611 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -24,6 +24,8 @@ $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/read_water_refindex.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 diff --git a/src/physics/utils/solar_parms_data.F90 b/src/physics/utils/solar_parms_data.F90 index 218d15f74..d6a37e394 100644 --- a/src/physics/utils/solar_parms_data.F90 +++ b/src/physics/utils/solar_parms_data.F90 @@ -1,4 +1,4 @@ -src/physics/utils/radiation_namelist.meta!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- ! solar variability parameters -- space weather indices !------------------------------------------------------------------------------- module solar_parms_data diff --git a/src/utils/table_interp_mod.F90 b/src/utils/table_interp_mod.F90 new file mode 100644 index 000000000..9daac52b5 --- /dev/null +++ b/src/utils/table_interp_mod.F90 @@ -0,0 +1,214 @@ +!---------------------------------------------------------------------------- +! Utility module used for interpolation of aerosol optics table +! NOTE: Results will be set to table edges for interpolations beyond +! the edges -- no extropolations +!---------------------------------------------------------------------------- +module table_interp_mod + use shr_kind_mod, only: r8=>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 From 47fd816bd4fa35bfd791c80303cd9294fdf2e407 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 16 Mar 2026 12:46:20 -0400 Subject: [PATCH 04/46] Port changes from Francis Vitt: CAM#1500 Fix issue with aerosol optics diagnostics (to merge into prev) (to merge into prev 2) --- src/aerosol/bulk_aerosol_state_mod.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index 082a4d6bc..db099be9e 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -316,8 +316,13 @@ function dry_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) 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 - vol = -huge(1._r8) + 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 @@ -335,7 +340,8 @@ function wet_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) real(r8) :: vol(ncol,nlev) ! m3/kg - vol = -huge(1._r8) + vol = self%dry_volume(aero_props, bin_idx, ncol, nlev) & + + self%water_volume(aero_props, bin_idx, ncol, nlev) end function wet_volume @@ -353,7 +359,7 @@ function water_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) real(r8) :: vol(ncol,nlev) ! m3/kg - vol = -huge(1._r8) + vol = 0._r8 end function water_volume From 46119323012e988972e94f05afc83bedafbdeb95 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 18 Mar 2026 15:22:50 -0400 Subject: [PATCH 05/46] Remove read_water_refindex and move to init phase of aerosol_optics CCPP scheme. --- cime_config/namelist_definition_cam.xml | 13 -- src/aerosol/read_water_refindex.F90 | 189 ------------------------ src/aerosol/read_water_refindex.meta | 17 --- src/control/cam_comp.F90 | 4 - src/control/runtime_opts.F90 | 2 - src/data/registry.xml | 1 - 6 files changed, 226 deletions(-) delete mode 100644 src/aerosol/read_water_refindex.F90 delete mode 100644 src/aerosol/read_water_refindex.meta diff --git a/cime_config/namelist_definition_cam.xml b/cime_config/namelist_definition_cam.xml index 664245b21..e04b2cf13 100644 --- a/cime_config/namelist_definition_cam.xml +++ b/cime_config/namelist_definition_cam.xml @@ -578,19 +578,6 @@ - - - char*256 - radiation - aerosol_optics_nl - none - - Full pathname of dataset for water refractive indices used in modal aerosol optics. - - - ${DIN_LOC_ROOT}/atm/cam/physprops/water_refindex_rrtmg_c080910.nc - - diff --git a/src/aerosol/read_water_refindex.F90 b/src/aerosol/read_water_refindex.F90 deleted file mode 100644 index 3c88c56e2..000000000 --- a/src/aerosol/read_water_refindex.F90 +++ /dev/null @@ -1,189 +0,0 @@ -!------------------------------------------------------------------- -! Read water refractive indices for modal aerosol optics. -!------------------------------------------------------------------- -! Note (hplin 3/14/26): I suppose this could be a ccpp scheme or -! collapsed into the aerosol_optics scheme init phase and use the -! CCPP i/o reader instead. -module read_water_refindex - use ccpp_kinds, only: kind_phys - use shr_kind_mod, only: shr_kind_cl - use runtime_obj, only: unset_str - - implicit none - private - - public :: read_water_refindex_readnl - public :: read_water_refindex_file - - ! Private module data - character(len=shr_kind_cl) :: water_refindex_file = unset_str - -!> \section arg_table_read_water_refindex Argument Table -!! \htmlinclude read_water_refindex.html - ! Complex refractive indices for water (shortwave and longwave) - complex(kind_phys), public, allocatable, target :: crefwsw(:) ! dimension(nswbands) - complex(kind_phys), public, allocatable, target :: crefwlw(:) ! dimension(nlwbands) - -contains - - subroutine read_water_refindex_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 cam_logfile, only: iulog - use cam_abortutils, only: endrun - use spmd_utils, only: masterproc - - character(len=*), intent(in) :: nlfile - - integer :: unitn, ierr - character(len=*), parameter :: subname = 'read_water_refindex_readnl' - character(len=shr_kind_cm) :: errmsg - - namelist /aerosol_optics_nl/ water_refindex_file - - errmsg = '' - - if (masterproc) then - open(newunit=unitn, file=trim(nlfile), status='old') - call find_group_name(unitn, 'aerosol_optics_nl', status=ierr) - if (ierr == 0) then - read(unitn, aerosol_optics_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(water_refindex_file, len(water_refindex_file), mpi_character, 0, mpicom, ierr) - - if (masterproc) then - write(iulog,*) subname, ' options:' - write(iulog,*) ' Water refindex file: ', trim(water_refindex_file) - end if - - end subroutine read_water_refindex_readnl - - subroutine read_water_refindex_file() - !------------------------------------------------------------------ - ! Read water refractive index dataset. - ! File contains real and imaginary parts of the refractive index - ! for shortwave and longwave bands. - !------------------------------------------------------------------ - use cam_logfile, only: iulog - use cam_abortutils, only: endrun, check_allocate - use spmd_utils, only: masterproc - use ioFileMod, only: cam_get_file - use cam_pio_utils, only: cam_pio_openfile - use pio, only: file_desc_t, var_desc_t, pio_inq_dimid, pio_inq_dimlen - use pio, only: pio_inq_varid, pio_get_var, pio_closefile, pio_nowrite - use radiation_namelist, only: nswbands, nlwbands - use phys_vars_init_check, only: mark_as_initialized - - ! Local variables - integer :: ierr - type(file_desc_t) :: pio_id - integer :: dimid, nsw_file, nlw_file - type(var_desc_t) :: vid - real(kind_phys), allocatable :: refr(:), refi(:) - character(len=shr_kind_cl) :: locfn - character(len=*), parameter :: subname = 'read_water_refindex_file' - character(len=256) :: errmsg - - ! Guard: skip if no file specified - if (trim(water_refindex_file) == trim(unset_str) .or. & - trim(water_refindex_file) == 'UNSET_PATH') then - if (masterproc) then - write(iulog,*) subname, ': no water refindex file specified, skipping' - end if - return - end if - - !----------------------------------------------------------------------- - ! Open file - !----------------------------------------------------------------------- - call cam_get_file(water_refindex_file, locfn, allow_fail=.false.) - call cam_pio_openfile(pio_id, trim(locfn), PIO_NOWRITE) - - !----------------------------------------------------------------------- - ! Validate shortwave dimension - !----------------------------------------------------------------------- - ierr = pio_inq_dimid(pio_id, 'sw_band', dimid) - ierr = pio_inq_dimlen(pio_id, dimid, nsw_file) - if (nsw_file /= nswbands) then - write(iulog,*) subname, ': nswbands mismatch: file=', nsw_file, ' expected=', nswbands - call endrun(subname//': nswbands mismatch in water refindex file') - end if - - !----------------------------------------------------------------------- - ! Validate longwave dimension - !----------------------------------------------------------------------- - ierr = pio_inq_dimid(pio_id, 'lw_band', dimid) - ierr = pio_inq_dimlen(pio_id, dimid, nlw_file) - if (nlw_file /= nlwbands) then - write(iulog,*) subname, ': nlwbands mismatch: file=', nlw_file, ' expected=', nlwbands - call endrun(subname//': nlwbands mismatch in water refindex file') - end if - - !----------------------------------------------------------------------- - ! Read shortwave refractive indices - !----------------------------------------------------------------------- - allocate(refr(nswbands), refi(nswbands), stat=ierr, errmsg=errmsg) - call check_allocate(ierr, subname, 'refr(nswbands), refi(nswbands)', errmsg=errmsg, & - file=__FILE__, line=__LINE__) - - ierr = pio_inq_varid(pio_id, 'refindex_real_water_sw', vid) - ierr = pio_get_var(pio_id, vid, refr) - - ierr = pio_inq_varid(pio_id, 'refindex_im_water_sw', vid) - ierr = pio_get_var(pio_id, vid, refi) - - allocate(crefwsw(nswbands), stat=ierr, errmsg=errmsg) - call check_allocate(ierr, subname, 'crefwsw(nswbands)', errmsg=errmsg, & - file=__FILE__, line=__LINE__) - crefwsw(:) = cmplx(refr(:), refi(:), kind=kind_phys) - - deallocate(refr, refi) - - !----------------------------------------------------------------------- - ! Read longwave refractive indices - !----------------------------------------------------------------------- - allocate(refr(nlwbands), refi(nlwbands), stat=ierr, errmsg=errmsg) - call check_allocate(ierr, subname, 'refr(nlwbands), refi(nlwbands)', errmsg=errmsg, & - file=__FILE__, line=__LINE__) - - ierr = pio_inq_varid(pio_id, 'refindex_real_water_lw', vid) - ierr = pio_get_var(pio_id, vid, refr) - - ierr = pio_inq_varid(pio_id, 'refindex_im_water_lw', vid) - ierr = pio_get_var(pio_id, vid, refi) - - allocate(crefwlw(nlwbands), stat=ierr, errmsg=errmsg) - call check_allocate(ierr, subname, 'crefwlw(nlwbands)', errmsg=errmsg, & - file=__FILE__, line=__LINE__) - crefwlw(:) = cmplx(refr(:), refi(:), kind=kind_phys) - - deallocate(refr, refi) - - !----------------------------------------------------------------------- - ! Close file - !----------------------------------------------------------------------- - call pio_closefile(pio_id) - - if (masterproc) then - write(iulog,*) subname, ': successfully read water refractive indices' - write(iulog,*) ' nswbands=', nswbands, ' nlwbands=', nlwbands - end if - - !-------------------------------------------------------- - ! Mark variables as initialized so they are not read from initial conditions - !-------------------------------------------------------- - call mark_as_initialized('water_refractive_index_for_shortwave_radiation') - call mark_as_initialized('water_refractive_index_for_longwave_radiation') - - end subroutine read_water_refindex_file - -end module read_water_refindex diff --git a/src/aerosol/read_water_refindex.meta b/src/aerosol/read_water_refindex.meta deleted file mode 100644 index 53d8fe4c1..000000000 --- a/src/aerosol/read_water_refindex.meta +++ /dev/null @@ -1,17 +0,0 @@ -[ccpp-table-properties] - name = read_water_refindex - type = module - -[ccpp-arg-table] - name = read_water_refindex - type = module -[ crefwsw ] - standard_name = water_refractive_index_for_shortwave_radiation - units = 1 - type = complex | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation) -[ crefwlw ] - standard_name = water_refractive_index_for_longwave_radiation - units = 1 - type = complex | kind = kind_phys - dimensions = (number_of_bands_for_longwave_radiation) diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index c0c8c9c7c..edf1f8eb5 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -722,7 +722,6 @@ subroutine rad_aer_init_all() ! 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 read_water_refindex, only: read_water_refindex_file use cam_ccpp_cap, only: cam_constituents_array use ccpp_kinds, only: kind_phys use phys_vars_init_check, only: mark_as_initialized @@ -735,9 +734,6 @@ subroutine rad_aer_init_all() ! Create aerosol properties objects call aerosol_instances_init() - ! Read water refractive index data - call read_water_refindex_file() - ! Wire constituents pointer into aerosol state objects constituents => cam_constituents_array() call aerosol_instances_init_states(constituents) diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 9c504970c..4fcef744f 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -42,7 +42,6 @@ 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 read_water_refindex, only: read_water_refindex_readnl use gravity_wave_drag_ridge_read, only: gravity_wave_drag_ridge_read_readnl use dyn_comp, only: dyn_readnl @@ -92,7 +91,6 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call tropopause_climo_readnl(nlfilename) call radiation_readnl(nlfilename) call rad_aer_readnl(nlfilename) - call read_water_refindex_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 95e671611..77077a2aa 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -24,7 +24,6 @@ $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/read_water_refindex.meta $SRCROOT/src/aerosol/radiative_aerosol_definitions.meta $SRCROOT/src/data/air_composition.meta $SRCROOT/src/data/cam_thermo.meta From 89463ed2c75f26aa11cf08bcadd5b7340a000364 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 24 Mar 2026 15:15:32 -0400 Subject: [PATCH 06/46] Aerosol pfUnit tests (coauthored with claude-opus-4.6 then reviewed); squash of 3 Add aerosol pfUnit tests (coauthored with claude-opus-4.6) Remove not-used in CAM-SIMA gas parsing test (but still cover it in a gas+aerosol compound test with a note about deprecation) Remove not-used in CAM-SIMA gas parsing test (but still cover it in a gas+aerosol compound test with a note about deprecation) --- src/aerosol/aerosol_mmr_ccpp.F90 | 2 +- src/aerosol/carma_aerosol_properties_mod.F90 | 2 +- src/aerosol/carma_aerosol_state_mod.F90 | 2 +- src/aerosol/modal_aerosol_properties_mod.F90 | 2 +- src/aerosol/modal_aerosol_state_mod.F90 | 2 +- src/aerosol/radiative_aerosol.F90 | 6 +- test/unit/fortran/CMakeLists.txt | 1 + test/unit/fortran/src/aerosol/CMakeLists.txt | 107 +++++++ .../src/aerosol/mock_aerosol_mmr_ccpp.F90 | 43 +++ .../mock_aerosol_physical_properties.F90 | 19 ++ .../src/aerosol/mock_cam_abortutils.F90 | 26 ++ .../fortran/src/aerosol/mock_cam_logfile.F90 | 11 + .../fortran/src/aerosol/mock_physconst.F90 | 14 + .../src/aerosol/mock_radiative_aerosol.F90 | 299 ++++++++++++++++++ .../src/aerosol/mock_shr_infnan_mod.F90 | 34 ++ .../src/aerosol/mock_shr_string_mod.F90 | 41 +++ .../fortran/src/aerosol/mock_spmd_utils.F90 | 12 + .../unit/fortran/src/aerosol/shr_kind_mod.F90 | 15 + .../aerosol/test_bulk_aerosol_properties.pf | 179 +++++++++++ .../src/aerosol/test_bulk_aerosol_state.pf | 158 +++++++++ .../aerosol/test_insoluble_aerosol_optics.pf | 150 +++++++++ .../fortran/src/aerosol/test_list_populate.pf | 119 +++++++ .../src/aerosol/test_parse_rad_specifier.pf | 141 +++++++++ .../fortran/src/aerosol/test_table_interp.pf | 236 ++++++++++++++ 24 files changed, 1614 insertions(+), 7 deletions(-) create mode 100644 test/unit/fortran/src/aerosol/CMakeLists.txt create mode 100644 test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_aerosol_physical_properties.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_cam_abortutils.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_cam_logfile.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_physconst.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_shr_infnan_mod.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_shr_string_mod.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_spmd_utils.F90 create mode 100644 test/unit/fortran/src/aerosol/shr_kind_mod.F90 create mode 100644 test/unit/fortran/src/aerosol/test_bulk_aerosol_properties.pf create mode 100644 test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf create mode 100644 test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf create mode 100644 test/unit/fortran/src/aerosol/test_list_populate.pf create mode 100644 test/unit/fortran/src/aerosol/test_parse_rad_specifier.pf create mode 100644 test/unit/fortran/src/aerosol/test_table_interp.pf diff --git a/src/aerosol/aerosol_mmr_ccpp.F90 b/src/aerosol/aerosol_mmr_ccpp.F90 index 15f98f6e2..253555951 100644 --- a/src/aerosol/aerosol_mmr_ccpp.F90 +++ b/src/aerosol/aerosol_mmr_ccpp.F90 @@ -5,7 +5,7 @@ module aerosol_mmr_ccpp ! CAM-SIMA (CCPP) aerosol MMR retrieval routines. These routines use ! the CCPP constituents array to return mixing ratio pointers. ! -! Ported from aerosol_mmr_cam — replaces pbuf/state%q with CCPP constituents. +! Ported from aerosol_mmr_cam: replaces pbuf/state%q with CCPP constituents. ! !------------------------------------------------------------------------------------------------ diff --git a/src/aerosol/carma_aerosol_properties_mod.F90 b/src/aerosol/carma_aerosol_properties_mod.F90 index 9fc75650a..29e47cfd9 100644 --- a/src/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/aerosol/carma_aerosol_properties_mod.F90 @@ -1,6 +1,6 @@ module carma_aerosol_properties_mod !----------------------------------------------------------------------------- - ! Stub module for CARMA aerosol properties — not yet implemented in CAM-SIMA. + ! 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 diff --git a/src/aerosol/carma_aerosol_state_mod.F90 b/src/aerosol/carma_aerosol_state_mod.F90 index 272768230..61853ee95 100644 --- a/src/aerosol/carma_aerosol_state_mod.F90 +++ b/src/aerosol/carma_aerosol_state_mod.F90 @@ -1,6 +1,6 @@ module carma_aerosol_state_mod !----------------------------------------------------------------------------- - ! Stub module for CARMA aerosol state — not yet implemented in CAM-SIMA. + ! 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 diff --git a/src/aerosol/modal_aerosol_properties_mod.F90 b/src/aerosol/modal_aerosol_properties_mod.F90 index 4caab1037..f5f099682 100644 --- a/src/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/aerosol/modal_aerosol_properties_mod.F90 @@ -1,6 +1,6 @@ module modal_aerosol_properties_mod !----------------------------------------------------------------------------- - ! Stub module for modal aerosol properties — not yet implemented in CAM-SIMA. + ! Stub module for modal 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 diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 index ee2bbf879..ad1a10a8d 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -1,6 +1,6 @@ module modal_aerosol_state_mod !----------------------------------------------------------------------------- - ! Stub module for modal aerosol state — not yet implemented in CAM-SIMA. + ! Stub module for modal 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 diff --git a/src/aerosol/radiative_aerosol.F90 b/src/aerosol/radiative_aerosol.F90 index 204911696..c5717faa3 100644 --- a/src/aerosol/radiative_aerosol.F90 +++ b/src/aerosol/radiative_aerosol.F90 @@ -26,7 +26,9 @@ module radiative_aerosol module procedure rad_aer_get_mam_props_by_idx end interface -! Public routines — aerosol queries (rad_aer_* naming) +! Public routines +! 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 @@ -1318,7 +1320,7 @@ subroutine rad_aer_readnl(nlfile) end if end do - ! Accumulate unique physprop files — bulk aerosol species + ! 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) diff --git a/test/unit/fortran/CMakeLists.txt b/test/unit/fortran/CMakeLists.txt index 898fc1b38..4b0b3ab5f 100644 --- a/test/unit/fortran/CMakeLists.txt +++ b/test/unit/fortran/CMakeLists.txt @@ -36,6 +36,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) diff --git a/test/unit/fortran/src/aerosol/CMakeLists.txt b/test/unit/fortran/src/aerosol/CMakeLists.txt new file mode 100644 index 000000000..7c095ea0a --- /dev/null +++ b/test/unit/fortran/src/aerosol/CMakeLists.txt @@ -0,0 +1,107 @@ +# 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 +) +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_aerosol_physical_properties.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_radiative_aerosol.F90 + mock_aerosol_mmr_ccpp.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) diff --git a/test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 b/test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 new file mode 100644 index 000000000..ee7dacd31 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 @@ -0,0 +1,43 @@ +!----------------------------------------------------------------------- +! Mock aerosol_mmr_ccpp 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. +!----------------------------------------------------------------------- +module aerosol_mmr_ccpp + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys + + implicit none + private + + ! Generic interface matching the real module + interface rad_cnst_get_aer_mmr + module procedure rad_cnst_get_aer_mmr_by_idx + end interface + + public :: rad_cnst_get_aer_mmr + +contains + + !----------------------------------------------------------------------- + ! Mock rad_cnst_get_aer_mmr: directly index into constituents(:,:,aer_idx). + ! In the real module, aer_idx is used to look up the resolved CCPP index. + ! Here we short-circuit that and use aer_idx directly as the 3rd dimension. + !----------------------------------------------------------------------- + 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 + +end module aerosol_mmr_ccpp diff --git a/test/unit/fortran/src/aerosol/mock_aerosol_physical_properties.F90 b/test/unit/fortran/src/aerosol/mock_aerosol_physical_properties.F90 new file mode 100644 index 000000000..76fa76263 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_aerosol_physical_properties.F90 @@ -0,0 +1,19 @@ +module aerosol_physical_properties + ! Mock stub for unit tests. + ! Provides physprop_get_id which simply returns a deterministic index + ! based on the filename hash (position in an internal counter). + implicit none + private + public :: physprop_get_id + + integer, save :: next_id = 0 + +contains + + 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 + +end module aerosol_physical_properties 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_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_physconst.F90 b/test/unit/fortran/src/aerosol/mock_physconst.F90 new file mode 100644 index 000000000..72ae5191e --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_physconst.F90 @@ -0,0 +1,14 @@ +!----------------------------------------------------------------------- +! 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 + +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..540759b59 --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 @@ -0,0 +1,299 @@ +!----------------------------------------------------------------------- +! Mock radiative_aerosol module for unit testing bulk_aerosol_properties. +! +! This mock replaces the real radiative_aerosol facade module. The real +! module delegates to aerosol_physical_properties (which reads NetCDF +! physprop files via PIO). This mock provides configurable in-memory data +! via setup_mock_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_props(list_idx, aer_idx, density_aer=..., hygro_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 + + ! Mock data storage (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) + + ! Generic interfaces matching the real module + interface rad_aer_get_info + module procedure rad_aer_get_info_basic + end interface + + interface rad_aer_get_props + module procedure rad_aer_get_props_by_idx + end interface + + public :: rad_aer_get_info + public :: rad_aer_get_props + public :: setup_mock_rad_aer + public :: setup_mock_optics_tables + public :: cleanup_mock_rad_aer + +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 + + !----------------------------------------------------------------------- + ! Clean up mock data. + !----------------------------------------------------------------------- + subroutine cleanup_mock_rad_aer() + mock_naero = 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 = 0 + 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 + +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_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/shr_kind_mod.F90 b/test/unit/fortran/src/aerosol/shr_kind_mod.F90 new file mode 100644 index 000000000..6d2fc5e86 --- /dev/null +++ b/test/unit/fortran/src/aerosol/shr_kind_mod.F90 @@ -0,0 +1,15 @@ +!----------------------------------------------------------------------- +! 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 + +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..d92a006de --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf @@ -0,0 +1,158 @@ +!----------------------------------------------------------------------- +! 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 +! aerosol_physical_properties) +! +! Mock boundaries: +! - radiative_aerosol (rad_aer_get_info, rad_aer_get_props) for properties +! - aerosol_mmr_ccpp (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 + + 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(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 + + 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(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 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(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 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(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..147e0aee0 --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf @@ -0,0 +1,150 @@ +!----------------------------------------------------------------------- +! 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_optics_mod, only: aerosol_optics + use radiative_aerosol, only: setup_mock_rad_aer, setup_mock_optics_tables, cleanup_mock_rad_aer + + 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) + + ! 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(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_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_optics_mod, only: aerosol_optics + use radiative_aerosol, only: setup_mock_rad_aer, setup_mock_optics_tables, cleanup_mock_rad_aer + + 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) + + 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(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_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_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 From d9793e349b41e2d83f98e835a9084c1a345b4124 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 24 Mar 2026 22:36:16 -0400 Subject: [PATCH 07/46] Frontport changes from code review in CAM --- src/aerosol/aerosol_optics_core.F90 | 32 ++++++++++++---------- src/aerosol/volcrad_aerosol_optics_mod.F90 | 2 +- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/src/aerosol/aerosol_optics_core.F90 b/src/aerosol/aerosol_optics_core.F90 index a0ab4b927..034d2cc33 100644 --- a/src/aerosol/aerosol_optics_core.F90 +++ b/src/aerosol/aerosol_optics_core.F90 @@ -46,17 +46,17 @@ function create_aerosol_optics_object(aeroprops, aerostate, ibin, & 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, target :: geometric_radius(:, :) + 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 @@ -90,8 +90,10 @@ function create_aerosol_optics_object(aeroprops, aerostate, ibin, & case ('volcanic_radius', 'volcanic_radius1', 'volcanic_radius2', 'volcanic_radius3', 'volcanic_radius5') if (present(geometric_radius)) then - aero_optics => volcrad_aerosol_optics(aeroprops, aerostate, & - ibin, ncol, nlev, geometric_radius) + if (associated(geometric_radius)) then + aero_optics => volcrad_aerosol_optics(aeroprops, aerostate, & + ibin, ncol, nlev, geometric_radius) + end if end if end select @@ -132,7 +134,7 @@ subroutine aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & real(r8), intent(in) :: mass(:, :) ! layer mass (pdeldry*rga) complex(r8), intent(in) :: crefwsw(:) complex(r8), intent(in) :: crefwlw(:) - real(r8), intent(in), optional, target :: geometric_radius(:, :) + 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 @@ -360,7 +362,7 @@ subroutine aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & real(r8), intent(in) :: mass(:, :) complex(r8), intent(in) :: crefwsw(:) complex(r8), intent(in) :: crefwlw(:) - real(r8), intent(in), optional, target :: geometric_radius(:, :) + 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) diff --git a/src/aerosol/volcrad_aerosol_optics_mod.F90 b/src/aerosol/volcrad_aerosol_optics_mod.F90 index 2ae41a5bc..58059706a 100644 --- a/src/aerosol/volcrad_aerosol_optics_mod.F90 +++ b/src/aerosol/volcrad_aerosol_optics_mod.F90 @@ -54,7 +54,7 @@ function constructor(aero_props, aero_state, ibin, ncols, nlevs, geometric_radiu 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(ncols,nlevs) + real(r8),intent(in) :: geometric_radius(:,:) type(volcrad_aerosol_optics), pointer :: newobj From c1c8a17d52ebb23830ffc99c664325ae9ce3ed4b Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 25 Mar 2026 12:51:17 -0400 Subject: [PATCH 08/46] fix palb, pasm comment - sync with CAM --- src/aerosol/aerosol_optics_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/aerosol/aerosol_optics_mod.F90 b/src/aerosol/aerosol_optics_mod.F90 index ae2a04bfb..be4deedef 100644 --- a/src/aerosol/aerosol_optics_mod.F90 +++ b/src/aerosol/aerosol_optics_mod.F90 @@ -34,8 +34,8 @@ subroutine aeropts_sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) 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),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor end subroutine aeropts_sw_props From 36b7bb44ca31647a7cd3c05c3b4b4e1337937996 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 8 Apr 2026 13:12:32 -0400 Subject: [PATCH 09/46] Sync up to CAM --- src/aerosol/aerosol_mmr_ccpp.F90 | 4 +- src/aerosol/aerosol_optics_core.F90 | 2 +- src/aerosol/aerosol_physical_properties.F90 | 4 +- src/aerosol/aerosol_properties_mod.F90 | 283 +++++++++++------- src/aerosol/aerosol_state_mod.F90 | 11 +- src/aerosol/bulk_aerosol_properties_mod.F90 | 188 +----------- src/aerosol/bulk_aerosol_state_mod.F90 | 9 +- .../hygrowghtpct_aerosol_optics_mod.F90 | 10 +- src/aerosol/radiative_aerosol.F90 | 221 +++++++------- src/aerosol/radiative_aerosol_definitions.F90 | 188 +++++++----- 10 files changed, 440 insertions(+), 480 deletions(-) diff --git a/src/aerosol/aerosol_mmr_ccpp.F90 b/src/aerosol/aerosol_mmr_ccpp.F90 index 253555951..2e7fea1eb 100644 --- a/src/aerosol/aerosol_mmr_ccpp.F90 +++ b/src/aerosol/aerosol_mmr_ccpp.F90 @@ -94,7 +94,7 @@ 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 aerosol_physical_properties, only: physprop_get_id + use phys_prop, only: physprop_get_id use cam_abortutils, only: endrun use radiative_aerosol_definitions, only: modes_t @@ -147,7 +147,7 @@ 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 aerosol_physical_properties, only: physprop_get_id + use phys_prop, only: physprop_get_id use cam_abortutils, only: endrun use radiative_aerosol_definitions, only: bins_t diff --git a/src/aerosol/aerosol_optics_core.F90 b/src/aerosol/aerosol_optics_core.F90 index 034d2cc33..63d47f849 100644 --- a/src/aerosol/aerosol_optics_core.F90 +++ b/src/aerosol/aerosol_optics_core.F90 @@ -30,7 +30,7 @@ function create_aerosol_optics_object(aeroprops, aerostate, ibin, & relh, sulfwtpct, crefwsw, crefwlw, & geometric_radius) result(aero_optics) - use aerosol_physical_properties, only: ot_length + use phys_prop, only: ot_length use aerosol_properties_mod, only: aerosol_properties use aerosol_state_mod, only: aerosol_state diff --git a/src/aerosol/aerosol_physical_properties.F90 b/src/aerosol/aerosol_physical_properties.F90 index e9f3c3a3a..e57b251c5 100644 --- a/src/aerosol/aerosol_physical_properties.F90 +++ b/src/aerosol/aerosol_physical_properties.F90 @@ -4,7 +4,7 @@ ! 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 aerosol_physical_properties +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 @@ -1666,4 +1666,4 @@ subroutine hygroscopic_wtp_optics_init(phys_prop, nc_id) end subroutine hygroscopic_wtp_optics_init -end module aerosol_physical_properties +end module phys_prop diff --git a/src/aerosol/aerosol_properties_mod.F90 b/src/aerosol/aerosol_properties_mod.F90 index eb1d89d6f..8aab8f728 100644 --- a/src/aerosol/aerosol_properties_mod.F90 +++ b/src/aerosol/aerosol_properties_mod.F90 @@ -75,7 +75,8 @@ module aerosol_properties_mod 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(aero_optics_params), deferred :: optics_params + 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 @@ -128,79 +129,13 @@ subroutine aero_props_get(self, bin_ndx, species_ndx, density, hygro, & end subroutine aero_props_get !------------------------------------------------------------------------ - ! returns optics type and table parameters + ! returns the physprop ID for a given bin index !------------------------------------------------------------------------ - subroutine aero_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 ) - - import :: aerosol_properties, r8 - + integer function aero_physprop_id(self, bin_ndx) + import :: aerosol_properties class(aerosol_properties), intent(in) :: self - integer, intent(in) :: bin_ndx ! 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 precent of H2SO4/H2O solution - integer, optional, intent(out) :: nwtp ! number of weight precent 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(:,:) - - end subroutine aero_optics_params + integer, intent(in) :: bin_ndx + end function aero_physprop_id !------------------------------------------------------------------------ ! returns species type @@ -488,25 +423,25 @@ subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ie if( ierr /= 0 ) then return end if - allocate(self%dgnum_(nbin),stat=ierr) - if( ierr /= 0 ) then - return + if (present(dgnum)) then + allocate(self%dgnum_(nbin),stat=ierr) + if( ierr /= 0 ) return end if - allocate(self%dgnumhi_(nbin),stat=ierr) - if( ierr /= 0 ) then - return + if (present(dgnumhi)) then + allocate(self%dgnumhi_(nbin),stat=ierr) + if( ierr /= 0 ) return end if - allocate(self%dgnumlo_(nbin),stat=ierr) - if( ierr /= 0 ) then - return + if (present(dgnumlo)) then + allocate(self%dgnumlo_(nbin),stat=ierr) + if( ierr /= 0 ) return end if - allocate(self%rhcrystal_(nbin),stat=ierr) - if( ierr /= 0 ) then - return + if (present(rhcrystal)) then + allocate(self%rhcrystal_(nbin),stat=ierr) + if( ierr /= 0 ) return end if - allocate(self%rhdeliques_(nbin),stat=ierr) - if( ierr /= 0 ) then - return + 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 ) @@ -539,28 +474,18 @@ subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ie if (present(dgnum)) then self%dgnum_(:) = dgnum(:) - else - self%dgnum_(:) = 0._r8 end if if (present(dgnumhi)) then self%dgnumhi_(:) = dgnumhi(:) - else - self%dgnumhi_(:) = 0._r8 end if if (present(dgnumlo)) then self%dgnumlo_(:) = dgnumlo(:) - else - self%dgnumlo_(:) = 0._r8 end if if (present(rhcrystal)) then self%rhcrystal_(:) = rhcrystal(:) - else - self%rhcrystal_(:) = 0._r8 end if if (present(rhdeliques)) then self%rhdeliques_(:) = rhdeliques(:) - else - self%rhdeliques_(:) = 0._r8 end if self%soa_equivso4_factor_ = spechygro_soa/spechygro_so4 @@ -710,7 +635,11 @@ pure real(r8) function get_dgnum(self, bin_ndx) class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx - get_dgnum = self%dgnum_(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 !------------------------------------------------------------------------------ @@ -720,7 +649,11 @@ pure real(r8) function get_dgnumhi(self, bin_ndx) class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx - get_dgnumhi = self%dgnumhi_(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 !------------------------------------------------------------------------------ @@ -730,7 +663,11 @@ pure real(r8) function get_dgnumlo(self, bin_ndx) class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx - get_dgnumlo = self%dgnumlo_(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 !------------------------------------------------------------------------------ @@ -740,7 +677,11 @@ pure real(r8) function get_rhcrystal(self, bin_ndx) class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx - get_rhcrystal = self%rhcrystal_(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 !------------------------------------------------------------------------------ @@ -750,7 +691,11 @@ pure real(r8) function get_rhdeliques(self, bin_ndx) class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx - get_rhdeliques = self%rhdeliques_(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 !------------------------------------------------------------------------------ @@ -845,4 +790,138 @@ pure integer function get_list_idx(self) 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 index 367aee96d..3b8feb339 100644 --- a/src/aerosol/aerosol_state_mod.F90 +++ b/src/aerosol/aerosol_state_mod.F90 @@ -238,13 +238,13 @@ subroutine aero_water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qa end subroutine aero_water_uptake !------------------------------------------------------------------------------ - ! aerosol weight precent of H2SO4/H2O solution + ! 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 precent of H2SO4/H2O solution for given icol, ilev + real(r8) :: wtp(ncol,nlev) ! weight percent of H2SO4/H2O solution for given icol, ilev end function aero_wgtpct @@ -348,7 +348,7 @@ subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, & 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(l,m, qqcw) + 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 @@ -514,7 +514,7 @@ subroutine icenuc_type_wght_base(self, bin_ndx, ncol, nlev, species_type, aero_p do ispc = 1, aero_props%nspecies(bin_ndx) if (cldbrne) then - call self%get_cldbrne_mmr(ispc, bin_ndx, aer_bin) + 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 @@ -896,9 +896,10 @@ end function refractive_index_lw !------------------------------------------------------------------------------ ! prescribed aerosol activation fraction for convective cloud !------------------------------------------------------------------------------ - function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) + 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 diff --git a/src/aerosol/bulk_aerosol_properties_mod.F90 b/src/aerosol/bulk_aerosol_properties_mod.F90 index f4213d6b6..14cd57941 100644 --- a/src/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/aerosol/bulk_aerosol_properties_mod.F90 @@ -7,7 +7,7 @@ module bulk_aerosol_properties_mod use cam_abortutils, only: endrun use string_utils, only : to_lower - use aerosol_properties_mod, only: aerosol_properties, aero_name_len + 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(=) @@ -37,7 +37,7 @@ module bulk_aerosol_properties_mod procedure :: icenuc_updates_mmr procedure :: apply_number_limits procedure :: hetfrz_species - procedure :: optics_params + procedure :: physprop_id procedure :: soluble procedure :: min_mass_mean_rad procedure :: bin_name @@ -221,185 +221,17 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, & end subroutine get !------------------------------------------------------------------------ - ! returns optics type and table parameters + ! returns the physprop ID for a given bin (aerosol) index !------------------------------------------------------------------------ - 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 ) - + 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 ! bin index + integer, intent(in) :: bin_ndx - 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 precent of H2SO4/H2O solution - integer, optional, intent(out) :: nwtp ! number of weight precent 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(:,:) - - ! refactive index table parameters - call rad_aer_get_props( & - list_idx=self%list_idx_, & - aer_idx=bin_ndx, & - opticstype=opticstype, & - sw_hygro_ext=sw_hygroscopic_ext, & - sw_hygro_ssa=sw_hygroscopic_ssa, & - sw_hygro_asm=sw_hygroscopic_asm, & - lw_hygro_ext=lw_hygroscopic_ext, & - sw_nonhygro_ext=sw_insoluble_ext, & - sw_nonhygro_ssa=sw_insoluble_ssa, & - sw_nonhygro_asm=sw_insoluble_asm, & - lw_ext=lw_insoluble_ext, & - 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 ) - - if (present(extpsw)) then - nullify(extpsw) - endif - - if (present(abspsw)) then - nullify(abspsw) - endif - if (present(asmpsw)) then - nullify(asmpsw) - endif - if (present(absplw)) then - nullify(absplw) - endif - if (present(refrtabsw)) then - nullify(refrtabsw) - endif - if (present(refitabsw)) then - nullify(refitabsw) - endif - if (present(refrtablw)) then - nullify(refrtablw) - endif - if (present(refitablw)) then - nullify(refitablw) - endif - if (present(ncoef)) then - ncoef = -huge(1) - endif - if (present(prefr)) then - prefr = -huge(1) - endif - if (present(prefi)) then - prefi = -huge(1) - endif - if (present(sw_hygro_ext_wtp)) then - nullify(sw_hygro_ext_wtp) - endif - if (present(sw_hygro_ssa_wtp)) then - nullify(sw_hygro_ssa_wtp) - endif - if (present(sw_hygro_asm_wtp)) then - nullify(sw_hygro_asm_wtp) - endif - if (present(lw_hygro_ext_wtp)) then - nullify(lw_hygro_ext_wtp) - endif - if (present(wgtpct)) then - nullify(wgtpct) - endif - if (present(nwtp)) then - nwtp = -huge(1) - endif - - if (present(sw_hygro_coreshell_ext)) then - nullify(sw_hygro_coreshell_ext) - endif - if (present(sw_hygro_coreshell_ssa)) then - nullify(sw_hygro_coreshell_ssa) - endif - if (present(sw_hygro_coreshell_asm)) then - nullify(sw_hygro_coreshell_asm) - endif - if (present(lw_hygro_coreshell_ext)) then - nullify(lw_hygro_coreshell_ext) - endif - if (present(corefrac)) then - nullify(corefrac) - endif - if (present(bcdust)) then - nullify(bcdust) - endif - if (present(kap)) then - nullify(kap) - endif - if (present(relh)) then - nullify(relh) - endif - - if (present(nfrac)) then - nfrac = -huge(1) - endif - if (present(nbcdust)) then - nbcdust = -huge(1) - endif - if (present(nkap)) then - nkap = -huge(1) - endif - if (present(nrelh)) then - nrelh = -huge(1) - endif - - end subroutine optics_params + 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 @@ -594,6 +426,8 @@ 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 diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index db099be9e..7cf35f539 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -4,7 +4,7 @@ module bulk_aerosol_state_mod use aerosol_mmr_ccpp, only: rad_cnst_get_aer_mmr use cam_abortutils, only: endrun - use aerosol_state_mod, only: aerosol_state, ptr2d_t + use aerosol_state_mod, only: aerosol_state, ptr2d_t use aerosol_properties_mod, only: aerosol_properties implicit none @@ -381,9 +381,10 @@ end function wet_diameter !------------------------------------------------------------------------------ ! prescribed aerosol activation fraction for convective cloud !------------------------------------------------------------------------------ - function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) + 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 @@ -396,12 +397,12 @@ function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) end function convcld_actfrac !------------------------------------------------------------------------------ - ! aerosol weight precent of H2SO4/H2O solution + ! 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 precent of H2SO4/H2O solution for given icol, ilev + real(r8) :: wtp(ncol,nlev) ! weight percent of H2SO4/H2O solution for given icol, ilev wtp = -huge(1._r8) diff --git a/src/aerosol/hygrowghtpct_aerosol_optics_mod.F90 b/src/aerosol/hygrowghtpct_aerosol_optics_mod.F90 index 617f0d81b..5f7ad9b7c 100644 --- a/src/aerosol/hygrowghtpct_aerosol_optics_mod.F90 +++ b/src/aerosol/hygrowghtpct_aerosol_optics_mod.F90 @@ -13,20 +13,20 @@ module hygrowghtpct_aerosol_optics_mod !> hygrowghtpct_aerosol_optics !! Table look up implementation of aerosol_optics to parameterize aerosol - !! radiative properties in terms of weight precent of H2SO4/H2O solution + !! 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 precent of H2SO4/H2O solution + 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 precent dimenstion values + real(r8), pointer :: tbl_wgtpct(:) ! weight percent dimenstion values - integer :: nwtp ! weight precent dimenstion size + integer :: nwtp ! weight percent dimenstion size contains @@ -80,7 +80,7 @@ function constructor(aero_props, aero_state, ibin, ncol, nlev, wgtpct_in) result return end if - ! weight precent of H2SO4/H2O solution + ! 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) diff --git a/src/aerosol/radiative_aerosol.F90 b/src/aerosol/radiative_aerosol.F90 index c5717faa3..981ee35d0 100644 --- a/src/aerosol/radiative_aerosol.F90 +++ b/src/aerosol/radiative_aerosol.F90 @@ -26,7 +26,7 @@ module radiative_aerosol module procedure rad_aer_get_mam_props_by_idx end interface -! Public routines +! Public subroutines ! Formerly rad_cnst queries that are related to aerosol ! have been moved to the rad_aer prefix. public :: rad_aer_get_info @@ -38,11 +38,13 @@ module radiative_aerosol public :: rad_aer_get_mode_props public :: rad_aer_get_props public :: rad_aer_get_bin_props_by_idx -public :: rad_aer_get_bin_props 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 @@ -628,7 +630,7 @@ subroutine rad_aer_get_props_by_idx(list_idx, & 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 aerosol_physical_properties, only: physprop_get, ot_length + 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 @@ -729,7 +731,7 @@ subroutine rad_aer_get_mam_props_by_idx(list_idx, & aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & num_to_mass_aer, spectype) use shr_kind_mod, only: r8 => shr_kind_r8 - use aerosol_physical_properties, only: physprop_get, ot_length + 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 @@ -845,7 +847,7 @@ subroutine rad_aer_get_bin_props_by_idx(list_idx, & 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 aerosol_physical_properties, only: physprop_get, ot_length + 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 @@ -960,7 +962,7 @@ subroutine rad_aer_get_mode_props(list_idx, mode_idx, opticstype, & rhcrystal, rhdeliques) use shr_kind_mod, only: r8 => shr_kind_r8 - use aerosol_physical_properties, only: physprop_get, ot_length + 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 @@ -1038,106 +1040,9 @@ end subroutine rad_aer_get_mode_props !================================================================================================ -subroutine rad_aer_get_bin_props(list_idx, bin_idx, opticstype, & - extpsw, abspsw, asmpsw, absplw, corefrac, nfrac, & - wgtpct, nwtp, bcdust, nbcdust, kap, nkap, relh, nrelh, & - sw_hygro_ext_wtp, sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, & - sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, dryrad ) - use shr_kind_mod, only: r8 => shr_kind_r8 - use aerosol_physical_properties, 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 - - ! Return requested properties for the bin 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 - - 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 :: corefrac(:) - integer, optional, intent(out) :: nfrac - - 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_ext_wtp(:,:) - 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_ext(:,:,:,:,:) - real(r8), optional, pointer :: wgtpct(:) - real(r8), optional, pointer :: bcdust(:) - real(r8), optional, pointer :: kap(:) - real(r8), optional, pointer :: relh(:) - integer, optional, intent(out) :: nwtp - integer, optional, intent(out) :: nbcdust - integer, optional, intent(out) :: nkap - integer, optional, intent(out) :: nrelh - real(r8), optional, intent(out) :: dryrad - - ! Local variables - integer :: idx - type(binlist_t), pointer :: slist - character(len=*), parameter :: subname = 'rad_aer_get_bin_props' - !------------------------------------------------------------------------------------ - - 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 physprop index for the requested bin - idx = slist%idx_props(bin_idx) - - if (present(opticstype)) call physprop_get(idx, opticstype=opticstype) - if (present(extpsw)) call physprop_get(idx, extpsw2=extpsw) - if (present(abspsw)) call physprop_get(idx, abspsw2=abspsw) - if (present(asmpsw)) call physprop_get(idx, asmpsw2=asmpsw) - if (present(absplw)) call physprop_get(idx, absplw2=absplw) - if (present(corefrac)) call physprop_get(idx, corefrac=corefrac) - if (present(nfrac)) call physprop_get(idx, nfrac=nfrac) - - if (present(sw_hygro_ext_wtp)) call physprop_get(idx, sw_hygro_ext_wtp=sw_hygro_ext_wtp) - if (present(sw_hygro_ssa_wtp)) call physprop_get(idx, sw_hygro_ssa_wtp=sw_hygro_ssa_wtp) - if (present(sw_hygro_asm_wtp)) call physprop_get(idx, sw_hygro_asm_wtp=sw_hygro_asm_wtp) - if (present(lw_hygro_ext_wtp)) call physprop_get(idx, lw_hygro_abs_wtp=lw_hygro_ext_wtp) - if (present(sw_hygro_coreshell_ext)) call physprop_get(idx, sw_hygro_coreshell_ext=sw_hygro_coreshell_ext) - if (present(sw_hygro_coreshell_ssa)) call physprop_get(idx, sw_hygro_coreshell_ssa=sw_hygro_coreshell_ssa) - if (present(sw_hygro_coreshell_asm)) call physprop_get(idx, sw_hygro_coreshell_asm=sw_hygro_coreshell_asm) - if (present(lw_hygro_coreshell_ext)) call physprop_get(idx, lw_hygro_coreshell_abs=lw_hygro_coreshell_ext) - if (present(wgtpct)) call physprop_get(idx, wgtpct=wgtpct) - if (present(bcdust)) call physprop_get(idx, bcdust=bcdust) - if (present(kap)) call physprop_get(idx, kap=kap) - if (present(relh)) call physprop_get(idx, relh=relh) - if (present(nwtp)) call physprop_get(idx, nwtp=nwtp) - if (present(nbcdust)) call physprop_get(idx, nbcdust=nbcdust) - if (present(nkap)) call physprop_get(idx, nkap=nkap) - if (present(nrelh)) call physprop_get(idx, nrelh=nrelh) - if (present(dryrad)) call physprop_get(idx, dryrad_aer=dryrad) - -end subroutine rad_aer_get_bin_props - -!================================================================================================ - subroutine print_aerosol_lists(aer_list, m_list, s_list) use cam_logfile, only: iulog - use radiative_aerosol_definitions, only: nl, aerlist_t, modelist_t, binlist_t, modes, bins + use radiative_aerosol_definitions, only: newline, aerlist_t, modelist_t, binlist_t, modes, bins ! Print summary of bulk, modal, and bin aerosol lists. @@ -1148,9 +1053,9 @@ subroutine print_aerosol_lists(aer_list, m_list, s_list) integer :: i, idx if (len_trim(aer_list%list_id) == 0) then - write(iulog,*) nl//' bulk aerosol list for climate calculations' + write(iulog,*) newline//' bulk aerosol list for climate calculations' else - write(iulog,*) nl//' bulk aerosol list for diag'//aer_list%list_id//' calculations' + write(iulog,*) newline//' bulk aerosol list for diag'//aer_list%list_id//' calculations' end if do i = 1, aer_list%numaerosols @@ -1159,9 +1064,9 @@ subroutine print_aerosol_lists(aer_list, m_list, s_list) enddo if (len_trim(m_list%list_id) == 0) then - write(iulog,*) nl//' modal aerosol list for climate calculations' + write(iulog,*) newline//' modal aerosol list for climate calculations' else - write(iulog,*) nl//' modal aerosol list for diag'//m_list%list_id//' calculations' + write(iulog,*) newline//' modal aerosol list for diag'//m_list%list_id//' calculations' end if do i = 1, m_list%nmodes @@ -1170,9 +1075,9 @@ subroutine print_aerosol_lists(aer_list, m_list, s_list) enddo if (len_trim(s_list%list_id) == 0) then - write(iulog,*) nl//' bin aerosol list for climate calculations' + write(iulog,*) newline//' bin aerosol list for climate calculations' else - write(iulog,*) nl//' bin aerosol list for diag'//s_list%list_id//' calculations' + write(iulog,*) newline//' bin aerosol list for diag'//s_list%list_id//' calculations' end if do i = 1, s_list%nbins @@ -1197,7 +1102,7 @@ subroutine rad_aer_readnl(nlfile) use shr_kind_mod, only: shr_kind_cm use mpi, only: mpi_character use spmd_utils, only: mpicom - use aerosol_physical_properties, only: physprop_accum_unique_files + use phys_prop, only: physprop_accum_unique_files use spmd_utils, only: masterproc use cam_abortutils, only: endrun use radiative_aerosol_definitions, only: & @@ -1367,7 +1272,7 @@ end subroutine rad_aer_readnl ! Reads physprop files, resolves constituent indices for modes/bins, ! finishes aerosol list init, and registers aerosol diagnostic fields. subroutine rad_aer_init() - use aerosol_physical_properties, only: physprop_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 @@ -1405,4 +1310,96 @@ 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 index 485cb6a72..81a277c3b 100644 --- a/src/aerosol/radiative_aerosol_definitions.F90 +++ b/src/aerosol/radiative_aerosol_definitions.F90 @@ -8,6 +8,8 @@ !----------------------------------------------------------------------------- module radiative_aerosol_definitions + use shr_kind_mod, only: shr_kind_cl + implicit none private save @@ -40,9 +42,8 @@ module radiative_aerosol_definitions !=========================== ! Shared constants (shared with rad_constituents for gases) part 1. !=========================== - integer, public, parameter :: cs1 = 256 - logical, public :: verbose = .true. - character(len=1), public, parameter :: nl = achar(10) + logical, public, parameter :: verbose = .true. + character(len=1), public, parameter :: newline = achar(10) !=========================== ! Types @@ -52,13 +53,13 @@ module radiative_aerosol_definitions ! 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), + 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=cs1), pointer :: radname(:) ! radname is the name as identfied in radiation, + character(len= 64), pointer :: camname(:) ! name registered in pbuf or constituents + character(len=shr_kind_cl), 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 + 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 @@ -69,21 +70,38 @@ module radiative_aerosol_definitions ! 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), pointer :: source_mmr_a(:) ! source of interstitial specie mmr fields - character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr of interstitial components - character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields - character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components - character(len= 32), pointer :: type(:) ! specie type (as used in MAM code) - character(len=cs1), pointer :: props(:) ! file containing specie properties - integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species - integer :: idx_num_c ! index in pbuf for number mixing ratio of interstitial species - integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species - integer, pointer :: idx_mmr_c(:) ! index in pbuf for mmr of interstitial species - integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module + + ! 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=shr_kind_cl), 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 @@ -114,22 +132,36 @@ module radiative_aerosol_definitions 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 - character(len= 1), pointer :: source_mmr_a(:) ! source of interstitial mmr field - character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr species - character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields - character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components - character(len= 32), pointer :: type(:) ! species type - character(len= 32), pointer :: morph(:) ! species morphology - character(len=cs1), pointer :: props(:) ! file containing specie properties - - integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species - integer :: idx_num_c ! index in pbuf for number mixing ratio of cloud-borne species - integer :: idx_mass_a ! index in pbuf or constituents for mass mixing ratio of interstitial species - integer :: idx_mass_c ! index in pbuf for mass mixing ratio of cloud-borne species - - integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species - integer, pointer :: idx_mmr_c(:) ! index in pbuf or constituents for mmr of cloud-borne species - integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module + ! 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=shr_kind_cl), 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 @@ -145,12 +177,12 @@ module radiative_aerosol_definitions !! \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=cs1) :: 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 + 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=shr_kind_cl) :: 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 @@ -166,24 +198,40 @@ module radiative_aerosol_definitions !! \htmlinclude modelist_t.html ! storage for modal aerosol components in the climate/diagnostic lists type, public :: modelist_t - integer :: nmodes ! number of modes - character(len=2) :: list_id ! set to " " for climate list, or two character integer - ! (include leading zero) to identify diagnostic list - integer, pointer :: idx(:) ! index of the mode in the mode definition object - character(len=cs1), pointer :: physprop_files(:) ! physprop filename - integer, pointer :: idx_props(:) ! index of the mode properties in the physprop object + ! number of modes + integer :: nmodes + + ! 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(:) + ! physprop filename + character(len=shr_kind_cl), pointer :: physprop_files(:) + ! index of the mode properties in the physprop object + integer, pointer :: idx_props(:) 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 - integer :: nbins ! number of bins - character(len=2) :: list_id ! set to " " for climate list, or two character integer - ! (include leading zero) to identify diagnostic list - integer, pointer :: idx(:) ! index of the bin in the bin definition object - character(len=cs1), pointer :: physprop_files(:) ! physprop filename - integer, pointer :: idx_props(:) ! index of the bin properties in the physprop object + ! number of bins + integer :: nbins + + ! 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(:) + ! physprop filename + character(len=shr_kind_cl), pointer :: physprop_files(:) + ! index of the bin properties in the physprop object + integer, pointer :: idx_props(:) end type binlist_t ! max number of strings in mode definitions @@ -285,9 +333,9 @@ subroutine list_populate(namelist, aerlist, modal_aerosol_list, sectional_aeroso if (masterproc .and. verbose) then if (len_trim(aerlist%list_id) == 0) then - write(iulog,*) nl//' '//subname//': namelist input for climate list' + write(iulog,*) newline//' '//subname//': namelist input for climate list' else - write(iulog,*) nl//' '//subname//': namelist input for diagnostic list:'//aerlist%list_id + write(iulog,*) newline//' '//subname//': namelist input for diagnostic list:'//aerlist%list_id end if end if @@ -379,7 +427,7 @@ subroutine list_resolve_physprops(aerlist, modal_aerosol_list, sectional_aerosol ! Host-specific index resolution (get_cam_idx) is handled ! separately by the host module (e.g. aerosol_mmr_cam). - use aerosol_physical_properties, only: physprop_get_id + use phys_prop, only: physprop_get_id type(aerlist_t), intent(inout) :: aerlist type(modelist_t), intent(inout) :: modal_aerosol_list @@ -1055,7 +1103,7 @@ end subroutine parse_bin_defs !=========================== subroutine parse_rad_specifier(specifier, namelist_data) - use cam_abortutils, only: endrun + use cam_abortutils, only: endrun !----------------------------------------------------------------------------- ! Parse the radiation namelist specifiers. @@ -1065,14 +1113,14 @@ subroutine parse_rad_specifier(specifier, namelist_data) type(rad_cnst_namelist_t), intent(inout) :: namelist_data ! Local variables - integer :: number, i, j - integer :: ipos, strlen - integer :: astat - character(len=cs1) :: tmpstr - character(len=1) :: source(n_rad_cnst) - character(len=64) :: camname(n_rad_cnst) - character(len=cs1) :: radname(n_rad_cnst) - character(len=1) :: type(n_rad_cnst) + integer :: number, i, j + integer :: ipos, strlen + integer :: astat + character(len=shr_kind_cl) :: tmpstr + character(len=1) :: source(n_rad_cnst) + character(len=64) :: camname(n_rad_cnst) + character(len=shr_kind_cl) :: radname(n_rad_cnst) + character(len=1) :: type(n_rad_cnst) !------------------------------------------------------------------------- number = 0 @@ -1151,7 +1199,7 @@ subroutine print_modes(modes) do m = 1, modes%nmodes - write(iulog,*) nl//' name=',trim(modes%names(m)),' type=',trim(modes%types(m)) + 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) @@ -1181,7 +1229,7 @@ subroutine print_bins(bins) do m = 1, bins%nbins - write(iulog,*) nl//' name=',trim(bins%names(m)) + write(iulog,*) newline//' name=',trim(bins%names(m)) do i = 1, bins%comps(m)%nspec From 76277360649a85f6bc37693a8aa317475e091fca Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 8 Apr 2026 13:46:03 -0400 Subject: [PATCH 10/46] Update unit tests to sync up with CAM. --- src/aerosol/carma_aerosol_properties_mod.F90 | 34 +----- test/unit/fortran/src/aerosol/CMakeLists.txt | 3 +- .../mock_aerosol_physical_properties.F90 | 19 --- .../fortran/src/aerosol/mock_phys_prop.F90 | 113 ++++++++++++++++++ .../src/aerosol/mock_radiative_aerosol.F90 | 14 ++- .../src/aerosol/test_bulk_aerosol_state.pf | 2 +- 6 files changed, 134 insertions(+), 51 deletions(-) delete mode 100644 test/unit/fortran/src/aerosol/mock_aerosol_physical_properties.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_phys_prop.F90 diff --git a/src/aerosol/carma_aerosol_properties_mod.F90 b/src/aerosol/carma_aerosol_properties_mod.F90 index 29e47cfd9..19e9b4b13 100644 --- a/src/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/aerosol/carma_aerosol_properties_mod.F90 @@ -28,7 +28,7 @@ module carma_aerosol_properties_mod procedure :: icenuc_updates_mmr procedure :: apply_number_limits procedure :: hetfrz_species - procedure :: optics_params + procedure :: physprop_id procedure :: soluble procedure :: min_mass_mean_rad procedure :: bin_name @@ -148,36 +148,12 @@ function hetfrz_species(self, bin_ndx, spc_ndx) result(res) res = .false. end function hetfrz_species - 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) + integer function physprop_id(self, bin_ndx) class(carma_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx - character(len=*), optional, intent(out) :: opticstype - real(r8), optional, pointer :: extpsw(:,:,:,:), abspsw(:,:,:,:), asmpsw(:,:,:,:), absplw(:,:,:,:) - real(r8), optional, pointer :: refrtabsw(:,:), refitabsw(:,:), refrtablw(:,:), refitablw(:,:) - integer, optional, intent(out) :: ncoef, prefr, prefi - real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:), sw_hygro_ssa_wtp(:,:) - real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:), lw_hygro_ext_wtp(:,:) - real(r8), optional, pointer :: wgtpct(:) - integer, optional, intent(out) :: nwtp - real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:), sw_hygro_coreshell_ssa(:,:,:,:,:) - real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:), lw_hygro_coreshell_ext(:,:,:,:,:) - real(r8), optional, pointer :: corefrac(:), bcdust(:), kap(:), relh(:) - integer, optional, intent(out) :: nfrac, nbcdust, nkap, nrelh - real(r8), optional, pointer :: sw_hygroscopic_ext(:,:), sw_hygroscopic_ssa(:,:) - real(r8), optional, pointer :: sw_hygroscopic_asm(:,:), lw_hygroscopic_ext(:,:) - real(r8), optional, pointer :: sw_insoluble_ext(:), sw_insoluble_ssa(:) - real(r8), optional, pointer :: sw_insoluble_asm(:), lw_insoluble_ext(:) - real(r8), optional, pointer :: r_sw_ext(:,:), r_sw_scat(:,:), r_sw_ascat(:,:) - real(r8), optional, pointer :: r_mu(:), r_lw_abs(:,:) - call endrun('carma_aerosol_properties%optics_params: not implemented') - end subroutine optics_params + 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 diff --git a/test/unit/fortran/src/aerosol/CMakeLists.txt b/test/unit/fortran/src/aerosol/CMakeLists.txt index 7c095ea0a..70dbff7a4 100644 --- a/test/unit/fortran/src/aerosol/CMakeLists.txt +++ b/test/unit/fortran/src/aerosol/CMakeLists.txt @@ -53,7 +53,7 @@ add_pfunit_ctest(test_table_interp # Tier 2: radiative_aerosol_definitions parsing and list population # ======================================================================== add_library(rad_aer_defs_testlib - mock_aerosol_physical_properties.F90 + mock_phys_prop.F90 ${AEROSOL_SRC}/radiative_aerosol_definitions.F90 ) target_link_libraries(rad_aer_defs_testlib PUBLIC aerosol_test_mocks) @@ -77,6 +77,7 @@ add_library(bulk_aero_testlib ${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_ccpp.F90 ${CCPP_STUB} diff --git a/test/unit/fortran/src/aerosol/mock_aerosol_physical_properties.F90 b/test/unit/fortran/src/aerosol/mock_aerosol_physical_properties.F90 deleted file mode 100644 index 76fa76263..000000000 --- a/test/unit/fortran/src/aerosol/mock_aerosol_physical_properties.F90 +++ /dev/null @@ -1,19 +0,0 @@ -module aerosol_physical_properties - ! Mock stub for unit tests. - ! Provides physprop_get_id which simply returns a deterministic index - ! based on the filename hash (position in an internal counter). - implicit none - private - public :: physprop_get_id - - integer, save :: next_id = 0 - -contains - - 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 - -end module aerosol_physical_properties 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..adf31270f --- /dev/null +++ b/test/unit/fortran/src/aerosol/mock_phys_prop.F90 @@ -0,0 +1,113 @@ +module phys_prop + ! Mock stub for unit tests. + ! Provides physprop_get_id (returns a deterministic index) + ! and a no-op physprop_get so that aerosol_properties_mod compiles. + 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 + + integer, save :: next_id = 0 + +contains + + 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(:,:,:,:,:) + + ! No-op: mock does not populate any fields + end subroutine physprop_get + +end module phys_prop diff --git a/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 b/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 index 540759b59..c52d550dd 100644 --- a/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 +++ b/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 @@ -2,7 +2,7 @@ ! Mock radiative_aerosol module for unit testing bulk_aerosol_properties. ! ! This mock replaces the real radiative_aerosol facade module. The real -! module delegates to aerosol_physical_properties (which reads NetCDF +! module delegates to phys_prop (which reads NetCDF ! physprop files via PIO). This mock provides configurable in-memory data ! via setup_mock_rad_aer(), removing all file I/O dependencies. ! @@ -60,6 +60,7 @@ module radiative_aerosol public :: setup_mock_rad_aer public :: setup_mock_optics_tables public :: cleanup_mock_rad_aer + public :: rad_aer_bulk_physprop_id contains @@ -296,4 +297,15 @@ subroutine rad_aer_get_props_by_idx(list_idx, & 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/test_bulk_aerosol_state.pf b/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf index d92a006de..d312b1932 100644 --- a/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf +++ b/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf @@ -5,7 +5,7 @@ ! 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 -! aerosol_physical_properties) +! phys_prop) ! ! Mock boundaries: ! - radiative_aerosol (rad_aer_get_info, rad_aer_get_props) for properties From 2278e8f34970a8d00390f3ab1e8ddd0dbddf574d Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 8 Apr 2026 13:46:22 -0400 Subject: [PATCH 11/46] Add modal properties, state direct copy from CAM for adapting --- src/aerosol/modal_aerosol_properties_mod.F90 | 933 ++++++++++++++++--- src/aerosol/modal_aerosol_state_mod.F90 | 660 +++++++++++-- 2 files changed, 1414 insertions(+), 179 deletions(-) diff --git a/src/aerosol/modal_aerosol_properties_mod.F90 b/src/aerosol/modal_aerosol_properties_mod.F90 index f5f099682..4de2cf602 100644 --- a/src/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/aerosol/modal_aerosol_properties_mod.F90 @@ -1,19 +1,33 @@ -module modal_aerosol_properties_mod - !----------------------------------------------------------------------------- - ! Stub module for modal aerosol properties not yet implemented in CAM-SIMA. - ! Exports the constructor interface so aerosol_instances_mod compiles. - !----------------------------------------------------------------------------- +test/unit/fortran/src/aerosol/mock_phys_prop.F90module modal_aerosol_properties_mod use shr_kind_mod, only: r8 => shr_kind_r8 - use cam_abortutils, only: endrun + 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 @@ -28,7 +42,7 @@ module modal_aerosol_properties_mod procedure :: icenuc_updates_mmr procedure :: apply_number_limits procedure :: hetfrz_species - procedure :: optics_params + procedure :: physprop_id procedure :: soluble procedure :: min_mass_mean_rad procedure :: bin_name @@ -37,204 +51,907 @@ module modal_aerosol_properties_mod 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 + + integer, optional, intent(in) :: list_idx ! radiation list index (0=climate) type(modal_aerosol_properties), pointer :: newobj - nullify(newobj) - call endrun('modal_aerosol_properties: not implemented in CAM-SIMA') + + 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 - call endrun('modal_aerosol_properties%number_transported: not implemented') 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, & - spectype, specname, specmorph, refindex_sw, refindex_lw, num_to_mass_aer, dryrad) - class(modal_aerosol_properties), intent(in) :: self - integer, intent(in) :: bin_ndx, species_ndx - real(r8), optional, intent(out) :: density, hygro - 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('modal_aerosol_properties%get: not implemented') + 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 + 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(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 - pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) + !------------------------------------------------------------------------ + ! 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 - real(r8), intent(in) :: volconc, numconc - amcube = -huge(1._r8) + + 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 - subroutine actfracs(self, bin_ndx, smc, smax, fn, fm) + !------------------------------------------------------------------------------ + ! 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 - real(r8), intent(in) :: smc, smax - real(r8), intent(out) :: fn, fm - call endrun('modal_aerosol_properties%actfracs: not implemented') + 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 - character(len=*), intent(out) :: name_a, name_c - call endrun('modal_aerosol_properties%num_names: not implemented') + 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, species_ndx - character(len=*), intent(out) :: name_a, name_c - call endrun('modal_aerosol_properties%mmr_names: not implemented') + 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 - character(len=*), intent(out) :: name - call endrun('modal_aerosol_properties%amb_num_name: not implemented') + 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, species_ndx - character(len=*), intent(out) :: name - call endrun('modal_aerosol_properties%amb_mmr_name: not implemented') + 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, species_ndx - character(len=*), intent(out) :: spectype - call endrun('modal_aerosol_properties%species_type: not implemented') + 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 + 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, species_ndx + 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 - subroutine apply_number_limits(self, naerosol, vaerosol, istart, istop, m) + !------------------------------------------------------------------------------ + ! apply max / min to number concentration + !------------------------------------------------------------------------------ + subroutine apply_number_limits( self, naerosol, vaerosol, istart, istop, m ) class(modal_aerosol_properties), intent(in) :: self - real(r8), intent(inout) :: naerosol(:) - real(r8), intent(in) :: vaerosol(:) - integer, intent(in) :: istart, istop, m - call endrun('modal_aerosol_properties%apply_number_limits: not implemented') + real(r8), intent(inout) :: naerosol(:) ! number conc (1/m3) + real(r8), intent(in) :: vaerosol(:) ! volume conc (m3/m3) + integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + integer, intent(in) :: m ! mode or bin index + + integer :: i + + ! 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 i = istart, istop + naerosol(i) = max(naerosol(i), vaerosol(i)*self%voltonumbhi_(m)) + naerosol(i) = min(naerosol(i), vaerosol(i)*self%voltonumblo_(m)) + 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, spc_ndx + 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 - 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) + !------------------------------------------------------------------------------ + ! returns TRUE if soluble + !------------------------------------------------------------------------------ + logical function soluble(self,bin_ndx) class(modal_aerosol_properties), intent(in) :: self - integer, intent(in) :: bin_ndx - character(len=*), optional, intent(out) :: opticstype - real(r8), optional, pointer :: extpsw(:,:,:,:), abspsw(:,:,:,:), asmpsw(:,:,:,:), absplw(:,:,:,:) - real(r8), optional, pointer :: refrtabsw(:,:), refitabsw(:,:), refrtablw(:,:), refitablw(:,:) - integer, optional, intent(out) :: ncoef, prefr, prefi - real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:), sw_hygro_ssa_wtp(:,:) - real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:), lw_hygro_ext_wtp(:,:) - real(r8), optional, pointer :: wgtpct(:) - integer, optional, intent(out) :: nwtp - real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:), sw_hygro_coreshell_ssa(:,:,:,:,:) - real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:), lw_hygro_coreshell_ext(:,:,:,:,:) - real(r8), optional, pointer :: corefrac(:), bcdust(:), kap(:), relh(:) - integer, optional, intent(out) :: nfrac, nbcdust, nkap, nrelh - real(r8), optional, pointer :: sw_hygroscopic_ext(:,:), sw_hygroscopic_ssa(:,:) - real(r8), optional, pointer :: sw_hygroscopic_asm(:,:), lw_hygroscopic_ext(:,:) - real(r8), optional, pointer :: sw_insoluble_ext(:), sw_insoluble_ssa(:) - real(r8), optional, pointer :: sw_insoluble_asm(:), lw_insoluble_ext(:) - real(r8), optional, pointer :: r_sw_ext(:,:), r_sw_scat(:,:), r_sw_ascat(:,:) - real(r8), optional, pointer :: r_mu(:), r_lw_abs(:,:) - call endrun('modal_aerosol_properties%optics_params: not implemented') - end subroutine optics_params - - logical function soluble(self, bin_ndx) - class(modal_aerosol_properties), intent(in) :: self - integer, intent(in) :: bin_ndx - soluble = .false. - call endrun('modal_aerosol_properties%soluble: not implemented') + 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 - function min_mass_mean_rad(self, bin_ndx, species_ndx) result(minrad) + !------------------------------------------------------------------------------ + ! 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, species_ndx - real(r8) :: minrad - minrad = 0._r8 + 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 - character(len=aero_name_len) :: name - name = '' - call endrun('modal_aerosol_properties%bin_name: not implemented') + 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 + integer, intent(in) :: bin_ndx ! bin number + real(r8) :: diam - diam = -huge(1._r8) + + 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(:) - call endrun('modal_aerosol_properties%resuspension_resize: not implemented') + + 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) - class(modal_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('modal_aerosol_properties%rebin_bulk_fluxes: not implemented') + 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 - hydrophilic = .false. + 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 - model_is = (trim(query) == 'MAM' .or. trim(query) == 'mam') + 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 index ad1a10a8d..89c9688a4 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -1,22 +1,33 @@ module modal_aerosol_state_mod - !----------------------------------------------------------------------------- - ! Stub module for modal 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 ccpp_kinds, only: kind_phys - use cam_abortutils, only: endrun + use shr_spfn_mod, only: erf => shr_spfn_erf use aerosol_state_mod, only: aerosol_state, ptr2d_t - use aerosol_properties_mod, only: aerosol_properties + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_mode_props + !REMOVECAM + use aerosol_mmr_cam, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num + !REMOVECAM_END + !REMOVECAM: no longer need pbuf and state after CAM is retired + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index + use physics_types, only: physics_state + !REMOVECAM_END + 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 + !REMOVECAM: state and pbuf will be replaced by SIMA MMR API + type(physics_state), pointer :: state => null() + type(physics_buffer_desc), pointer :: pbuf(:) => null() + !REMOVECAM_END contains + procedure :: get_transported procedure :: set_transported procedure :: ambient_total_bin_mmr @@ -27,6 +38,7 @@ module modal_aerosol_state_mod 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 @@ -35,167 +47,673 @@ module modal_aerosol_state_mod procedure :: wet_volume procedure :: water_volume procedure :: wet_diameter + procedure :: convcld_actfrac procedure :: wgtpct + + 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(constituents, list_idx) result(newobj) - real(kind_phys), pointer, intent(in) :: constituents(:,:,:) + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(state,pbuf,list_idx) result(newobj) + type(physics_state), target :: state + type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in), optional :: list_idx + type(modal_aerosol_state), pointer :: newobj - nullify(newobj) - call endrun('modal_aerosol_state: not implemented in CAM-SIMA') + + integer :: ierr + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%state => state + newobj%pbuf => pbuf + + if (present(list_idx)) call newobj%set_list_idx(list_idx) + end function constructor - subroutine set_transported(self, transported_array) + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(modal_aerosol_state), intent(inout) :: self + + nullify(self%state) + nullify(self%pbuf) + + 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(:,:,:) - call endrun('modal_aerosol_state%set_transported: not implemented') + ! to be implemented later end subroutine set_transported - subroutine get_transported(self, transported_array) + !------------------------------------------------------------------------------ + ! 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(:,:,:) - call endrun('modal_aerosol_state%get_transported: not implemented') + ! 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, col_ndx, lyr_ndx - real(r8) :: mmr_tot + 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 - call endrun('modal_aerosol_state%ambient_total_bin_mmr: not implemented') + + do spec_ndx=1,aero_props%nspecies(bin_ndx) + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, spec_ndx, 'a', self%state, self%pbuf, 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, bin_ndx - real(r8), pointer :: mmr(:,:) - nullify(mmr) - call endrun('modal_aerosol_state%get_ambient_mmr: not implemented') + 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%state, self%pbuf, 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, bin_ndx - real(r8), pointer :: mmr(:,:) - nullify(mmr) - call endrun('modal_aerosol_state%get_cldbrne_mmr: not implemented') + 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%state, self%pbuf, 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 - real(r8), pointer :: num(:,:) - nullify(num) - call endrun('modal_aerosol_state%get_ambient_num: not implemented') + 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%state, self%pbuf, 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 + integer, intent(in) :: bin_ndx ! bin index real(r8), pointer :: num(:,:) - nullify(num) - call endrun('modal_aerosol_state%get_cldbrne_num: not implemented') + + call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'c', self%state, self%pbuf, num) end subroutine get_cldbrne_num - subroutine get_states(self, aero_props, raer, qqcw) + !------------------------------------------------------------------------------ + ! 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(:), qqcw(:) - call endrun('modal_aerosol_state%get_states: not implemented') + 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) class(modal_aerosol_state), intent(in) :: self - integer, intent(in) :: bin_ndx, ncol, nlev - character(len=*), intent(in) :: species_type - logical, intent(in) :: use_preexisting_ice + 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(:,:) - call endrun('modal_aerosol_state%icenuc_size_wght_arr: not implemented') + + character(len=aero_name_len) :: modetype + real(r8), pointer :: dgnum(:,:,:) ! mode dry radius + real(r8) :: sigmag_aitken + integer :: i,k + + 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 + call rad_aer_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum) + do k = 1,nlev + do i = 1,ncol + if (dgnum(i,k,bin_ndx) > 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/dgnum(i,k,bin_ndx))/ & + (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) class(modal_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 + 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 - call endrun('modal_aerosol_state%icenuc_size_wght_val: not implemented') + + character(len=aero_name_len) :: modetype + real(r8), pointer :: dgnum(:,:,:) ! mode dry radius + real(r8) :: sigmag_aitken + + 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) + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum) + + if (dgnum(col_ndx,lyr_ndx,bin_ndx) > 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/dgnum(col_ndx,lyr_ndx,bin_ndx))/ & + (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 - subroutine update_bin(self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend) + !------------------------------------------------------------------------------ + ! 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 + + 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, col_ndx, lyr_ndx, tnd_ndx - real(r8), intent(in) :: delmmr_sum, delnum_sum, dtime - real(r8), intent(inout) :: tend(:,:,:) - call endrun('modal_aerosol_state%update_bin: not implemented') + 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) class(modal_aerosol_state), intent(in) :: self - integer, intent(in) :: bin_ndx, ncol, nlev + 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('modal_aerosol_state%hetfrz_size_wght: not implemented') + + 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 - real(r8), intent(out) :: kappa(:,:) - call endrun('modal_aerosol_state%hygroscopicity: not implemented') + 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 + ! radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + !REMOVECAM - under CAM-SIMA, water uptake computed by CCPP scheme; results passed via constituent interface subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) + use modal_aero_wateruptake, only: modal_aero_wateruptake_dr + use modal_aero_calcsize, only: modal_aero_calcsize_diag + class(modal_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('modal_aerosol_state%water_uptake: not implemented') + 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) + + integer :: istat, nmodes + real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes + real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes + real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes + real(r8), pointer :: wetdens_m(:,:,:) ! + real(r8), pointer :: hygro_m(:,:,:) ! + real(r8), pointer :: dryvol_m(:,:,:) ! + real(r8), pointer :: dryrad_m(:,:,:) ! + real(r8), pointer :: drymass_m(:,:,:) ! + real(r8), pointer :: so4dryvol_m(:,:,:) ! + real(r8), pointer :: naer_m(:,:,:) ! + + nmodes = aero_props%nbins() + + if (self%list_idx_ == 0) then + ! water uptake and wet radius for the climate list has already been calculated + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet_m) + call pbuf_get_field(self%pbuf, pbuf_get_index('QAERWAT'), qaerwat_m) + + dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx) + qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx) + + else + ! If doing a diagnostic calculation then need to calculate the wet radius + ! and water uptake for the diagnostic modes + allocate(dgnumdry_m(ncol,nlev,nmodes), dgnumwet_m(ncol,nlev,nmodes), & + qaerwat_m(ncol,nlev,nmodes), wetdens_m(ncol,nlev,nmodes), & + hygro_m(ncol,nlev,nmodes), dryvol_m(ncol,nlev,nmodes), & + dryrad_m(ncol,nlev,nmodes), drymass_m(ncol,nlev,nmodes), & + so4dryvol_m(ncol,nlev,nmodes), naer_m(ncol,nlev,nmodes), stat=istat) + if (istat > 0) then + dgnumwet = -huge(1._r8) + qaerwat = -huge(1._r8) + return + end if + call modal_aero_calcsize_diag(self%state, self%pbuf, aero_props, self, dgnumdry_m, hygro_m, & + dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) + call modal_aero_wateruptake_dr(self%state, self%pbuf, aero_props, self, dgnumdry_m, dgnumwet_m, & + qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & + drymass_m, so4dryvol_m, naer_m) + + dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx) + qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx) + + deallocate(dgnumdry_m) + deallocate(dgnumwet_m) + deallocate(qaerwat_m) + deallocate(wetdens_m) + deallocate(hygro_m) + deallocate(dryvol_m) + deallocate(dryrad_m) + deallocate(drymass_m) + deallocate(so4dryvol_m) + deallocate(naer_m) + endif + + 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(modal_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) + + 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(:,:) + real(r8) :: specdens ! species density (kg/m3) + + integer :: ispec + + vol(:,:) = 0._r8 + + do ispec = 1, aero_props%nspecies(bin_idx) + call self%get_ambient_mmr(species_ndx=ispec, bin_ndx=bin_idx, mmr=mmr) + call aero_props%get(bin_idx, ispec, density=specdens) + vol(:ncol,:) = vol(:ncol,:) + mmr(:ncol,:)/specdens + end do + 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(modal_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) + + 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) :: dryvol(ncol,nlev) + real(r8) :: watervol(ncol,nlev) + + dryvol = self%dry_volume(aero_props, bin_idx, ncol, nlev) + watervol = self%water_volume(aero_props, bin_idx, ncol, nlev) + + vol = watervol + dryvol + 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(modal_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) + + 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) :: dgnumwet(ncol,nlev) + real(r8) :: qaerwat(ncol,nlev) + + call self%water_uptake(aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) + + vol(:ncol,:nlev) = qaerwat(:ncol,:nlev)*rh2odens + where (vol<0._r8) + vol = 0._r8 + end where + end function water_volume + !------------------------------------------------------------------------------ + ! aerosol wet diameter + !------------------------------------------------------------------------------ + !REMOVECAM - under CAM-SIMA, wet diameter provided by CCPP scheme output function wet_diameter(self, bin_idx, ncol, nlev) result(diam) class(modal_aerosol_state), intent(in) :: self - integer, intent(in) :: bin_idx, ncol, nlev + 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('modal_aerosol_state%wet_diameter: not implemented') + + real(r8), pointer :: dgnumwet(:,:,:) + + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet) + + diam(:ncol,:nlev) = dgnumwet(:ncol,:nlev,bin_idx) + end function wet_diameter + !------------------------------------------------------------------------------ + ! prescribed aerosol activation fraction for convective cloud + !------------------------------------------------------------------------------ + function convcld_actfrac(self, aero_props, ibin, ispc, ncol, nlev) result(frac) + + class(modal_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) + + real(r8) :: f_act_conv_coarse(ncol,nlev) + real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl + real(r8) :: tmpdust, tmpnacl + real(r8), pointer :: dust_mmr(:,:), nacl_mmr(:,:) + integer :: dust_ndx, nacl_ndx + integer :: i,k,l + character(len=aero_name_len) :: bin_type, spectype + + bin_type = aero_props%bin_name(ibin) + + f_act_conv_coarse(:,:) = 0.60_r8 + f_act_conv_coarse_dust = 0.40_r8 + f_act_conv_coarse_nacl = 0.80_r8 + if (trim(bin_type) == 'coarse') then + ! find dust and seasalt species indices in the coarse mode + dust_ndx = -1 + nacl_ndx = -1 + do l = 1, aero_props%nspecies(ibin) + call aero_props%species_type(ibin, l, spectype) + if (trim(spectype) == 'dust') dust_ndx = l + if (trim(spectype) == 'seasalt') nacl_ndx = l + end do + if ((dust_ndx > 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) - wtp = -huge(1._r8) + 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 end module modal_aerosol_state_mod From 2bc8ae09adf98542bffa5f99d2a60e6934adef63 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 9 Apr 2026 12:20:41 -0400 Subject: [PATCH 12/46] Implement modal aerosol properties and state concrete implementations in CAM-SIMA, subject to some stubs --- src/aerosol/modal_aerosol_properties_mod.F90 | 2 +- src/aerosol/modal_aerosol_state_mod.F90 | 176 ++++++++----------- 2 files changed, 78 insertions(+), 100 deletions(-) diff --git a/src/aerosol/modal_aerosol_properties_mod.F90 b/src/aerosol/modal_aerosol_properties_mod.F90 index 4de2cf602..51605bd07 100644 --- a/src/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/aerosol/modal_aerosol_properties_mod.F90 @@ -1,4 +1,4 @@ -test/unit/fortran/src/aerosol/mock_phys_prop.F90module modal_aerosol_properties_mod +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 diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 index 89c9688a4..99b7b4b84 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -1,16 +1,11 @@ module modal_aerosol_state_mod use shr_kind_mod, only: r8 => shr_kind_r8 + use ccpp_kinds, only: kind_phys 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 - !REMOVECAM - use aerosol_mmr_cam, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num - !REMOVECAM_END - !REMOVECAM: no longer need pbuf and state after CAM is retired - use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index - use physics_types, only: physics_state - !REMOVECAM_END - use aerosol_properties_mod, only: aerosol_properties, aero_name_len + use aerosol_mmr_ccpp, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num + use aerosol_properties_mod, only: aerosol_properties use physconst, only: rhoh2o use cam_abortutils, only: endrun @@ -22,10 +17,7 @@ module modal_aerosol_state_mod type, extends(aerosol_state) :: modal_aerosol_state private - !REMOVECAM: state and pbuf will be replaced by SIMA MMR API - type(physics_state), pointer :: state => null() - type(physics_buffer_desc), pointer :: pbuf(:) => null() - !REMOVECAM_END + real(kind_phys), pointer :: constituents(:,:,:) => null() contains procedure :: get_transported @@ -64,9 +56,8 @@ module modal_aerosol_state_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(state,pbuf,list_idx) result(newobj) - type(physics_state), target :: state - type(physics_buffer_desc), pointer :: pbuf(:) + function constructor(constituents, list_idx) result(newobj) + real(kind_phys), pointer, intent(in) :: constituents(:,:,:) integer, intent(in), optional :: list_idx type(modal_aerosol_state), pointer :: newobj @@ -79,8 +70,7 @@ function constructor(state,pbuf,list_idx) result(newobj) return end if - newobj%state => state - newobj%pbuf => pbuf + newobj%constituents => constituents if (present(list_idx)) call newobj%set_list_idx(list_idx) @@ -91,8 +81,7 @@ end function constructor subroutine destructor(self) type(modal_aerosol_state), intent(inout) :: self - nullify(self%state) - nullify(self%pbuf) + nullify(self%constituents) end subroutine destructor @@ -135,7 +124,7 @@ function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) resu 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%state, self%pbuf, mmrptr) + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, spec_ndx, 'a', self%constituents, mmrptr) mmr_tot = mmr_tot + mmrptr(col_ndx,lyr_ndx) end do @@ -150,7 +139,7 @@ subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) 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%state, self%pbuf, mmr) + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, species_ndx, 'a', self%constituents, mmr) end subroutine get_ambient_mmr !------------------------------------------------------------------------------ @@ -162,7 +151,7 @@ subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) 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%state, self%pbuf, mmr) + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, species_ndx, 'c', self%constituents, mmr) end subroutine get_cldbrne_mmr !------------------------------------------------------------------------------ @@ -173,7 +162,7 @@ subroutine get_ambient_num(self, bin_ndx, num) 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%state, self%pbuf, num) + call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'a', self%constituents, num) end subroutine get_ambient_num !------------------------------------------------------------------------------ @@ -184,7 +173,7 @@ subroutine get_cldbrne_num(self, bin_ndx, num) integer, intent(in) :: bin_ndx ! bin index real(r8), pointer :: num(:,:) - call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'c', self%state, self%pbuf, num) + call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'c', self%constituents, num) end subroutine get_cldbrne_num !------------------------------------------------------------------------------ @@ -215,6 +204,9 @@ 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 @@ -224,9 +216,10 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre real(r8), intent(out) :: wght(:,:) character(len=aero_name_len) :: modetype - real(r8), pointer :: dgnum(:,:,:) ! mode dry radius 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)') @@ -246,14 +239,18 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre 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) - call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum) - do k = 1,nlev - do i = 1,ncol - if (dgnum(i,k,bin_ndx) > 0._r8) then + 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%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/dgnum(i,k,bin_ndx))/ & + erf(log(0.1e-6_r8 / self%constituents(i,k,idx_dgnum)) / & (2._r8**0.5_r8*log(sigmag_aitken))) )) end if end do @@ -276,6 +273,9 @@ 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 @@ -285,8 +285,9 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u real(r8), intent(out) :: wght character(len=aero_name_len) :: modetype - real(r8), pointer :: dgnum(:,:,:) ! mode dry radius 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)') @@ -307,14 +308,14 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u wght = 1._r8 else call rad_aer_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) - call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum) + write(cname, '(a,i2.2)') 'dgnum_m', bin_ndx + call const_get_index(trim(cname), idx_dgnum) - if (dgnum(col_ndx,lyr_ndx,bin_ndx) > 0._r8) then + if (self%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/dgnum(col_ndx,lyr_ndx,bin_ndx))/ & + erf(log(0.1e-6_r8 / self%constituents(col_ndx, lyr_ndx, idx_dgnum)) / & (2._r8**0.5_r8*log(sigmag_aitken))) )) - end if endif endif @@ -336,6 +337,7 @@ end subroutine icenuc_size_wght_val 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 @@ -413,6 +415,8 @@ end subroutine update_bin ! 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 @@ -450,13 +454,21 @@ subroutine hygroscopicity(self, bin_ndx, kappa) end subroutine hygroscopicity !------------------------------------------------------------------------------ - ! returns aerosol wet diameter and aerosol water concentration for a given - ! radiation diagnostic list number and bin number + ! 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) then - dgnumwet = -huge(1._r8) - qaerwat = -huge(1._r8) - return - end if - call modal_aero_calcsize_diag(self%state, self%pbuf, aero_props, self, dgnumdry_m, hygro_m, & - dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) - call modal_aero_wateruptake_dr(self%state, self%pbuf, aero_props, self, dgnumdry_m, dgnumwet_m, & - qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & - drymass_m, so4dryvol_m, naer_m) - - dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx) - qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx) - - deallocate(dgnumdry_m) - deallocate(dgnumwet_m) - deallocate(qaerwat_m) - deallocate(wetdens_m) - deallocate(hygro_m) - deallocate(dryvol_m) - deallocate(dryrad_m) - deallocate(drymass_m) - deallocate(so4dryvol_m) - deallocate(naer_m) - endif - + ! Diagnostic lists: recomputation requires modal_aero_calcsize and + ! modal_aero_wateruptake, which are not yet CCPPized. + call endrun('modal_aerosol_state::water_uptake: diagnostic-list water uptake ' // & + 'not yet available in CAM-SIMA (requires CCPPized modal_aero_calcsize/wateruptake)') + end if end subroutine water_uptake @@ -605,10 +580,11 @@ function water_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) end function water_volume !------------------------------------------------------------------------------ - ! aerosol wet diameter + ! aerosol wet diameter for a given mode !------------------------------------------------------------------------------ - !REMOVECAM - under CAM-SIMA, wet diameter provided by CCPP scheme output function wet_diameter(self, bin_idx, ncol, nlev) result(diam) + use cam_constituents, only: const_get_index + class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns @@ -616,11 +592,12 @@ function wet_diameter(self, bin_idx, ncol, nlev) result(diam) real(r8) :: diam(ncol,nlev) - real(r8), pointer :: dgnumwet(:,:,:) - - call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet) + integer :: idx_wet + character(len=64) :: cname - diam(:ncol,:nlev) = dgnumwet(:ncol,:nlev,bin_idx) + write(cname, '(a,i2.2)') 'dgnumwet_m', bin_idx + call const_get_index(trim(cname), idx_wet) + diam(:ncol,:nlev) = self%constituents(:ncol,:nlev,idx_wet) end function wet_diameter @@ -628,6 +605,7 @@ end function wet_diameter ! prescribed aerosol activation fraction for convective cloud !------------------------------------------------------------------------------ function convcld_actfrac(self, aero_props, ibin, ispc, ncol, nlev) result(frac) + use aerosol_properties_mod, only: aero_name_len class(modal_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object From 75cf1dae67517beba57747066352aad12ba015b5 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 9 Apr 2026 12:29:10 -0400 Subject: [PATCH 13/46] Fix Fortran unit tests: missing shr_kind_cl decl replacing cs1 --- test/unit/fortran/src/aerosol/shr_kind_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/test/unit/fortran/src/aerosol/shr_kind_mod.F90 b/test/unit/fortran/src/aerosol/shr_kind_mod.F90 index 6d2fc5e86..9806b5ebb 100644 --- a/test/unit/fortran/src/aerosol/shr_kind_mod.F90 +++ b/test/unit/fortran/src/aerosol/shr_kind_mod.F90 @@ -11,5 +11,8 @@ module shr_kind_mod private public :: shr_kind_r8 + public :: shr_kind_cl + + integer, parameter :: shr_kind_cl = 256 end module shr_kind_mod From 05a575884728b0307e04d245439c45447eae3b46 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 9 Apr 2026 12:44:38 -0400 Subject: [PATCH 14/46] Update to return physprop for concrete aerosol_properties%optics_params implementation introduced during CAM code review. --- .../fortran/src/aerosol/mock_phys_prop.F90 | 90 ++++++++++++++++++- .../aerosol/test_insoluble_aerosol_optics.pf | 8 ++ 2 files changed, 96 insertions(+), 2 deletions(-) diff --git a/test/unit/fortran/src/aerosol/mock_phys_prop.F90 b/test/unit/fortran/src/aerosol/mock_phys_prop.F90 index adf31270f..b2108b50e 100644 --- a/test/unit/fortran/src/aerosol/mock_phys_prop.F90 +++ b/test/unit/fortran/src/aerosol/mock_phys_prop.F90 @@ -1,7 +1,10 @@ module phys_prop ! Mock stub for unit tests. ! Provides physprop_get_id (returns a deterministic index) - ! and a no-op physprop_get so that aerosol_properties_mod compiles. + ! 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 @@ -11,11 +14,65 @@ module phys_prop 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 @@ -107,7 +164,36 @@ subroutine physprop_get(id, sourcefile, opticstype, & real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) real(r8), optional, pointer :: lw_hygro_coreshell_abs(:,:,:,:,:) - ! No-op: mock does not populate any fields + ! 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/test_insoluble_aerosol_optics.pf b/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf index 147e0aee0..a15a100e7 100644 --- a/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf +++ b/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf @@ -22,6 +22,7 @@ subroutine test_sw_props() use bulk_aerosol_state_mod, only: bulk_aerosol_state 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 @@ -52,6 +53,8 @@ subroutine test_sw_props() 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() @@ -83,6 +86,7 @@ subroutine test_sw_props() deallocate(state) deallocate(props) deallocate(constituents) + call cleanup_mock_physprop() call cleanup_mock_rad_aer() end subroutine test_sw_props @@ -96,6 +100,7 @@ subroutine test_lw_props() use bulk_aerosol_state_mod, only: bulk_aerosol_state 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 @@ -124,6 +129,8 @@ subroutine test_lw_props() 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() @@ -146,5 +153,6 @@ subroutine test_lw_props() deallocate(state) deallocate(props) deallocate(constituents) + call cleanup_mock_physprop() call cleanup_mock_rad_aer() end subroutine test_lw_props From a4c14bdba726d64d41c94a85d858e80cda767690 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 9 Apr 2026 14:10:16 -0400 Subject: [PATCH 15/46] Extend pfUnit tests to MAM aerosol state/properties --- test/unit/fortran/src/aerosol/CMakeLists.txt | 20 ++ .../src/aerosol/mock_aerosol_mmr_ccpp.F90 | 59 +++- .../src/aerosol/mock_cam_constituents.F90 | 23 ++ .../fortran/src/aerosol/mock_physconst.F90 | 1 + .../src/aerosol/mock_radiative_aerosol.F90 | 248 +++++++++++++++- .../fortran/src/aerosol/mock_shr_spfn_mod.F90 | 21 ++ .../aerosol/test_modal_aerosol_properties.pf | 272 ++++++++++++++++++ .../src/aerosol/test_modal_aerosol_state.pf | 193 +++++++++++++ 8 files changed, 830 insertions(+), 7 deletions(-) create mode 100644 test/unit/fortran/src/aerosol/mock_cam_constituents.F90 create mode 100644 test/unit/fortran/src/aerosol/mock_shr_spfn_mod.F90 create mode 100644 test/unit/fortran/src/aerosol/test_modal_aerosol_properties.pf create mode 100644 test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf diff --git a/test/unit/fortran/src/aerosol/CMakeLists.txt b/test/unit/fortran/src/aerosol/CMakeLists.txt index 70dbff7a4..5fba695d1 100644 --- a/test/unit/fortran/src/aerosol/CMakeLists.txt +++ b/test/unit/fortran/src/aerosol/CMakeLists.txt @@ -32,6 +32,8 @@ add_library(aerosol_test_mocks mock_physconst.F90 mock_shr_infnan_mod.F90 mock_shr_string_mod.F90 + mock_shr_spfn_mod.F90 + mock_cam_constituents.F90 ) target_compile_options(aerosol_test_mocks PRIVATE -ffree-line-length-none) target_include_directories(aerosol_test_mocks PUBLIC ${CMAKE_CURRENT_BINARY_DIR}) @@ -106,3 +108,21 @@ 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 +) +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_ccpp.F90 b/test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 index ee7dacd31..023521cd7 100644 --- a/test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 +++ b/test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 @@ -20,16 +20,16 @@ module aerosol_mmr_ccpp ! 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 end interface public :: rad_cnst_get_aer_mmr + public :: rad_cnst_get_mode_num contains !----------------------------------------------------------------------- - ! Mock rad_cnst_get_aer_mmr: directly index into constituents(:,:,aer_idx). - ! In the real module, aer_idx is used to look up the resolved CCPP index. - ! Here we short-circuit that and use aer_idx directly as the 3rd dimension. + ! 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 @@ -40,4 +40,57 @@ subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, constituents, mmr) mmr => constituents(:, :, aer_idx) end subroutine rad_cnst_get_aer_mmr_by_idx + !----------------------------------------------------------------------- + ! 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 + + !----------------------------------------------------------------------- + ! 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(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 + end module aerosol_mmr_ccpp 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_physconst.F90 b/test/unit/fortran/src/aerosol/mock_physconst.F90 index 72ae5191e..7d9f42521 100644 --- a/test/unit/fortran/src/aerosol/mock_physconst.F90 +++ b/test/unit/fortran/src/aerosol/mock_physconst.F90 @@ -10,5 +10,6 @@ module physconst 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 index c52d550dd..dd595a428 100644 --- a/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 +++ b/test/unit/fortran/src/aerosol/mock_radiative_aerosol.F90 @@ -1,14 +1,18 @@ !----------------------------------------------------------------------- -! Mock radiative_aerosol module for unit testing bulk_aerosol_properties. +! 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(), removing all file I/O dependencies. +! 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 @@ -19,8 +23,10 @@ module radiative_aerosol ! 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 (populated by setup_mock_rad_aer) + ! 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 @@ -46,21 +52,45 @@ module radiative_aerosol 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 @@ -121,11 +151,221 @@ subroutine setup_mock_optics_tables(nswbands, nlwbands, & 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) @@ -151,7 +391,7 @@ subroutine rad_aer_get_info_basic(list_idx, aernames, naero, nmodes, nbins) integer :: i if (present(naero)) naero = mock_naero - if (present(nmodes)) nmodes = 0 + if (present(nmodes)) nmodes = mock_nmodes if (present(nbins)) nbins = 0 if (present(aernames)) then do i = 1, mock_naero 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/test_modal_aerosol_properties.pf b/test/unit/fortran/src/aerosol/test_modal_aerosol_properties.pf new file mode 100644 index 000000000..e8f97cb89 --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_modal_aerosol_properties.pf @@ -0,0 +1,272 @@ +!----------------------------------------------------------------------- +! 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 to set up and tear down the 2-mode mock config +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 + +@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..cd9675da2 --- /dev/null +++ b/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf @@ -0,0 +1,193 @@ +!----------------------------------------------------------------------- +! 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_ccpp (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 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(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 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(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 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(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 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(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 From 70030186a641c8ee0b93559d313c0811e05f381e Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 9 Apr 2026 14:14:09 -0400 Subject: [PATCH 16/46] Add modal_test_helpers for constructing 2-mode MAM test --- test/unit/fortran/src/aerosol/CMakeLists.txt | 1 + .../src/aerosol/modal_test_helpers.F90 | 68 +++++++++++++++++++ .../aerosol/test_modal_aerosol_properties.pf | 64 +---------------- 3 files changed, 70 insertions(+), 63 deletions(-) create mode 100644 test/unit/fortran/src/aerosol/modal_test_helpers.F90 diff --git a/test/unit/fortran/src/aerosol/CMakeLists.txt b/test/unit/fortran/src/aerosol/CMakeLists.txt index 5fba695d1..62198f326 100644 --- a/test/unit/fortran/src/aerosol/CMakeLists.txt +++ b/test/unit/fortran/src/aerosol/CMakeLists.txt @@ -115,6 +115,7 @@ add_pfunit_ctest(test_insoluble_aerosol_optics 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) 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/test_modal_aerosol_properties.pf b/test/unit/fortran/src/aerosol/test_modal_aerosol_properties.pf index e8f97cb89..726d0382e 100644 --- a/test/unit/fortran/src/aerosol/test_modal_aerosol_properties.pf +++ b/test/unit/fortran/src/aerosol/test_modal_aerosol_properties.pf @@ -6,71 +6,9 @@ ! Mode 2 "coarse": 1 species (dust) ! ! Mock boundary: radiative_aerosol (modal mock interfaces) +! Helper module: modal_test_helpers (compiled separately) !----------------------------------------------------------------------- -! Helper module to set up and tear down the 2-mode mock config -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 - @test subroutine test_constructor_and_sizes() use funit From 510b50ee6e4013ef11b7b9fd079e3744d83b296f Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 9 Apr 2026 14:24:54 -0400 Subject: [PATCH 17/46] CCPP framework does not like shr_kind_cl --- src/aerosol/radiative_aerosol_definitions.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/aerosol/radiative_aerosol_definitions.F90 b/src/aerosol/radiative_aerosol_definitions.F90 index 81a277c3b..de6997284 100644 --- a/src/aerosol/radiative_aerosol_definitions.F90 +++ b/src/aerosol/radiative_aerosol_definitions.F90 @@ -8,7 +8,7 @@ !----------------------------------------------------------------------------- module radiative_aerosol_definitions - use shr_kind_mod, only: shr_kind_cl + use shr_kind_mod, only: 256 implicit none private @@ -56,7 +56,7 @@ module radiative_aerosol_definitions 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=shr_kind_cl), pointer :: radname(:) ! radname is the name as identfied in radiation, + 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 @@ -90,7 +90,7 @@ module radiative_aerosol_definitions ! specie type (as used in MAM code) character(len= 32), pointer :: type(:) ! file containing specie properties - character(len=shr_kind_cl), pointer :: props(:) + character(len=256), pointer :: props(:) ! index in pbuf or constituents for number mixing ratio of interstitial species integer :: idx_num_a @@ -145,7 +145,7 @@ module radiative_aerosol_definitions ! species morphology character(len= 32), pointer :: morph(:) ! file containing specie properties - character(len=shr_kind_cl), pointer :: props(:) + character(len=256), pointer :: props(:) ! index in pbuf or constituents for number mixing ratio of interstitial species integer :: idx_num_a @@ -179,7 +179,7 @@ module radiative_aerosol_definitions 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=shr_kind_cl) :: physprop_file ! physprop filename + 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 @@ -209,7 +209,7 @@ module radiative_aerosol_definitions ! index of the mode in the mode definition object integer, pointer :: idx(:) ! physprop filename - character(len=shr_kind_cl), pointer :: physprop_files(:) + character(len=256), pointer :: physprop_files(:) ! index of the mode properties in the physprop object integer, pointer :: idx_props(:) end type modelist_t @@ -229,7 +229,7 @@ module radiative_aerosol_definitions ! index of the bin in the bin definition object integer, pointer :: idx(:) ! physprop filename - character(len=shr_kind_cl), pointer :: physprop_files(:) + character(len=256), pointer :: physprop_files(:) ! index of the bin properties in the physprop object integer, pointer :: idx_props(:) end type binlist_t @@ -1116,10 +1116,10 @@ subroutine parse_rad_specifier(specifier, namelist_data) integer :: number, i, j integer :: ipos, strlen integer :: astat - character(len=shr_kind_cl) :: tmpstr + character(len=256) :: tmpstr character(len=1) :: source(n_rad_cnst) character(len=64) :: camname(n_rad_cnst) - character(len=shr_kind_cl) :: radname(n_rad_cnst) + character(len=256) :: radname(n_rad_cnst) character(len=1) :: type(n_rad_cnst) !------------------------------------------------------------------------- From 0797661b2f0126d8d65cf38803958a5accf37377 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 9 Apr 2026 14:30:44 -0400 Subject: [PATCH 18/46] Oops, should not have done replace all --- src/aerosol/radiative_aerosol_definitions.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/aerosol/radiative_aerosol_definitions.F90 b/src/aerosol/radiative_aerosol_definitions.F90 index de6997284..036e3c92e 100644 --- a/src/aerosol/radiative_aerosol_definitions.F90 +++ b/src/aerosol/radiative_aerosol_definitions.F90 @@ -8,8 +8,6 @@ !----------------------------------------------------------------------------- module radiative_aerosol_definitions - use shr_kind_mod, only: 256 - implicit none private save From 3683fd0f8ea4390055c8e01cc31a8ff85d1aee41 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 13 Apr 2026 11:22:00 -0400 Subject: [PATCH 19/46] fix cs1 -> 256 to make ccpp-framework happy --- src/aerosol/radiative_aerosol.F90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/aerosol/radiative_aerosol.F90 b/src/aerosol/radiative_aerosol.F90 index 981ee35d0..b16d19a9a 100644 --- a/src/aerosol/radiative_aerosol.F90 +++ b/src/aerosol/radiative_aerosol.F90 @@ -1106,7 +1106,7 @@ subroutine rad_aer_readnl(nlfile) use spmd_utils, only: masterproc use cam_abortutils, only: endrun use radiative_aerosol_definitions, only: & - cs1, verbose, N_DIAG, n_rad_cnst, n_mode_str, n_bin_str, & + 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, & @@ -1123,19 +1123,19 @@ subroutine rad_aer_readnl(nlfile) character(len=shr_kind_cm) :: errmsg ! Namelist variables (matching XML: group rad_aer_nl) - character(len=cs1), dimension(n_mode_str) :: mode_defs = ' ' - character(len=cs1), dimension(n_bin_str) :: bin_defs = ' ' - character(len=cs1) :: rad_aer_climate(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_1(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_2(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_3(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_4(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_5(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_6(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_7(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_8(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_9(n_rad_cnst) = ' ' - character(len=cs1) :: rad_aer_diag_10(n_rad_cnst) = ' ' + 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, & From f75166ad3d1f844b36cbe36dbb438faf3d82b09c Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 20 Apr 2026 11:42:30 -0400 Subject: [PATCH 20/46] bulk_aero_3: sync up to work-in-progress microp-enabled version in CAM (draft) --- src/aerosol/aerosol_state_mod.F90 | 20 ++ src/aerosol/bulk_aerosol_properties_mod.F90 | 4 +- src/aerosol/bulk_aerosol_state_mod.F90 | 211 +++++++++++++++++- src/aerosol/carma_aerosol_state_mod.F90 | 3 +- src/aerosol/modal_aerosol_state_mod.F90 | 4 +- src/data/registry.xml | 37 +++ test/unit/fortran/src/aerosol/CMakeLists.txt | 2 +- .../src/aerosol/mock_radiative_aerosol.F90 | 4 +- 8 files changed, 268 insertions(+), 17 deletions(-) diff --git a/src/aerosol/aerosol_state_mod.F90 b/src/aerosol/aerosol_state_mod.F90 index 3b8feb339..685d76008 100644 --- a/src/aerosol/aerosol_state_mod.F90 +++ b/src/aerosol/aerosol_state_mod.F90 @@ -25,9 +25,12 @@ module aerosol_state_mod !! 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 @@ -300,6 +303,23 @@ subroutine set_list_idx(self, 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 !------------------------------------------------------------------------------ diff --git a/src/aerosol/bulk_aerosol_properties_mod.F90 b/src/aerosol/bulk_aerosol_properties_mod.F90 index 14cd57941..e9260b78f 100644 --- a/src/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/aerosol/bulk_aerosol_properties_mod.F90 @@ -370,7 +370,9 @@ subroutine apply_number_limits( self, naerosol, vaerosol, istart, istop, m ) integer, intent(in) :: istop ! stop column index integer, intent(in) :: m ! mode or bin index - call endrun('ERROR: bulk_aerosol_properties_mod%apply_number_limits not yet implemented') + ! no-op for bulk aerosols: no min/max number constraints since numbers are diagnosed + ! from bulk mass concentrations + return end subroutine apply_number_limits diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index 7cf35f539..3fd6a8578 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -9,11 +9,23 @@ module bulk_aerosol_state_mod 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 real(kind_phys), pointer :: constituents(:,:,:) => null() + ! 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 @@ -37,6 +49,9 @@ module bulk_aerosol_state_mod procedure :: wet_diameter procedure :: convcld_actfrac procedure :: wgtpct + procedure :: get_bulk_num_and_mass + ! for bit-for-bit + procedure :: nuclice_get_numdens => nuclice_get_numdens_bam final :: destructor @@ -50,7 +65,10 @@ module bulk_aerosol_state_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(constituents, list_idx) result(newobj) + function constructor(ncol, constituents, list_idx) result(newobj) + use vert_coord, only: pver + + integer, intent(in) :: ncol real(kind_phys), pointer, intent(in) :: constituents(:,:,:) integer, intent(in), optional :: list_idx type(bulk_aerosol_state), pointer :: newobj @@ -65,8 +83,20 @@ function constructor(constituents, list_idx) result(newobj) newobj%constituents => constituents + ! 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 !------------------------------------------------------------------------------ @@ -76,6 +106,15 @@ subroutine destructor(self) nullify(self%constituents) + 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 !------------------------------------------------------------------------------ @@ -143,7 +182,8 @@ subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) integer, intent(in) :: bin_ndx ! bin index real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) - call endrun('ERROR: bulk_aerosol_state_mod%get_cldbrne_mmr not yet implemented') + ! BAM has no cloud-borne aerosol equivalent, return zero array. + mmr => self%zero_fld_ end subroutine get_cldbrne_mmr @@ -155,9 +195,30 @@ subroutine get_ambient_num(self, bin_ndx, num) integer, intent(in) :: bin_ndx ! bin index real(r8), pointer :: num(:,:) ! number densities - nullify(num) + 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 - call endrun('ERROR: bulk_aerosol_state_mod%get_ambient_num not yet implemented') + num => self%num_work_ end subroutine get_ambient_num @@ -169,9 +230,8 @@ subroutine get_cldbrne_num(self, bin_ndx, num) integer, intent(in) :: bin_ndx ! bin index real(r8), pointer :: num(:,:) - nullify(num) - - call endrun('ERROR: bulk_aerosol_state_mod%get_cldbrne_num not yet implemented') + ! BAM has no cloud-borne equivalent, return zero array. + num => self%zero_fld_ end subroutine get_cldbrne_num @@ -200,7 +260,9 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag real(r8), intent(out) :: wght(:,:) - call endrun('ERROR: bulk_aerosol_state_mod%icenuc_size_wght_arr not yet implemented') + ! 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 @@ -216,7 +278,8 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag real(r8), intent(out) :: wght - call endrun('ERROR: bulk_aerosol_state_mod%icenuc_size_wght_val not yet implemented') + ! Empirical 1/25 scaling factor for BAM ice nucleation number densities. + wght = 1._r8 / 25._r8 end subroutine icenuc_size_wght_val @@ -236,7 +299,20 @@ subroutine icenuc_type_wght(self, bin_ndx, ncol, nlev, species_type, aero_props, logical, optional, intent(in) :: cloud_borne ! if TRUE cloud-borne aerosols are used ! otherwise ambient aerosols are used - call endrun('ERROR: bulk_aerosol_state_mod%icenuc_type_wght not yet implemented') + 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 @@ -253,7 +329,8 @@ subroutine update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, real(r8),intent(in) :: dtime ! time step size (sec) real(r8),intent(inout) :: tend(:,:,:) ! tendency - call endrun('ERROR: bulk_aerosol_state_mod%update_bin not yet implemented') + ! No-op for BAM: ice nucleation does not produce aerosol tendencies + ! (no interstitial-to-cloud-borne transfer for bulk aerosols). end subroutine update_bin @@ -408,4 +485,116 @@ function wgtpct(self, ncol, nlev) result(wtp) end function wgtpct + !------------------------------------------------------------------------------ + ! 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) + !REMOVECAM: host-model specific dimensions + use ppgrid, only: pcols, pver + !REMOVECAM_END + + 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_state_mod.F90 b/src/aerosol/carma_aerosol_state_mod.F90 index 61853ee95..5136bea55 100644 --- a/src/aerosol/carma_aerosol_state_mod.F90 +++ b/src/aerosol/carma_aerosol_state_mod.F90 @@ -44,7 +44,8 @@ module carma_aerosol_state_mod contains - function constructor(constituents, list_idx) result(newobj) + function constructor(ncol, constituents, list_idx) result(newobj) + integer, intent(in) :: ncol real(kind_phys), pointer, intent(in) :: constituents(:,:,:) integer, intent(in), optional :: list_idx type(carma_aerosol_state), pointer :: newobj diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 index 99b7b4b84..cca8a16ac 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -56,7 +56,8 @@ module modal_aerosol_state_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(constituents, list_idx) result(newobj) + function constructor(ncol, constituents, list_idx) result(newobj) + integer, intent(in) :: ncol real(kind_phys), pointer, intent(in) :: constituents(:,:,:) integer, intent(in), optional :: list_idx @@ -70,6 +71,7 @@ function constructor(constituents, list_idx) result(newobj) return end if + call newobj%set_ncol(ncol) newobj%constituents => constituents if (present(list_idx)) call newobj%set_list_idx(list_idx) diff --git a/src/data/registry.xml b/src/data/registry.xml index 77077a2aa..7f9b53353 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -1491,6 +1491,43 @@ 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 + + + Date: Mon, 20 Apr 2026 11:56:57 -0400 Subject: [PATCH 21/46] Fix build --- src/aerosol/bulk_aerosol_state_mod.F90 | 2 ++ src/data/registry.xml | 8 ++++++++ 2 files changed, 10 insertions(+) diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index 3fd6a8578..541ce8664 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -6,6 +6,8 @@ module bulk_aerosol_state_mod 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 diff --git a/src/data/registry.xml b/src/data/registry.xml index 7f9b53353..9b2dcd8a5 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -1625,6 +1625,14 @@ 0.0_kind_phys pbuf_kvh + + horizontal_dimension vertical_interface_dimension + 0.0_kind_phys + pbuf_tke + Date: Mon, 20 Apr 2026 12:32:39 -0400 Subject: [PATCH 22/46] Unit test fixes; build fixes; pbuf setup in registry.xml --- src/aerosol/aerosol_instances_mod.F90 | 8 ++-- src/data/registry.xml | 41 +++++++++++++++++++ test/unit/fortran/src/aerosol/CMakeLists.txt | 1 + .../fortran/src/aerosol/mock_vert_coord.F90 | 12 ++++++ 4 files changed, 59 insertions(+), 3 deletions(-) create mode 100644 test/unit/fortran/src/aerosol/mock_vert_coord.F90 diff --git a/src/aerosol/aerosol_instances_mod.F90 b/src/aerosol/aerosol_instances_mod.F90 index 30ccbf908..ab693be7e 100644 --- a/src/aerosol/aerosol_instances_mod.F90 +++ b/src/aerosol/aerosol_instances_mod.F90 @@ -199,8 +199,10 @@ subroutine aerosol_instances_init_states(constituents) 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 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(:,:,:) @@ -222,21 +224,21 @@ subroutine aerosol_instances_init_states(constituents) iaermod = iaermod + 1 if (associated(aero_props_all(iaermod, ilist)%obj)) then aero_states_all(iaermod, ilist)%obj => & - modal_aerosol_state(constituents, ilist) + modal_aerosol_state(ncol, constituents, 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(constituents, ilist) + carma_aerosol_state(ncol, constituents, 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(constituents, ilist) + bulk_aerosol_state(ncol, constituents, ilist) end if end if end do diff --git a/src/data/registry.xml b/src/data/registry.xml index 9b2dcd8a5..0f0c612c9 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -1820,6 +1820,47 @@ 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 + 0.0_kind_phys + pbuf_NACON + + + horizontal_dimension vertical_layer_dimension + 0.0_kind_phys + pbuf_RNDST + Date: Mon, 20 Apr 2026 12:38:11 -0400 Subject: [PATCH 23/46] Fix extra ppgrid call; comment out rndst in registry --- src/aerosol/bulk_aerosol_state_mod.F90 | 3 --- src/data/registry.xml | 7 ++++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index 541ce8664..7215e4793 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -540,9 +540,6 @@ end subroutine get_bulk_num_and_mass ! 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) - !REMOVECAM: host-model specific dimensions - use ppgrid, only: pcols, pver - !REMOVECAM_END class(bulk_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props diff --git a/src/data/registry.xml b/src/data/registry.xml index 0f0c612c9..f41f0bfc5 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -1853,14 +1853,15 @@ 0.0_kind_phys pbuf_NACON - - horizontal_dimension vertical_layer_dimension + horizontal_dimension vertical_layer_dimension dust_size_bin_dimension 0.0_kind_phys pbuf_RNDST - + --> Date: Mon, 20 Apr 2026 12:51:24 -0400 Subject: [PATCH 24/46] Fix unit tests due to new ncol --- test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf | 8 ++++---- .../fortran/src/aerosol/test_insoluble_aerosol_optics.pf | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf b/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf index d312b1932..cd1887e09 100644 --- a/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf +++ b/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf @@ -26,7 +26,7 @@ subroutine test_constructor() constituents = 1.0e-6_kind_phys cptr => constituents - state => bulk_aerosol_state(cptr) + state => bulk_aerosol_state(2, cptr) @assertTrue(associated(state)) @@ -52,7 +52,7 @@ subroutine test_get_ambient_mmr() constituents(:, :, 2) = 2.0e-6_kind_phys ! sulfate cptr => constituents - state => bulk_aerosol_state(cptr) + state => bulk_aerosol_state(ncol, cptr) ! Get MMR for aerosol 1 (dust) call state%get_ambient_mmr(species_ndx=1, bin_ndx=1, mmr=mmr) @@ -99,7 +99,7 @@ subroutine test_dry_volume() constituents(:, :, 1) = 1.0e-6_kind_phys cptr => constituents - state => bulk_aerosol_state(cptr) + state => bulk_aerosol_state(ncol, cptr) ! dry_volume = mmr / density = 1e-6 / 2000 = 5e-10 m3/kg vol = state%dry_volume(props, bin_idx=1, ncol=ncol, nlev=nlev) @@ -142,7 +142,7 @@ subroutine test_ambient_total_bin_mmr() constituents(:, :, 2) = 7.0e-6_kind_phys cptr => constituents - state => bulk_aerosol_state(cptr) + state => bulk_aerosol_state(ncol, 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) diff --git a/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf b/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf index a15a100e7..594c59413 100644 --- a/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf +++ b/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf @@ -62,7 +62,7 @@ subroutine test_sw_props() allocate(constituents(ncol, nlev, naero)) constituents(:, :, 1) = 1.0e-6_kind_phys ! MMR = 1e-6 kg/kg cptr => constituents - state => bulk_aerosol_state(cptr) + state => bulk_aerosol_state(ncol, cptr) ! Create insoluble optics object optics => insoluble_aerosol_optics(props, state, ibin=1) @@ -137,7 +137,7 @@ subroutine test_lw_props() allocate(constituents(ncol, nlev, naero)) constituents(:, :, 1) = 2.0e-6_kind_phys ! MMR = 2e-6 cptr => constituents - state => bulk_aerosol_state(cptr) + state => bulk_aerosol_state(ncol, cptr) optics => insoluble_aerosol_optics(props, state, ibin=1) From 79ebf1d075cbf1cbaef15142a8c93f9ee56b0922 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 20 Apr 2026 12:51:33 -0400 Subject: [PATCH 25/46] Disable pbuf input fields with dust dimension as problematic --- src/data/registry.xml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/data/registry.xml b/src/data/registry.xml index f41f0bfc5..aa2e9ccab 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -1845,23 +1845,23 @@ 0.0_kind_phys pbuf_NPCCN - + + + --> Date: Mon, 20 Apr 2026 12:55:58 -0400 Subject: [PATCH 26/46] Continue to fix unit tests --- test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf b/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf index cd9675da2..c38b0f041 100644 --- a/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf +++ b/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf @@ -44,7 +44,7 @@ subroutine test_get_ambient_mmr() constituents(:, :, 5) = 5.0e-9_kind_phys cptr => constituents - state => modal_aerosol_state(cptr) + state => modal_aerosol_state(ncol, 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) @@ -89,7 +89,7 @@ subroutine test_get_ambient_num() constituents(:, :, 4) = 5.0e6_kind_phys cptr => constituents - state => modal_aerosol_state(cptr) + state => modal_aerosol_state(ncol, cptr) ! get_ambient_num(bin_ndx=1) -> index 1 call state%get_ambient_num(bin_ndx=1, num=num) @@ -132,7 +132,7 @@ subroutine test_ambient_total_bin_mmr() cptr => constituents props => modal_aerosol_properties() - state => modal_aerosol_state(cptr) + state => modal_aerosol_state(ncol, 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) @@ -175,7 +175,7 @@ subroutine test_dry_volume() cptr => constituents props => modal_aerosol_properties() - state => modal_aerosol_state(cptr) + state => modal_aerosol_state(ncol, cptr) ! dry_volume for mode 1 = sum(mmr_i / density_i) expected = mmr_so4 / dens_sulfate + mmr_bc / dens_bc From d538b0128367cc7380a140d77af9651af07b1bf1 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 20 Apr 2026 21:36:03 -0400 Subject: [PATCH 27/46] Make wv_stdname register consistent with initialize_constituents; move rad_aer_init to before physics schemes init; add numice, numliq to registry to read --- src/control/cam_comp.F90 | 10 ++++++---- src/data/registry.xml | 22 ++++++++++++++++++---- 2 files changed, 24 insertions(+), 8 deletions(-) diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index edf1f8eb5..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 @@ -277,9 +282,6 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & call stepon_init(cam_runtime_opts, dyn_in, dyn_out) - ! Aerosol optics infrastructure init (after phys_init, before history_init_files) - call rad_aer_init_all() - ! if (single_column) then ! call scm_intht() ! end if @@ -655,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", & diff --git a/src/data/registry.xml b/src/data/registry.xml index aa2e9ccab..e66d0cb46 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -622,6 +622,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 + @@ -1822,7 +1836,7 @@ horizontal_dimension vertical_layer_dimension @@ -1830,7 +1844,7 @@ pbuf_NAAI horizontal_dimension vertical_layer_dimension @@ -1838,7 +1852,7 @@ pbuf_NAAI_HOM horizontal_dimension vertical_layer_dimension @@ -1847,7 +1861,7 @@ horizontal_dimension vertical_layer_dimension 0.0_kind_phys - pbuf_aist + pbuf_AIST From ac8a284f3e78157ad8b1e9d1a24557076f0cec7f Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 23 Apr 2026 13:46:59 -0400 Subject: [PATCH 29/46] Add dust dimensioned variables to snapshot check. --- src/data/registry.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/data/registry.xml b/src/data/registry.xml index 3c0d65df4..8291067d9 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -1868,22 +1868,22 @@ pbuf_NPCCN - - + Date: Fri, 24 Apr 2026 11:52:10 -0400 Subject: [PATCH 30/46] Make it a parameter --- src/data/registry.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/data/registry.xml b/src/data/registry.xml index 8291067d9..304546b11 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -1541,7 +1541,7 @@ + units="count" type="integer" allocatable="parameter"> number of dust size bins used in aerosol model 4 + + + + + + + + + + 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..7a07873db --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_microp_aero_bam_derecho/user_nl_cam @@ -0,0 +1,44 @@ +! 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' From 2b752a76785275e08dd401244785ff3527fe7e41 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 18 May 2026 14:58:58 -0400 Subject: [PATCH 33/46] Add diagnostics fields to testmod. --- .../user_nl_cam | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) 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 index 7a07873db..4a9662890 100644 --- 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 @@ -42,3 +42,27 @@ rad_aer_climate = 'N:sulf:/glade/campaign/cesm/cesmdata/inputdata/atm/cam/physpr '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 From af5f828f86877b5e6c0b01cd24d64b63963b3e98 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 18 May 2026 16:27:16 -0400 Subject: [PATCH 34/46] Disable aerosols in QPC cases. --- .../testmods_dirs/cam/outfrq_analy_ic_cam4/user_nl_cam | 6 ++++++ 1 file changed, 6 insertions(+) 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 = '' From 2be2c6482603b152c831399d881873b3764afcab Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 18 May 2026 17:34:11 -0400 Subject: [PATCH 35/46] Add sane defaults for type declarations for safety Assisted-by: claude-opus:4.6[1m] --- src/aerosol/radiative_aerosol_definitions.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/aerosol/radiative_aerosol_definitions.F90 b/src/aerosol/radiative_aerosol_definitions.F90 index 036e3c92e..8ac81c57c 100644 --- a/src/aerosol/radiative_aerosol_definitions.F90 +++ b/src/aerosol/radiative_aerosol_definitions.F90 @@ -186,10 +186,10 @@ module radiative_aerosol_definitions !! \section arg_table_aerlist_t !! \htmlinclude aerlist_t.html type, public :: aerlist_t - integer :: numaerosols ! number of aerosols + 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(:) ! dimension(numaerosols) + type(aerosol_t), pointer :: aer(:) => null() ! dimension(numaerosols) end type aerlist_t !! \section arg_table_modelist_t @@ -197,7 +197,7 @@ module radiative_aerosol_definitions ! storage for modal aerosol components in the climate/diagnostic lists type, public :: modelist_t ! number of modes - integer :: nmodes + integer :: nmodes = 0 ! set to " " for climate list, or two character integer ! (include leading zero) to identify diagnostic list @@ -205,11 +205,11 @@ module radiative_aerosol_definitions character(len=2) :: list_id ! index of the mode in the mode definition object - integer, pointer :: idx(:) + integer, pointer :: idx(:) => null() ! physprop filename - character(len=256), pointer :: physprop_files(:) + character(len=256), pointer :: physprop_files(:) => null() ! index of the mode properties in the physprop object - integer, pointer :: idx_props(:) + integer, pointer :: idx_props(:) => null() end type modelist_t !! \section arg_table_binlist_t @@ -217,7 +217,7 @@ module radiative_aerosol_definitions ! storage for bin aerosol components in the climate/diagnostic lists type, public :: binlist_t ! number of bins - integer :: nbins + integer :: nbins = 0 ! set to " " for climate list, or two character integer ! (include leading zero) to identify diagnostic list @@ -225,11 +225,11 @@ module radiative_aerosol_definitions character(len=2) :: list_id ! index of the bin in the bin definition object - integer, pointer :: idx(:) + integer, pointer :: idx(:) => null() ! physprop filename - character(len=256), pointer :: physprop_files(:) + character(len=256), pointer :: physprop_files(:) => null() ! index of the bin properties in the physprop object - integer, pointer :: idx_props(:) + integer, pointer :: idx_props(:) => null() end type binlist_t ! max number of strings in mode definitions From 772e240fa11ca4c3b9e60a64130d8467ab69dcfc Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 9 Jun 2026 16:25:28 -0400 Subject: [PATCH 36/46] Sync up to cam6_4_177. --- src/aerosol/aerosol_properties_mod.F90 | 3 +- src/aerosol/aerosol_state_mod.F90 | 16 ++++ src/aerosol/bulk_aerosol_properties_mod.F90 | 20 ++++- src/aerosol/bulk_aerosol_state_mod.F90 | 17 ++++ src/aerosol/carma_aerosol_properties_mod.F90 | 3 +- src/aerosol/carma_aerosol_state_mod.F90 | 13 +++ src/aerosol/modal_aerosol_properties_mod.F90 | 8 +- src/aerosol/modal_aerosol_state_mod.F90 | 88 +++++++++++++++++++- 8 files changed, 162 insertions(+), 6 deletions(-) diff --git a/src/aerosol/aerosol_properties_mod.F90 b/src/aerosol/aerosol_properties_mod.F90 index 0c7f70d73..db2f74022 100644 --- a/src/aerosol/aerosol_properties_mod.F90 +++ b/src/aerosol/aerosol_properties_mod.F90 @@ -109,7 +109,7 @@ end function aero_number_transported ! long wave species refractive indices ! species morphology !------------------------------------------------------------------------ - subroutine aero_props_get(self, bin_ndx, species_ndx, density, hygro, & + 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 @@ -118,6 +118,7 @@ subroutine aero_props_get(self, bin_ndx, species_ndx, density, hygro, & 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 diff --git a/src/aerosol/aerosol_state_mod.F90 b/src/aerosol/aerosol_state_mod.F90 index f904db3c0..24cb00bcf 100644 --- a/src/aerosol/aerosol_state_mod.F90 +++ b/src/aerosol/aerosol_state_mod.F90 @@ -64,6 +64,7 @@ module aerosol_state_mod 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 @@ -282,6 +283,21 @@ function aero_wet_diam(self, bin_idx, ncol, nlev) result(diam) 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 diff --git a/src/aerosol/bulk_aerosol_properties_mod.F90 b/src/aerosol/bulk_aerosol_properties_mod.F90 index fe159129b..4b68185b5 100644 --- a/src/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/aerosol/bulk_aerosol_properties_mod.F90 @@ -152,7 +152,7 @@ end function number_transported ! long wave species refractive indices ! species morphology !------------------------------------------------------------------------ - subroutine get(self, bin_ndx, species_ndx, density, hygro, & + subroutine get(self, bin_ndx, species_ndx, density, hygro, spec_mw, & spectype, specname, specmorph, refindex_sw, refindex_lw, num_to_mass_aer, & dryrad) @@ -161,6 +161,7 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, & 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 @@ -217,6 +218,23 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, & 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 diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index 7215e4793..70185a4ea 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -51,6 +51,7 @@ module bulk_aerosol_state_mod 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 @@ -487,6 +488,22 @@ function wgtpct(self, ncol, nlev) result(wtp) 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). diff --git a/src/aerosol/carma_aerosol_properties_mod.F90 b/src/aerosol/carma_aerosol_properties_mod.F90 index 2a3f6805a..28979b8e5 100644 --- a/src/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/aerosol/carma_aerosol_properties_mod.F90 @@ -58,11 +58,12 @@ integer function number_transported(self) call endrun('carma_aerosol_properties%number_transported: not implemented') end function number_transported - subroutine get(self, bin_ndx, species_ndx, density, hygro, & + 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 diff --git a/src/aerosol/carma_aerosol_state_mod.F90 b/src/aerosol/carma_aerosol_state_mod.F90 index 5136bea55..ac7204a87 100644 --- a/src/aerosol/carma_aerosol_state_mod.F90 +++ b/src/aerosol/carma_aerosol_state_mod.F90 @@ -35,6 +35,7 @@ module carma_aerosol_state_mod procedure :: wet_volume procedure :: water_volume procedure :: wet_diameter + procedure :: aqu_gain_binfraction procedure :: wgtpct end type carma_aerosol_state @@ -199,4 +200,16 @@ function wgtpct(self, ncol, nlev) result(wtp) 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/modal_aerosol_properties_mod.F90 b/src/aerosol/modal_aerosol_properties_mod.F90 index 7fc6e6034..7d3147dd9 100644 --- a/src/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/aerosol/modal_aerosol_properties_mod.F90 @@ -3,7 +3,6 @@ module modal_aerosol_properties_mod 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 @@ -407,7 +406,7 @@ end function number_transported ! long wave species refractive indices ! species morphology !------------------------------------------------------------------------ - subroutine get(self, bin_ndx, species_ndx, density, hygro, & + 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 @@ -417,6 +416,7 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, & 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 @@ -429,6 +429,10 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, & 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 diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 index cca8a16ac..580549286 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -5,7 +5,7 @@ module modal_aerosol_state_mod 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_ccpp, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num - use aerosol_properties_mod, only: aerosol_properties + use aerosol_properties_mod, only: aerosol_properties, aero_name_len use physconst, only: rhoh2o use cam_abortutils, only: endrun @@ -41,6 +41,7 @@ module modal_aerosol_state_mod procedure :: wet_diameter procedure :: convcld_actfrac procedure :: wgtpct + procedure :: aqu_gain_binfraction final :: destructor @@ -696,4 +697,89 @@ function wgtpct(self, ncol, nlev) result(wtp) 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%state%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 From 72eb6df05844740ca733705bae58e7431695e346 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 10 Jun 2026 22:50:17 -0400 Subject: [PATCH 37/46] Abstract host binding for constituents in SIMA to avoid divergence. Assisted-by: claude-fable:5[1m] --- src/aerosol/aerosol_instances_mod.F90 | 10 +- ...osol_mmr_ccpp.F90 => aerosol_mmr_host.F90} | 184 +++++++++++++++--- src/aerosol/bulk_aerosol_state_mod.F90 | 18 +- src/aerosol/carma_aerosol_state_mod.F90 | 6 +- src/aerosol/modal_aerosol_state_mod.F90 | 40 ++-- src/aerosol/radiative_aerosol.F90 | 2 +- test/unit/fortran/src/aerosol/CMakeLists.txt | 2 +- ...mmr_ccpp.F90 => mock_aerosol_mmr_host.F90} | 67 ++++++- .../src/aerosol/test_bulk_aerosol_state.pf | 14 +- .../src/aerosol/test_modal_aerosol_state.pf | 14 +- 10 files changed, 281 insertions(+), 76 deletions(-) rename src/aerosol/{aerosol_mmr_ccpp.F90 => aerosol_mmr_host.F90} (79%) rename test/unit/fortran/src/aerosol/{mock_aerosol_mmr_ccpp.F90 => mock_aerosol_mmr_host.F90} (56%) diff --git a/src/aerosol/aerosol_instances_mod.F90 b/src/aerosol/aerosol_instances_mod.F90 index ab693be7e..b647cd113 100644 --- a/src/aerosol/aerosol_instances_mod.F90 +++ b/src/aerosol/aerosol_instances_mod.F90 @@ -199,6 +199,7 @@ subroutine aerosol_instances_init_states(constituents) 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 @@ -207,6 +208,7 @@ subroutine aerosol_instances_init_states(constituents) 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 @@ -216,6 +218,8 @@ subroutine aerosol_instances_init_states(constituents) 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 @@ -224,21 +228,21 @@ subroutine aerosol_instances_init_states(constituents) iaermod = iaermod + 1 if (associated(aero_props_all(iaermod, ilist)%obj)) then aero_states_all(iaermod, ilist)%obj => & - modal_aerosol_state(ncol, constituents, ilist) + 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, constituents, ilist) + 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, constituents, ilist) + bulk_aerosol_state(ncol, host, ilist) end if end if end do diff --git a/src/aerosol/aerosol_mmr_ccpp.F90 b/src/aerosol/aerosol_mmr_host.F90 similarity index 79% rename from src/aerosol/aerosol_mmr_ccpp.F90 rename to src/aerosol/aerosol_mmr_host.F90 index 2e7fea1eb..a4664b2a8 100644 --- a/src/aerosol/aerosol_mmr_ccpp.F90 +++ b/src/aerosol/aerosol_mmr_host.F90 @@ -1,11 +1,17 @@ -module aerosol_mmr_ccpp +module aerosol_mmr_host !------------------------------------------------------------------------------------------------ ! -! CAM-SIMA (CCPP) aerosol MMR retrieval routines. These routines use -! the CCPP constituents array to return mixing ratio pointers. +! Host-binding module for aerosol MMR retrieval (CAM-SIMA flavor). ! -! Ported from aerosol_mmr_cam: replaces pbuf/state%q with CCPP constituents. +! 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. ! !------------------------------------------------------------------------------------------------ @@ -16,17 +22,47 @@ module aerosol_mmr_ccpp 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_ccpp_idx +public :: get_host_idx public :: resolve_mode_idx, resolve_bin_idx public :: resolve_bulk_idx public :: rad_cnst_get_aer_mmr @@ -57,7 +93,22 @@ end subroutine aerosol_mmr_init !================================================================================================ -integer function get_ccpp_idx(source, name, routine) +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 @@ -83,9 +134,9 @@ integer function get_ccpp_idx(source, name, routine) call endrun(routine//' ERROR: invalid source for specie '//trim(name)) end if - get_ccpp_idx = idx + get_host_idx = idx -end function get_ccpp_idx +end function get_host_idx !=========================== @@ -110,8 +161,8 @@ subroutine resolve_mode_idx(modes) do m = 1, modes%nmodes ! indices for number mixing ratio components - modes%comps(m)%idx_num_a = get_ccpp_idx(modes%comps(m)%source_num_a, modes%comps(m)%camname_num_a, routine) - modes%comps(m)%idx_num_c = get_ccpp_idx(modes%comps(m)%source_num_c, modes%comps(m)%camname_num_c, routine) + 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 @@ -123,9 +174,9 @@ subroutine resolve_mode_idx(modes) do ispec = 1, nspec ! indices for species mixing ratio components - modes%comps(m)%idx_mmr_a(ispec) = get_ccpp_idx(modes%comps(m)%source_mmr_a(ispec), & + 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_ccpp_idx(modes%comps(m)%source_mmr_c(ispec), & + 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 @@ -163,13 +214,13 @@ subroutine resolve_bin_idx(bins) do m = 1, bins%nbins ! indices for number mixing ratio components - bins%comps(m)%idx_num_a = get_ccpp_idx(bins%comps(m)%source_num_a, bins%comps(m)%camname_num_a, routine) - bins%comps(m)%idx_num_c = get_ccpp_idx(bins%comps(m)%source_num_c, bins%comps(m)%camname_num_c, routine) + 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_ccpp_idx(bins%comps(m)%source_mass_a, bins%comps(m)%camname_mass_a, routine) + 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_ccpp_idx(bins%comps(m)%source_mass_c, bins%comps(m)%camname_mass_c, routine) + 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 @@ -182,9 +233,9 @@ subroutine resolve_bin_idx(bins) do ispec = 1, nspec ! indices for species mixing ratio components - bins%comps(m)%idx_mmr_a(ispec) = get_ccpp_idx(bins%comps(m)%source_mmr_a(ispec), & + 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_ccpp_idx(bins%comps(m)%source_mmr_c(ispec), & + 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 @@ -216,7 +267,7 @@ subroutine resolve_bulk_idx(aerlist) !----------------------------------------------------------------------------- do i = 1, aerlist%numaerosols - aerlist%aer(i)%idx = get_ccpp_idx(aerlist%aer(i)%source, aerlist%aer(i)%camname, routine) + aerlist%aer(i)%idx = get_host_idx(aerlist%aer(i)%source, aerlist%aer(i)%camname, routine) end do end subroutine resolve_bulk_idx @@ -272,6 +323,21 @@ 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 @@ -342,7 +408,24 @@ end subroutine rad_cnst_get_mam_mmr_by_idx !================================================================================================ -subroutine rad_cnst_get_bin_mmr_by_idx(list_idx, bin_idx, spec_idx, phase, constituents, mmr) +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. @@ -402,7 +485,24 @@ subroutine rad_cnst_get_bin_mmr_by_idx(list_idx, bin_idx, spec_idx, phase, const mmr => zero_cols end select -end subroutine rad_cnst_get_bin_mmr_by_idx +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 !================================================================================================ @@ -533,7 +633,7 @@ end subroutine rad_cnst_get_bin_mmr !================================================================================================ -subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, constituents, num) +subroutine rad_cnst_get_mode_num_ccpp(list_idx, mode_idx, phase, constituents, num) use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -583,11 +683,27 @@ subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, constituents, num) num => zero_cols end select -end subroutine rad_cnst_get_mode_num +end subroutine rad_cnst_get_mode_num_ccpp !================================================================================================ -subroutine rad_cnst_get_bin_num(list_idx, bin_idx, phase, constituents, num) +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 @@ -637,7 +753,23 @@ subroutine rad_cnst_get_bin_num(list_idx, bin_idx, phase, constituents, num) num => zero_cols end select -end subroutine rad_cnst_get_bin_num +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 !================================================================================================ @@ -846,4 +978,4 @@ end subroutine rad_aer_diag_out !================================================================================================ -end module aerosol_mmr_ccpp +end module aerosol_mmr_host diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index 70185a4ea..f192f928f 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -1,7 +1,6 @@ module bulk_aerosol_state_mod use shr_kind_mod, only: r8 => shr_kind_r8 - use ccpp_kinds, only: kind_phys - use aerosol_mmr_ccpp, only: rad_cnst_get_aer_mmr + 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 @@ -21,7 +20,9 @@ module bulk_aerosol_state_mod type, extends(aerosol_state) :: bulk_aerosol_state private - real(kind_phys), pointer :: constituents(:,:,:) => null() + ! 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. @@ -68,11 +69,11 @@ module bulk_aerosol_state_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(ncol, constituents, list_idx) result(newobj) + function constructor(ncol, host, list_idx) result(newobj) use vert_coord, only: pver integer, intent(in) :: ncol - real(kind_phys), pointer, intent(in) :: constituents(:,:,:) + type(aero_host_binding_t), intent(in) :: host integer, intent(in), optional :: list_idx type(bulk_aerosol_state), pointer :: newobj @@ -84,7 +85,7 @@ function constructor(ncol, constituents, list_idx) result(newobj) return end if - newobj%constituents => constituents + newobj%host_ = host ! set number of active columns internally to prevent loops from accessing beyond ! meaningful data in arrays @@ -107,7 +108,8 @@ end function constructor subroutine destructor(self) type(bulk_aerosol_state), intent(inout) :: self - nullify(self%constituents) + ! 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_) @@ -172,7 +174,7 @@ subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) ! 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%constituents, mmr) + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, self%host_, mmr) end subroutine get_ambient_mmr diff --git a/src/aerosol/carma_aerosol_state_mod.F90 b/src/aerosol/carma_aerosol_state_mod.F90 index ac7204a87..1e0bc7240 100644 --- a/src/aerosol/carma_aerosol_state_mod.F90 +++ b/src/aerosol/carma_aerosol_state_mod.F90 @@ -4,8 +4,8 @@ module carma_aerosol_state_mod ! Exports the constructor interface so aerosol_instances_mod compiles. !----------------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 - use ccpp_kinds, only: kind_phys 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 @@ -45,9 +45,9 @@ module carma_aerosol_state_mod contains - function constructor(ncol, constituents, list_idx) result(newobj) + function constructor(ncol, host, list_idx) result(newobj) integer, intent(in) :: ncol - real(kind_phys), pointer, intent(in) :: constituents(:,:,:) + type(aero_host_binding_t), intent(in) :: host integer, intent(in), optional :: list_idx type(carma_aerosol_state), pointer :: newobj nullify(newobj) diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 index 580549286..dec6f53e5 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -1,10 +1,9 @@ module modal_aerosol_state_mod use shr_kind_mod, only: r8 => shr_kind_r8 - use ccpp_kinds, only: kind_phys 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_ccpp, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num + 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 @@ -17,7 +16,9 @@ module modal_aerosol_state_mod type, extends(aerosol_state) :: modal_aerosol_state private - real(kind_phys), pointer :: constituents(:,:,:) => null() + ! 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 @@ -57,9 +58,9 @@ module modal_aerosol_state_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(ncol, constituents, list_idx) result(newobj) + function constructor(ncol, host, list_idx) result(newobj) integer, intent(in) :: ncol - real(kind_phys), pointer, intent(in) :: constituents(:,:,:) + type(aero_host_binding_t), intent(in) :: host integer, intent(in), optional :: list_idx type(modal_aerosol_state), pointer :: newobj @@ -73,7 +74,7 @@ function constructor(ncol, constituents, list_idx) result(newobj) end if call newobj%set_ncol(ncol) - newobj%constituents => constituents + newobj%host_ = host if (present(list_idx)) call newobj%set_list_idx(list_idx) @@ -84,7 +85,8 @@ end function constructor subroutine destructor(self) type(modal_aerosol_state), intent(inout) :: self - nullify(self%constituents) + ! disassociate the host binding (data referenced within is not owned here) + self%host_ = aero_host_binding_t() end subroutine destructor @@ -127,7 +129,7 @@ function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) resu 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%constituents, mmrptr) + 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 @@ -142,7 +144,7 @@ subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) 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%constituents, mmr) + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, species_ndx, 'a', self%host_, mmr) end subroutine get_ambient_mmr !------------------------------------------------------------------------------ @@ -154,7 +156,7 @@ subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) 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%constituents, mmr) + call rad_cnst_get_aer_mmr(self%list_idx_, bin_ndx, species_ndx, 'c', self%host_, mmr) end subroutine get_cldbrne_mmr !------------------------------------------------------------------------------ @@ -165,7 +167,7 @@ subroutine get_ambient_num(self, bin_ndx, num) 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%constituents, num) + call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'a', self%host_, num) end subroutine get_ambient_num !------------------------------------------------------------------------------ @@ -176,7 +178,7 @@ subroutine get_cldbrne_num(self, bin_ndx, num) integer, intent(in) :: bin_ndx ! bin index real(r8), pointer :: num(:,:) - call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'c', self%constituents, num) + call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'c', self%host_, num) end subroutine get_cldbrne_num !------------------------------------------------------------------------------ @@ -250,10 +252,10 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre call const_get_index(trim(cname), idx_dgnum) do k = 1, nlev do i = 1, ncol - if (self%constituents(i,k,idx_dgnum) > 0._r8) then + 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%constituents(i,k,idx_dgnum)) / & + 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 @@ -314,10 +316,10 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u write(cname, '(a,i2.2)') 'dgnum_m', bin_ndx call const_get_index(trim(cname), idx_dgnum) - if (self%constituents(col_ndx, lyr_ndx, idx_dgnum) > 0._r8) then + 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%constituents(col_ndx, lyr_ndx, idx_dgnum)) / & + 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 @@ -489,11 +491,11 @@ subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat ! by the modal water uptake CCPPized scheme. write(cname, '(a,i2.2)') 'dgnumwet_m', bin_idx call const_get_index(trim(cname), idx_wet) - dgnumwet(:ncol,:nlev) = self%constituents(:ncol,:nlev,idx_wet) + dgnumwet(:ncol,:nlev) = self%host_%constituents(:ncol,:nlev,idx_wet) write(cname, '(a,i2.2)') 'qaerwat_m', bin_idx call const_get_index(trim(cname), idx_qaw) - qaerwat(:ncol,:nlev) = self%constituents(:ncol,:nlev,idx_qaw) + qaerwat(:ncol,:nlev) = self%host_%constituents(:ncol,:nlev,idx_qaw) else ! Diagnostic lists: recomputation requires modal_aero_calcsize and ! modal_aero_wateruptake, which are not yet CCPPized. @@ -600,7 +602,7 @@ function wet_diameter(self, bin_idx, ncol, nlev) result(diam) write(cname, '(a,i2.2)') 'dgnumwet_m', bin_idx call const_get_index(trim(cname), idx_wet) - diam(:ncol,:nlev) = self%constituents(:ncol,:nlev,idx_wet) + diam(:ncol,:nlev) = self%host_%constituents(:ncol,:nlev,idx_wet) end function wet_diameter diff --git a/src/aerosol/radiative_aerosol.F90 b/src/aerosol/radiative_aerosol.F90 index b16d19a9a..797a06f72 100644 --- a/src/aerosol/radiative_aerosol.F90 +++ b/src/aerosol/radiative_aerosol.F90 @@ -1277,7 +1277,7 @@ subroutine rad_aer_init() N_DIAG, modes, bins, active_calls, & bulk_aerosol_list, modal_aerosol_list, sectional_aerosol_list, list_resolve_physprops - use aerosol_mmr_ccpp, only: aerosol_mmr_init, & + use aerosol_mmr_host, only: aerosol_mmr_init, & resolve_mode_idx, resolve_bin_idx, resolve_bulk_idx, & rad_aer_diag_init diff --git a/test/unit/fortran/src/aerosol/CMakeLists.txt b/test/unit/fortran/src/aerosol/CMakeLists.txt index 6df5aed4b..f835179a7 100644 --- a/test/unit/fortran/src/aerosol/CMakeLists.txt +++ b/test/unit/fortran/src/aerosol/CMakeLists.txt @@ -82,7 +82,7 @@ add_library(bulk_aero_testlib ${CORE_UTILS}/string_core_utils.F90 mock_phys_prop.F90 mock_radiative_aerosol.F90 - mock_aerosol_mmr_ccpp.F90 + mock_aerosol_mmr_host.F90 ${CCPP_STUB} ) target_link_libraries(bulk_aero_testlib PUBLIC aerosol_test_mocks) diff --git a/test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 b/test/unit/fortran/src/aerosol/mock_aerosol_mmr_host.F90 similarity index 56% rename from test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 rename to test/unit/fortran/src/aerosol/mock_aerosol_mmr_host.F90 index 023521cd7..3aa732adf 100644 --- a/test/unit/fortran/src/aerosol/mock_aerosol_mmr_ccpp.F90 +++ b/test/unit/fortran/src/aerosol/mock_aerosol_mmr_host.F90 @@ -1,5 +1,5 @@ !----------------------------------------------------------------------- -! Mock aerosol_mmr_ccpp module for unit testing bulk_aerosol_state. +! 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 @@ -8,8 +8,11 @@ ! ! 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_ccpp +module aerosol_mmr_host use shr_kind_mod, only: r8 => shr_kind_r8 use ccpp_kinds, only: kind_phys @@ -17,17 +20,41 @@ module aerosol_mmr_ccpp 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). !----------------------------------------------------------------------- @@ -40,6 +67,15 @@ subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, constituents, 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). @@ -70,11 +106,22 @@ subroutine rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, cons mmr => 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(list_idx, mode_idx, phase, constituents, num) + 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 @@ -91,6 +138,16 @@ subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, constituents, num) end do num => constituents(:, :, flat_idx) - end subroutine rad_cnst_get_mode_num + 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_ccpp +end module aerosol_mmr_host diff --git a/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf b/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf index cd1887e09..895b8640b 100644 --- a/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf +++ b/test/unit/fortran/src/aerosol/test_bulk_aerosol_state.pf @@ -9,7 +9,7 @@ ! ! Mock boundaries: ! - radiative_aerosol (rad_aer_get_info, rad_aer_get_props) for properties -! - aerosol_mmr_ccpp (rad_cnst_get_aer_mmr) for state MMR retrieval +! - aerosol_mmr_host (rad_cnst_get_aer_mmr) for state MMR retrieval !----------------------------------------------------------------------- @test @@ -17,6 +17,7 @@ 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(:,:,:) @@ -26,7 +27,7 @@ subroutine test_constructor() constituents = 1.0e-6_kind_phys cptr => constituents - state => bulk_aerosol_state(2, cptr) + state => bulk_aerosol_state(2, aero_host_binding(cptr)) @assertTrue(associated(state)) @@ -40,6 +41,7 @@ subroutine test_get_ambient_mmr() 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(:,:,:) @@ -52,7 +54,7 @@ subroutine test_get_ambient_mmr() constituents(:, :, 2) = 2.0e-6_kind_phys ! sulfate cptr => constituents - state => bulk_aerosol_state(ncol, cptr) + 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) @@ -73,6 +75,7 @@ subroutine test_dry_volume() 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 @@ -99,7 +102,7 @@ subroutine test_dry_volume() constituents(:, :, 1) = 1.0e-6_kind_phys cptr => constituents - state => bulk_aerosol_state(ncol, cptr) + 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) @@ -117,6 +120,7 @@ subroutine test_ambient_total_bin_mmr() 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 @@ -142,7 +146,7 @@ subroutine test_ambient_total_bin_mmr() constituents(:, :, 2) = 7.0e-6_kind_phys cptr => constituents - state => bulk_aerosol_state(ncol, cptr) + 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) diff --git a/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf b/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf index c38b0f041..3bb54ae66 100644 --- a/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf +++ b/test/unit/fortran/src/aerosol/test_modal_aerosol_state.pf @@ -14,7 +14,7 @@ ! ! Mock boundaries: ! - radiative_aerosol (modal mock interfaces) for properties -! - aerosol_mmr_ccpp (modal overloads) for state MMR retrieval +! - aerosol_mmr_host (modal overloads) for state MMR retrieval !----------------------------------------------------------------------- @test @@ -23,6 +23,7 @@ subroutine test_get_ambient_mmr() 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 @@ -44,7 +45,7 @@ subroutine test_get_ambient_mmr() constituents(:, :, 5) = 5.0e-9_kind_phys cptr => constituents - state => modal_aerosol_state(ncol, cptr) + 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) @@ -70,6 +71,7 @@ subroutine test_get_ambient_num() 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 @@ -89,7 +91,7 @@ subroutine test_get_ambient_num() constituents(:, :, 4) = 5.0e6_kind_phys cptr => constituents - state => modal_aerosol_state(ncol, cptr) + 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) @@ -111,6 +113,7 @@ subroutine test_ambient_total_bin_mmr() 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 @@ -132,7 +135,7 @@ subroutine test_ambient_total_bin_mmr() cptr => constituents props => modal_aerosol_properties() - state => modal_aerosol_state(ncol, cptr) + 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) @@ -150,6 +153,7 @@ subroutine test_dry_volume() 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 @@ -175,7 +179,7 @@ subroutine test_dry_volume() cptr => constituents props => modal_aerosol_properties() - state => modal_aerosol_state(ncol, cptr) + 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 From 3729ad8a9d3ac9f807f8bb3ded26429dfa1e2692 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 10 Jun 2026 23:01:02 -0400 Subject: [PATCH 38/46] Fix pfUnit test in bulk aero construction. --- .../fortran/src/aerosol/test_insoluble_aerosol_optics.pf | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf b/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf index 594c59413..c5cb5f9c2 100644 --- a/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf +++ b/test/unit/fortran/src/aerosol/test_insoluble_aerosol_optics.pf @@ -20,6 +20,7 @@ subroutine test_sw_props() 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 @@ -62,7 +63,7 @@ subroutine test_sw_props() allocate(constituents(ncol, nlev, naero)) constituents(:, :, 1) = 1.0e-6_kind_phys ! MMR = 1e-6 kg/kg cptr => constituents - state => bulk_aerosol_state(ncol, cptr) + state => bulk_aerosol_state(ncol, aero_host_binding(cptr)) ! Create insoluble optics object optics => insoluble_aerosol_optics(props, state, ibin=1) @@ -98,6 +99,7 @@ subroutine test_lw_props() 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 @@ -137,7 +139,7 @@ subroutine test_lw_props() allocate(constituents(ncol, nlev, naero)) constituents(:, :, 1) = 2.0e-6_kind_phys ! MMR = 2e-6 cptr => constituents - state => bulk_aerosol_state(ncol, cptr) + state => bulk_aerosol_state(ncol, aero_host_binding(cptr)) optics => insoluble_aerosol_optics(props, state, ibin=1) From 4280895e29ed0154c47c55ef54d548439943bdfb Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 10 Jun 2026 23:11:56 -0400 Subject: [PATCH 39/46] Fix pfUnit regression in aqu_gain_binfraction --- src/aerosol/modal_aerosol_state_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 index dec6f53e5..fa9c5d66f 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -718,7 +718,7 @@ subroutine aqu_gain_binfraction(self, aero_props, type, qcw, delso4_o3rxn, faqga real(r8) :: sumf real(r8), allocatable :: qnum_c(:) - ncol = self%state%ncol + ncol = self%ncol() nbins = aero_props%nbins() !------------------------------------------------------------------------- From 27af652f3b36378db4f06eb6cecb71a6666f30f9 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 10 Jun 2026 23:45:26 -0400 Subject: [PATCH 40/46] Further sync up to cam6_4_177 and work-in-progress microp_aero branch to match code space-for-space. --- src/aerosol/aerosol_state_mod.F90 | 1 + src/aerosol/bulk_aerosol_state_mod.F90 | 7 ++++--- src/aerosol/modal_aerosol_state_mod.F90 | 7 ------- src/aerosol/radiative_aerosol.F90 | 2 +- src/aerosol/radiative_aerosol_definitions.F90 | 4 ++-- 5 files changed, 8 insertions(+), 13 deletions(-) diff --git a/src/aerosol/aerosol_state_mod.F90 b/src/aerosol/aerosol_state_mod.F90 index 24cb00bcf..a39e3653d 100644 --- a/src/aerosol/aerosol_state_mod.F90 +++ b/src/aerosol/aerosol_state_mod.F90 @@ -65,6 +65,7 @@ module aerosol_state_mod procedure :: convcld_actfrac procedure :: sol_factb_interstitial procedure(aero_aqu_gain_binfraction), deferred :: aqu_gain_binfraction + end type aerosol_state ! for state fields diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index f192f928f..2d509a819 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -2,17 +2,18 @@ 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 radiative_aerosol, only: rad_aer_get_props + use string_utils, only: to_lower 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: + ! former microp_aero_bulk_scale namelist parameter (always 2.0). real(r8), parameter :: bam_sulfate_scale = 2.0_r8 public :: bulk_aerosol_state @@ -198,7 +199,7 @@ end subroutine get_cldbrne_mmr 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 :: num(:,:) ! number mixing ratio (#/kg) real(r8), pointer :: mmr(:,:) real(r8) :: ntm diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 index fa9c5d66f..189c38f3d 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -209,7 +209,6 @@ 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 @@ -278,7 +277,6 @@ 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 @@ -341,9 +339,6 @@ end subroutine icenuc_size_wght_val !------------------------------------------------------------------------------ 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 @@ -420,7 +415,6 @@ end subroutine update_bin ! 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 @@ -610,7 +604,6 @@ end function wet_diameter ! prescribed aerosol activation fraction for convective cloud !------------------------------------------------------------------------------ function convcld_actfrac(self, aero_props, ibin, ispc, ncol, nlev) result(frac) - use aerosol_properties_mod, only: aero_name_len class(modal_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object diff --git a/src/aerosol/radiative_aerosol.F90 b/src/aerosol/radiative_aerosol.F90 index 797a06f72..530344b17 100644 --- a/src/aerosol/radiative_aerosol.F90 +++ b/src/aerosol/radiative_aerosol.F90 @@ -1291,7 +1291,7 @@ subroutine rad_aer_init() ! Read physical properties from data files call physprop_init() - ! Resolve host-specific CCPP constituent indices + ! Resolve host-specific indices call resolve_mode_idx(modes) call resolve_bin_idx(bins) diff --git a/src/aerosol/radiative_aerosol_definitions.F90 b/src/aerosol/radiative_aerosol_definitions.F90 index 8ac81c57c..81e0dab5e 100644 --- a/src/aerosol/radiative_aerosol_definitions.F90 +++ b/src/aerosol/radiative_aerosol_definitions.F90 @@ -422,8 +422,8 @@ subroutine list_resolve_physprops(aerlist, modal_aerosol_list, sectional_aerosol ! 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). + ! Host-specific index resolution (get_host_idx) is handled + ! separately by the host module (e.g. aerosol_mmr_host). use phys_prop, only: physprop_get_id From 0cee7535731b0003187063438b7d4f8052392ccf Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 20 Jul 2026 12:28:23 -0400 Subject: [PATCH 41/46] Update tke standard name. --- src/data/registry.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/data/registry.xml b/src/data/registry.xml index 304546b11..714f2c4b7 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -1648,7 +1648,7 @@ pbuf_kvh horizontal_dimension vertical_interface_dimension From ca182e65d296ba4d5dd8ebadea7f033f787f04b4 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Sat, 27 Jun 2026 14:46:55 -0400 Subject: [PATCH 42/46] Draft registry and modal aerosol state updates for water_uptake. --- src/aerosol/modal_aerosol_state_mod.F90 | 58 +++------ src/data/registry.xml | 118 ++++++++++++++++++ test/unit/fortran/src/aerosol/CMakeLists.txt | 1 + .../src/aerosol/mock_physics_types.F90 | 23 ++++ 4 files changed, 160 insertions(+), 40 deletions(-) create mode 100644 test/unit/fortran/src/aerosol/mock_physics_types.F90 diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 index 189c38f3d..3dd45487d 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -209,7 +209,7 @@ 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 cam_constituents, only: const_get_index + use physics_types, only: dgncur_a class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number @@ -222,8 +222,6 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre 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)') @@ -243,18 +241,16 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre 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. + ! Dry number mode diameter (dgncur_a, the climate-list registry + ! field) is computed by the CCPPized modal_aero_calcsize scheme; + ! in CAM this is the DGNUM pbuf field. 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 + if (dgncur_a(i,k,bin_ndx) > 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)) / & + erf(log(0.1e-6_r8 / dgncur_a(i,k,bin_ndx)) / & (2._r8**0.5_r8*log(sigmag_aitken))) )) end if end do @@ -277,7 +273,7 @@ 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 cam_constituents, only: const_get_index + use physics_types, only: dgncur_a class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number @@ -289,8 +285,6 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u 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)') @@ -311,13 +305,11 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u 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 + if (dgncur_a(col_ndx, lyr_ndx, bin_ndx) > 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)) / & + erf(log(0.1e-6_r8 / dgncur_a(col_ndx, lyr_ndx, bin_ndx)) / & (2._r8**0.5_r8*log(sigmag_aitken))) )) end if endif @@ -460,14 +452,13 @@ end subroutine hygroscopicity ! 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 + + + number of aerosol modes (set by mam_mode_metadata_init) + 4 + + + dry number mode diameter of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + wet number mode diameter of modal aerosol (from previous timestep) + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + volume-weighted hygroscopicity of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + single-particle mean dry volume of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + dry volume mean radius of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + single-particle mean dry mass of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + single-particle mean sulfate dry volume of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + aerosol number mixing ratio per mode + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + wet radius of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + single-particle mean wet volume of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + single-particle mean water volume of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + aerosol water mass mixing ratio per mode + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + H2SO4 equilibrium mixing ratio of modal aerosol + horizontal_dimension vertical_layer_dimension number_of_aerosol_modes + 0.0_kind_phys + + + flag for stratospheric sulfate equilibrium treatment in modal aerosol + .false. + + Date: Sun, 5 Jul 2026 19:40:12 -0400 Subject: [PATCH 43/46] Implement spec_mw in modal aerosol properties. --- src/aerosol/modal_aerosol_properties_mod.F90 | 15 +++++++++++++-- .../fortran/src/aerosol/mock_cam_constituents.F90 | 15 +++++++++++++-- 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/src/aerosol/modal_aerosol_properties_mod.F90 b/src/aerosol/modal_aerosol_properties_mod.F90 index 7d3147dd9..44da7b55c 100644 --- a/src/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/aerosol/modal_aerosol_properties_mod.F90 @@ -409,7 +409,8 @@ 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) - use cam_abortutils, only: endrun + use cam_abortutils, only: endrun + use cam_constituents, only: const_get_index, const_molec_weight class(modal_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -425,12 +426,22 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, spec_mw, & 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=aero_name_len) :: lcl_specname + integer :: cnst_idx + 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)') + ! Species molar mass (CAM specmw_amode, g mol-1). CAM reads specmw_amode + ! = cnst_mw for the interstitial constituent of this (mode, species); the + ! SIMA equivalent resolves that constituent and reads its registered + ! molar_mass. const_molec_weight returns kg mol-1; *1e3 -> g mol-1 matches + ! CAM cnst_mw (and mam_mode_metadata's specmw_amode_arr) bitwise. + call rad_aer_get_info(self%list_idx_, bin_ndx, species_ndx, spec_name=lcl_specname) + call const_get_index(lcl_specname, cnst_idx, abort=.true.) + spec_mw = const_molec_weight(cnst_idx) * 1.0e3_r8 end if if (present(specname)) then diff --git a/test/unit/fortran/src/aerosol/mock_cam_constituents.F90 b/test/unit/fortran/src/aerosol/mock_cam_constituents.F90 index ae82efd50..780da7fbd 100644 --- a/test/unit/fortran/src/aerosol/mock_cam_constituents.F90 +++ b/test/unit/fortran/src/aerosol/mock_cam_constituents.F90 @@ -1,14 +1,19 @@ !----------------------------------------------------------------------- ! 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. +! Provides const_get_index as a no-op stub (returns idx = -1) and +! const_molec_weight as a no-op stub (returns 0). +! Required by modal_aerosol_state_mod and modal_aerosol_properties_mod +! procedure-level use statements. !----------------------------------------------------------------------- module cam_constituents + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none private public :: const_get_index + public :: const_molec_weight contains @@ -20,4 +25,10 @@ subroutine const_get_index(name, idx, abort) idx = -1 end subroutine const_get_index + real(r8) function const_molec_weight(const_ind) + integer, intent(in) :: const_ind + + const_molec_weight = 0._r8 + end function const_molec_weight + end module cam_constituents From 1e4d4f9dd400223bb9dc575c7ecc5502676cfa66 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 21 Jul 2026 13:23:53 -0400 Subject: [PATCH 44/46] Sync up with CAM latest changes in MAM branch. --- src/aerosol/aerosol_mmr_host.F90 | 61 +++++++ src/aerosol/aerosol_optics_core.F90 | 47 +++-- src/aerosol/aerosol_state_mod.F90 | 35 +++- src/aerosol/bulk_aerosol_state_mod.F90 | 27 ++- src/aerosol/carma_aerosol_state_mod.F90 | 18 +- src/aerosol/modal_aerosol_state_mod.F90 | 168 +++++++++++++----- src/aerosol/refractive_aerosol_optics_mod.F90 | 11 +- src/data/registry.xml | 6 +- 8 files changed, 299 insertions(+), 74 deletions(-) diff --git a/src/aerosol/aerosol_mmr_host.F90 b/src/aerosol/aerosol_mmr_host.F90 index a4664b2a8..eb4c25194 100644 --- a/src/aerosol/aerosol_mmr_host.F90 +++ b/src/aerosol/aerosol_mmr_host.F90 @@ -11,6 +11,10 @@ module aerosol_mmr_host ! directly. Here the routines access the CCPP constituents array to return ! mixing ratio pointers. ! +! The pair also provides get_mode_dry_diameter, get_mode_wet_diameter and +! get_mode_aer_water accessors for the climate-list mode diagnostics computed +! by the calcsize/wateruptake calculations. +! ! Ported from the CAM flavor: replaces pbuf/state%q with CCPP constituents. ! !------------------------------------------------------------------------------------------------ @@ -61,6 +65,9 @@ module aerosol_mmr_host public :: aero_host_binding_t public :: aero_host_binding ! build a handle from host data structures +public :: get_mode_dry_diameter ! dry number mode diameters of the climate list +public :: get_mode_wet_diameter ! wet number mode diameters of the climate list +public :: get_mode_aer_water ! aerosol water of the climate list modes public :: aerosol_mmr_init ! allocate zero_cols public :: get_host_idx public :: resolve_mode_idx, resolve_bin_idx @@ -108,6 +115,60 @@ end function aero_host_binding !================================================================================================ +subroutine get_mode_dry_diameter(host, dgnum) + + ! Return the dry number mode diameters (all modes) of the climate list, + ! computed by the modal_aero_calcsize calculation. + ! CAM-SIMA: the dgncur_a registry field written by the CCPPized scheme + ! (the host handle is not needed; kept for interface parity with CAM). + + use physics_types, only: dgncur_a + + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: dgnum(:,:,:) + + dgnum => dgncur_a + +end subroutine get_mode_dry_diameter + +!================================================================================================ + +subroutine get_mode_wet_diameter(host, dgnumwet) + + ! Return the wet number mode diameters (all modes) of the climate list, + ! computed by the modal_aero_wateruptake calculation. + ! CAM-SIMA: the dgncur_awet registry field written by the CCPPized scheme + ! (the host handle is not needed; kept for interface parity with CAM). + + use physics_types, only: dgncur_awet + + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: dgnumwet(:,:,:) + + dgnumwet => dgncur_awet + +end subroutine get_mode_wet_diameter + +!================================================================================================ + +subroutine get_mode_aer_water(host, qaerwat) + + ! Return the aerosol water (all modes) of the climate list, + ! computed by the modal_aero_wateruptake calculation. + ! CAM-SIMA: the qaerwat_aer registry field written by the CCPPized scheme + ! (the host handle is not needed; kept for interface parity with CAM). + + use physics_types, only: qaerwat_aer + + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: qaerwat(:,:,:) + + qaerwat => qaerwat_aer + +end subroutine get_mode_aer_water + +!================================================================================================ + integer function get_host_idx(source, name, routine) ! Get index of name in the CCPP constituents array. diff --git a/src/aerosol/aerosol_optics_core.F90 b/src/aerosol/aerosol_optics_core.F90 index 63d47f849..eb1095861 100644 --- a/src/aerosol/aerosol_optics_core.F90 +++ b/src/aerosol/aerosol_optics_core.F90 @@ -26,8 +26,9 @@ module aerosol_optics_core ! 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, & + ncol, nlev, top_lev, nswbands, nlwbands, numrh, & + relh, sulfwtpct, t, pmid, h2ommr, cldn, & + crefwsw, crefwlw, & geometric_radius) result(aero_optics) use phys_prop, only: ot_length @@ -49,11 +50,16 @@ function create_aerosol_optics_object(aeroprops, aerostate, ibin, & integer, intent(in) :: ibin integer, intent(in) :: ncol integer, intent(in) :: nlev + integer, intent(in) :: top_lev 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) :: t(:, :) ! temperature (K) + real(r8), intent(in) :: pmid(:, :) ! layer pressure (Pa) + real(r8), intent(in) :: h2ommr(:, :) ! specific humidity (kg/kg) + real(r8), intent(in) :: cldn(:, :) ! layer cloud fraction (0-1) complex(r8), intent(in) :: crefwsw(:) complex(r8), intent(in) :: crefwlw(:) real(r8), intent(in), optional, pointer :: geometric_radius(:, :) @@ -69,7 +75,8 @@ function create_aerosol_optics_object(aeroprops, aerostate, ibin, & select case (trim(opticstype)) case ('modal') ! refractive method aero_optics => refractive_aerosol_optics(aeroprops, aerostate, ibin, & - ncol, nlev, nswbands, nlwbands, crefwsw, crefwlw) + ncol, nlev, top_lev, t, pmid, h2ommr, cldn, & + nswbands, nlwbands, crefwsw, crefwlw) case ('hygroscopic_coreshell') aero_optics => hygrocoreshell_aerosol_optics(aeroprops, aerostate, & ibin, ncol, nlev, relh) @@ -111,7 +118,8 @@ end function create_aerosol_optics_object subroutine aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & ncol, nlev, top_lev, nswbands, nlwbands, numrh, & idx_sw_diag, & - relh, sulfwtpct, mass, crefwsw, crefwlw, & + relh, sulfwtpct, t, pmid, h2ommr, cldn, & + mass, crefwsw, crefwlw, & geometric_radius, & tau_bin, ssa_bin, asm_bin, & pabs_vis, dopaer0_vis, & @@ -131,6 +139,10 @@ subroutine aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & integer, intent(in) :: idx_sw_diag real(r8), intent(in) :: relh(:, :) real(r8), intent(in) :: sulfwtpct(:, :) + real(r8), intent(in) :: t(:, :) ! temperature (K) + real(r8), intent(in) :: pmid(:, :) ! layer pressure (Pa) + real(r8), intent(in) :: h2ommr(:, :) ! specific humidity (kg/kg) + real(r8), intent(in) :: cldn(:, :) ! layer cloud fraction (0-1) real(r8), intent(in) :: mass(:, :) ! layer mass (pdeldry*rga) complex(r8), intent(in) :: crefwsw(:) complex(r8), intent(in) :: crefwlw(:) @@ -181,8 +193,9 @@ subroutine aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & ! Create aerosol optics object aero_optics => create_aerosol_optics_object(aeroprops, aerostate, ibin, & - ncol, nlev, nswbands, nlwbands, numrh, & - relh, sulfwtpct, crefwsw, crefwlw, & + ncol, nlev, top_lev, nswbands, nlwbands, numrh, & + relh, sulfwtpct, t, pmid, h2ommr, cldn, & + crefwsw, crefwlw, & geometric_radius) if (.not. associated(aero_optics)) then @@ -226,8 +239,10 @@ subroutine aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & ! 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) + wetvol(:ncol, :nlev) = aerostate%wet_volume(aeroprops, ibin, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) + watervol(:ncol, :nlev) = aerostate%water_volume(aeroprops, ibin, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) do ilev = top_lev, nlev scatdust(:ncol) = 0._r8 @@ -341,8 +356,9 @@ end subroutine aerosol_optics_sw_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, & + ncol, nlev, top_lev, nswbands, nlwbands, numrh, & + relh, sulfwtpct, t, pmid, h2ommr, cldn, & + mass, crefwsw, crefwlw, & geometric_radius, & tau_lw_bin, absorp_bin, & errmsg, errflg) @@ -353,12 +369,16 @@ subroutine aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & 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) :: ncol, nlev, top_lev 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) :: t(:, :) ! temperature (K) + real(r8), intent(in) :: pmid(:, :) ! layer pressure (Pa) + real(r8), intent(in) :: h2ommr(:, :) ! specific humidity (kg/kg) + real(r8), intent(in) :: cldn(:, :) ! layer cloud fraction (0-1) real(r8), intent(in) :: mass(:, :) complex(r8), intent(in) :: crefwsw(:) complex(r8), intent(in) :: crefwlw(:) @@ -381,8 +401,9 @@ subroutine aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & ! Create aerosol optics object aero_optics => create_aerosol_optics_object(aeroprops, aerostate, ibin, & - ncol, nlev, nswbands, nlwbands, numrh, & - relh, sulfwtpct, crefwsw, crefwlw, & + ncol, nlev, top_lev, nswbands, nlwbands, numrh, & + relh, sulfwtpct, t, pmid, h2ommr, cldn, & + crefwsw, crefwlw, & geometric_radius) if (.not. associated(aero_optics)) then diff --git a/src/aerosol/aerosol_state_mod.F90 b/src/aerosol/aerosol_state_mod.F90 index a39e3653d..5839f2c7e 100644 --- a/src/aerosol/aerosol_state_mod.F90 +++ b/src/aerosol/aerosol_state_mod.F90 @@ -59,8 +59,8 @@ module aerosol_state_mod 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_volume), deferred :: wet_volume + procedure(aero_wet_volume), deferred :: water_volume procedure(aero_wet_diam), deferred :: wet_diameter procedure :: convcld_actfrac procedure :: sol_factb_interstitial @@ -229,7 +229,8 @@ 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) + subroutine aero_water_uptake(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn, dgnumwet, qaerwat) import :: aerosol_state, aerosol_properties, r8 class(aerosol_state), intent(in) :: self @@ -237,6 +238,11 @@ subroutine aero_water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qa integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8),intent(in) :: t(:,:) ! temperature (K) + real(r8),intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8),intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8),intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) @@ -269,6 +275,29 @@ function aero_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) end function aero_volume + !------------------------------------------------------------------------------ + ! aerosol wet/water volume interface -- carries the atmospheric state + ! needed to recompute water uptake for diagnostic radiation lists + !------------------------------------------------------------------------------ + function aero_wet_volume(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) 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 + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8),intent(in) :: t(:,:) ! temperature (K) + real(r8),intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8),intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8),intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) + + real(r8) :: vol(ncol,nlev) ! m3/kg + + end function aero_wet_volume + !------------------------------------------------------------------------------ ! aerosol wet diameter !------------------------------------------------------------------------------ diff --git a/src/aerosol/bulk_aerosol_state_mod.F90 b/src/aerosol/bulk_aerosol_state_mod.F90 index 2d509a819..600d1d0a6 100644 --- a/src/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/aerosol/bulk_aerosol_state_mod.F90 @@ -372,13 +372,19 @@ 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) + subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn, 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 + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8),intent(in) :: t(:,:) ! temperature (K) + real(r8),intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8),intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8),intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) @@ -412,7 +418,8 @@ 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) + function wet_volume(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) result(vol) class(bulk_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props @@ -420,18 +427,25 @@ function wet_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8),intent(in) :: t(:,:) ! temperature (K) + real(r8),intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8),intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8),intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) 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) + + self%water_volume(aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) 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) + function water_volume(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) result(vol) class(bulk_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props @@ -439,6 +453,11 @@ function water_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8),intent(in) :: t(:,:) ! temperature (K) + real(r8),intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8),intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8),intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) real(r8) :: vol(ncol,nlev) ! m3/kg diff --git a/src/aerosol/carma_aerosol_state_mod.F90 b/src/aerosol/carma_aerosol_state_mod.F90 index 1e0bc7240..139565063 100644 --- a/src/aerosol/carma_aerosol_state_mod.F90 +++ b/src/aerosol/carma_aerosol_state_mod.F90 @@ -154,10 +154,12 @@ subroutine hygroscopicity(self, bin_ndx, kappa) call endrun('carma_aerosol_state%hygroscopicity: not implemented') end subroutine hygroscopicity - subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) + subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn, dgnumwet, qaerwat) class(carma_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props - integer, intent(in) :: bin_idx, ncol, nlev + integer, intent(in) :: bin_idx, ncol, nlev, top_lev + real(r8), intent(in) :: t(:,:), pmid(:,:), h2ommr(:,:), cldn(:,:) real(r8), intent(out) :: dgnumwet(ncol,nlev), qaerwat(ncol,nlev) call endrun('carma_aerosol_state%water_uptake: not implemented') end subroutine water_uptake @@ -170,18 +172,22 @@ function dry_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) vol = -huge(1._r8) end function dry_volume - function wet_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) + function wet_volume(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) result(vol) class(carma_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props - integer, intent(in) :: bin_idx, ncol, nlev + integer, intent(in) :: bin_idx, ncol, nlev, top_lev + real(r8), intent(in) :: t(:,:), pmid(:,:), h2ommr(:,:), cldn(:,:) 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) + function water_volume(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) result(vol) class(carma_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props - integer, intent(in) :: bin_idx, ncol, nlev + integer, intent(in) :: bin_idx, ncol, nlev, top_lev + real(r8), intent(in) :: t(:,:), pmid(:,:), h2ommr(:,:), cldn(:,:) real(r8) :: vol(ncol,nlev) vol = -huge(1._r8) end function water_volume diff --git a/src/aerosol/modal_aerosol_state_mod.F90 b/src/aerosol/modal_aerosol_state_mod.F90 index 3dd45487d..a59b288c1 100644 --- a/src/aerosol/modal_aerosol_state_mod.F90 +++ b/src/aerosol/modal_aerosol_state_mod.F90 @@ -4,8 +4,9 @@ module modal_aerosol_state_mod 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_mmr_host, only: get_mode_dry_diameter, get_mode_wet_diameter, get_mode_aer_water use aerosol_properties_mod, only: aerosol_properties, aero_name_len - use physconst, only: rhoh2o + use physconst, only: rhoh2o, pi use cam_abortutils, only: endrun implicit none @@ -13,11 +14,13 @@ module modal_aerosol_state_mod private public :: modal_aerosol_state + public :: modal_aerosol_state_register_water_uptake_diag 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) + ! host model data; built by host-side wiring (aerosol_instances_mod). + ! This keeps model-specific data structures outside of the aerosol interface. type(aero_host_binding_t) :: host_ contains @@ -52,10 +55,53 @@ module modal_aerosol_state_mod procedure :: constructor end interface modal_aerosol_state + ! Interface of the diagnostic-list water uptake recompute. The science + ! (modal_aero_wateruptake_diag) lives with the portable modal aerosol + ! schemes, which are not part of every build, so it is wired in by host + ! code at initialization through a procedure pointer rather than + ! referenced directly; when nothing is registered, diagnostic-list + ! water uptake aborts as unavailable. + abstract interface + subroutine water_uptake_diag_i(aero_props, aero_state, ncol, nlev, top_lev, & + pi, rhoh2o, t, pmid, h2ommr, cldn, bin_idx, dgnumwet, qaerwat, errmsg, errflg) + import :: aerosol_properties, aerosol_state, r8 + class(aerosol_properties), intent(in) :: aero_props + class(aerosol_state), intent(in) :: aero_state + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8), intent(in) :: pi ! pi + real(r8), intent(in) :: rhoh2o ! density of liquid water (kg/m3) + real(r8), intent(in) :: t(:,:) ! temperature (K) + real(r8), intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8), intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8), intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) + integer, intent(in) :: bin_idx ! mode index of the returned slices + real(r8), intent(out) :: dgnumwet(:,:) ! wet number mode diameter of mode bin_idx (m) + real(r8), intent(out) :: qaerwat(:,:) ! aerosol water of mode bin_idx (g/g) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + end subroutine water_uptake_diag_i + end interface + + procedure(water_uptake_diag_i), pointer :: water_uptake_diag_fn => null() + real(r8), parameter :: rh2odens = 1._r8/rhoh2o contains + !------------------------------------------------------------------------------ + ! register the diagnostic-list water uptake implementation (host wiring; + ! called at initialization from code that has access to the portable + ! modal aerosol schemes) + !------------------------------------------------------------------------------ + subroutine modal_aerosol_state_register_water_uptake_diag(fn) + procedure(water_uptake_diag_i) :: fn + + water_uptake_diag_fn => fn + + end subroutine modal_aerosol_state_register_water_uptake_diag + !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ function constructor(ncol, host, list_idx) result(newobj) @@ -209,7 +255,6 @@ 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 physics_types, only: dgncur_a class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number @@ -220,6 +265,7 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre real(r8), intent(out) :: wght(:,:) character(len=aero_name_len) :: modetype + real(r8), pointer :: dgnum(:,:,:) ! mode dry radius real(r8) :: sigmag_aitken integer :: i,k @@ -241,16 +287,14 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre if ( use_preexisting_ice ) then wght(:ncol,:) = 1._r8 else - ! Dry number mode diameter (dgncur_a, the climate-list registry - ! field) is computed by the CCPPized modal_aero_calcsize scheme; - ! in CAM this is the DGNUM pbuf field. call rad_aer_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) - do k = 1, nlev - do i = 1, ncol - if (dgncur_a(i,k,bin_ndx) > 0._r8) then + call get_mode_dry_diameter(self%host_, dgnum) + do k = 1,nlev + do i = 1,ncol + if (dgnum(i,k,bin_ndx) > 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 / dgncur_a(i,k,bin_ndx)) / & + erf(log(0.1e-6_r8/dgnum(i,k,bin_ndx))/ & (2._r8**0.5_r8*log(sigmag_aitken))) )) end if end do @@ -273,7 +317,6 @@ 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 physics_types, only: dgncur_a class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number @@ -284,6 +327,7 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u real(r8), intent(out) :: wght character(len=aero_name_len) :: modetype + real(r8), pointer :: dgnum(:,:,:) ! mode dry radius real(r8) :: sigmag_aitken if (self%list_idx_ /= 0) then @@ -305,12 +349,14 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u wght = 1._r8 else call rad_aer_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) + call get_mode_dry_diameter(self%host_, dgnum) - if (dgncur_a(col_ndx, lyr_ndx, bin_ndx) > 0._r8) then + if (dgnum(col_ndx,lyr_ndx,bin_ndx) > 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 / dgncur_a(col_ndx, lyr_ndx, bin_ndx)) / & + erf(log(0.1e-6_r8/dgnum(col_ndx,lyr_ndx,bin_ndx))/ & (2._r8**0.5_r8*log(sigmag_aitken))) )) + end if endif endif @@ -447,38 +493,58 @@ 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 - ! the registry fields dgncur_awet and qaerwat_aer, written in place by the - ! CCPPized modal_aero_wateruptake scheme. - ! Diagnostic-list recomputation is not yet available (it requires the eventual - ! CCPPized schemes) + ! For the climate list (list_idx==0) these were pre-computed by the water + ! uptake calculation and are retrieved via the aerosol_mmr_host accessors + ! (DGNUMWET/QAERWAT pbuf fields in CAM; dgncur_awet/qaerwat_aer registry + ! fields written by the CCPPized wateruptake scheme in CAM-SIMA). + ! Diagnostic lists are recomputed from the atmospheric state passed in by + ! the caller, via the registered portable implementation (see the + ! water_uptake_diag_i interface above). !------------------------------------------------------------------------------ - subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) - use physics_types, only: dgncur_awet, qaerwat_aer + subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn, dgnumwet, qaerwat) class(modal_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 + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8),intent(in) :: t(:,:) ! temperature (K) + real(r8),intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8),intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8),intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) + real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes + real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes + + character(len=512) :: errmsg + integer :: errflg + if (self%list_idx_ == 0) then - ! Climate list: retrieve pre-computed wet diameter and aerosol water - ! (registry fields written by the CCPPized modal_aero_wateruptake scheme). - dgnumwet(:ncol,:nlev) = dgncur_awet(:ncol,:nlev,bin_idx) - qaerwat (:ncol,:nlev) = qaerwat_aer(:ncol,:nlev,bin_idx) + ! water uptake and wet radius for the climate list has already been calculated + call get_mode_wet_diameter(self%host_, dgnumwet_m) + call get_mode_aer_water(self%host_, qaerwat_m) + + dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx) + qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx) + else - ! Diagnostic lists: recomputation requires modal_aero_calcsize and - ! modal_aero_wateruptake, which are not yet CCPPized. - call endrun('modal_aerosol_state::water_uptake: diagnostic-list water uptake ' // & - 'not yet available in CAM-SIMA (requires CCPPized modal_aero_calcsize/wateruptake)') - end if + ! If doing a diagnostic calculation then need to calculate the wet radius + ! and water uptake for the diagnostic modes + if (.not. associated(water_uptake_diag_fn)) then + call endrun('modal_aerosol_state::water_uptake: diagnostic-list water uptake ' // & + 'is not available: no implementation registered (the modal aerosol ' // & + 'schemes are not part of this build)') + end if + call water_uptake_diag_fn(aero_props, self, ncol, nlev, top_lev, pi, rhoh2o, & + t, pmid, h2ommr, cldn, bin_idx, dgnumwet, qaerwat, errmsg, errflg) + if (errflg /= 0) then + call endrun('modal_aerosol_state::water_uptake: '//trim(errmsg)) + end if + endif end subroutine water_uptake @@ -514,7 +580,8 @@ 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) + function wet_volume(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) result(vol) class(modal_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props @@ -522,6 +589,11 @@ function wet_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8),intent(in) :: t(:,:) ! temperature (K) + real(r8),intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8),intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8),intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) real(r8) :: vol(ncol,nlev) ! m3/kg @@ -529,7 +601,8 @@ function wet_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) real(r8) :: watervol(ncol,nlev) dryvol = self%dry_volume(aero_props, bin_idx, ncol, nlev) - watervol = self%water_volume(aero_props, bin_idx, ncol, nlev) + watervol = self%water_volume(aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) vol = watervol + dryvol @@ -538,7 +611,8 @@ 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) + function water_volume(self, aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn) result(vol) class(modal_aerosol_state), intent(in) :: self class(aerosol_properties), intent(in) :: aero_props @@ -546,13 +620,19 @@ function water_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8),intent(in) :: t(:,:) ! temperature (K) + real(r8),intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8),intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8),intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) real(r8) :: vol(ncol,nlev) ! m3/kg real(r8) :: dgnumwet(ncol,nlev) real(r8) :: qaerwat(ncol,nlev) - call self%water_uptake(aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) + call self%water_uptake(aero_props, bin_idx, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn, dgnumwet, qaerwat) vol(:ncol,:nlev) = qaerwat(:ncol,:nlev)*rh2odens where (vol<0._r8) @@ -565,8 +645,6 @@ end function water_volume ! aerosol wet diameter for a given mode !------------------------------------------------------------------------------ function wet_diameter(self, bin_idx, ncol, nlev) result(diam) - use physics_types, only: dgncur_awet - class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns @@ -574,7 +652,11 @@ function wet_diameter(self, bin_idx, ncol, nlev) result(diam) real(r8) :: diam(ncol,nlev) - diam(:ncol,:nlev) = dgncur_awet(:ncol,:nlev,bin_idx) + real(r8), pointer :: dgnumwet(:,:,:) + + call get_mode_wet_diameter(self%host_, dgnumwet) + + diam(:ncol,:nlev) = dgnumwet(:ncol,:nlev,bin_idx) end function wet_diameter @@ -674,7 +756,6 @@ 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 @@ -684,12 +765,13 @@ subroutine aqu_gain_binfraction(self, aero_props, type, qcw, delso4_o3rxn, faqga 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 :: i,k,l,m,n,mm, ncol, nlev, nbins integer :: accum_n real(r8) :: sumf real(r8), allocatable :: qnum_c(:) ncol = self%ncol() + nlev = size(qcw, 2) nbins = aero_props%nbins() !------------------------------------------------------------------------- @@ -716,7 +798,7 @@ subroutine aqu_gain_binfraction(self, aero_props, type, qcw, delso4_o3rxn, faqga faqgain = 0.0_r8 - lev_loop: do k = 1,pver + lev_loop: do k = 1,nlev col_loop: do i = 1,ncol do m = 1, nbins mm = aero_props%indexer(m,0) diff --git a/src/aerosol/refractive_aerosol_optics_mod.F90 b/src/aerosol/refractive_aerosol_optics_mod.F90 index e96fa0c59..427c66da8 100644 --- a/src/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/aerosol/refractive_aerosol_optics_mod.F90 @@ -70,7 +70,8 @@ module refractive_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, aero_state, ibin, ncol, nlev, nsw, nlw, crefwsw, crefwlw) & + function constructor(aero_props, aero_state, ibin, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn, nsw, nlw, crefwsw, crefwlw) & result(newobj) class(aerosol_properties),intent(in), target :: aero_props ! aerosol_properties object @@ -78,6 +79,11 @@ function constructor(aero_props, aero_state, ibin, ncol, nlev, nsw, nlw, crefwsw integer, intent(in) :: ibin ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels + integer, intent(in) :: top_lev ! top level for aerosol calculations + real(r8),intent(in) :: t(:,:) ! temperature (K) + real(r8),intent(in) :: pmid(:,:) ! layer pressure (Pa) + real(r8),intent(in) :: h2ommr(:,:) ! specific humidity (kg/kg) + real(r8),intent(in) :: cldn(:,:) ! layer cloud fraction (0-1) 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 @@ -150,7 +156,8 @@ function constructor(aero_props, aero_state, ibin, ncol, nlev, nsw, nlw, crefwsw end if newobj%crefwsw(:) = crefwsw(:) - call aero_state%water_uptake(aero_props, ibin, ncol, nlev, dgnumwet, qaerwat) + call aero_state%water_uptake(aero_props, ibin, ncol, nlev, top_lev, & + t, pmid, h2ommr, cldn, dgnumwet, qaerwat) nspec = aero_props%nspecies(ibin) diff --git a/src/data/registry.xml b/src/data/registry.xml index cd4e358d2..979f17f6d 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -1560,7 +1560,7 @@ + allocatable="allocatable, target"> dry number mode diameter of modal aerosol horizontal_dimension vertical_layer_dimension number_of_aerosol_modes 0.0_kind_phys @@ -1568,7 +1568,7 @@ + allocatable="allocatable, target"> wet number mode diameter of modal aerosol (from previous timestep) horizontal_dimension vertical_layer_dimension number_of_aerosol_modes 0.0_kind_phys @@ -1648,7 +1648,7 @@ + allocatable="allocatable, target"> aerosol water mass mixing ratio per mode horizontal_dimension vertical_layer_dimension number_of_aerosol_modes 0.0_kind_phys From 28d3377be216c3f11117ec312300a599b3e5a535 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 20 Jul 2026 15:40:19 -0400 Subject: [PATCH 45/46] Registry generator: allocate 'allocatable, target' variables. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The allocatable check matched the string 'allocatable' exactly, so an 'allocatable, target' registry entry got its initial_value assignment but no allocate — a segfault at physics init for dgncur_a/dgncur_awet from the modal water-uptake block, in every test. The self_ref_dim sample updates covering this stay parked on the MAM branch: they extend the #520 (registry parameter dims) sample expectations, which this branch does not carry. --- src/data/generate_registry_data.py | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/data/generate_registry_data.py b/src/data/generate_registry_data.py index a738fc78c..6d8bc257f 100755 --- a/src/data/generate_registry_data.py +++ b/src/data/generate_registry_data.py @@ -807,7 +807,8 @@ def write_allocate_routine(self, outfile, indent, lname = f'{ddt_str}{self.local_name}' if self.allocatable == "pointer": all_type = 'associated' - elif self.allocatable == "allocatable": + elif self.allocatable[0:11] == "allocatable": + # covers both "allocatable" and "allocatable, target" all_type = 'allocated' else: all_type = '' From 3c06f5bb9837e26a3b79d98a88e518d3414c76b4 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 22 Jul 2026 18:38:20 -0400 Subject: [PATCH 46/46] Fix pfUnit tests --- test/unit/fortran/src/aerosol/CMakeLists.txt | 2 +- .../src/aerosol/mock_aerosol_mmr_host.F90 | 33 +++++++++++++++++++ .../src/aerosol/mock_physics_types.F90 | 8 +++-- 3 files changed, 39 insertions(+), 4 deletions(-) diff --git a/test/unit/fortran/src/aerosol/CMakeLists.txt b/test/unit/fortran/src/aerosol/CMakeLists.txt index 5550a3909..6736e454b 100644 --- a/test/unit/fortran/src/aerosol/CMakeLists.txt +++ b/test/unit/fortran/src/aerosol/CMakeLists.txt @@ -82,6 +82,7 @@ add_library(bulk_aero_testlib ${CORE_UTILS}/string_core_utils.F90 mock_phys_prop.F90 mock_radiative_aerosol.F90 + mock_physics_types.F90 mock_aerosol_mmr_host.F90 ${CCPP_STUB} ) @@ -116,7 +117,6 @@ add_pfunit_ctest(test_insoluble_aerosol_optics add_library(modal_aero_testlib ${AEROSOL_SRC}/modal_aerosol_properties_mod.F90 ${AEROSOL_SRC}/modal_aerosol_state_mod.F90 - mock_physics_types.F90 modal_test_helpers.F90 ) target_link_libraries(modal_aero_testlib PUBLIC bulk_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 index 3aa732adf..7cf70380d 100644 --- a/test/unit/fortran/src/aerosol/mock_aerosol_mmr_host.F90 +++ b/test/unit/fortran/src/aerosol/mock_aerosol_mmr_host.F90 @@ -42,6 +42,9 @@ module aerosol_mmr_host public :: aero_host_binding public :: rad_cnst_get_aer_mmr public :: rad_cnst_get_mode_num + public :: get_mode_dry_diameter + public :: get_mode_wet_diameter + public :: get_mode_aer_water contains @@ -55,6 +58,36 @@ function aero_host_binding(constituents) result(host) host%constituents => constituents end function aero_host_binding + !----------------------------------------------------------------------- + ! Mode diameter / aerosol water accessors. Mirror the real module by + ! returning the mock physics_types registry fields; the host handle is + ! ignored (parity with the real interface). Tests exercising these paths + ! must allocate and fill dgncur_a / dgncur_awet / qaerwat_aer. + !----------------------------------------------------------------------- + subroutine get_mode_dry_diameter(host, dgnum) + use physics_types, only: dgncur_a + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: dgnum(:,:,:) + + dgnum => dgncur_a + end subroutine get_mode_dry_diameter + + subroutine get_mode_wet_diameter(host, dgnumwet) + use physics_types, only: dgncur_awet + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: dgnumwet(:,:,:) + + dgnumwet => dgncur_awet + end subroutine get_mode_wet_diameter + + subroutine get_mode_aer_water(host, qaerwat) + use physics_types, only: qaerwat_aer + type(aero_host_binding_t), intent(in) :: host + real(r8), pointer :: qaerwat(:,:,:) + + qaerwat => qaerwat_aer + end subroutine get_mode_aer_water + !----------------------------------------------------------------------- ! Mock rad_cnst_get_aer_mmr (bulk): directly index into constituents(:,:,aer_idx). !----------------------------------------------------------------------- diff --git a/test/unit/fortran/src/aerosol/mock_physics_types.F90 b/test/unit/fortran/src/aerosol/mock_physics_types.F90 index 72fa37e03..73010924a 100644 --- a/test/unit/fortran/src/aerosol/mock_physics_types.F90 +++ b/test/unit/fortran/src/aerosol/mock_physics_types.F90 @@ -13,11 +13,13 @@ module physics_types implicit none + ! target so the aerosol_mmr_host accessors can return pointers to them + ! (mirrors the real registry-generated fields). ! dry number mode diameter of modal aerosol [m] - real(kind_phys), public, allocatable :: dgncur_a(:,:,:) + real(kind_phys), public, allocatable, target :: dgncur_a(:,:,:) ! wet number mode diameter of modal aerosol [m] - real(kind_phys), public, allocatable :: dgncur_awet(:,:,:) + real(kind_phys), public, allocatable, target :: dgncur_awet(:,:,:) ! aerosol water mass mixing ratio per mode [kg kg-1] - real(kind_phys), public, allocatable :: qaerwat_aer(:,:,:) + real(kind_phys), public, allocatable, target :: qaerwat_aer(:,:,:) end module physics_types