From ebe31948ab4dd939898da254b468583ad9395987 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 20 Feb 2026 20:54:32 -0500 Subject: [PATCH 01/22] rad_cnst/aerosol abstract interface refactor and extension phases 1 through 4f plus cleanup (interactive rebase on 64_156) rad_cnst/aerosol interface refactor phases 1 to 3 rad_cnst/aerosol interface refactor 1: make one aerosol property obj per list_idx rad_cnst/aerosol interface refactor 1b: make one aerosol state obj per list_idx rad_cnst/aerosol interface refactor 1c: remove list_idx argument from aerosol property objects rad_cnst/aerosol interface refactor 2a: migrate to aerosol_definition_mod.F90 (non-buildable) aer-gas split in rad_cnst (to test) split non-portable code by feature (to test) continued refactoring of rad_cnst/abstract aerosol interface. rad_cnst/aerosol interface refactor 3: gas-aerosol split; module reorg wip refactor 3c: move indexing-related to aerosol_mmr_cam aerosol abstract interface refactor 4a: prototypes for moving all access to abstract aerosol interface (aer_rad_props; microp_aero testbed) abstract aerosol interface refactor 4b: move initialization of state to avoid wrong ordering; revert bam validation logic in mirop abstract aerosol interface refactor 4c: move runtime to use aerosol_state when possible (excl register and init phases) abstract aerosol interface refactor 4c bugfix: aquaplanet sets; ODV_ diagnostic abstract aerosol interface refactor 4d bugfix: nucleate_ice_cam always active even when aerosol count is 0; implement nlogsig for BAM abstract aerosol interface refactor 4e: cleanup use statements; keyword args for get mmr for clarity; rename init1 init2 for clarity. abstract aerosol interface refactor 4f: cleanup use statements for radiative_aerosol; radiative_aerosol_definitions Continue cleanup of remnant rad_constituents; reorder comments, etc. Fix build for FCARMA (but introduces aerosol_mmr_cam dep into carma_aero/aero_model.F90) Fix OMP bug; cleanup Aerosol list renaming for clarity. Fix build error in var rename Comment cleanup Cleanup of dryrad, num_to_mass_aer leftover in modal, sectional_props. Change to globally held aerosol_state instance (to test threading) Fix build (remnant issue in microp_aero_final) --- src/chemistry/aerosol/aero_wetdep_cam.F90 | 42 +- .../aerosol/aerosol_instances_mod.F90 | 353 ++ .../aerosol/aerosol_properties_mod.F90 | 229 +- src/chemistry/aerosol/aerosol_state_mod.F90 | 86 +- .../aerosol/bulk_aerosol_properties_mod.F90 | 121 +- .../aerosol/bulk_aerosol_state_mod.F90 | 56 +- .../aerosol/carma_aerosol_properties_mod.F90 | 140 +- .../aerosol/carma_aerosol_state_mod.F90 | 109 +- .../aerosol/hygro_aerosol_optics_mod.F90 | 7 +- .../hygrocoreshell_aerosol_optics_mod.F90 | 15 +- .../hygroscopic_aerosol_optics_mod.F90 | 7 +- .../hygrowghtpct_aerosol_optics_mod.F90 | 11 +- .../aerosol/insoluble_aerosol_optics_mod.F90 | 7 +- src/chemistry/aerosol/modal_aero_data.F90 | 14 +- .../aerosol/modal_aerosol_properties_mod.F90 | 209 +- .../aerosol/modal_aerosol_state_mod.F90 | 115 +- src/chemistry/aerosol/radiative_aerosol.F90 | 1342 ++++++ .../aerosol/radiative_aerosol_definitions.F90 | 1178 ++++++ .../aerosol/refractive_aerosol_optics_mod.F90 | 22 +- .../aerosol/volcrad_aerosol_optics_mod.F90 | 7 +- src/chemistry/carma_aero/aero_model.F90 | 30 +- .../carma_aero/carma_aero_gasaerexch.F90 | 22 +- src/chemistry/carma_aero/sox_cldaero_mod.F90 | 12 +- src/chemistry/geoschem/chemistry.F90 | 10 +- src/chemistry/modal_aero/aero_model.F90 | 8 +- src/chemistry/modal_aero/dust_model.F90 | 18 +- .../modal_aero/modal_aero_gasaerexch.F90 | 4 +- .../modal_aero/modal_aero_rename.F90 | 4 +- src/chemistry/modal_aero/seasalt_model.F90 | 18 +- src/chemistry/mozart/fire_emissions.F90 | 38 +- src/chemistry/mozart/mo_usrrxt.F90 | 6 +- src/chemistry/utils/modal_aero_calcsize.F90 | 74 +- src/chemistry/utils/modal_aero_deposition.F90 | 26 +- .../utils/modal_aero_wateruptake.F90 | 42 +- src/chemistry/utils/prescribed_aero.F90 | 7 +- src/physics/cam/aer_rad_props.F90 | 30 +- src/physics/cam/aer_vis_diag_mod.F90 | 26 +- src/physics/cam/aerosol_mmr_cam.F90 | 992 +++++ src/physics/cam/aerosol_optics_cam.F90 | 246 +- src/physics/cam/clubb_intr.F90 | 1 - src/physics/cam/microp_aero.F90 | 172 +- src/physics/cam/ndrop_bam.F90 | 39 +- src/physics/cam/nucleate_ice_cam.F90 | 38 +- src/physics/cam/phys_debug.F90 | 7 +- src/physics/cam/physpkg.F90 | 45 +- src/physics/cam/rad_constituents.F90 | 3675 ++--------------- src/physics/cam/radiation_data.F90 | 27 +- src/physics/cam/zm_conv_intr.F90 | 2 - src/physics/cam7/physpkg.F90 | 79 +- src/physics/camrt/radiation.F90 | 6 +- src/physics/rrtmg/radiation.F90 | 18 +- src/physics/rrtmgp/radiation.F90 | 10 +- 52 files changed, 5302 insertions(+), 4500 deletions(-) create mode 100644 src/chemistry/aerosol/aerosol_instances_mod.F90 create mode 100644 src/chemistry/aerosol/radiative_aerosol.F90 create mode 100644 src/chemistry/aerosol/radiative_aerosol_definitions.F90 create mode 100644 src/physics/cam/aerosol_mmr_cam.F90 diff --git a/src/chemistry/aerosol/aero_wetdep_cam.F90 b/src/chemistry/aerosol/aero_wetdep_cam.F90 index 4f782d0b74..b059f7e4bc 100644 --- a/src/chemistry/aerosol/aero_wetdep_cam.F90 +++ b/src/chemistry/aerosol/aero_wetdep_cam.F90 @@ -16,7 +16,7 @@ module aero_wetdep_cam use cam_history, only: addfld, add_default, horiz_only, outfld use wetdep, only: wetdep_init - use rad_constituents, only: rad_cnst_get_info + use radiative_aerosol, only: rad_aer_get_info use aerosol_properties_mod, only: aero_name_len use aerosol_properties_mod, only: aerosol_properties @@ -24,8 +24,9 @@ module aero_wetdep_cam use carma_aerosol_properties_mod, only: carma_aerosol_properties use aerosol_state_mod, only: aerosol_state, ptr2d_t - use modal_aerosol_state_mod, only: modal_aerosol_state - use carma_aerosol_state_mod, only: carma_aerosol_state + use aerosol_instances_mod, only: aerosol_instances_get_state, & + aerosol_instances_get_props, & + aerosol_instances_get_num_models use aero_convproc, only: aero_convproc_readnl, aero_convproc_init, aero_convproc_intr use aero_convproc, only: convproc_do_evaprain_atonce @@ -172,7 +173,7 @@ subroutine aero_wetdep_init( ) history_chemistry_out=history_chemistry, & convproc_do_aer_out = convproc_do_aer) - call rad_cnst_get_info(0, nmodes=nmodes, nbins=nbins) + call rad_aer_get_info(0, nmodes=nmodes, nbins=nbins) if (nmodes>0) then aero_props => modal_aerosol_properties() @@ -409,6 +410,8 @@ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) real(r8) :: sflxbc(pcols), sflxbcdp(pcols) ! deposition flux class(aerosol_state), pointer :: aero_state + class(aerosol_properties), pointer :: props_tmp + integer :: iaermod nullify(aero_state) @@ -416,19 +419,21 @@ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) dcondt_resusp3d(:,:,:) = 0._r8 - if (nmodes>0) then - aero_state => modal_aerosol_state(state,pbuf) - if (.not.associated(aero_state)) then - call endrun(subrname//' : construction of aero_state modal_aerosol_state object failed') - end if - else if (nbins>0) then - aero_state => carma_aerosol_state(state,pbuf) - if (.not.associated(aero_state)) then - call endrun(subrname//' : construction of aero_state carma_aerosol_state object failed') + !REMOVECAM - get persistent state from factory; under CAM-SIMA states will be passed as scheme inputs + nullify(aero_state) + do iaermod = 1, aerosol_instances_get_num_models() + props_tmp => aerosol_instances_get_props(iaermod, 0) + if (associated(props_tmp)) then + if (.not. props_tmp%model_is('BAM')) then + aero_state => aerosol_instances_get_state(iaermod, 0, state%lchnk) + exit + end if end if - else - call endrun(subrname//' : cannot determine aerosol model') - endif + end do + if (.not.associated(aero_state)) then + call endrun(subrname//' : no non-BAM aerosol state available for wetdep') + end if + !REMOVECAM_END lchnk = state%lchnk ncol = state%ncol @@ -796,10 +801,7 @@ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) end do bins_loop - if (associated(aero_state)) then - deallocate(aero_state) - nullify(aero_state) - end if + nullify(aero_state) ! if the user has specified prescribed aerosol dep fluxes then ! do not set cam_out dep fluxes according to the prognostic aerosols diff --git a/src/chemistry/aerosol/aerosol_instances_mod.F90 b/src/chemistry/aerosol/aerosol_instances_mod.F90 new file mode 100644 index 0000000000..fb1e597862 --- /dev/null +++ b/src/chemistry/aerosol/aerosol_instances_mod.F90 @@ -0,0 +1,353 @@ +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(:,:,:) + + ! Which diagnostic lists are active (0:N_DIAG). Promoted from local to module-level + ! so that init_states can reuse it. + logical, allocatable :: call_list_(:) + + ! 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, rad_aer_get_call_list + 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 + + allocate(call_list_(0:N_DIAG), stat=istat) + if (istat /= 0) then + call endrun(subname//'allocation error: call_list_') + end if + call rad_aer_get_call_list(call_list_) + + do ilist = 0, N_DIAG + if (.not. call_list_(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 + + if (allocated(call_list_)) deallocate(call_list_) + + 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 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(:) + 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. call_list_(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/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index b2bc986fba..eb1d89d6f8 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -29,29 +29,36 @@ module aerosol_properties_mod 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,private :: nbins_0list - procedure(aero_nbins_rlist), deferred :: nbins_rlist - generic :: nbins => nbins_0list,nbins_rlist + procedure :: nbins => get_nbins procedure :: ncnst_tot procedure,private :: nspecies_per_bin - procedure(aero_nspecies_rlist), deferred :: nspecies_per_bin_rlist procedure,private :: nspecies_all_bins - generic :: nspecies => nspecies_all_bins,nspecies_per_bin,nspecies_per_bin_rlist + 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_0list - procedure(aero_alogsig_rlist), deferred :: alogsig_rlist - generic :: alogsig => alogsig_0list,alogsig_rlist + 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 @@ -76,10 +83,10 @@ module aerosol_properties_mod procedure(aero_hydrophilic), deferred :: hydrophilic procedure(aero_id_query), deferred :: model_is - procedure :: final=>aero_props_final + procedure :: final => aero_props_final end type aerosol_properties - integer,public, parameter :: aero_name_len = 32 ! common length of aersols names, species, etc + integer, public, parameter :: aero_name_len = 32 ! common length of aerosols names, species, etc abstract interface @@ -101,13 +108,13 @@ end function aero_number_transported ! long wave species refractive indices ! species morphology !------------------------------------------------------------------------ - subroutine aero_props_get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & - spectype, specname, specmorph, refindex_sw, refindex_lw) + 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 - integer, optional, intent(in) :: list_ndx ! climate or a diagnostic list number real(r8), optional, intent(out) :: density ! density (kg/m3) real(r8), optional, intent(out) :: hygro ! hygroscopicity character(len=*), optional, intent(out) :: spectype ! species type @@ -115,13 +122,15 @@ subroutine aero_props_get(self, bin_ndx, species_ndx, list_ndx, density, hygro, 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, list_ndx, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absplw, & + 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, & @@ -134,7 +143,6 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index - integer, intent(in) :: list_ndx ! rad climate/diags list character(len=*), optional, intent(out) :: opticstype @@ -356,51 +364,11 @@ logical function aero_soluble(self,bin_ndx) end function aero_soluble !------------------------------------------------------------------------------ - ! returns the total number of bins for a given radiation list index + ! returns name for a given aerosol bin !------------------------------------------------------------------------------ - function aero_nbins_rlist(self, list_ndx) result(res) - import :: aerosol_properties - class(aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - - integer :: res - - end function aero_nbins_rlist - - !------------------------------------------------------------------------------ - ! returns number of species in a bin for a given radiation list index - !------------------------------------------------------------------------------ - function aero_nspecies_rlist(self, list_ndx, bin_ndx) result(res) - import :: aerosol_properties - class(aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - integer, intent(in) :: bin_ndx ! bin number - - integer :: res - - end function aero_nspecies_rlist - - !------------------------------------------------------------------------------ - ! returns the natural log of geometric standard deviation of the number - ! distribution for radiation list number and aerosol bin - !------------------------------------------------------------------------------ - function aero_alogsig_rlist(self, list_ndx, bin_ndx) result(res) - import :: aerosol_properties, r8 - class(aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - integer, intent(in) :: bin_ndx ! bin number - - real(r8) :: res - - end function aero_alogsig_rlist - - !------------------------------------------------------------------------------ - ! returns name for a given radiation list number and aerosol bin - !------------------------------------------------------------------------------ - function aero_bin_name(self, list_ndx, bin_ndx) result(name) + 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) :: list_ndx ! radiation list number integer, intent(in) :: bin_ndx ! bin number character(len=aero_name_len) :: name @@ -473,7 +441,8 @@ end function aero_id_query !------------------------------------------------------------------------------ ! object initializer !------------------------------------------------------------------------------ - subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ierr ) + 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 @@ -483,6 +452,12 @@ subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ie 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: ' @@ -513,6 +488,26 @@ 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 + 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 @@ -542,9 +537,41 @@ subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ie 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 !------------------------------------------------------------------------------ @@ -571,9 +598,25 @@ subroutine aero_props_final(self) 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 @@ -634,12 +677,12 @@ end function indexer !------------------------------------------------------------------------------ ! returns the total number of bins !------------------------------------------------------------------------------ - pure function nbins_0list(self) result(nbins) + pure function get_nbins(self) result(nbins) class(aerosol_properties), intent(in) :: self integer :: nbins nbins = self%nbins_ - end function nbins_0list + end function get_nbins !------------------------------------------------------------------------------ ! returns number of constituents (or elements) totaled across all bins @@ -653,12 +696,62 @@ end function ncnst_tot !------------------------------------------------------------------------------ ! returns the natural log of geometric standard deviation of the number distribution for aerosol bin !------------------------------------------------------------------------------ - pure real(r8) function alogsig_0list(self, bin_ndx) + pure real(r8) function get_alogsig(self, bin_ndx) class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number - alogsig_0list = self%alogsig_(bin_ndx) - end function alogsig_0list + 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 @@ -742,4 +835,14 @@ pure real(r8) function pom_equivso4_factor(self) 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/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index d56bade22d..367aee96dc 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -24,13 +24,14 @@ module aerosol_state_mod !! 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_0list - procedure(aero_get_list_mmr), deferred :: get_ambient_mmr_rlist - generic :: get_ambient_mmr=>get_ambient_mmr_0list,get_ambient_mmr_rlist + 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 @@ -60,7 +61,7 @@ module aerosol_state_mod procedure(aero_wet_diam), deferred :: wet_diameter procedure :: convcld_actfrac procedure :: sol_factb_interstitial - end type aerosol_state + end type aerosol_state ! for state fields type ptr2d_t @@ -99,19 +100,6 @@ subroutine aero_get_state_mmr(self, species_ndx, bin_ndx, mmr) real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) end subroutine aero_get_state_mmr - !------------------------------------------------------------------------ - ! returns aerosol mass mixing ratio for a given species index, bin index - ! and raditaion climate or diagnsotic list number - !------------------------------------------------------------------------ - subroutine aero_get_list_mmr(self, list_ndx, species_ndx, bin_ndx, mmr) - import :: aerosol_state, r8 - class(aerosol_state), intent(in) :: self - integer, intent(in) :: list_ndx ! rad climate/diagnostic list index - 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_list_mmr - !------------------------------------------------------------------------ ! returns aerosol number mixing ratio for a given species index and bin index !------------------------------------------------------------------------ @@ -223,10 +211,9 @@ end function aero_hetfrz_size_wght ! returns hygroscopicity for a given radiation diagnostic list number and ! bin number !------------------------------------------------------------------------------ - subroutine aero_hygroscopicity(self, list_ndx, bin_ndx, kappa) + subroutine aero_hygroscopicity(self, bin_ndx, kappa) import :: aerosol_state, r8 class(aerosol_state), intent(in) :: self - integer, intent(in) :: list_ndx ! rad climate/diagnostic list index integer, intent(in) :: bin_ndx ! bin number real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) @@ -237,12 +224,11 @@ 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, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -265,12 +251,11 @@ end function aero_wgtpct !------------------------------------------------------------------------------ ! aerosol volume interface !------------------------------------------------------------------------------ - function aero_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -298,6 +283,23 @@ end function aero_wet_diam 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 !------------------------------------------------------------------------------ @@ -345,7 +347,7 @@ subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, & do l = 1, aero_props%nspecies(m) - call self%get_ambient_mmr(l,m, raer) + 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 @@ -514,7 +516,7 @@ subroutine icenuc_type_wght_base(self, bin_ndx, ncol, nlev, species_type, aero_p if (cldbrne) then call self%get_cldbrne_mmr(ispc, bin_ndx, aer_bin) else - call self%get_ambient_mmr(ispc, bin_ndx, aer_bin) + 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) @@ -665,22 +667,22 @@ function coated_frac(self, bin_ndx, species_type, ncol, nlev, aero_props, radiu if (sulf_ndx>0) then call aero_props%get(bin_ndx, sulf_ndx, density=specdens_so4) - call self%get_ambient_mmr(sulf_ndx, bin_ndx, sulf_mmr) + 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(pom_ndx, bin_ndx, pom_mmr) + 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(soa_ndx, bin_ndx, soa_mmr) + 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, bin_ndx, aer_mmr) + 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) @@ -734,7 +736,7 @@ function mass_mean_radius(self, bin_ndx, species_ndx, ncol, nlev, aero_props, rh 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, bin_ndx, aer_mmr) ! kg/kg + 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 @@ -789,11 +791,11 @@ subroutine watact_mfactor(self, bin_ndx, species_type, ncol, nlev, aero_props, 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(ispc, bin_ndx, aer_mmr) + 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(ispc, bin_ndx, aer_mmr) + 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 @@ -824,12 +826,11 @@ end subroutine watact_mfactor !------------------------------------------------------------------------------ ! aerosol short wave refactive index !------------------------------------------------------------------------------ - function refractive_index_sw(self, ncol, ilev, ilist, ibin, iwav, aero_props) result(crefin) + 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) :: ilist ! radiation diagnostics list index integer, intent(in) :: ibin ! bin index integer, intent(in) :: iwav ! wave length index class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object @@ -844,10 +845,10 @@ function refractive_index_sw(self, ncol, ilev, ilist, ibin, iwav, aero_props) re crefin(:ncol) = (0._r8, 0._r8) - do ispec = 1, aero_props%nspecies(ilist,ibin) + do ispec = 1, aero_props%nspecies(ibin) - call self%get_ambient_mmr(ilist,ispec,ibin,specmmr) - call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, refindex_sw=specrefindex) + 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 @@ -860,12 +861,11 @@ end function refractive_index_sw !------------------------------------------------------------------------------ ! aerosol long wave refactive index !------------------------------------------------------------------------------ - function refractive_index_lw(self, ncol, ilev, ilist, ibin, iwav, aero_props) result(crefin) + 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) :: ilist ! radiation diagnostics list index integer, intent(in) :: ibin ! bin index integer, intent(in) :: iwav ! wave length index class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object @@ -880,10 +880,10 @@ function refractive_index_lw(self, ncol, ilev, ilist, ibin, iwav, aero_props) re crefin(:ncol) = (0._r8, 0._r8) - do ispec = 1, aero_props%nspecies(ilist,ibin) + do ispec = 1, aero_props%nspecies(ibin) - call self%get_ambient_mmr(ilist,ispec,ibin,specmmr) - call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, refindex_lw=specrefindex) + 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 @@ -937,7 +937,7 @@ function sol_factb_interstitial(self, bin_ndx, ncol, nlev, aero_props) result(so do ispc = 1, aero_props%nspecies(bin_ndx) call aero_props%get(bin_ndx, ispc, hygro=spechygro) - call self%get_ambient_mmr(ispc, bin_ndx, aer_mmr) + 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 diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index 3033851289..efa6b43b0d 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -9,7 +9,7 @@ module bulk_aerosol_properties_mod use aerosol_properties_mod, only: aerosol_properties, aero_name_len - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_props, rad_cnst_get_aer_mmr + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_props use infnan, only: nan, assignment(=) implicit none @@ -38,9 +38,6 @@ module bulk_aerosol_properties_mod procedure :: apply_number_limits procedure :: hetfrz_species procedure :: optics_params - procedure :: nbins_rlist - procedure :: nspecies_per_bin_rlist - procedure :: alogsig_rlist procedure :: soluble procedure :: min_mass_mean_rad procedure :: bin_name @@ -62,14 +59,20 @@ module bulk_aerosol_properties_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor() result(newobj) + 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 + 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 @@ -77,7 +80,7 @@ function constructor() result(newobj) return end if - call rad_cnst_get_info(0, naero=naero) + call rad_aer_get_info(list_idx_loc, naero=naero) ! Here treat each aerosol as a separate bin allocate( nspecies(naero),stat=ierr ) @@ -99,14 +102,17 @@ function constructor() result(newobj) ! Bulk aerosols have 1 chemical species in each bin nspecies(:) = 1 - ! Taken from CARMA -- not sure if it will be used for our purposes - alogsig(:) = log(2._r8) + ! 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) + alogsig=alogsig, f1=f1, f2=f1, ierr=ierr, list_idx=list_idx_loc) deallocate(nspecies) deallocate(alogsig) @@ -146,13 +152,13 @@ end function number_transported ! long wave species refractive indices ! species morphology !------------------------------------------------------------------------ - subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & - spectype, specname, specmorph, refindex_sw, refindex_lw) + 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 - integer, optional, intent(in) :: list_ndx ! climate or a diagnostic list number real(r8), optional, intent(out) :: density ! density (kg/m3) real(r8), optional, intent(out) :: hygro ! hygroscopicity character(len=*), optional, intent(out) :: spectype ! species type @@ -160,26 +166,21 @@ subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & 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) - integer :: ilist character(len=20) :: aername - if (present(list_ndx)) then - ilist = list_ndx - else - ilist = 0 - end if - if (present(density)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, density_aer=density) + call rad_aer_get_props(self%list_idx_, bin_ndx, density_aer=density) end if if (present(hygro)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, hygro_aer=hygro) + call rad_aer_get_props(self%list_idx_, bin_ndx, hygro_aer=hygro) end if if (present(spectype)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, aername=aername) + call rad_aer_get_props(self%list_idx_, bin_ndx, aername=aername) select case ( to_lower( aername(:4) ) ) case('dust') @@ -202,13 +203,19 @@ subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & call endrun('ERROR: bulk_aerosol_properties_mod%get specmorph not yet implemented') end if if (present(specname)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, aername=specname) + call rad_aer_get_props(self%list_idx_, bin_ndx, aername=specname) end if if (present(refindex_sw)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, refindex_aer_sw=refindex_sw) + call rad_aer_get_props(self%list_idx_, bin_ndx, refindex_aer_sw=refindex_sw) end if if (present(refindex_lw)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, refindex_aer_lw=refindex_lw) + 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 @@ -216,7 +223,7 @@ end subroutine get !------------------------------------------------------------------------ ! returns optics type and table parameters !------------------------------------------------------------------------ - subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absplw, & + 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, & @@ -228,7 +235,6 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as class(bulk_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index - integer, intent(in) :: list_ndx ! rad climate/diags list character(len=*), optional, intent(out) :: opticstype @@ -287,7 +293,9 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as real(r8), optional, pointer :: r_lw_abs(:,:) ! refactive index table parameters - call rad_cnst_get_aer_props(list_ndx, bin_ndx, & + 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, & @@ -559,7 +567,7 @@ logical function soluble(self,bin_ndx) character(len=20) :: aername logical :: primary_carbon ! primary carbons (CB1 and OC1) are hydrophobic - call rad_cnst_get_aer_props(0, bin_ndx, aername=aername) + call rad_aer_get_props(self%list_idx_, bin_ndx, aername=aername) aername = to_lower(aername) @@ -583,67 +591,22 @@ function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) end function min_mass_mean_rad !------------------------------------------------------------------------------ - ! returns the total number of bins for a given radiation list index - !------------------------------------------------------------------------------ - function nbins_rlist(self, list_ndx) result(res) - class(bulk_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - - integer :: res - - call rad_cnst_get_info(list_ndx, naero=res) - - end function nbins_rlist - - !------------------------------------------------------------------------------ - ! returns number of species in a bin for a given radiation list index + ! returns name for a given aerosol bin !------------------------------------------------------------------------------ - function nspecies_per_bin_rlist(self, list_ndx, bin_ndx) result(res) + function bin_name(self, bin_ndx) result(name) class(bulk_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - integer, intent(in) :: bin_ndx ! bin number - - integer :: res - - res = 1 - - end function nspecies_per_bin_rlist - - !------------------------------------------------------------------------------ - ! returns the natural log of geometric standard deviation of the number - ! distribution for radiation list number and aerosol bin - !------------------------------------------------------------------------------ - function alogsig_rlist(self, list_ndx, bin_ndx) result(res) - class(bulk_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - integer, intent(in) :: bin_ndx ! bin number - - real(r8) :: res - - ! to be implemented later if needed - res = nan - - end function alogsig_rlist - - !------------------------------------------------------------------------------ - ! returns name for a given radiation list number and aerosol bin - !------------------------------------------------------------------------------ - function bin_name(self, list_ndx, bin_ndx) result(name) - class(bulk_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number integer, intent(in) :: bin_ndx ! bin number character(len=aero_name_len) :: name character(len=64), allocatable :: names(:) integer :: naer, astat - - call rad_cnst_get_info(list_ndx, naero=naer) + 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_cnst_get_info(list_ndx, aernames=names) + call rad_aer_get_info(self%list_idx_, aernames=names) name = names(bin_ndx) diff --git a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 index 4289adb086..55a5e369a3 100644 --- a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 @@ -1,10 +1,14 @@ module bulk_aerosol_state_mod use shr_kind_mod, only: r8 => shr_kind_r8 - use rad_constituents, only: rad_cnst_get_aer_mmr + !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 @@ -14,16 +18,17 @@ 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 contains procedure :: get_transported procedure :: set_transported procedure :: ambient_total_bin_mmr - procedure :: get_ambient_mmr_0list - procedure :: get_ambient_mmr_rlist + procedure :: get_ambient_mmr procedure :: get_cldbrne_mmr procedure :: get_ambient_num procedure :: get_cldbrne_num @@ -54,9 +59,10 @@ module bulk_aerosol_state_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(state,pbuf) result(newobj) + 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 @@ -70,6 +76,8 @@ function constructor(state,pbuf) result(newobj) newobj%state => state newobj%pbuf => pbuf + if (present(list_idx)) call newobj%set_list_idx(list_idx) + end function constructor !------------------------------------------------------------------------------ @@ -117,7 +125,7 @@ function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) resu 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(1, bin_ndx, mmr) + call self%get_ambient_mmr(species_ndx=1, bin_ndx=bin_ndx, mmr=mmr) mmr_tot = mmr(col_ndx, lyr_ndx) @@ -126,30 +134,17 @@ end function ambient_total_bin_mmr !------------------------------------------------------------------------------ ! returns ambient aerosol mass mixing ratio for a given species index and bin index !------------------------------------------------------------------------------ - subroutine get_ambient_mmr_0list(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 self%get_ambient_mmr(0, species_ndx, bin_ndx, mmr) - - end subroutine get_ambient_mmr_0list - - !------------------------------------------------------------------------------ - ! returns ambient aerosol mass mixing ratio for a given radiation diagnostics - ! list index, species index and bin index - !------------------------------------------------------------------------------ - subroutine get_ambient_mmr_rlist(self, list_ndx, species_ndx, bin_ndx, mmr) + subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) class(bulk_aerosol_state), intent(in) :: self - integer, intent(in) :: list_ndx ! rad climate list index 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(list_ndx, bin_ndx, self%state, self%pbuf, 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) - end subroutine get_ambient_mmr_rlist + end subroutine get_ambient_mmr !------------------------------------------------------------------------------ ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index @@ -293,9 +288,8 @@ end function hetfrz_size_wght ! returns hygroscopicity for a given radiation diagnostic list number and ! bin number !------------------------------------------------------------------------------ - subroutine hygroscopicity(self, list_ndx, bin_ndx, kappa) + subroutine hygroscopicity(self, bin_ndx, kappa) class(bulk_aerosol_state), intent(in) :: self - integer, intent(in) :: list_ndx ! rad climate list number integer, intent(in) :: bin_ndx ! bin number real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) @@ -307,11 +301,10 @@ 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, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -325,12 +318,11 @@ end subroutine water_uptake !------------------------------------------------------------------------------ ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number !------------------------------------------------------------------------------ - function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -344,12 +336,11 @@ end function dry_volume !------------------------------------------------------------------------------ ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number !------------------------------------------------------------------------------ - function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -363,12 +354,11 @@ end function wet_volume !------------------------------------------------------------------------------ ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number !------------------------------------------------------------------------------ - function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index e00c807257..d3fd480f3e 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -2,8 +2,8 @@ module carma_aerosol_properties_mod use shr_kind_mod, only: r8 => shr_kind_r8 use physconst, only: pi use aerosol_properties_mod, only: aerosol_properties, aero_name_len - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_bin_props_by_idx, & - rad_cnst_get_info_by_bin, rad_cnst_get_info_by_bin_spec, rad_cnst_get_bin_props + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_bin_props_by_idx, & + rad_aer_get_info_by_bin, rad_aer_get_info_by_bin_spec, rad_aer_get_bin_props use infnan, only: nan, assignment(=) implicit none @@ -30,9 +30,6 @@ module carma_aerosol_properties_mod procedure :: apply_number_limits procedure :: hetfrz_species procedure :: optics_params - procedure :: nbins_rlist - procedure :: nspecies_per_bin_rlist - procedure :: alogsig_rlist procedure :: soluble procedure :: min_mass_mean_rad procedure :: bin_name @@ -55,11 +52,13 @@ module carma_aerosol_properties_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor() result(newobj) + function constructor(list_idx) result(newobj) + integer, optional, intent(in) :: list_idx ! radiation list index (0=climate) type(carma_aerosol_properties), pointer :: newobj integer :: l, m, nbins, ncnst_tot + integer :: list_idx_loc integer,allocatable :: nspecies(:) integer,allocatable :: nmasses(:) real(r8),allocatable :: alogsig(:) @@ -77,13 +76,16 @@ function constructor() result(newobj) integer, allocatable :: imx_mmr_bl(:) ! index used to map pure sulfate bin to mixed sulfate bin for mmr integer, allocatable :: imx_num_bl(:) ! index used to map pure sulfate bin to mixed sulfate bin for num + 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_cnst_get_info( 0, nbins=nbins) + call rad_aer_get_info( list_idx_loc, nbins=nbins) allocate( nspecies(nbins),stat=ierr ) if( ierr /= 0 ) then @@ -114,7 +116,7 @@ function constructor() result(newobj) ncnst_tot = 0 do m = 1, nbins - call rad_cnst_get_info_by_bin(0, m, nspec=nspecies(m)) + call rad_aer_get_info_by_bin(list_idx_loc, m, nspec=nspecies(m)) ncnst_tot = ncnst_tot + nspecies(m) + 1 nmasses(m) = nspecies(m) end do @@ -123,7 +125,7 @@ function constructor() result(newobj) f1 = 1._r8 f2 = 1._r8 - call newobj%initialize(nbins,ncnst_tot,nspecies,nmasses,alogsig,f1,f2,ierr) + call newobj%initialize(nbins,ncnst_tot,nspecies,nmasses,alogsig,f1,f2,ierr,list_idx_loc) if( ierr /= 0 ) then nullify(newobj) return @@ -167,10 +169,10 @@ function constructor() result(newobj) ipr_num = 0 do m = 1,nbins - bin_name = newobj%bin_name(0,m) + bin_name = newobj%bin_name(m) bin_name_l = ' ' if (mself%nspecies(bin_ndx)) then - call rad_cnst_get_info_by_bin(0, bin_ndx, mmr_name=specname) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, mmr_name=specname) else - call rad_cnst_get_info_by_bin_spec(ilist, bin_ndx, species_ndx, spec_name=specname) + call rad_aer_get_info_by_bin_spec(self%list_idx_, bin_ndx, species_ndx, spec_name=specname) end if end if + if (present(num_to_mass_aer)) then + ! num_to_mass_aer not meaningful for sectional aerosols: + num_to_mass_aer = 0.0_r8 + end if + + if (present(dryrad)) then + ! dryrad is not meaningful for sectional aerosols: + dryrad = 0.0_r8 + end if + end subroutine get !------------------------------------------------------------------------ ! returns optics type and table parameters !------------------------------------------------------------------------ - subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absplw, & + 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, & @@ -326,7 +332,6 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as class(carma_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index - integer, intent(in) :: list_ndx ! rad climate/diags list character(len=*), optional, intent(out) :: opticstype @@ -418,7 +423,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as prefi = huge(1) end if - call rad_cnst_get_bin_props(list_ndx,bin_ndx, & + call rad_aer_get_bin_props(self%list_idx_,bin_ndx, & opticstype=opticstype, & sw_hygro_ext_wtp=sw_hygro_ext_wtp, & sw_hygro_ssa_wtp=sw_hygro_ssa_wtp, & @@ -531,7 +536,7 @@ subroutine num_names(self, bin_ndx, name_a, name_c) 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_cnst_get_info_by_bin(0, bin_ndx, num_name=name_a, num_name_cw=name_c) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, num_name=name_a, num_name_cw=name_c) end subroutine num_names @@ -546,9 +551,9 @@ subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c) character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol MMR if (species_ndx>0) then - call rad_cnst_get_info_by_bin_spec(0, bin_ndx, species_ndx, spec_name=name_a, spec_name_cw=name_c) + call rad_aer_get_info_by_bin_spec(self%list_idx_, bin_ndx, species_ndx, spec_name=name_a, spec_name_cw=name_c) else - call rad_cnst_get_info_by_bin(0, bin_ndx, mmr_name=name_a, mmr_name_cw=name_c) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, mmr_name=name_a, mmr_name_cw=name_c) end if end subroutine mmr_names @@ -561,7 +566,7 @@ subroutine amb_num_name(self, bin_ndx, name) integer, intent(in) :: bin_ndx ! bin number character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens - call rad_cnst_get_info_by_bin(0, bin_ndx, num_name=name) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, num_name=name) end subroutine amb_num_name @@ -575,9 +580,9 @@ subroutine amb_mmr_name(self, bin_ndx, species_ndx, name) character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR if (species_ndx>0) then - call rad_cnst_get_info_by_bin_spec(0, bin_ndx, species_ndx, spec_name=name) + call rad_aer_get_info_by_bin_spec(self%list_idx_, bin_ndx, species_ndx, spec_name=name) else - call rad_cnst_get_info_by_bin(0, bin_ndx, mmr_name=name) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, mmr_name=name) end if end subroutine amb_mmr_name @@ -591,7 +596,7 @@ subroutine species_type(self, bin_ndx, species_ndx, spectype) integer, intent(in) :: species_ndx ! species number character(len=*), intent(out) :: spectype ! species type - call rad_cnst_get_info_by_bin_spec(0, bin_ndx, species_ndx, spec_type=spectype) + call rad_aer_get_info_by_bin_spec(self%list_idx_, bin_ndx, species_ndx, spec_type=spectype) end subroutine species_type @@ -702,58 +707,15 @@ function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) end function min_mass_mean_rad !------------------------------------------------------------------------------ - ! returns the total number of bins for a given radiation list index - !------------------------------------------------------------------------------ - function nbins_rlist(self, list_ndx) result(res) - class(carma_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - - integer :: res - - call rad_cnst_get_info(list_ndx, nbins=res) - - end function nbins_rlist - - !------------------------------------------------------------------------------ - ! returns number of species in a bin for a given radiation list index - !------------------------------------------------------------------------------ - function nspecies_per_bin_rlist(self, list_ndx, bin_ndx) result(res) - class(carma_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - integer, intent(in) :: bin_ndx ! bin number - - integer :: res - - call rad_cnst_get_info_by_bin(list_ndx, bin_ndx, nspec=res) - - end function nspecies_per_bin_rlist - - !------------------------------------------------------------------------------ - ! returns the natural log of geometric standard deviation of the number - ! distribution for radiation list number and aerosol bin - !------------------------------------------------------------------------------ - function alogsig_rlist(self, list_ndx, bin_ndx) result(res) - class(carma_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - integer, intent(in) :: bin_ndx ! bin number - - real(r8) :: res - - res = self%alogsig(bin_ndx) - - end function alogsig_rlist - - !------------------------------------------------------------------------------ - ! returns name for a given radiation list number and aerosol bin + ! returns name for a given aerosol bin !------------------------------------------------------------------------------ - function bin_name(self, list_ndx, bin_ndx) result(name) + function bin_name(self, bin_ndx) result(name) class(carma_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number integer, intent(in) :: bin_ndx ! bin number character(len=32) name - call rad_cnst_get_info_by_bin(list_ndx, bin_ndx, bin_name=name) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, bin_name=name) end function bin_name @@ -778,7 +740,7 @@ function scav_diam(self, bin_ndx) result(diam) character(len=aero_name_len) :: bin_name, shortname integer :: igroup, ibin, rc, nchr - call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -918,7 +880,7 @@ real(r8) function bin_mass(bin_ndx) ! (kg) integer :: ibin, igroup, rc, nchr real(r8) :: rmass - call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -950,7 +912,7 @@ end function hydrophilic !------------------------------------------------------------------------------ pure logical function model_is(self, query) class(carma_aerosol_properties), intent(in) :: self - character(len=*), intent(in) :: query + character(len=*), intent(in) :: query if (trim(query) == 'CARMA' .or. trim(query) == 'carma') then model_is = .true. diff --git a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 index b0e82b2170..d40ac7f8e6 100644 --- a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 @@ -2,11 +2,16 @@ module carma_aerosol_state_mod use shr_kind_mod, only: r8 => shr_kind_r8 use aerosol_state_mod, only: aerosol_state, ptr2d_t - use rad_constituents, only: rad_cnst_get_bin_mmr_by_idx, rad_cnst_get_bin_num !, rad_cnst_get_bin_mmr - use rad_constituents, only: rad_cnst_get_info_by_bin + use radiative_aerosol, only: rad_aer_get_info_by_bin + !REMOVECAM + use aerosol_mmr_cam, only: rad_cnst_get_bin_mmr_by_idx, rad_cnst_get_bin_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 cam_abortutils, only: endrun use physconst, only: pi use carma_intr, only: carma_get_total_mmr, carma_get_dry_radius, carma_get_number, carma_get_number_cld @@ -22,15 +27,16 @@ module carma_aerosol_state_mod type, extends(aerosol_state) :: carma_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_0list - procedure :: get_ambient_mmr_rlist + procedure :: get_ambient_mmr procedure :: get_cldbrne_mmr procedure :: get_ambient_num procedure :: get_cldbrne_num @@ -61,9 +67,10 @@ module carma_aerosol_state_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(state,pbuf) result(newobj) + function constructor(state,pbuf,list_idx) result(newobj) type(physics_state), target, optional :: state type(physics_buffer_desc), pointer, optional :: pbuf(:) + integer, intent(in), optional :: list_idx type(carma_aerosol_state), pointer :: newobj @@ -78,6 +85,8 @@ function constructor(state,pbuf) result(newobj) newobj%state => state newobj%pbuf => pbuf + if (present(list_idx)) call newobj%set_list_idx(list_idx) + end function constructor !------------------------------------------------------------------------------ @@ -128,7 +137,7 @@ function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) resu character(len=aero_name_len) :: bin_name, shortname integer :: igroup, ibin, rc, nchr - call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -146,30 +155,15 @@ end function ambient_total_bin_mmr !------------------------------------------------------------------------------ ! returns ambient aerosol mass mixing ratio for a given species index and bin index !------------------------------------------------------------------------------ - subroutine get_ambient_mmr_0list(self, species_ndx, bin_ndx, mmr) + subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) class(carma_aerosol_state), intent(in) :: self integer, intent(in) :: species_ndx ! species index integer, intent(in) :: bin_ndx ! bin index real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) - call rad_cnst_get_bin_mmr_by_idx(0, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) + call rad_cnst_get_bin_mmr_by_idx(self%list_idx_, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) - end subroutine get_ambient_mmr_0list - - !------------------------------------------------------------------------------ - ! returns ambient aerosol mass mixing ratio for a given radiation diagnostics - ! list index, species index and bin index - !------------------------------------------------------------------------------ - subroutine get_ambient_mmr_rlist(self, list_ndx, species_ndx, bin_ndx, mmr) - class(carma_aerosol_state), intent(in) :: self - integer, intent(in) :: list_ndx ! rad climate list index - 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_bin_mmr_by_idx(list_ndx, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) - - end subroutine get_ambient_mmr_rlist + end subroutine get_ambient_mmr !------------------------------------------------------------------------------ ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index @@ -180,7 +174,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_bin_mmr_by_idx(0, bin_ndx, species_ndx, 'c', self%state, self%pbuf, mmr) + call rad_cnst_get_bin_mmr_by_idx(self%list_idx_, bin_ndx, species_ndx, 'c', self%state, self%pbuf, mmr) end subroutine get_cldbrne_mmr @@ -198,7 +192,7 @@ subroutine get_ambient_num(self, bin_ndx, num) ncol = self%state%ncol - call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -207,7 +201,7 @@ subroutine get_ambient_num(self, bin_ndx, num) read(bin_name(nchr+1:),*) ibin - call rad_cnst_get_bin_num(0, bin_ndx, 'a', self%state, self%pbuf, num) + call rad_cnst_get_bin_num(self%list_idx_, bin_ndx, 'a', self%state, self%pbuf, num) call carma_get_number(self%state, igroup, ibin, nmr, rc) @@ -229,7 +223,7 @@ subroutine get_cldbrne_num(self, bin_ndx, num) ncol = self%state%ncol - call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + call rad_aer_get_info_by_bin(self%list_idx_, bin_ndx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -238,7 +232,7 @@ subroutine get_cldbrne_num(self, bin_ndx, num) read(bin_name(nchr+1:),*) ibin - call rad_cnst_get_bin_num(0, bin_ndx, 'c', self%state, self%pbuf, num) + call rad_cnst_get_bin_num(self%list_idx_, bin_ndx, 'c', self%state, self%pbuf, num) call carma_get_number_cld(self%pbuf, igroup, ibin, ncol, pver, nmr, rc) @@ -263,7 +257,7 @@ subroutine get_states( self, aero_props, raer, qqcw ) 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(ispc,ibin, raer(indx)%fld) + call self%get_ambient_mmr(species_ndx=ispc, bin_ndx=ibin, mmr=raer(indx)%fld) call self%get_cldbrne_mmr(ispc,ibin, qqcw(indx)%fld) end do end do @@ -288,9 +282,13 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre real(r8) :: diamdry integer :: igroup, ibin, rc, nchr + if (self%list_idx_ /= 0) then + call endrun('carma_aerosol_state::icenuc_size_wght_arr: only valid for climate list (list_idx=0)') + end if + wght = 0._r8 - call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + call rad_aer_get_info_by_bin(0, bin_ndx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -370,9 +368,13 @@ function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) real(r8) :: diamdry integer :: igroup, ibin, rc, nchr + if (self%list_idx_ /= 0) then + call endrun('carma_aerosol_state::hetfrz_size_wght: only valid for climate list (list_idx=0)') + end if + wght = 0._r8 - call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + call rad_aer_get_info_by_bin(0, bin_ndx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -397,16 +399,19 @@ end function hetfrz_size_wght ! returns hygroscopicity for a given radiation diagnostic list number and ! bin number !------------------------------------------------------------------------------ - subroutine hygroscopicity(self, list_ndx, bin_ndx, kappa) + subroutine hygroscopicity(self, bin_ndx, kappa) class(carma_aerosol_state), intent(in) :: self - integer, intent(in) :: list_ndx ! rad climate list number integer, intent(in) :: bin_ndx ! bin number real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) character(len=aero_name_len) :: bin_name, shortname integer :: igroup, ibin, rc, nchr, ncol - call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + if (self%list_idx_ /= 0) then + call endrun('carma_aerosol_state::hygroscopicity: only valid for climate list (list_idx=0)') + end if + + call rad_aer_get_info_by_bin(0, bin_ndx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -423,11 +428,10 @@ 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, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -454,12 +458,11 @@ end function wgtpct !------------------------------------------------------------------------------ ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number !------------------------------------------------------------------------------ - function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -473,7 +476,11 @@ function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) character(len=aero_name_len) :: bin_name, shortname integer :: igroup, ibin, rc, nchr - call rad_cnst_get_info_by_bin(0, bin_idx, bin_name=bin_name) + if (self%list_idx_ /= 0) then + call endrun('carma_aerosol_state::dry_volume: only valid for climate list (list_idx=0)') + end if + + call rad_aer_get_info_by_bin(0, bin_idx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -494,12 +501,11 @@ end function dry_volume !------------------------------------------------------------------------------ ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number !------------------------------------------------------------------------------ - function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -513,7 +519,11 @@ function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) character(len=aero_name_len) :: bin_name, shortname integer :: igroup, ibin, rc, nchr - call rad_cnst_get_info_by_bin(0, bin_idx, bin_name=bin_name) + if (self%list_idx_ /= 0) then + call endrun('carma_aerosol_state::wet_volume: only valid for climate list (list_idx=0)') + end if + + call rad_aer_get_info_by_bin(0, bin_idx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -534,12 +544,11 @@ end function wet_volume !------------------------------------------------------------------------------ ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number !------------------------------------------------------------------------------ - function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -549,8 +558,8 @@ function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vo real(r8) :: wetvol(ncol,nlev) real(r8) :: dryvol(ncol,nlev) - wetvol = self%wet_volume(aero_props, list_idx, bin_idx, ncol, nlev) - dryvol = self%dry_volume(aero_props, list_idx, bin_idx, ncol, nlev) + wetvol = self%wet_volume(aero_props, bin_idx, ncol, nlev) + dryvol = self%dry_volume(aero_props, bin_idx, ncol, nlev) vol(:ncol,:) = wetvol(:ncol,:) - dryvol(:ncol,:) @@ -577,7 +586,11 @@ function wet_diameter(self, bin_idx, ncol, nlev) result(diam) character(len=aero_name_len) :: bin_name, shortname integer :: igroup, ibin, rc, nchr - call rad_cnst_get_info_by_bin(0, bin_idx, bin_name=bin_name) + if (self%list_idx_ /= 0) then + call endrun('carma_aerosol_state::wet_diameter: only valid for climate list (list_idx=0)') + end if + + call rad_aer_get_info_by_bin(0, bin_idx, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) diff --git a/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 index d6bf3d4c4e..b116cddf94 100644 --- a/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 @@ -47,11 +47,10 @@ module hygro_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, numrh, relhum) & + 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) :: ilist ! climate or a diagnostic list number integer, intent(in) :: ibin ! bin number integer, intent(in) :: ncols, nlevs, numrh real(r8),intent(in) :: relhum(ncols,nlevs) @@ -85,13 +84,13 @@ function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, numrh, r 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(ilist, ibin, & + 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(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + call aero_state%get_ambient_mmr(species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) end function constructor diff --git a/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 index 3e78f5a8c9..e6e36e777c 100644 --- a/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 @@ -54,11 +54,10 @@ module hygrocoreshell_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, relhum) result(newobj) + 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) :: ilist ! climate or a diagnostic list number integer, intent(in) :: ibin ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -117,7 +116,7 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, relhum) re return end if - nspec = aero_props%nspecies(ilist,ibin) + nspec = aero_props%nspecies(ibin) coremmr(:,:) = 0._r8 coredustmmr(:,:) = 0._r8 @@ -126,9 +125,9 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, relhum) re do ispec = 1,nspec - call aero_state%get_ambient_mmr(ilist,ispec,ibin,specmmr) + call aero_state%get_ambient_mmr(species_ndx=ispec,bin_ndx=ibin,mmr=specmmr) - call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, & + call aero_props%get(ibin, ispec, density=specdens, & spectype=spectype, specmorph=specmorph) if (trim(specmorph) == 'core') then @@ -171,9 +170,9 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, relhum) re end do end do - call aero_state%hygroscopicity(ilist, ibin, newobj%kappa) + call aero_state%hygroscopicity(ibin, newobj%kappa) - call aero_props%optics_params(ilist, ibin, & + 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, & @@ -182,7 +181,7 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, relhum) re newobj%relh(:ncol,:) = relhum(:ncol,:) ! long wave optical properties table - call aero_props%optics_params(ilist, ibin, & + 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, & diff --git a/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 index 3fa1d01f0e..d1d9fd656b 100644 --- a/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 @@ -46,11 +46,10 @@ module hygroscopic_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, numrh, relhum) & + 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) :: ilist ! climate or a diagnostic list number integer, intent(in) :: ibin ! bin number integer, intent(in) :: ncols, nlevs, numrh real(r8),intent(in) :: relhum(ncols,nlevs) @@ -84,13 +83,13 @@ function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, numrh, r 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(ilist, ibin, & + 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(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + call aero_state%get_ambient_mmr(species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) end function constructor diff --git a/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 index 7153e13986..617f0d81b2 100644 --- a/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 @@ -45,11 +45,10 @@ module hygrowghtpct_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, wgtpct_in) result(newobj) + 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) :: ilist ! climate or a diagnostic list number integer, intent(in) :: ibin ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -84,20 +83,20 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, wgtpct_in) ! weight precent of H2SO4/H2O solution newobj%wgtpct(:ncol,:nlev) = wgtpct_in(:ncol,:nlev) - call aero_props%optics_params(ilist, ibin, wgtpct=newobj%tbl_wgtpct, nwtp=newobj%nwtp) + call aero_props%optics_params(ibin, wgtpct=newobj%tbl_wgtpct, nwtp=newobj%nwtp) - nspec = aero_props%nspecies(ilist, ibin) + nspec = aero_props%nspecies(ibin) newobj%totalmmr(:,:) = 0._r8 do ispec = 1,nspec - call aero_state%get_ambient_mmr(ilist,ispec,ibin,specmmr) + 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(ilist, ibin, & + 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, & diff --git a/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 index ac7475dc33..3b9f9228c2 100644 --- a/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 @@ -40,11 +40,10 @@ module insoluble_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, aero_state, ilist, ibin) result(newobj) + 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) :: ilist ! climate or a diagnostic list number integer, intent(in) :: ibin ! bin number type(insoluble_aerosol_optics), pointer :: newobj @@ -58,13 +57,13 @@ function constructor(aero_props, aero_state, ilist, ibin) result(newobj) end if ! get mode properties - call aero_props%optics_params(ilist, ibin, & + 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(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + call aero_state%get_ambient_mmr(species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) end function constructor diff --git a/src/chemistry/aerosol/modal_aero_data.F90 b/src/chemistry/aerosol/modal_aero_data.F90 index 15b247584d..3245dbdb68 100644 --- a/src/chemistry/aerosol/modal_aero_data.F90 +++ b/src/chemistry/aerosol/modal_aero_data.F90 @@ -19,7 +19,7 @@ module modal_aero_data use chem_mods, only: gas_pcnst use radconstants, only: nswbands, nlwbands use shr_const_mod, only: pi => shr_const_pi - use rad_constituents,only: rad_cnst_get_info, rad_cnst_get_aer_props, rad_cnst_get_mode_props + use radiative_aerosol,only: rad_aer_get_info, rad_aer_get_props, rad_aer_get_mode_props use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk implicit none @@ -157,7 +157,7 @@ subroutine modal_aero_data_reg character(len=32) :: spec_name, mode_type character(len=1) :: modestr - call rad_cnst_get_info( 0, nmodes=ntot_amode ) + call rad_aer_get_info( 0, nmodes=ntot_amode ) allocate( nspec_amode(ntot_amode) ) allocate( numptr_amode(ntot_amode) ) allocate( numptrcw_amode(ntot_amode) ) @@ -211,12 +211,12 @@ subroutine modal_aero_data_reg ) do m = 1, ntot_amode - call rad_cnst_get_info(0, m, mode_type=mode_type, nspec=nspec_amode(m)) + call rad_aer_get_info(0, m, mode_type=mode_type, nspec=nspec_amode(m)) modename_amode(m) = mode_type ! count number of soa, poa, and bc bins in mode 1 if (m==1) then do l = 1, nspec_amode(m) - call rad_cnst_get_info(0, m, l, spec_name=spec_name ) + call rad_aer_get_info(0, m, l, spec_name=spec_name ) if (spec_name(:3) == 'soa') nsoa=nsoa+1 if (spec_name(:3) == 'pom') npoa=npoa+1 if (spec_name(:2) == 'bc' ) nbc =nbc +1 @@ -239,7 +239,7 @@ subroutine modal_aero_data_reg do m = 1, ntot_amode do l = 1, nspec_amode(m) - call rad_cnst_get_info(0, m, l, spec_name=spec_name ) + call rad_aer_get_info(0, m, l, spec_name=spec_name ) xname_massptr(l,m) = spec_name write(modestr,'(I1)') m idx = index( xname_massptr(l,m), '_' ) @@ -423,7 +423,7 @@ subroutine modal_aero_data_init(pbuf2d) ! Mode specific properties. do m = 1, ntot_amode - call rad_cnst_get_mode_props(0, m, & + call rad_aer_get_mode_props(0, m, & sigmag=sigmag_amode(m), dgnum=dgnum_amode(m), dgnumlo=dgnumlo_amode(m), & dgnumhi=dgnumhi_amode(m), rhcrystal=rhcrystal_amode(m), rhdeliques=rhdeliques_amode(m)) @@ -487,7 +487,7 @@ subroutine modal_aero_data_init(pbuf2d) do m = 1, ntot_amode do l = 1, nspec_amode(m) qArrIndex = lmassptr_amode(l,m) !index of the species in the state%q array - call rad_cnst_get_aer_props(0, m, l , & + call rad_aer_get_props(0, m, l , & refindex_aer_sw=refindex_aer_sw, & refindex_aer_lw=refindex_aer_lw, & density_aer=specdens_amode(l,m), & diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index e255be91da..3e85c26262 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -2,7 +2,7 @@ module modal_aerosol_properties_mod use shr_kind_mod, only: r8 => shr_kind_r8 use physconst, only: pi use aerosol_properties_mod, only: aerosol_properties, aero_name_len - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_props, rad_cnst_get_aer_props + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_mode_props, rad_aer_get_props implicit none @@ -24,6 +24,7 @@ module modal_aerosol_properties_mod 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 @@ -42,9 +43,6 @@ module modal_aerosol_properties_mod procedure :: apply_number_limits procedure :: hetfrz_species procedure :: optics_params - procedure :: nbins_rlist - procedure :: nspecies_per_bin_rlist - procedure :: alogsig_rlist procedure :: soluble procedure :: min_mass_mean_rad procedure :: bin_name @@ -67,31 +65,43 @@ module modal_aerosol_properties_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor() result(newobj) + function constructor(list_idx) result(newobj) + integer, optional, intent(in) :: list_idx ! radiation list index (0=climate) type(modal_aerosol_properties), pointer :: newobj - integer :: l, m, nmodes, ncnst_tot, mm - real(r8) :: dgnumlo - real(r8) :: dgnumhi + 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_cnst_get_info(0, nmodes=nmodes) + call rad_aer_get_info(list_idx_loc, nmodes=nmodes) allocate(nspecies(nmodes),stat=ierr) if( ierr /= 0 ) then @@ -134,16 +144,34 @@ function constructor() result(newobj) 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_cnst_get_info(0, m, nspec=nspecies(m)) + call rad_aer_get_info(list_idx_loc, m, nspec=nspecies(m)) ncnst_tot = ncnst_tot + nspecies(m) + 1 - call rad_cnst_get_mode_props(0, m, sigmag=sigmag(m), & - dgnumhi=dgnumhi, dgnumlo=dgnumlo ) + 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)) @@ -153,13 +181,29 @@ function constructor() result(newobj) f2(m) = 1._r8 + 0.25_r8*alogsig(m) newobj%voltonumblo_(m) = 1._r8 / ( (pi/6._r8)* & - (dgnumlo**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) + (dgnumlo_val**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) newobj%voltonumbhi_(m) = 1._r8 / ( (pi/6._r8)* & - (dgnumhi**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) + (dgnumhi_val**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) end do - call newobj%initialize(nmodes,ncnst_tot,nspecies,nspecies,alogsig,f1,f2,ierr) + ! 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 @@ -286,6 +330,11 @@ function constructor() result(newobj) deallocate(sigmag) deallocate(f1) deallocate(f2) + deallocate(dgnum_arr) + deallocate(dgnumhi_arr) + deallocate(dgnumlo_arr) + deallocate(rhcrystal_arr) + deallocate(rhdeliques_arr) end function constructor @@ -303,6 +352,9 @@ subroutine destructor(self) 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_) @@ -355,13 +407,13 @@ end function number_transported ! long wave species refractive indices ! species morphology !------------------------------------------------------------------------ - subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & - spectype, specname, specmorph, refindex_sw, refindex_lw) + 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 ! bin index integer, intent(in) :: species_ndx ! species index - integer, optional, intent(in) :: list_ndx ! climate or a diagnostic list number real(r8), optional, intent(out) :: density ! density (kg/m3) real(r8), optional, intent(out) :: hygro ! hygroscopicity character(len=*), optional, intent(out) :: spectype ! species type @@ -369,33 +421,37 @@ subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & 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) -- not meaningful for modal - integer :: ilist - - if (present(list_ndx)) then - ilist = list_ndx - else - ilist = 0 - end if - - call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, & + 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_cnst_get_info(ilist, bin_ndx, species_ndx, spec_name=specname) + 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 not meaningful for modal aerosols: + num_to_mass_aer = 0.0_r8 + end if + + if (present(dryrad)) then + ! dryrad is not meaningful for modal aerosols: + dryrad = 0.0_r8 + end if + end subroutine get !------------------------------------------------------------------------ ! returns optics type and table parameters !------------------------------------------------------------------------ - subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absplw, & + 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, & @@ -406,7 +462,6 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as class(modal_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index - integer, intent(in) :: list_ndx ! rad climate/diags list character(len=*), optional, intent(out) :: opticstype @@ -465,7 +520,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as real(r8), optional, pointer :: r_lw_abs(:,:) ! refactive index table parameters - call rad_cnst_get_mode_props(list_ndx, bin_ndx, & + call rad_aer_get_mode_props(self%list_idx_, bin_ndx, & opticstype=opticstype, & extpsw=extpsw, & abspsw=abspsw, & @@ -631,7 +686,7 @@ subroutine num_names(self, bin_ndx, name_a, name_c) 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_cnst_get_info(0,bin_ndx, num_name=name_a, num_name_cw=name_c) + call rad_aer_get_info(self%list_idx_,bin_ndx, num_name=name_a, num_name_cw=name_c) end subroutine num_names !------------------------------------------------------------------------ @@ -644,7 +699,7 @@ subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c) 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_cnst_get_info(0, bin_ndx, species_ndx, spec_name=name_a, spec_name_cw=name_c) + 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 !------------------------------------------------------------------------ @@ -655,7 +710,7 @@ subroutine amb_num_name(self, bin_ndx, name) integer, intent(in) :: bin_ndx ! bin number character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens - call rad_cnst_get_info(0,bin_ndx, num_name=name) + call rad_aer_get_info(self%list_idx_,bin_ndx, num_name=name) end subroutine amb_num_name @@ -668,7 +723,7 @@ subroutine amb_mmr_name(self, bin_ndx, species_ndx, name) integer, intent(in) :: species_ndx ! species number character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR - call rad_cnst_get_info(0, bin_ndx, species_ndx, spec_name=name) + call rad_aer_get_info(self%list_idx_, bin_ndx, species_ndx, spec_name=name) end subroutine amb_mmr_name @@ -681,7 +736,7 @@ subroutine species_type(self, bin_ndx, species_ndx, spectype) integer, intent(in) :: species_ndx ! species number character(len=*), intent(out) :: spectype ! species type - call rad_cnst_get_info(0, bin_ndx, species_ndx, spec_type=spectype) + call rad_aer_get_info(self%list_idx_, bin_ndx, species_ndx, spec_type=spectype) end subroutine species_type @@ -700,7 +755,7 @@ function icenuc_updates_num(self, bin_ndx) result(res) res = .false. - call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + 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 @@ -729,7 +784,7 @@ function icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) if (species_ndx>0) then - call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + 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 @@ -778,7 +833,7 @@ function hetfrz_species(self, bin_ndx, spc_ndx) result(res) res = .false. - call rad_cnst_get_info(0, bin_ndx, mode_type=mode_name) + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=mode_name) if ((trim(mode_name)/='aitken')) then @@ -803,7 +858,7 @@ logical function soluble(self,bin_ndx) character(len=aero_name_len) :: mode_name - call rad_cnst_get_info(0, bin_ndx, mode_type=mode_name) + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=mode_name) soluble = trim(mode_name)/='primary_carbon' @@ -825,7 +880,7 @@ function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) call self%species_type(bin_ndx, species_ndx, spectype=species_type) select case ( trim(species_type) ) case('dust') - call rad_cnst_get_info(0, bin_ndx, mode_type=mode_type) + 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 @@ -835,7 +890,7 @@ function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) minrad = -huge(1._r8) end select case('black-c') - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_aer_get_info(self%list_idx_, nmodes=nmodes) if (nmodes==3) then minrad = 0.04e-6_r8 else @@ -848,61 +903,15 @@ function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) end function min_mass_mean_rad !------------------------------------------------------------------------------ - ! returns the total number of bins for a given radiation list index + ! returns name for a given aerosol bin !------------------------------------------------------------------------------ - function nbins_rlist(self, list_ndx) result(res) + function bin_name(self, bin_ndx) result(name) class(modal_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - - integer :: res - - call rad_cnst_get_info(list_ndx, nmodes=res) - - end function nbins_rlist - - !------------------------------------------------------------------------------ - ! returns number of species in a bin for a given radiation list index - !------------------------------------------------------------------------------ - function nspecies_per_bin_rlist(self, list_ndx, bin_ndx) result(res) - class(modal_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number integer, intent(in) :: bin_ndx ! bin number - integer :: res - - call rad_cnst_get_info(list_ndx, bin_ndx, nspec=res) - - end function nspecies_per_bin_rlist - - !------------------------------------------------------------------------------ - ! returns the natural log of geometric standard deviation of the number - ! distribution for radiation list number and aerosol bin - !------------------------------------------------------------------------------ - function alogsig_rlist(self, list_ndx, bin_ndx) result(res) - class(modal_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - integer, intent(in) :: bin_ndx ! bin number + character(len=32) :: name - real(r8) :: res - - real(r8) :: sig - - call rad_cnst_get_mode_props(list_ndx, bin_ndx, sigmag=sig) - res = log(sig) - - end function alogsig_rlist - - !------------------------------------------------------------------------------ - ! returns name for a given radiation list number and aerosol bin - !------------------------------------------------------------------------------ - function bin_name(self, list_ndx, bin_ndx) result(name) - class(modal_aerosol_properties), intent(in) :: self - integer, intent(in) :: list_ndx ! radiation list number - integer, intent(in) :: bin_ndx ! bin number - - character(len=32) name - - call rad_cnst_get_info(list_ndx, bin_ndx, mode_type=name) + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=name) end function bin_name @@ -910,14 +919,12 @@ end function bin_name ! returns scavenging diameter (cm) for a given aerosol bin number !------------------------------------------------------------------------------ function scav_diam(self, bin_ndx) result(diam) - use modal_aero_data, only: dgnum_amode - class(modal_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number real(r8) :: diam - diam = dgnum_amode(bin_ndx) + diam = self%dgnum(bin_ndx) end function scav_diam @@ -927,8 +934,6 @@ end function scav_diam !------------------------------------------------------------------------------ subroutine resuspension_resize(self, dcondt) - use modal_aero_data, only: mode_size_order - class(modal_aerosol_properties), intent(in) :: self real(r8), intent(inout) :: dcondt(:) @@ -976,7 +981,7 @@ subroutine accumulate_to_larger_mode( spc_name, lptr, prevap ) ! find constituent index of the largest mode for the species loop1: do m = 1,self%nbins()-1 - nl = lptr(mode_size_order(m)) + nl = lptr(self%mode_size_order_(m)) if (nl>0) exit loop1 end do loop1 @@ -984,7 +989,7 @@ subroutine accumulate_to_larger_mode( spc_name, lptr, prevap ) ! accumulate the smaller modes into the largest mode do n = m+1,self%nbins() - ns = lptr(mode_size_order(n)) + ns = lptr(self%mode_size_order_(n)) if (ns>0) then prevap(nl) = prevap(nl) + prevap(ns) prevap(ns) = 0._r8 @@ -1055,10 +1060,10 @@ subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxe Mtotal = Mtotal + dep_fluxes(mm) ! kg/m2 end do mode_has_type: if (has_type) then - call rad_cnst_get_info(0, m, mode_type=modetype) + 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_cnst_get_mode_props(0, m, sigmag=sigma_g) + call rad_aer_get_mode_props(self%list_idx_, m, sigmag=sigma_g) tmp = sqrtwo*log(sigma_g) ! type number concentration @@ -1103,7 +1108,7 @@ logical function hydrophilic(self, bin_ndx) character(len=aero_name_len) :: modetype - call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + call rad_aer_get_info(self%list_idx_, bin_ndx, mode_type=modetype) hydrophilic = (trim(modetype) == 'accum') diff --git a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 index 5e24eac8b3..30c8b51ee7 100644 --- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -2,12 +2,17 @@ module modal_aerosol_state_mod use shr_kind_mod, only: r8 => shr_kind_r8 use shr_spfn_mod, only: erf => shr_spfn_erf use aerosol_state_mod, only: aerosol_state, ptr2d_t - use rad_constituents, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num, rad_cnst_get_info - use rad_constituents, only: rad_cnst_get_mode_props + 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 @@ -17,15 +22,16 @@ 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 contains procedure :: get_transported procedure :: set_transported procedure :: ambient_total_bin_mmr - procedure :: get_ambient_mmr_0list - procedure :: get_ambient_mmr_rlist + procedure :: get_ambient_mmr procedure :: get_cldbrne_mmr procedure :: get_ambient_num procedure :: get_cldbrne_num @@ -58,9 +64,10 @@ module modal_aerosol_state_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(state,pbuf) result(newobj) + 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 @@ -75,6 +82,8 @@ function constructor(state,pbuf) result(newobj) newobj%state => state newobj%pbuf => pbuf + if (present(list_idx)) call newobj%set_list_idx(list_idx) + end function constructor !------------------------------------------------------------------------------ @@ -126,7 +135,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(0, 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%state, self%pbuf, mmrptr) mmr_tot = mmr_tot + mmrptr(col_ndx,lyr_ndx) end do @@ -135,28 +144,14 @@ end function ambient_total_bin_mmr !------------------------------------------------------------------------------ ! returns ambient aerosol mass mixing ratio for a given species index and bin index !------------------------------------------------------------------------------ - subroutine get_ambient_mmr_0list(self, species_ndx, bin_ndx, mmr) - class(modal_aerosol_state), intent(in) :: self - integer, intent(in) :: species_ndx ! species index - integer, intent(in) :: bin_ndx ! bin index - real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) - - call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) - end subroutine get_ambient_mmr_0list - - !------------------------------------------------------------------------------ - ! returns ambient aerosol mass mixing ratio for a given radiation diagnostics - ! list index, species index and bin index - !------------------------------------------------------------------------------ - subroutine get_ambient_mmr_rlist(self, list_ndx, species_ndx, bin_ndx, mmr) + subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) class(modal_aerosol_state), intent(in) :: self - integer, intent(in) :: list_ndx ! rad climate list index 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(list_ndx, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) - end subroutine get_ambient_mmr_rlist + 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 @@ -167,7 +162,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(0, 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%state, self%pbuf, mmr) end subroutine get_cldbrne_mmr !------------------------------------------------------------------------------ @@ -178,7 +173,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(0, bin_ndx, 'a', self%state, self%pbuf, num) + call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'a', self%state, self%pbuf, num) end subroutine get_ambient_num !------------------------------------------------------------------------------ @@ -189,7 +184,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(0, bin_ndx, 'c', self%state, self%pbuf, num) + call rad_cnst_get_mode_num(self%list_idx_, bin_ndx, 'c', self%state, self%pbuf, num) end subroutine get_cldbrne_num !------------------------------------------------------------------------------ @@ -209,7 +204,7 @@ subroutine get_states( self, aero_props, raer, qqcw ) 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(ispc,ibin, raer(indx)%fld) + call self%get_ambient_mmr(species_ndx=ispc, bin_ndx=ibin, mmr=raer(indx)%fld) call self%get_cldbrne_mmr(ispc,ibin, qqcw(indx)%fld) end do end do @@ -233,7 +228,11 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre real(r8) :: sigmag_aitken integer :: i,k - call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + 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 @@ -247,7 +246,7 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre if ( use_preexisting_ice ) then wght(:ncol,:) = 1._r8 else - call rad_cnst_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) + 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 @@ -289,9 +288,13 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u 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_cnst_get_info(0, bin_ndx, mode_type=modetype) + call rad_aer_get_info(0, bin_ndx, mode_type=modetype) select case ( trim(species_type) ) case('dust') @@ -303,7 +306,7 @@ subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, u if ( use_preexisting_ice ) then wght = 1._r8 else - call rad_cnst_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) + 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 @@ -347,7 +350,11 @@ subroutine icenuc_type_wght(self, bin_ndx, ncol, nlev, species_type, aero_props, character(len=aero_name_len) :: modetype - call rad_cnst_get_info(0, bin_ndx, mode_type=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 @@ -415,9 +422,13 @@ function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) 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_cnst_get_info(0, bin_ndx, mode_type=modetype) + call rad_aer_get_info(0, bin_ndx, mode_type=modetype) if (trim(modetype) == 'aitken') then wght(:,:) = 0._r8 @@ -429,9 +440,8 @@ end function hetfrz_size_wght ! returns hygroscopicity for a given radiation diagnostic list number and ! bin number !------------------------------------------------------------------------------ - subroutine hygroscopicity(self, list_ndx, bin_ndx, kappa) + subroutine hygroscopicity(self, bin_ndx, kappa) class(modal_aerosol_state), intent(in) :: self - integer, intent(in) :: list_ndx ! rad climate list number integer, intent(in) :: bin_ndx ! bin number real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) @@ -443,13 +453,13 @@ 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, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + !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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -470,7 +480,7 @@ subroutine water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dgnumwe nmodes = aero_props%nbins() - if (list_idx == 0) then + 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) @@ -491,10 +501,10 @@ subroutine water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dgnumwe qaerwat = -huge(1._r8) return end if - call modal_aero_calcsize_diag(self%state, self%pbuf, list_idx, dgnumdry_m, hygro_m, & + 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, list_idx, dgnumdry_m, dgnumwet_m, & - qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_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) @@ -518,12 +528,11 @@ end subroutine water_uptake !------------------------------------------------------------------------------ ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number !------------------------------------------------------------------------------ - function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -537,9 +546,9 @@ function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) vol(:,:) = 0._r8 - do ispec = 1, aero_props%nspecies(list_idx,bin_idx) - call self%get_ambient_mmr(list_idx, ispec, bin_idx, mmr) - call aero_props%get(bin_idx, ispec, list_ndx=list_idx, density=specdens) + 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 @@ -548,12 +557,11 @@ end function dry_volume !------------------------------------------------------------------------------ ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number !------------------------------------------------------------------------------ - function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -563,8 +571,8 @@ function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) real(r8) :: dryvol(ncol,nlev) real(r8) :: watervol(ncol,nlev) - dryvol = self%dry_volume(aero_props, list_idx, bin_idx, ncol, nlev) - watervol = self%water_volume(aero_props, list_idx, bin_idx, 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 @@ -573,12 +581,11 @@ end function wet_volume !------------------------------------------------------------------------------ ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number !------------------------------------------------------------------------------ - function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + 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) :: list_idx ! rad climate/diags list number integer, intent(in) :: bin_idx ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -588,7 +595,7 @@ function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vo real(r8) :: dgnumwet(ncol,nlev) real(r8) :: qaerwat(ncol,nlev) - call self%water_uptake(aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + call self%water_uptake(aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat) vol(:ncol,:nlev) = qaerwat(:ncol,:nlev)*rh2odens where (vol<0._r8) @@ -600,6 +607,7 @@ 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 ! bin number @@ -619,6 +627,7 @@ end function wet_diameter !------------------------------------------------------------------------------ ! prescribed aerosol activation fraction for convective cloud !------------------------------------------------------------------------------ + !REMOVECAM - direct state%q access and modal_aero_data dependency function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) use modal_aero_data diff --git a/src/chemistry/aerosol/radiative_aerosol.F90 b/src/chemistry/aerosol/radiative_aerosol.F90 new file mode 100644 index 0000000000..0bdaa9410e --- /dev/null +++ b/src/chemistry/aerosol/radiative_aerosol.F90 @@ -0,0 +1,1342 @@ +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_get_call_list +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 + +!================================================================================================ + +subroutine rad_aer_get_call_list(call_list) + use radiative_aerosol_definitions, only: N_DIAG, active_calls + + ! Return info about which climate/diagnostic calculations are requested + + ! Arguments + logical, intent(out) :: call_list(0:N_DIAG) + !----------------------------------------------------------------------------- + + call_list(:) = active_calls(:) + +end subroutine rad_aer_get_call_list + +!================================================================================================ + +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_cam_init, & + resolve_mode_cam_idx, resolve_bin_cam_idx, resolve_bulk_cam_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_cam_init() + + ! Read physical properties from data files + call physprop_init() + + !REMOVECAM: resolve host-specific indices (CAM uses pbuf and state) + call resolve_mode_cam_idx(modes) + call resolve_bin_cam_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_cam_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/chemistry/aerosol/radiative_aerosol_definitions.F90 b/src/chemistry/aerosol/radiative_aerosol_definitions.F90 new file mode 100644 index 0000000000..174f2163c0 --- /dev/null +++ b/src/chemistry/aerosol/radiative_aerosol_definitions.F90 @@ -0,0 +1,1178 @@ +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 + logical :: particle_mr_found + integer :: m + integer :: istat + integer :: nbins, nstr, istr + integer :: mbeg, mcur + integer :: nspec, ispec + integer :: strlen, ibeg, iend, ipos + logical :: part_mr_found + 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 + particle_mr_found = .false. ! keep track of whether particle mixing ratio component is found + 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/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index e1289a8790..e96fa0c59e 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -17,7 +17,7 @@ module refractive_aerosol_optics_mod !! surface mode wet radius and wet refractive index using chebychev polynomials type, extends(aerosol_optics) :: refractive_aerosol_optics - integer :: ibin, ilist + integer :: ibin class(aerosol_state), pointer :: aero_state ! aerosol_state object class(aerosol_properties), pointer :: aero_props ! aerosol_properties object @@ -70,12 +70,11 @@ module refractive_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, crefwsw, crefwlw) & + 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) :: ilist ! climate or a diagnostic list number integer, intent(in) :: ibin ! bin number integer, intent(in) :: ncol ! number of columns integer, intent(in) :: nlev ! number of levels @@ -105,7 +104,7 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, end if ! get mode properties - call aero_props%optics_params(ilist, ibin, & + 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, & @@ -151,11 +150,11 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, end if newobj%crefwsw(:) = crefwsw(:) - call aero_state%water_uptake(aero_props, ilist, ibin, ncol, nlev, dgnumwet, qaerwat) + call aero_state%water_uptake(aero_props, ibin, ncol, nlev, dgnumwet, qaerwat) - nspec = aero_props%nspecies(ilist,ibin) + nspec = aero_props%nspecies(ibin) - logsigma=aero_props%alogsig(ilist,ibin) + logsigma=aero_props%alogsig(ibin) ! calc size parameter for all columns call modal_size_parameters(newobj%ncoef, ncol, nlev, logsigma, dgnumwet, & @@ -164,8 +163,8 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, do ilev = 1, nlev dryvol(:ncol) = 0._r8 do ispec = 1, nspec - call aero_state%get_ambient_mmr(ilist,ispec,ibin,specmmr) - call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens) + 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 @@ -183,7 +182,6 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, newobj%aero_state => aero_state newobj%aero_props => aero_props - newobj%ilist = ilist newobj%ibin = ibin end function constructor @@ -212,7 +210,7 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) type(table_interp_wghts) :: wghtsr(ncol) type(table_interp_wghts) :: wghtsi(ncol) - crefin(:ncol) = self%aero_state%refractive_index_sw(ncol, ilev, self%ilist, self%ibin, iwav, self%aero_props) + 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) @@ -281,7 +279,7 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) type(table_interp_wghts) :: wghtsr(ncol) type(table_interp_wghts) :: wghtsi(ncol) - crefin(:ncol) = self%aero_state%refractive_index_lw(ncol, ilev, self%ilist, self%ibin, iwav, self%aero_props) + 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) diff --git a/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 b/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 index 45227dd363..2ae41a5bcd 100644 --- a/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 @@ -48,11 +48,10 @@ module volcrad_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, geometric_radius) & + 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) :: ilist ! climate or a diagnostic list number integer, intent(in) :: ibin ! bin number integer, intent(in) :: ncols, nlevs real(r8),intent(in) :: geometric_radius(ncols,nlevs) @@ -81,14 +80,14 @@ function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, geometri end if ! optical properties tables - call aero_props%optics_params(ilist, ibin, & + 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(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + call aero_state%get_ambient_mmr(species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) ! NOTE should try to use table_interp_mod utility !!! diff --git a/src/chemistry/carma_aero/aero_model.F90 b/src/chemistry/carma_aero/aero_model.F90 index c41d64d30b..778e8093f6 100644 --- a/src/chemistry/carma_aero/aero_model.F90 +++ b/src/chemistry/carma_aero/aero_model.F90 @@ -19,9 +19,9 @@ module aero_model use chem_mods, only: gas_pcnst, adv_mass use mo_tracname, only: solsym use infnan, only: nan, assignment(=) - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_info_by_bin, & - rad_cnst_get_info_by_bin_spec, rad_cnst_get_bin_props_by_idx, & - rad_cnst_get_bin_mmr_by_idx + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_info_by_bin, rad_aer_get_info_by_bin_spec, & + rad_aer_get_bin_props_by_idx + use aerosol_mmr_cam, only: rad_cnst_get_bin_mmr_by_idx use mo_setsox, only: setsox, has_sox use carma_aerosol_properties_mod, only: carma_aerosol_properties @@ -156,17 +156,17 @@ subroutine aero_model_register() integer :: idx, ierr - call rad_cnst_get_info( 0, nbins=nbins) + call rad_aer_get_info( 0, nbins=nbins) allocate( nspec(nbins), stat=ierr ) if (ierr/=0) call endrun('aero_model_register: allocate error') ! add pbuf fields for interstitial (cloud borne) aerosols in CARMA do m = 1, nbins - call rad_cnst_get_info_by_bin(0, m, num_name=num_name, num_name_cw=num_name_cw, nspec=nspec(m)) + call rad_aer_get_info_by_bin(0, m, num_name=num_name, num_name_cw=num_name_cw, nspec=nspec(m)) call pbuf_add_field(num_name,'global',dtype_r8,(/pcols,pver/), idx) call pbuf_add_field(num_name_cw,'global',dtype_r8,(/pcols,pver/), idx) do l = 1, nspec(m) - call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name_cw=spec_name_cw) + call rad_aer_get_info_by_bin_spec(0, m, l, spec_name_cw=spec_name_cw) call pbuf_add_field(spec_name_cw,'global',dtype_r8,(/pcols,pver/),idx) enddo enddo @@ -230,13 +230,13 @@ subroutine aero_model_init( pbuf2d ) if (is_first_step()) then do m = 1, nbins - call rad_cnst_get_info_by_bin(0, m, num_name=num_name, num_name_cw=num_name_cw) + call rad_aer_get_info_by_bin(0, m, num_name=num_name, num_name_cw=num_name_cw) idx = pbuf_get_index(num_name) call pbuf_set_field(pbuf2d, idx, 0.0_r8) idx = pbuf_get_index(num_name_cw) call pbuf_set_field(pbuf2d, idx, 0.0_r8) do l = 1, nspec(m) - call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name_cw=spec_name_cw) + call rad_aer_get_info_by_bin_spec(0, m, l, spec_name_cw=spec_name_cw) idx = pbuf_get_index(spec_name_cw) call pbuf_set_field(pbuf2d, idx, 0.0_r8) enddo @@ -294,9 +294,9 @@ subroutine aero_model_init( pbuf2d ) bin_idx(m,l) = ii if (l <= nspec(m) ) then ! species - call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name=fieldname(ii), spec_name_cw=fieldname_cw(ii)) + call rad_aer_get_info_by_bin_spec(0, m, l, spec_name=fieldname(ii), spec_name_cw=fieldname_cw(ii)) else !number - call rad_cnst_get_info_by_bin(0, m, num_name=fieldname(ii), num_name_cw=fieldname_cw(ii)) + call rad_aer_get_info_by_bin(0, m, num_name=fieldname(ii), num_name_cw=fieldname_cw(ii)) end if call cnst_get_ind(fieldname(ii), idxtmp, abort=.false.) @@ -613,7 +613,7 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re ! Note: taken here from CARMA pbuf field which may be not any more consistent with changed fields after carma was applied ! Need to add new code that recalcuates dryr and wetr ! get bin info - call rad_cnst_get_info_by_bin(0, m, nspec=nspec(m), bin_name=bin_name) + call rad_aer_get_info_by_bin(0, m, nspec=nspec(m), bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -643,7 +643,7 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re do l = 1, nspec(m) mm = bin_idx(m, l) if (l <= nspec(m)) then - call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, m, l,spectype=spectype) call rad_cnst_get_bin_mmr_by_idx(0, m, l, 'a', state, pbuf, raer(mm)%fld) call rad_cnst_get_bin_mmr_by_idx(0, m, l, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol if (trim(spectype) == 'sulfate') then @@ -762,7 +762,7 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re do l = 1, nspec(m) ! for sulfate only mm = bin_idx(m, l) ! sulfate mass that needs to be added to the total mass - call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, m, l,spectype=spectype) if (trim(spectype) == 'sulfate') then ! only do loop if vmrcw has changed do k=1,pver @@ -854,7 +854,7 @@ subroutine surf_area_dens( state, pbuf, ncol, mmr, beglev, endlev, sad, reff, sf reff = 0._r8 do ibin=1,nbins ! loop over aerosol bins - call rad_cnst_get_info_by_bin(0, ibin, bin_name=bin_name) + call rad_aer_get_info_by_bin(0, ibin, bin_name=bin_name) nchr = len_trim(bin_name)-2 shortname = bin_name(:nchr) @@ -887,7 +887,7 @@ subroutine surf_area_dens( state, pbuf, ncol, mmr, beglev, endlev, sad, reff, sf tot_mass = tot_mass + aer_bin_mmr(icol,ilev) - call rad_cnst_get_bin_props_by_idx(0, ibin, ispec, spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, ibin, ispec, spectype=spectype) if ( trim(spectype) == 'sulfate' .or. & trim(spectype) == 's-organic' .or. & diff --git a/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 b/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 index ed8cf30859..c44fe03704 100644 --- a/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 +++ b/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 @@ -12,8 +12,8 @@ module carma_aero_gasaerexch use chem_mods, only: gas_pcnst use ref_pres, only: top_lev => clim_modal_aero_top_lev use ppgrid, only: pcols, pver - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx, & - rad_cnst_get_info_by_bin_spec + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_info_by_bin, rad_aer_get_bin_props_by_idx, & + rad_aer_get_info_by_bin_spec use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field implicit none @@ -109,14 +109,14 @@ subroutine carma_aero_gasaerexch_init ! get info about the bin aerosols ! get nbins - call rad_cnst_get_info( 0, nbins=nbins) + call rad_aer_get_info( 0, nbins=nbins) allocate( nspec(nbins) ) allocate( cnsoa(nbins) ) allocate( cnpoa(nbins) ) do m = 1, nbins - call rad_cnst_get_info_by_bin(0, m, nspec=nspec(m)) + call rad_aer_get_info_by_bin(0, m, nspec=nspec(m)) end do nspec_max = maxval(nspec) @@ -168,7 +168,7 @@ subroutine carma_aero_gasaerexch_init cnsoa(m) = 0 cnpoa(m) = 0 do l = 1, nspec(m) - call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, m, l,spectype=spectype) if (trim(spectype) == 's-organic') then cnsoa(m) = cnsoa(m) + 1 end if @@ -185,9 +185,9 @@ subroutine carma_aero_gasaerexch_init do m = 1, nbins ns = 0 do l = 1, nspec(m) - call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, m, l,spectype=spectype) if (trim(spectype) == 's-organic') then - call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name=spec_name) + call rad_aer_get_info_by_bin_spec(0, m, l, spec_name=spec_name) ns = ns + 1 dqdtsoa_idx(m,ns) = pbuf_get_index('DQDT_'//trim(spec_name)) end if @@ -238,9 +238,9 @@ subroutine carma_aero_gasaerexch_init do l = 1, nspec(m) ! do through nspec ii = bin_idx(m,l) if (l <= nspec(m) ) then ! species - call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name=fldname(ii) ) + call rad_aer_get_info_by_bin_spec(0, m, l, spec_name=fldname(ii) ) ! only write out SOA exchange here - call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, m, l,spectype=spectype) if (trim(spectype) == 's-organic') then fieldname= trim(fldname(ii)) // '_sfgaex1' long_name = trim(fldname(ii)) // ' gas-aerosol-exchange primary column tendency' @@ -430,7 +430,7 @@ subroutine carma_aero_gasaerexch_sub( state, & nn = 0 do l = 1, nspec(m) mm = bin_idx(m, l) - call rad_cnst_get_bin_props_by_idx(0, m, l, spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, m, l, spectype=spectype) if (trim(spectype) == 's-organic') then n = n + 1 soa_c(:ncol,:,m,n) = raervmr(:ncol,:,mm) @@ -691,7 +691,7 @@ subroutine carma_aero_gasaerexch_sub( state, & j = 0 do l = 1, nspec(m) mm = bin_idx(m,l) - call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, m, l,spectype=spectype) if (trim(spectype) == 's-organic') then j = j + 1 fieldname= trim(fldname(mm)) // '_sfgaex1' diff --git a/src/chemistry/carma_aero/sox_cldaero_mod.F90 b/src/chemistry/carma_aero/sox_cldaero_mod.F90 index 474e594f2c..fead6a2fe8 100644 --- a/src/chemistry/carma_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/carma_aero/sox_cldaero_mod.F90 @@ -14,7 +14,7 @@ module sox_cldaero_mod use phys_control, only : phys_getopts use cldaero_mod, only : cldaero_uptakerate use chem_mods, only : gas_pcnst - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_info_by_bin, rad_aer_get_bin_props_by_idx implicit none private @@ -66,12 +66,12 @@ subroutine sox_cldaero_init ! get info about the modal aerosols ! get nbins - call rad_cnst_get_info( 0, nbins=nbins) + call rad_aer_get_info( 0, nbins=nbins) allocate( nspec(nbins) ) do m = 1, nbins - call rad_cnst_get_info_by_bin(0, m, nspec=nspec(m)) + call rad_aer_get_info_by_bin(0, m, nspec=nspec(m)) end do ! add plus one to include number, total mmr and nspec nspec_max = maxval(nspec) @@ -146,7 +146,7 @@ function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( do m = 1, nbins do l = 1, nspec(m) mm = bin_idx(m, l) - call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, m, l,spectype=spectype) if (trim(spectype) == 'sulfate') then so4mmr(i,k) = so4mmr(i,k) + qcw(i,k,mm) end if @@ -261,7 +261,7 @@ subroutine sox_cldaero_update( & aqso4_o3 = 0.0_r8 do n = 1, nbins - call rad_cnst_get_info_by_bin(0, n, nspec=nspec(n), bin_name=bin_name) + call rad_aer_get_info_by_bin(0, n, nspec=nspec(n), bin_name=bin_name) nchr = len_trim(bin_name)-2 @@ -347,7 +347,7 @@ subroutine sox_cldaero_update( & do n = 1, nbins do l = 1, nspec(n) mm = bin_idx(n, l) - call rad_cnst_get_bin_props_by_idx(0, n, l,spectype=spectype) + call rad_aer_get_bin_props_by_idx(0, n, l,spectype=spectype) if (trim(spectype) == 'sulfate') then if (faqgain_so4(n) .gt. 0.0_r8) then dqdt_aqso4(i,k,mm) = faqgain_so4(n)*dso4dt_aqrxn*cldfrc(i,k) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 6e080c004d..adf71a332a 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -202,7 +202,7 @@ subroutine chem_register use aero_model, only : aero_model_register use modal_aero_data, only : nspec_max use modal_aero_data, only : ntot_amode, nspec_amode - use rad_constituents, only : rad_cnst_get_info + use radiative_aerosol, only : rad_aer_get_info #endif ! GEOS-Chem interface modules in CAM @@ -578,7 +578,7 @@ subroutine chem_register DO M = 1, ntot_amode DO L = 1, nspec_amode(M) - call rad_cnst_get_info(0,M,L,spec_name=aername) + call rad_aer_get_info(0,M,L,spec_name=aername) SELECT CASE ( to_upper(aername(:3)) ) CASE ( 'BC_' ) SELECT CASE ( to_upper(aername(4:5)) ) @@ -1937,7 +1937,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p use phys_grid, only : get_area_all_p, get_lat_all_p, get_lon_all_p use physconst, only : MWDry, Gravit - use rad_constituents, only : rad_cnst_get_info + use radiative_aerosol, only : rad_aer_get_info use short_lived_species, only : get_short_lived_species_gc, set_short_lived_species_gc use spmd_utils, only : masterproc use time_manager, only : Get_Curr_Calday, Get_Curr_Date ! For computing SZA @@ -2344,7 +2344,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) if (usePrescribedAerDistribution) then ! do not zero out sulfate aerosol here since aerosol distribution for sulfate ! will be prescribed (hplin, 5/9/23) - call rad_cnst_get_info(0,M,SM,spec_name=aerName) + call rad_aer_get_info(0,M,SM,spec_name=aerName) IF ( to_upper(aerName(:3)) == "SO4" ) CYCLE end if @@ -2366,7 +2366,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) if (usePrescribedAerDistribution) then ! do not zero out sulfate aerosol here since aerosol distribution for sulfate ! will be prescribed (hplin, 5/9/23) - call rad_cnst_get_info(0,M,SM,spec_name=aerName) + call rad_aer_get_info(0,M,SM,spec_name=aerName) IF ( to_upper(aerName(:3)) == "SO4" ) CYCLE end if diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index 07ca0d84bc..6e450ab2b4 100644 --- a/src/chemistry/modal_aero/aero_model.F90 +++ b/src/chemistry/modal_aero/aero_model.F90 @@ -178,7 +178,7 @@ subroutine aero_model_init( pbuf2d ) use mo_chem_utls, only: get_spc_ndx use modal_aero_data, only: cnst_name_cw use modal_aero_data, only: modal_aero_data_init - use rad_constituents,only: rad_cnst_get_info + use radiative_aerosol,only: rad_aer_get_info use dust_model, only: dust_init, dust_names, dust_active, dust_nbin, dust_nnum use seasalt_model, only: seasalt_init, seasalt_names, seasalt_active,seasalt_nbin use aer_drydep_mod, only: inidrydep @@ -234,7 +234,7 @@ subroutine aero_model_init( pbuf2d ) history_cesm_forcing_out=history_cesm_forcing, & history_dust_out=history_dust) - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_aer_get_info(0, nmodes=nmodes) call modal_aero_data_init(pbuf2d) call modal_aero_bcscavcoef_init() @@ -502,10 +502,10 @@ subroutine aero_model_init( pbuf2d ) ! for surf_area_dens ! define indices associated with the various aerosol types do n = 1,nmodes - call rad_cnst_get_info(0, n, mode_type=mode_type, nspec=nspec) + call rad_aer_get_info(0, n, mode_type=mode_type, nspec=nspec) if ( trim(mode_type) /= 'primary_carbon') then ! ignore the primary_carbon mode do l = 1, nspec - call rad_cnst_get_info(0, n, l, spec_type=spec_type, spec_name=spec_name) + call rad_aer_get_info(0, n, l, spec_type=spec_type, spec_name=spec_name) index_tot_mass(n,l) = get_spc_ndx(spec_name) if ( trim(spec_type) == 'sulfate' .or. & trim(spec_type) == 's-organic' .or. & diff --git a/src/chemistry/modal_aero/dust_model.F90 b/src/chemistry/modal_aero/dust_model.F90 index f2b9ff4bc7..ad85a0bbfd 100644 --- a/src/chemistry/modal_aero/dust_model.F90 +++ b/src/chemistry/modal_aero/dust_model.F90 @@ -105,12 +105,14 @@ end subroutine dust_readnl subroutine dust_init() use soil_erod_mod, only: soil_erod_init use constituents, only: cnst_get_ind - use rad_constituents, only: rad_cnst_get_info + use aerosol_instances_mod, only: aerosol_instances_get_props, aerosol_instances_get_num_models + use aerosol_properties_mod, only: aerosol_properties use dust_common, only: dust_set_params - integer :: l, m, mm, ndx, nspec + integer :: l, m, mm, ndx, nspec, iaermod character(len=32) :: spec_name integer, parameter :: mymodes(7) = (/ 2, 1, 3, 4, 5, 6, 7 /) ! tricky order ... + class(aerosol_properties), pointer :: aero_props_modal dust_nbin = ndst dust_nnum = ndst @@ -143,12 +145,20 @@ subroutine dust_init() endif ! dmleung -- + ! Find modal properties object from factory + aero_props_modal => null() + do iaermod = 1, aerosol_instances_get_num_models() + aero_props_modal => aerosol_instances_get_props(iaermod, 0) + if (aero_props_modal%model_is('MAM')) exit + aero_props_modal => null() + end do + ndx = 0 do mm = 1, ntot_amode m = mymodes(mm) - call rad_cnst_get_info(0, m, nspec=nspec) + nspec = aero_props_modal%nspecies(m) do l = 1, nspec - call rad_cnst_get_info(0, m, l, spec_name=spec_name ) + call aero_props_modal%get(m, l, specname=spec_name) if (spec_name(:3) == 'dst') then ndx=ndx+1 dust_names(ndx) = spec_name diff --git a/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 index d45b0d46af..8b36461075 100644 --- a/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +++ b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 @@ -98,7 +98,7 @@ subroutine modal_aero_gasaerexch_sub( & use modal_aero_data, only: lptr_so4_a_amode,lptr_nh4_a_amode use modal_aero_data, only: modeptr_pcarbon,nspec_amode,specmw_amode,specdens_amode use modal_aero_rename, only: modal_aero_rename_sub -use rad_constituents, only: rad_cnst_get_info +use radiative_aerosol, only: rad_aer_get_info use constituents, only: pcnst, cnst_mw use cam_history, only: outfld, fieldname_len @@ -599,7 +599,7 @@ subroutine modal_aero_gasaerexch_sub( & ! get molecular weight from the host model do n = 1, ntot_amode do l = 1, nspec_amode(n) - call rad_cnst_get_info(0, n, l, spec_type=spec_type ) + call rad_aer_get_info(0, n, l, spec_type=spec_type ) select case( spec_type ) case('s-organic') mw_soa_host(:) = specmw_amode(l,n) diff --git a/src/chemistry/modal_aero/modal_aero_rename.F90 b/src/chemistry/modal_aero/modal_aero_rename.F90 index 9ff3a2c87d..4482cf6def 100644 --- a/src/chemistry/modal_aero/modal_aero_rename.F90 +++ b/src/chemistry/modal_aero/modal_aero_rename.F90 @@ -23,7 +23,7 @@ module modal_aero_rename use modal_aero_data, only: modeptr_stracoar use modal_aero_data, only: specmw_amode, specdens_amode, lmassptr_amode, lmassptrcw_amode, numptr_amode, numptrcw_amode use modal_aero_data, only: dgnumhi_amode, dgnumlo_amode, cnst_name_cw, modeptr_aitken - use rad_constituents,only: rad_cnst_get_mode_idx + use radiative_aerosol,only: rad_aer_get_mode_idx implicit none private @@ -109,7 +109,7 @@ subroutine modal_aero_rename_init(modal_accum_coarse_exch_in) ! 3001 = coarse --> accum ! 1005 = accum --> stracoar ! 5001 = stracoar --> accum - if( rad_cnst_get_mode_idx(0,'coarse_strat') > 0 ) then + if( rad_aer_get_mode_idx(0,'coarse_strat') > 0 ) then ipair_select_renamexf(1:maxpair_renamexf) = (/ 2001, 1005, 5001 /) else ipair_select_renamexf(1:maxpair_renamexf) = (/ 2001, 1003, 3001 /) diff --git a/src/chemistry/modal_aero/seasalt_model.F90 b/src/chemistry/modal_aero/seasalt_model.F90 index da917ad525..565348787c 100644 --- a/src/chemistry/modal_aero/seasalt_model.F90 +++ b/src/chemistry/modal_aero/seasalt_model.F90 @@ -34,22 +34,32 @@ module seasalt_model subroutine seasalt_init(seasalt_emis_scale) use sslt_sections, only: sslt_sections_init use constituents, only: cnst_get_ind - use rad_constituents, only: rad_cnst_get_info + use aerosol_instances_mod, only: aerosol_instances_get_props, aerosol_instances_get_num_models + use aerosol_properties_mod, only: aerosol_properties real(r8), intent(in) :: seasalt_emis_scale - integer :: m, l, nspec, ndx + integer :: m, l, nspec, ndx, iaermod character(len=32) :: spec_name + class(aerosol_properties), pointer :: aero_props_modal seasalt_nbin = nslt seasalt_nnum = nslt allocate(seasalt_names(2*nslt)) allocate(seasalt_indices(2*nslt)) + ! Find modal properties object from factory + aero_props_modal => null() + do iaermod = 1, aerosol_instances_get_num_models() + aero_props_modal => aerosol_instances_get_props(iaermod, 0) + if (aero_props_modal%model_is('MAM')) exit + aero_props_modal => null() + end do + ndx=0 do m = 1, ntot_amode - call rad_cnst_get_info(0, m, nspec=nspec) + nspec = aero_props_modal%nspecies(m) do l = 1, nspec - call rad_cnst_get_info(0, m, l, spec_name=spec_name ) + call aero_props_modal%get(m, l, specname=spec_name) if (spec_name(:3) == 'ncl') then ndx=ndx+1 seasalt_names(ndx) = spec_name diff --git a/src/chemistry/mozart/fire_emissions.F90 b/src/chemistry/mozart/fire_emissions.F90 index 301c5af9f6..54204499f6 100644 --- a/src/chemistry/mozart/fire_emissions.F90 +++ b/src/chemistry/mozart/fire_emissions.F90 @@ -13,7 +13,8 @@ module fire_emissions use cam_logfile, only : iulog use ppgrid, only : pver, pverp use constituents, only : cnst_get_ind - use rad_constituents, only : rad_cnst_get_aer_props, rad_cnst_num_name + use aerosol_instances_mod, only: aerosol_instances_get_props, aerosol_instances_get_num_models + use aerosol_properties_mod, only: aerosol_properties, aero_name_len use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx use chem_mods, only : adv_mass ! g/mole use infnan, only : nan, assignment(=) @@ -52,9 +53,11 @@ subroutine fire_emissions_init() integer :: n, ii integer :: frc_ndx, spc_ndx - integer :: mode, spec + integer :: mode, spec, iaermod, m, l character(len=16) :: name character(len=32) :: num_name + character(len=aero_name_len) :: spec_name_tmp + class(aerosol_properties), pointer :: aero_props_modal real(r8), parameter :: demis_acc = 0.134e-6_r8 ! meters ! volume-mean emissions diameter of primary BC/OM aerosols, see : @@ -70,6 +73,14 @@ subroutine fire_emissions_init() if (shr_fire_emis_mechcomps_n<1) return + ! Find modal properties object from factory + aero_props_modal => null() + do iaermod = 1, aerosol_instances_get_num_models() + aero_props_modal => aerosol_instances_get_props(iaermod, 0) + if (aero_props_modal%model_is('MAM')) exit + aero_props_modal => null() + end do + if (shr_fire_emis_elevated) then ! initialize elevated forcings allocate( frc_spc_map(shr_fire_emis_mechcomps_n) ) @@ -116,15 +127,30 @@ subroutine fire_emissions_init() spc_mass_factor(n) = 1.e-6_r8 * avogad / adv_mass(spc_ndx) ! 1.e-6 converts m-3 to cm-3. ! (molecules/kmole) / (g/mole) --> molecules/kg - ! for MAM need to include cooresponding forcings of number densities - - found = rad_cnst_num_name(0, name, num_name, mode_out=mode, spec_out=spec ) + ! for MAM need to include corresponding forcings of number densities + + found = .false. + if (associated(aero_props_modal)) then + do m = 1, aero_props_modal%nbins() + do l = 1, aero_props_modal%nspecies(m) + call aero_props_modal%get(m, l, specname=spec_name_tmp) + if (trim(spec_name_tmp) == trim(name)) then + call aero_props_modal%amb_num_name(m, num_name) + mode = m + spec = l + found = .true. + exit + end if + end do + if (found) exit + end do + end if if ( found ) then frc_ndx = get_extfrc_ndx( num_name ) - call rad_cnst_get_aer_props(0, mode, spec, density_aer=specdens) + call aero_props_modal%get(mode, spec, density=specdens) frc_num_map(n) = frc_ndx num_mass_factor(n) = x_numfact / specdens diff --git a/src/chemistry/mozart/mo_usrrxt.F90 b/src/chemistry/mozart/mo_usrrxt.F90 index 837401dea0..432c4038f1 100644 --- a/src/chemistry/mozart/mo_usrrxt.F90 +++ b/src/chemistry/mozart/mo_usrrxt.F90 @@ -797,7 +797,7 @@ subroutine usrrxt( state, rxt, temp, tempi, tempe, invariants, h2ovmr, use physics_types, only : physics_state use carma_flags_mod, only : carma_hetchem_feedback use aero_model, only : aero_model_surfarea - use rad_constituents,only : rad_cnst_get_info + use radiative_aerosol,only : rad_aer_get_info use time_manager, only : get_curr_calday use infnan, only : nan use mo_slh_routines, only : SSAdehal_ScalingFactor, SSAhno3_ScalingFactor, SSAn2o5_ScalingFactor, & @@ -1078,8 +1078,8 @@ subroutine usrrxt( state, rxt, temp, tempi, tempe, invariants, h2ovmr, ! get info about the modal aerosols ! get ntot_amode - call rad_cnst_get_info(0, nmodes=ntot_amode) - call rad_cnst_get_info(0, nbins=nbins) + call rad_aer_get_info(0, nmodes=ntot_amode) + call rad_aer_get_info(0, nbins=nbins) if (ntot_amode>0.and.nbins>0) then call endrun(subname // ':: ERROR running with MAM and CARMA simultaneously not supported.') diff --git a/src/chemistry/utils/modal_aero_calcsize.F90 b/src/chemistry/utils/modal_aero_calcsize.F90 index 7fcb00390e..696713af1e 100644 --- a/src/chemistry/utils/modal_aero_calcsize.F90 +++ b/src/chemistry/utils/modal_aero_calcsize.F90 @@ -11,8 +11,8 @@ module modal_aero_calcsize use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field use phys_control, only: phys_getopts -use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & - rad_cnst_get_mode_props, rad_cnst_get_mode_num +use aerosol_properties_mod, only: aerosol_properties +use aerosol_state_mod, only: aerosol_state use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -72,11 +72,11 @@ module modal_aero_calcsize subroutine modal_aero_calcsize_reg() use physics_buffer, only: pbuf_add_field, dtype_r8 - use rad_constituents, only: rad_cnst_get_info + use radiative_aerosol, only: rad_aer_get_info integer :: nmodes - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_aer_get_info(0, nmodes=nmodes) call pbuf_add_field('DGNUM', 'global', dtype_r8, (/pcols, pver, nmodes/), dgnum_idx) @@ -264,8 +264,8 @@ end subroutine modal_aero_calcsize_init !=============================================================================== -subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, & - do_aitacc_transfer_in) +subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, aero_props, aero_state, & + do_adjust_in, do_aitacc_transfer_in) !----------------------------------------------------------------------- ! @@ -289,6 +289,8 @@ subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, & real(r8), intent(in) :: deltat ! model time-step size (s) type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + class(aerosol_properties), intent(in), target :: aero_props + class(aerosol_state), intent(in) :: aero_state logical, optional :: do_adjust_in logical, optional :: do_aitacc_transfer_in @@ -1187,7 +1189,7 @@ subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, & end do ! jac = ... end do ! iq = ... - call modal_aero_calcdry(state, pbuf) + call modal_aero_calcdry(state, pbuf, aero_props, aero_state) #endif @@ -1197,23 +1199,24 @@ end subroutine modal_aero_calcsize_sub !---------------------------------------------------------------------- -subroutine modal_aero_calcsize_diag(state, pbuf, list_idx_in, dgnum_m, & +subroutine modal_aero_calcsize_diag(state, pbuf, aero_props, aero_state, dgnum_m, & hygro_m, dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) !----------------------------------------------------------------------- ! - ! Calculate aerosol size distribution parameters + ! Calculate aerosol size distribution parameters ! ! ***N.B.*** DGNUM for the modes in the climate list are put directly into ! the physics buffer. For diagnostic list calculations use the - ! optional list_idx and dgnum args. + ! optional dgnum_m args. !----------------------------------------------------------------------- ! arguments type(physics_state), intent(in), target :: state ! Physics state variables type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + class(aerosol_properties), intent(in), target :: aero_props + class(aerosol_state), intent(in), target :: aero_state - integer, optional, intent(in) :: list_idx_in ! diagnostic list index real(r8), optional, pointer :: dgnum_m(:,:,:) ! interstital aerosol dry number mode radius (m) real(r8), optional, pointer :: hygro_m(:,:,:) real(r8), optional, pointer :: dryvol_m(:,:,:) @@ -1255,10 +1258,9 @@ subroutine modal_aero_calcsize_diag(state, pbuf, list_idx_in, dgnum_m, & lchnk = state%lchnk ncol = state%ncol - list_idx = 0 ! climate list by default - if (present(list_idx_in)) list_idx = list_idx_in + list_idx = aero_props%list_idx() - call rad_cnst_get_info(list_idx, nmodes=nmodes) + nmodes = aero_props%nbins() if (list_idx /= 0) then if (.not. present(dgnum_m)) then @@ -1335,22 +1337,24 @@ subroutine modal_aero_calcsize_diag(state, pbuf, list_idx_in, dgnum_m, & end if ! get mode properties - call rad_cnst_get_mode_props(list_idx, n, dgnum=dgnum, dgnumhi=dgnumhi, dgnumlo=dgnumlo, & - sigmag=sigmag) + dgnum = aero_props%dgnum(n) + dgnumhi = aero_props%dgnumhi(n) + dgnumlo = aero_props%dgnumlo(n) + sigmag = exp(aero_props%alogsig(n)) ! get mode number mixing ratio - call rad_cnst_get_mode_num(list_idx, n, 'a', state, pbuf, mode_num) + call aero_state%get_ambient_num(n, mode_num) dgncur_a(:,:) = dgnum dryvol_a(:,:) = 0.0_r8 - ! compute dry volume mixrats = + ! compute dry volume mixrats = ! sum_over_components{ component_mass mixrat / density } - call rad_cnst_get_info(list_idx, n, nspec=nspec) + nspec = aero_props%nspecies(n) do l1 = 1, nspec - call rad_cnst_get_aer_mmr(list_idx, n, l1, 'a', state, pbuf, specmmr) - call rad_cnst_get_aer_props(list_idx, n, l1, density_aer=specdens) + call aero_state%get_ambient_mmr(species_ndx=l1, bin_ndx=n, mmr=specmmr) + call aero_props%get(n, l1, density=specdens) ! need qmass*dummwdens = (kg/kg-air) * [1/(kg/m3)] = m3/kg-air dummwdens = 1.0_r8 / specdens @@ -1394,15 +1398,16 @@ subroutine modal_aero_calcsize_diag(state, pbuf, list_idx_in, dgnum_m, & end do ! nmodes - call modal_aero_calcdry(state, pbuf, list_idx_in, dgnum_m, hygro_m, dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) + call modal_aero_calcdry(state, pbuf, aero_props, aero_state, dgnum_m, hygro_m, dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) end subroutine modal_aero_calcsize_diag -subroutine modal_aero_calcdry(state, pbuf, list_idx_in, dgnumdry_m, hygro_m, dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) +subroutine modal_aero_calcdry(state, pbuf, aero_props, aero_state, dgnumdry_m, hygro_m, dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) type(physics_state), target, intent(in) :: state ! Physics state variables type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer - integer, optional, intent(in) :: list_idx_in ! diagnostic list index + class(aerosol_properties), intent(in), target :: aero_props + class(aerosol_state), intent(in), target :: aero_state real(r8), optional, pointer :: dgnumdry_m(:,:,:) real(r8), optional, pointer :: hygro_m(:,:,:) real(r8), optional, pointer :: dryvol_m(:,:,:) @@ -1417,7 +1422,7 @@ subroutine modal_aero_calcdry(state, pbuf, list_idx_in, dgnumdry_m, hygro_m, dry real(r8), pointer :: maer(:,:) ! aerosol wet mass MR (including water) (kg/kg-air) real(r8), pointer :: hygro(:,:,:) ! volume-weighted mean hygroscopicity (--) real(r8), pointer :: dryvol(:,:,:) ! single-particle-mean dry volume (m3) - real(r8), pointer :: dryrad(:,:,:) ! dry volume mean radius of aerosol (m) + real(r8), pointer :: dryrad(:,:,:) ! dry volume mean radius of aerosol (m) real(r8), pointer :: drymass(:,:,:) ! single-particle-mean dry mass (kg) real(r8), pointer :: so4dryvol(:,:,:) ! single-particle-mean so4 dry volume (m3) real(r8), pointer :: naer(:,:,:) ! aerosol number MR (bounded!) (#/kg-air) @@ -1446,13 +1451,13 @@ subroutine modal_aero_calcdry(state, pbuf, list_idx_in, dgnumdry_m, hygro_m, dry integer :: nspec + lchnk = state%lchnk ncol = state%ncol - list_idx = 0 - if (present(list_idx_in)) then - list_idx = list_idx_in + list_idx = aero_props%list_idx() + if (list_idx /= 0) then ! check that all optional args are present if (.not. present(dgnumdry_m)) then call endrun('modal_aero_calcdry called for'// & @@ -1467,7 +1472,7 @@ subroutine modal_aero_calcdry(state, pbuf, list_idx_in, dgnumdry_m, hygro_m, dry end if ! loop over all aerosol modes - call rad_cnst_get_info(list_idx, nmodes=nmodes) + nmodes = aero_props%nbins() allocate( maer(pcols,pver)) @@ -1499,17 +1504,17 @@ subroutine modal_aero_calcdry(state, pbuf, list_idx_in, dgnumdry_m, hygro_m, dry so4dryvolmr(:,:) = 0._r8 ! get mode properties - call rad_cnst_get_mode_props(list_idx, m, sigmag=sigmag) + sigmag = exp(aero_props%alogsig(m)) ! get mode info - call rad_cnst_get_info(list_idx, m, nspec=nspec) + nspec = aero_props%nspecies(m) do l = 1, nspec ! get species interstitial mixing ratio ('a') - call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, raer) - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & - hygro_aer=spechygro, spectype=spectype) + call aero_state%get_ambient_mmr(species_ndx=l, bin_ndx=m, mmr=raer) + call aero_props%get(m, l, density=specdens, & + hygro=spechygro, spectype=spectype) if (l == 1) then ! save off these values to be used as defaults @@ -1582,7 +1587,6 @@ subroutine modal_aero_calcdry(state, pbuf, list_idx_in, dgnumdry_m, hygro_m, dry deallocate( maer) - end subroutine modal_aero_calcdry !---------------------------------------------------------------------- diff --git a/src/chemistry/utils/modal_aero_deposition.F90 b/src/chemistry/utils/modal_aero_deposition.F90 index 6f6f854d7e..352b43ba25 100644 --- a/src/chemistry/utils/modal_aero_deposition.F90 +++ b/src/chemistry/utils/modal_aero_deposition.F90 @@ -21,7 +21,8 @@ module modal_aero_deposition use camsrfexch, only: cam_out_t use constituents, only: cnst_get_ind, pcnst use cam_abortutils, only: endrun -use rad_constituents, only: rad_cnst_get_info +use aerosol_instances_mod, only: aerosol_instances_get_props, aerosol_instances_get_num_models +use aerosol_properties_mod, only: aerosol_properties, aero_name_len implicit none private @@ -293,24 +294,37 @@ subroutine get_indices( type, modes, indices, count ) integer, intent(out) :: indices(:) integer, intent(out) :: count - integer :: l, n, ndx, nmodes, nspec - character(len=32) :: spec_type, spec_name, mode_type + integer :: l, n, ndx, nmodes, nspec, iaermod + character(len=aero_name_len) :: spec_type, spec_name, mode_type + class(aerosol_properties), pointer :: aero_props_modal - call rad_cnst_get_info(0, nmodes=nmodes) + ! Find modal properties object from factory + aero_props_modal => null() + do iaermod = 1, aerosol_instances_get_num_models() + aero_props_modal => aerosol_instances_get_props(iaermod, 0) + if (aero_props_modal%model_is('MAM')) exit + aero_props_modal => null() + end do count = 0 indices(:) = -1 + if (.not. associated(aero_props_modal)) return + + nmodes = aero_props_modal%nbins() + if (nmodes==7) return ! historically turned off for mam7 do n = 1, nmodes - call rad_cnst_get_info(0, n, mode_type=mode_type, nspec=nspec) + mode_type = aero_props_modal%bin_name(n) + nspec = aero_props_modal%nspecies(n) if ( any(modes==trim(mode_type)) ) then do l = 1,nspec - call rad_cnst_get_info(0, n, l, spec_type=spec_type, spec_name=spec_name) + call aero_props_modal%species_type(n, l, spectype=spec_type) + call aero_props_modal%get(n, l, specname=spec_name) call cnst_get_ind(spec_name, ndx, abort=.false.) if (ndx>0) then if (trim(spec_type) == trim(type)) then diff --git a/src/chemistry/utils/modal_aero_wateruptake.F90 b/src/chemistry/utils/modal_aero_wateruptake.F90 index f00ed05cda..9a0b03697b 100644 --- a/src/chemistry/utils/modal_aero_wateruptake.F90 +++ b/src/chemistry/utils/modal_aero_wateruptake.F90 @@ -9,8 +9,8 @@ module modal_aero_wateruptake use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field use wv_saturation, only: qsat_water -use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & - rad_cnst_get_mode_props +use aerosol_properties_mod, only: aerosol_properties +use aerosol_state_mod, only: aerosol_state use cam_history, only: addfld, add_default, outfld, horiz_only use cam_logfile, only: iulog use ref_pres, only: top_lev => clim_modal_aero_top_lev @@ -57,11 +57,11 @@ module modal_aero_wateruptake subroutine modal_aero_wateruptake_reg() use physics_buffer, only: pbuf_add_field, dtype_r8 - use rad_constituents, only: rad_cnst_get_info + use radiative_aerosol, only: rad_aer_get_info integer :: nmodes - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_aer_get_info(0, nmodes=nmodes) call pbuf_add_field('DGNUMWET', 'global', dtype_r8, (/pcols, pver, nmodes/), dgnumwet_idx) call pbuf_add_field('WETDENS_AP', 'physpkg', dtype_r8, (/pcols, pver, nmodes/), wetdens_ap_idx) @@ -82,6 +82,7 @@ subroutine modal_aero_wateruptake_init(pbuf2d) use time_manager, only: is_first_step use physics_buffer,only: pbuf_set_field use infnan, only : nan, assignment(=) + use radiative_aerosol, only: rad_aer_get_info type(physics_buffer_desc), pointer :: pbuf2d(:,:) real(r8) :: real_nan @@ -106,7 +107,7 @@ subroutine modal_aero_wateruptake_init(pbuf2d) ! assume for now that will compute wateruptake for climate list modes only - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_aer_get_info(0, nmodes=nmodes) do m = 1, nmodes write(trnum, '(i3.3)') m @@ -160,7 +161,8 @@ end subroutine modal_aero_wateruptake_init !=============================================================================== -subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnumwet_m, & +subroutine modal_aero_wateruptake_dr(state, pbuf, aero_props, aero_state, & + dgnumdry_m, dgnumwet_m, & qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, drymass_m,& so4dryvol_m, naer_m) !----------------------------------------------------------------------- @@ -168,19 +170,21 @@ subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnum ! CAM specific driver for modal aerosol water uptake code. ! ! *** N.B. *** The calculation has been enabled for diagnostic mode lists -! via optional arguments. If the list_idx arg is present then -! all the optional args must be present. +! via optional arguments. For diagnostic list calculations +! all the optional array args must be present. ! !----------------------------------------------------------------------- use time_manager, only: is_first_step use cam_history, only: outfld, fieldname_len use tropopause, only: tropopause_find_cam, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + ! Arguments type(physics_state), target, intent(in) :: state ! Physics state variables type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + class(aerosol_properties), intent(in), target :: aero_props + class(aerosol_state), intent(in), target :: aero_state - integer, optional, intent(in) :: list_idx_in real(r8), optional, pointer :: dgnumdry_m(:,:,:) real(r8), optional, pointer :: dgnumwet_m(:,:,:) real(r8), optional, pointer :: qaerwat_m(:,:,:) @@ -260,15 +264,15 @@ subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnum character(len=3) :: trnum ! used to hold mode number (as characters) character(len=32) :: spectype + !----------------------------------------------------------------------- lchnk = state%lchnk ncol = state%ncol - list_idx = 0 - if (present(list_idx_in)) then - list_idx = list_idx_in + list_idx = aero_props%list_idx() + if (list_idx /= 0) then ! check that all optional args are present if (.not. present(dgnumdry_m) .or. .not. present(dgnumwet_m) .or. & .not. present(qaerwat_m) .or. .not. present(wetdens_m)) then @@ -290,7 +294,7 @@ subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnum end if ! loop over all aerosol modes - call rad_cnst_get_info(list_idx, nmodes=nmodes) + nmodes = aero_props%nbins() if (modal_strat_sulfate) then call pbuf_get_field(pbuf, sulfeq_idx, sulfeq ) @@ -355,20 +359,21 @@ subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnum do m = 1, nmodes - call rad_cnst_get_mode_props(list_idx, m, sigmag=sigmag, & - rhcrystal=rhcrystal(m), rhdeliques=rhdeliques(m)) + sigmag = exp(aero_props%alogsig(m)) + rhcrystal(m) = aero_props%rhcrystal(m) + rhdeliques(m) = aero_props%rhdeliques(m) ! get mode info - call rad_cnst_get_info(list_idx, m, nspec=nspec) + nspec = aero_props%nspecies(m) do l = 1, nspec ! accumulate the aerosol masses of each mode - call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, raer) + call aero_state%get_ambient_mmr(species_ndx=l, bin_ndx=m, mmr=raer) maer(:ncol,:,m)= maer(:ncol,:,m) + raer(:ncol,:) ! get species interstitial mixing ratio ('a') - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & + call aero_props%get(m, l, density=specdens, & spectype=spectype) if (modal_strat_sulfate .and. (trim(spectype).eq.'sulfate')) then @@ -518,6 +523,7 @@ subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnum deallocate(maer, alnsg) deallocate( & wetrad, wetvol, wtrvol, wtpct, sulden, rhcrystal, rhdeliques, specdens_1 ) + end subroutine modal_aero_wateruptake_dr !=============================================================================== diff --git a/src/chemistry/utils/prescribed_aero.F90 b/src/chemistry/utils/prescribed_aero.F90 index 6b5759edff..95b7728c88 100644 --- a/src/chemistry/utils/prescribed_aero.F90 +++ b/src/chemistry/utils/prescribed_aero.F90 @@ -178,12 +178,12 @@ subroutine prescribed_aero_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit use mpishorthand - use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not + use aerosol_instances_mod, only: aerosol_instances_is_active character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables - integer :: unitn, ierr, nmodes, aero_loop_end + integer :: unitn, ierr, aero_loop_end logical :: skip_spec character(len=*), parameter :: subname = 'prescribed_aero_readnl' @@ -266,8 +266,7 @@ subroutine prescribed_aero_readnl(nlfile) if ( .not. has_prescribed_aero) return ! Determine whether its a 'modal' aerosol simulation or not - call rad_cnst_get_info(0, nmodes=nmodes) - clim_modal_aero = (nmodes > 0) + clim_modal_aero = aerosol_instances_is_active('modal') ! For modal aerosols, interstitial species(*_a) are diagnosed from ! their *_logm and *_logv counterparts (e.g. soa_a1 is diagnosed from diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 435c94f7b1..82ad64e388 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -13,8 +13,8 @@ module aer_rad_props use physics_buffer, only: physics_buffer_desc use radconstants, only: nswbands, nlwbands, idx_sw_diag use phys_prop, only: nrh, ot_length -use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, & - rad_cnst_get_aer_props +use aerosol_instances_mod, only: aerosol_instances_get_num_models, & + aerosol_instances_is_active use wv_saturation, only: qsat use aerosol_optics_cam,only: aerosol_optics_cam_init, aerosol_optics_cam_sw, aerosol_optics_cam_lw use cam_history, only: fieldname_len, addfld, outfld, add_default, horiz_only @@ -48,12 +48,9 @@ module aer_rad_props subroutine aer_rad_props_init() use phys_control, only: phys_getopts - integer :: numaerosols ! number of aerosols logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_aero_optics ! Output aerosol optics diagnostics logical :: history_dust ! Output dust diagnostics - integer :: nmodes ! number of aerosol modes - integer :: nbins ! number of aerosol bins character(len=2) :: numch integer :: i @@ -71,9 +68,6 @@ subroutine aer_rad_props_init() ! Contributions to AEROD_v from individual aerosols (climate species). - ! number of bulk aerosols in climate list - call rad_cnst_get_info(0, naero=numaerosols, nmodes=nmodes, nbins=nbins) - call aer_vis_diag_init() ! Determine default fields @@ -81,11 +75,11 @@ subroutine aer_rad_props_init() call add_default ('AEROD_v', 1, ' ') endif - if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then + if (aerosol_instances_get_num_models() > 0) then call aerosol_optics_cam_init() endif - bam_debug = numaerosols>0 .and. history_aero_optics + bam_debug = aerosol_instances_is_active('bulk') .and. history_aero_optics ! for BAM debugging if (bam_debug) then @@ -146,9 +140,6 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & integer :: lchnk integer :: troplev(pcols) - integer :: numaerosols ! number of bulk aerosols in climate/diagnostic list - integer :: nmodes ! number of aerosol modes in climate/diagnostic list - integer :: nbins ! number of aerosol bins in climate/diagnostic list integer :: i !----------------------------------------------------------------------------- @@ -162,11 +153,8 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & tau_w_g(1:ncol,:,:) = 0._r8 tau_w_f(1:ncol,:,:) = 0._r8 - ! get number of bulk aerosols and number of modes in current list - call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes, nbins=nbins) - ! Contributions from modal and bin aerosols. - if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then + if (aerosol_instances_get_num_models() > 0) then call aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, & tau, tau_w, tau_w_g, tau_w_f) end if @@ -210,19 +198,13 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! Local variables - integer :: numaerosols ! number of bulk aerosols in climate/diagnostic list - integer :: nmodes ! number of aerosol modes in climate/diagnostic list - integer :: nbins ! number of aerosol bins in climate/diagnostic list integer :: i, ncol !----------------------------------------------------------------------------- - ! get number of bulk aerosols and number of modes in current list - call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes, nbins=nbins) - odap_aer = 0._r8 ! Contributions from modal and sectional aerosols. - if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then + if (aerosol_instances_get_num_models() > 0) then call aerosol_optics_cam_lw(list_idx, state, pbuf, odap_aer) end if diff --git a/src/physics/cam/aer_vis_diag_mod.F90 b/src/physics/cam/aer_vis_diag_mod.F90 index da96377864..67d20da16e 100644 --- a/src/physics/cam/aer_vis_diag_mod.F90 +++ b/src/physics/cam/aer_vis_diag_mod.F90 @@ -5,7 +5,8 @@ module aer_vis_diag_mod use shr_kind_mod, only: r8 => shr_kind_r8 use cam_history, only: fieldname_len, addfld, outfld, add_default, horiz_only, hist_fld_active use cam_history_support, only : fillvalue - use rad_constituents, only: rad_cnst_get_info + use aerosol_instances_mod, only: aerosol_instances_get_props, aerosol_instances_get_num_models + use aerosol_properties_mod, only: aerosol_properties use ppgrid, only: pcols, pver use phys_control, only: phys_getopts use cam_abortutils, only: endrun @@ -24,12 +25,27 @@ module aer_vis_diag_mod !============================================================================== subroutine aer_vis_diag_init() - integer :: i, astat + integer :: i, iaermod, astat character(len=64), allocatable :: aernames(:) logical :: history_aero_optics ! Output aerosol optics diagnostics + class(aerosol_properties), pointer :: aero_props_bam + + ! Find BAM properties object from factory + aero_props_bam => null() + do iaermod = 1, aerosol_instances_get_num_models() + aero_props_bam => aerosol_instances_get_props(iaermod, 0) + if (associated(aero_props_bam)) then + if (aero_props_bam%model_is('BAM')) exit + end if + aero_props_bam => null() + end do ! number of bulk aerosols in climate list - call rad_cnst_get_info(0, naero=numaerosols) + if (associated(aero_props_bam)) then + numaerosols = aero_props_bam%nbins() + else + numaerosols = 0 + end if if (numaerosols<1) return @@ -37,7 +53,9 @@ subroutine aer_vis_diag_init() allocate(aernames(numaerosols),stat=astat) if( astat/= 0 ) call endrun('aer_vis_diag_init: aernames allocate error') - call rad_cnst_get_info(0, aernames=aernames) + do i = 1, numaerosols + aernames(i) = aero_props_bam%bin_name(i) + end do call phys_getopts( history_aero_optics_out = history_aero_optics ) diff --git a/src/physics/cam/aerosol_mmr_cam.F90 b/src/physics/cam/aerosol_mmr_cam.F90 new file mode 100644 index 0000000000..4191fb968a --- /dev/null +++ b/src/physics/cam/aerosol_mmr_cam.F90 @@ -0,0 +1,992 @@ +module aerosol_mmr_cam + +!------------------------------------------------------------------------------------------------ +! +! CAM-specific aerosol MMR retrieval routines. These routines access +! state%q and physics buffer (pbuf) to return mixing ratio pointers. +! +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 + +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_cam_init ! allocate zero_cols +public :: get_cam_idx +public :: resolve_mode_cam_idx, resolve_bin_cam_idx +public :: resolve_bulk_cam_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_cam_init() + use ppgrid, only: pcols, pver + ! Allocate zero_cols array (must be called after ppgrid is set up) + if (.not. allocated(zero_cols)) then + allocate(zero_cols(pcols,pver)) + zero_cols = 0._r8 + end if +end subroutine aerosol_mmr_cam_init + +!================================================================================================ + +integer function get_cam_idx(source, name, routine) + + ! get index of name in internal CAM array; either the constituent array + ! or the physics buffer + + use physics_buffer, only: pbuf_get_index + use constituents, only: cnst_get_ind + 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 + integer :: errcode + !----------------------------------------------------------------------------- + + if (source(1:1) == 'N') then + + idx = pbuf_get_index(trim(name),errcode) + if (errcode < 0) then + call endrun(routine//' ERROR: cannot find physics buffer field '//trim(name)) + end if + + else if (source(1:1) == 'A') then + + call cnst_get_ind(trim(name), idx, abort=.false.) + if (idx < 0) then + call endrun(routine//' ERROR: cannot find constituent field '//trim(name)) + end if + + else if (source(1:1) == 'Z') then + + idx = -1 + + else + + call endrun(routine//' ERROR: invalid source for specie '//trim(name)) + + end if + + get_cam_idx = idx + +end function get_cam_idx + +!=========================== + +subroutine resolve_mode_cam_idx(modes) + + ! Initialize the mode definitions by looking up the relevent indices in the + ! constituent and pbuf arrays, and getting the physprop IDs + + use phys_prop, only: physprop_get_id + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: modes_t + + ! Arguments + type(modes_t), intent(inout) :: modes + + ! Local variables + integer :: m, ispec, nspec + + character(len=*), parameter :: routine = 'resolve_mode_cam_idx' + !----------------------------------------------------------------------------- + + do m = 1, modes%nmodes + + ! indices for number mixing ratio components + modes%comps(m)%idx_num_a = get_cam_idx(modes%comps(m)%source_num_a, modes%comps(m)%camname_num_a, routine) + modes%comps(m)%idx_num_c = get_cam_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_cam_idx(modes%comps(m)%source_mmr_a(ispec), & + modes%comps(m)%camname_mmr_a(ispec), routine) + modes%comps(m)%idx_mmr_c(ispec) = get_cam_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_cam_idx + +!=========================== + +subroutine resolve_bin_cam_idx(bins) + + ! Initialize the bin definitions by looking up the relevent indices in the + ! constituent and pbuf arrays, and getting the physprop IDs + + use phys_prop, only: physprop_get_id + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: bins_t + + ! Arguments + type(bins_t), intent(inout) :: bins + + ! Local variables + integer :: m, ispec, nspec + + character(len=*), parameter :: routine = 'resolve_bin_cam_idx' + !----------------------------------------------------------------------------- + + do m = 1, bins%nbins + + ! indices for number mixing ratio components + bins%comps(m)%idx_num_a = get_cam_idx(bins%comps(m)%source_num_a, bins%comps(m)%camname_num_a, routine) + bins%comps(m)%idx_num_c = get_cam_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_cam_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_cam_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_cam_idx(bins%comps(m)%source_mmr_a(ispec), & + bins%comps(m)%camname_mmr_a(ispec), routine) + bins%comps(m)%idx_mmr_c(ispec) = get_cam_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_cam_idx + +!=========================== + +subroutine resolve_bulk_cam_idx(aerlist) + + ! Resolve host-specific indices for bulk aerosols. + ! 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_cam_idx' + !----------------------------------------------------------------------------- + + do i = 1, aerlist%numaerosols + aerlist%aer(i)%idx = get_cam_idx(aerlist%aer(i)%source, aerlist%aer(i)%camname, routine) + end do + +end subroutine resolve_bulk_cam_idx + +!================================================================================================ + +subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, state, pbuf, mmr) + + ! Return pointer to mass mixing ratio for the aerosol from the specified + ! climate or diagnostic list. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + 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 + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: lchnk + 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 + + lchnk = state%lchnk + + ! 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') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + 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, state, pbuf, mmr) + + ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified + ! climate or diagnostic list. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + 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 + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: m_idx + integer :: idx + integer :: lchnk + 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 + + lchnk = state%lchnk + + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + 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, state, pbuf, mmr) + + ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified + ! climate or diagnostic list. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use radiative_aerosol_definitions, only: N_DIAG, binlist_t, sectional_aerosol_list, bins + + ! 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=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: s_idx + integer :: idx + integer :: lchnk + 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 + + ! 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 + s_idx = slist%idx(bin_idx) + + ! Check for valid specie index + 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 + + ! Get data source + 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 + + lchnk = state%lchnk + + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + 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. + + ! This is a special routine to allow direct access to information in the + ! constituent array inside physics parameterizations that have been passed, + ! and are operating over the entire constituent array. The interstitial phase + ! is assumed since that's what is contained in the constituent array. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: modelist_t, modes, modal_aerosol_list + + ! Arguments + integer, intent(in) :: mode_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + integer, intent(out) :: idx ! index of specie in the constituent array + + ! Local variables + integer :: m_idx + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_idx' + !----------------------------------------------------------------------------- + + ! assume climate list (i.e., species are in the constituent array) + mlist => modal_aerosol_list(0) + + ! 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 + + ! Assume data source is interstitial since that's what's in the constituent array + 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) + + ! Return constituent index of camra species mass mixing ratio for aerosol bins in + ! the climate list. + + ! This is a special routine to allow direct access to information in the + ! constituent array inside physics parameterizations that have been passed, + ! and are operating over the entire constituent array. The interstitial phase + ! is assumed since that's what is contained in the constituent array. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: binlist_t, bins, sectional_aerosol_list + + ! Arguments + integer, intent(in) :: bin_idx ! bin index + integer, intent(in) :: spec_idx ! index of specie in the bin + integer, intent(out) :: idx ! index of specie in the constituent array + + ! Local variables + integer :: b_idx + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_carma_mmr_idx' + !----------------------------------------------------------------------------- + + ! assume climate list (i.e., species are in the constituent array) + slist => sectional_aerosol_list(0) + + ! Check for valid bin 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 bin in the bin definition object + b_idx = slist%idx(bin_idx) + + ! Check for valid specie index + 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 + + ! Assume data source is interstitial since that's what's in the constituent array + 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, state, pbuf, mmr) + + ! Return pointer to mass mixing ratio for the aerosol bin from the specified + ! climate or diagnostic list. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use radiative_aerosol_definitions, only: N_DIAG, binlist_t, sectional_aerosol_list, bins + + ! Arguments + 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(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: m_idx + integer :: idx + integer :: lchnk + 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 + + ! Check for valid bin 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 bin in the bin definition object + m_idx = slist%idx(bin_idx) + + ! Get data source + 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 + + lchnk = state%lchnk + + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + 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, state, pbuf, num) + + ! Return pointer to number mixing ratio for the aerosol mode from the specified + ! climate or diagnostic list. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + 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 + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: num(:,:) + + ! Local variables + integer :: m_idx + integer :: idx + integer :: lchnk + 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 + + ! 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) + + ! Get data source + 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 + + lchnk = state%lchnk + + select case( source ) + case ('A') + num => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, num) + 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, state, pbuf, num) + + ! Return pointer to number mixing ratio for the aerosol bin from the specified + ! climate or diagnostic list. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use radiative_aerosol_definitions, only: N_DIAG, binlist_t, sectional_aerosol_list, bins + + ! Arguments + 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(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: num(:,:) + + ! Local variables + integer :: m_idx + integer :: idx + integer :: lchnk + 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 + + ! Check for valid bin 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 bin in the bin definition object + m_idx = slist%idx(bin_idx) + + ! Get data source + 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 + + lchnk = state%lchnk + + select case( source ) + case ('A') + num => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, num) + 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) + + ! Return constituent index of mode number mixing ratio for the aerosol mode in + ! the climate list. + + ! This is a special routine to allow direct access to information in the + ! constituent array inside physics parameterizations that have been passed, + ! and are operating over the entire constituent array. The interstitial phase + ! is assumed since that's what is contained in the constituent array. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: modelist_t, modes, modal_aerosol_list + + ! Arguments + integer, intent(in) :: mode_idx ! mode index + integer, intent(out) :: cnst_idx ! constituent index + + ! Local variables + integer :: m_idx + character(len=1) :: source + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mode_num' + !----------------------------------------------------------------------------- + + ! assume climate list + mlist => modal_aerosol_list(0) + + ! 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 that source is 'A' which means the index is for the constituent array + 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 + + ! Return index in constituent array + 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) + + ! Return constituent index of bin number mixing ratio for the aerosol bin in + ! the climate list. + + ! This is a special routine to allow direct access to information in the + ! constituent array inside physics parameterizations that have been passed, + ! and are operating over the entire constituent array. The interstitial phase + ! is assumed since that's what is contained in the constituent array. + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use radiative_aerosol_definitions, only: binlist_t, bins, sectional_aerosol_list + + ! Arguments + integer, intent(in) :: bin_idx ! bin index + integer, intent(out) :: cnst_idx ! constituent index + + ! Local variables + integer :: b_idx + character(len=1) :: source + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_num_idx' + !----------------------------------------------------------------------------- + + ! assume climate list + slist => sectional_aerosol_list(0) + + ! Check for valid bin 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 bin in the bin definition object + b_idx = slist%idx(bin_idx) + + ! Check that source is 'A' which means the index is for the constituent array + 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 + + ! Return index in constituent array + 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: addfld, fieldname_len, 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 addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name)) + + ! 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 addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name)) + + ! error check for name length + if (len_trim(name) > fieldname_len) then + write(iulog,*) 'rad_aer_diag_init: '//trim(name)//' longer than ', fieldname_len, ' 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, state, pbuf) + + ! Output the mass per layer, and total column burdens for aerosol + ! constituents in either the climate or diagnostic lists. + + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use physconst, only: rga + use cam_history, only: outfld + 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 + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + ! Local variables + integer :: i, naer, lchnk, ncol + integer :: idx + character(len=1) :: source + character(len=32) :: name, cbname + real(r8) :: mass(pcols,pver) + real(r8) :: cb(pcols) + real(r8), pointer :: mmr(:,:) + type(aerlist_t), pointer :: aerlist + character(len=*), parameter :: subname = 'rad_aer_diag_out' + !----------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + ! 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 + do i = 1, naer + + source = aerlist%aer(i)%source + idx = aerlist%aer(i)%idx + name = aerlist%aer(i)%mass_name + ! construct name for column burden field by replacing the 'm_' prefix by 'cb_' + cbname = 'cb_' // name(3:len_trim(name)) + + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + end select + + mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga + call outfld(trim(name), mass, pcols, lchnk) + + cb(:ncol) = sum(mass(:ncol,:),2) + call outfld(trim(cbname), cb, pcols, lchnk) + + end do + +end subroutine rad_aer_diag_out + +!================================================================================================ + +end module aerosol_mmr_cam diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index eab1796814..e072069947 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -11,7 +11,8 @@ module aerosol_optics_cam use physconst, only: rga, rair use cam_abortutils, only: endrun use spmd_utils, only: masterproc - use rad_constituents, only: n_diag, rad_cnst_get_call_list + use radiative_aerosol_definitions, only: N_DIAG + use radiative_aerosol, only: rad_aer_get_call_list use cam_history, only: addfld, add_default, outfld, horiz_only, fieldname_len use cam_history_support, only: fillvalue @@ -20,20 +21,17 @@ module aerosol_optics_cam use wv_saturation, only: qsat use aerosol_properties_mod, only: aerosol_properties, aero_name_len - 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 aerosol_instances_mod, only: aerosol_instances_get_props, & + aerosol_instances_get_num_models, aerosol_instances_is_active, & + aerosol_instances_final, & + aerosol_instances_get_state use aerosol_state_mod, only: aerosol_state - 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_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 rad_constituents, only: rad_cnst_get_info use hygroscopic_aerosol_optics_mod, only: hygroscopic_aerosol_optics use hygro_aerosol_optics_mod, only: hygro_aerosol_optics use insoluble_aerosol_optics_mod, only: insoluble_aerosol_optics @@ -51,27 +49,10 @@ module aerosol_optics_cam public :: aerosol_optics_cam_sw public :: aerosol_optics_cam_lw - type aero_props_t - class(aerosol_properties), pointer :: obj => null() - end type aero_props_t - type aero_state_t - class(aerosol_state), pointer :: obj => null() - end type aero_state_t - - type(aero_props_t), allocatable :: aero_props(:) ! array of aerosol properties objects to allow for - ! multiple aerosol representations in the same sim - ! such as MAM and CARMA - ! refractive index for water read in read_water_refindex complex(r8) :: crefwsw(nswbands) = -huge(1._r8) ! complex refractive index for water visible complex(r8) :: crefwlw(nlwbands) = -huge(1._r8) ! complex refractive index for water infrared character(len=cl) :: water_refindex_file = 'NONE' ! full pathname for water refractive index dataset - - logical :: carma_active = .false. - logical :: modal_active = .false. - logical :: bulk_active = .false. - - integer :: num_aero_models = 0 integer :: lw10um_indx = -1 ! wavelength index corresponding to 10 microns real(r8), parameter :: lw10um = 10._r8 ! microns @@ -144,8 +125,8 @@ subroutine aerosol_optics_cam_init use ioFileMod, only: getfil character(len=*), parameter :: prefix = 'aerosol_optics_cam_init: ' - integer :: nmodes=0, nbins=0, iaermod, istat, ilist, i - integer :: nbulk_aerosols=0 + integer :: iaermod, istat, ilist, i + integer :: num_aero_models logical :: call_list(0:n_diag) real(r8) :: lwavlen_lo(nlwbands), lwavlen_hi(nlwbands) @@ -158,6 +139,8 @@ subroutine aerosol_optics_cam_init logical :: history_dust ! output dust diagnostics logical :: prog_modal_aero ! prognostic modal aerosols present + class(aerosol_properties), pointer :: aprops + character(len=cl) :: locfile call phys_getopts(history_amwg_out = history_amwg, & @@ -172,51 +155,10 @@ subroutine aerosol_optics_cam_init top_lev = 1 endif - num_aero_models = 0 - - call rad_cnst_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,*) prefix,'nmodes,nbins,nbulk_aerosols: ',nmodes,nbins,nbulk_aerosols - end if - - ! count aerosol models - if (modal_active) then - num_aero_models = num_aero_models+1 - end if - if (carma_active) then - num_aero_models = num_aero_models+1 - end if - if (bulk_active) then - num_aero_models = num_aero_models+1 - end if - - if (num_aero_models>0) then - allocate(aero_props(num_aero_models), stat=istat) - if (istat/=0) then - call endrun(prefix//'array allocation error: aero_props') - end if - end if - - iaermod = 0 - - if (modal_active) then - iaermod = iaermod+1 - aero_props(iaermod)%obj => modal_aerosol_properties() - end if - if (carma_active) then - iaermod = iaermod+1 - aero_props(iaermod)%obj => carma_aerosol_properties() - end if - if (bulk_active) then - iaermod = iaermod+1 - aero_props(iaermod)%obj => bulk_aerosol_properties() - end if + num_aero_models = aerosol_instances_get_num_models() if (water_refindex_file=='NONE') then - if (modal_active .or. carma_active) then + if (aerosol_instances_is_active('modal') .or. aerosol_instances_is_active('carma')) then call endrun(prefix//'water_refindex_file must be specified') end if else @@ -230,7 +172,7 @@ subroutine aerosol_optics_cam_init lw10um_indx = i ! index corresponding to 10 microns end if end do - call rad_cnst_get_call_list(call_list) + call rad_aer_get_call_list(call_list) do ilist = 0, n_diag if (call_list(ilist)) then @@ -342,33 +284,36 @@ subroutine aerosol_optics_cam_init do n = 1,num_aero_models - allocate(burden_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + ! for history output use the climate list. + aprops => aerosol_instances_get_props(n, list_idx=0) + + allocate(burden_fields(n)%name(aprops%nbins()), stat=istat) if (istat/=0) then call endrun(prefix//'array allocation error: burden_fields(n)%name') end if - allocate(aodbin_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + allocate(aodbin_fields(n)%name(aprops%nbins()), stat=istat) if (istat/=0) then call endrun(prefix//'array allocation error: aodbin_fields(n)%name') end if - allocate(aoddust_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + allocate(aoddust_fields(n)%name(aprops%nbins()), stat=istat) if (istat/=0) then call endrun(prefix//'array allocation error: aoddust_fields(n)%name') end if - allocate(burdendn_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + allocate(burdendn_fields(n)%name(aprops%nbins()), stat=istat) if (istat/=0) then call endrun(prefix//'array allocation error: burdendn_fields(n)%name') end if - allocate(aodbindn_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + allocate(aodbindn_fields(n)%name(aprops%nbins()), stat=istat) if (istat/=0) then call endrun(prefix//'array allocation error: aodbindn_fields(n)%name') end if - allocate(aoddustdn_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + allocate(aoddustdn_fields(n)%name(aprops%nbins()), stat=istat) if (istat/=0) then call endrun(prefix//'array allocation error: aoddustdn_fields(n)%name') end if - do m = 1, aero_props(n)%obj%nbins() + do m = 1, aprops%nbins() cnt = cnt+1 @@ -380,9 +325,9 @@ subroutine aerosol_optics_cam_init call add_default (fldname, 1, ' ') end if - fldname = 'AOD_'//trim(aero_props(n)%obj%bin_name(0,m)) + fldname = 'AOD_'//trim(aprops%bin_name(bin_ndx=m)) aodbin_fields(n)%name(m) = fldname - lngname = 'Aerosol optical depth, day only, 550 nm, '//trim(aero_props(n)%obj%bin_name(0,m)) + lngname = 'Aerosol optical depth, day only, 550 nm, '//trim(aprops%bin_name(bin_ndx=m)) call addfld (aodbin_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) if (history_aero_optics) then call add_default (fldname, 1, ' ') @@ -404,9 +349,9 @@ subroutine aerosol_optics_cam_init call add_default (fldname, 1, ' ') end if - fldname = 'AODdn_'//trim(aero_props(n)%obj%bin_name(0,m)) + fldname = 'AODdn_'//trim(aprops%bin_name(bin_ndx=m)) aodbindn_fields(n)%name(m) = fldname - lngname = 'Aerosol optical depth 550 nm, day night, '//trim(aero_props(n)%obj%bin_name(0,m)) + lngname = 'Aerosol optical depth 550 nm, day night, '//trim(aprops%bin_name(bin_ndx=m)) call addfld (aodbindn_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) if (history_aero_optics) then call add_default (fldname, 1, ' ') @@ -562,18 +507,7 @@ end subroutine aerosol_optics_cam_init !=============================================================================== subroutine aerosol_optics_cam_final - integer :: iaermod - - do iaermod = 1,num_aero_models - if (associated(aero_props(iaermod)%obj)) then - deallocate(aero_props(iaermod)%obj) - nullify(aero_props(iaermod)%obj) - end if - end do - - if (allocated(aero_props)) then - deallocate(aero_props) - endif + call aerosol_instances_final() end subroutine aerosol_optics_cam_final @@ -601,15 +535,11 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, integer :: iwav, ilev integer :: icol, istat integer :: lchnk, ncol + integer :: num_aero_models - integer :: nmodes=0 character(len=aero_name_len) :: modetype logical :: coarse_dust_mode ! coarse dust mode for different MAM versions - type(aero_state_t), allocatable :: aero_state(:) ! array of aerosol state objects to allow for - ! multiple aerosol representations in the same sim - ! such as MAM and CARMA - class(aerosol_optics), pointer :: aero_optics real(r8) :: dopaer(pcols) @@ -771,27 +701,9 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, dopaer0 = 0.0_r8 ! dmleung -- + num_aero_models = aerosol_instances_get_num_models() if (num_aero_models<1) return - allocate(aero_state(num_aero_models), stat=istat) - if (istat/=0) then - call endrun(prefix//'array allocation error: aero_state') - end if - - iaermod = 0 - if (modal_active) then - iaermod = iaermod+1 - aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) - end if - if (carma_active) then - iaermod = iaermod+1 - aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) - end if - if (bulk_active) then - iaermod = iaermod+1 - aero_state(iaermod)%obj => bulk_aerosol_state( state, pbuf ) - end if - allocate(pext(ncol), stat=istat) if (istat/=0) then call endrun(prefix//'array allocation error: pext') @@ -818,10 +730,11 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, aeromodel: do iaermod = 1,num_aero_models - aeroprops => aero_props(iaermod)%obj - aerostate => aero_state(iaermod)%obj + aeroprops => aerosol_instances_get_props(iaermod, list_idx) + if (.not. associated(aeroprops)) cycle aeromodel + aerostate => aerosol_instances_get_state(iaermod, list_idx, lchnk) - nbins=aeroprops%nbins(list_idx) + nbins=aeroprops%nbins() sulfwtpct(:ncol,:pver) = aerostate%wgtpct(ncol,pver) call outfld('SULFWTPCT', sulfwtpct(1:ncol,:), ncol, lchnk) @@ -830,7 +743,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, ! MAM coarse mode if (aeroprops%model_is('MAM')) then - modetype = aeroprops%bin_name(list_idx, ibin) + modetype = aeroprops%bin_name(bin_ndx=ibin) coarse_dust_mode = (modetype=='coarse' .or. modetype=='coarse_dust') else coarse_dust_mode = .false. @@ -841,30 +754,30 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, aodbin(:) = 0.0_r8 taubam(:,:) = 0._r8 - call aeroprops%optics_params(list_idx, ibin, opticstype=opticstype) + call aeroprops%optics_params(bin_ndx=ibin, opticstype=opticstype) select case (trim(opticstype)) case('modal') ! refractive method - aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & + aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, ibin, & ncol, pver, nswbands, nlwbands, crefwsw, crefwlw) case('hygroscopic_coreshell') - aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, list_idx, & + aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, & ibin, ncol, pver, relh(:ncol,:)) case('hygroscopic_wtp') - aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & + aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, & ibin, ncol, pver, sulfwtpct(:ncol,:)) case('hygro') ! Short-wave hygroscopic aerosol, Long-wave non-hygroscopic ! aerosol optical properties - aero_optics=>hygro_aerosol_optics(aeroprops, aerostate, list_idx, & + aero_optics=>hygro_aerosol_optics(aeroprops, aerostate, & ibin, ncol, pver, numrh, relh(:ncol,:)) case('hygroscopic') ! Short-wave and long-wave hygroscopic aerosol properties - aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, list_idx, & - ibin, ncol, pver, numrh, relh(:ncol,:)) + aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, ibin, & + ncol, pver, numrh, relh(:ncol,:)) case('nonhygro', 'insoluble') - aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, list_idx, ibin) + aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, ibin) case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3','volcanic_radius5') @@ -879,7 +792,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, call pbuf_get_field(pbuf, idx, geometric_radius) ! construct aerosol optics object - aero_optics=>volcrad_aerosol_optics(aeroprops, aerostate, list_idx, & + aero_optics=>volcrad_aerosol_optics(aeroprops, aerostate, & ibin, ncol, pver, geometric_radius(:ncol,:)) case default @@ -888,8 +801,8 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, if (associated(aero_optics)) then - wetvol(:ncol,:pver) = aerostate%wet_volume(aeroprops, list_idx, ibin, ncol, pver) - watervol(:ncol,:pver) = aerostate%water_volume(aeroprops, list_idx, ibin, ncol, pver) + wetvol(:ncol,:pver) = aerostate%wet_volume(aeroprops, ibin, ncol, pver) + watervol(:ncol,:pver) = aerostate%water_volume(aeroprops, ibin, ncol, pver) wavelength: do iwav = 1, nswbands @@ -960,13 +873,6 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, deallocate(palb) deallocate(pasm) - do iaermod = 1,num_aero_models - deallocate(aero_state(iaermod)%obj) - nullify(aero_state(iaermod)%obj) - end do - - deallocate(aero_state) - contains !=============================================================================== @@ -1010,10 +916,10 @@ subroutine update_diags( is_coarse_dust ) ! loop over species ... - do ispec = 1, aeroprops%nspecies(list_idx,ibin) - call aeroprops%get(ibin, ispec, list_ndx=list_idx, density=specdens, & + 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(list_idx, ispec, ibin, specmmr) + call aerostate%get_ambient_mmr(species_ndx=ispec, bin_ndx=ibin, mmr=specmmr) burden(icol) = burden(icol) + specmmr(icol,ilev)*mass(icol,ilev) @@ -1352,10 +1258,7 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) integer :: ibin, nbins integer :: iwav, ilev integer :: ncol, icol, istat - - type(aero_state_t), allocatable :: aero_state(:) ! array of aerosol state objects to allow for - ! multiple aerosol representations in the same sim - ! such as MAM and CARMA + integer :: num_aero_models class(aerosol_optics), pointer :: aero_optics class(aerosol_state), pointer :: aerostate @@ -1381,24 +1284,7 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) nullify(aero_optics) - allocate(aero_state(num_aero_models), stat=istat) - if (istat/=0) then - call endrun(prefix//'array allocation error: aero_state') - end if - - iaermod = 0 - if (modal_active) then - iaermod = iaermod+1 - aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) - end if - if (carma_active) then - iaermod = iaermod+1 - aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) - end if - if (bulk_active) then - iaermod = iaermod+1 - aero_state(iaermod)%obj => bulk_aerosol_state( state, pbuf ) - end if + num_aero_models = aerosol_instances_get_num_models() ncol = state%ncol @@ -1416,38 +1302,39 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) aeromodel: do iaermod = 1,num_aero_models - aeroprops => aero_props(iaermod)%obj - aerostate => aero_state(iaermod)%obj + aeroprops => aerosol_instances_get_props(iaermod, list_idx) + if (.not. associated(aeroprops)) cycle aeromodel + aerostate => aerosol_instances_get_state(iaermod, list_idx, state%lchnk) - nbins=aero_props(iaermod)%obj%nbins(list_idx) + nbins=aeroprops%nbins() sulfwtpct(:ncol,:pver) = aerostate%wgtpct(ncol,pver) binloop: do ibin = 1, nbins - call aeroprops%optics_params(list_idx, ibin, opticstype=opticstype) + call aeroprops%optics_params(bin_ndx=ibin, opticstype=opticstype) select case (trim(opticstype)) case('modal') ! refractive method - aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & + aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, ibin, & ncol, pver, nswbands, nlwbands, crefwsw, crefwlw) case('hygroscopic_coreshell') - aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, list_idx, & + aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, & ibin, ncol, pver, relh(:ncol,:)) case('hygroscopic_wtp') - aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & + aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, & ibin, ncol, pver, sulfwtpct(:ncol,:)) case('hygroscopic') - aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & + aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, ibin, & ncol, pver, numrh, relh(:ncol,:)) case('hygro') - aero_optics=>hygro_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & + aero_optics=>hygro_aerosol_optics(aeroprops, aerostate, ibin, & ncol, pver, numrh, relh(:ncol,:)) case('nonhygro', 'insoluble') - aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, list_idx, ibin) + aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, ibin) case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3','volcanic_radius5') @@ -1462,7 +1349,7 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) call pbuf_get_field(pbuf, idx, geometric_radius) ! construct aerosol optics object - aero_optics=>volcrad_aerosol_optics(aeroprops, aerostate, list_idx, & + aero_optics=>volcrad_aerosol_optics(aeroprops, aerostate, & ibin, ncol, pver, geometric_radius(:ncol,:)) case default @@ -1504,13 +1391,6 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) deallocate(pabs) - do iaermod = 1,num_aero_models - deallocate(aero_state(iaermod)%obj) - nullify(aero_state(iaermod)%obj) - end do - - deallocate(aero_state) - end subroutine aerosol_optics_cam_lw !=============================================================================== diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index d1cfa8efeb..0d13b4e5c8 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1416,7 +1416,6 @@ subroutine clubb_ini_cam(pbuf2d) ! From CAM libraries use cam_history, only: addfld, add_default, horiz_only - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num_idx, rad_cnst_get_mam_mmr_idx use cam_abortutils, only: endrun ! These are needed to set parameters diff --git a/src/physics/cam/microp_aero.F90 b/src/physics/cam/microp_aero.F90 index d14d4d5967..85bf43f88c 100644 --- a/src/physics/cam/microp_aero.F90 +++ b/src/physics/cam/microp_aero.F90 @@ -32,8 +32,12 @@ module microp_aero use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field, & pbuf_get_chunk use phys_control, only: phys_getopts, use_hetfrz_classnuc -use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & - rad_cnst_get_mode_num +use aerosol_instances_mod, only: aerosol_instances_get_num_models, & + aerosol_instances_is_active, & + aerosol_instances_get_props, & + aerosol_instances_create_states, & + aerosol_instances_destroy_states, & + aero_state_entry_t use nucleate_ice_cam, only: use_preexisting_ice, nucleate_ice_cam_readnl, nucleate_ice_cam_register, & nucleate_ice_cam_init, nucleate_ice_cam_calc @@ -49,12 +53,8 @@ module microp_aero use cam_abortutils, only: endrun use aerosol_properties_mod, only: aerosol_properties -use modal_aerosol_properties_mod, only: modal_aerosol_properties -use carma_aerosol_properties_mod, only: carma_aerosol_properties use aerosol_state_mod, only: aerosol_state -use modal_aerosol_state_mod, only: modal_aerosol_state -use carma_aerosol_state_mod, only: carma_aerosol_state implicit none private @@ -119,6 +119,8 @@ module microp_aero ! modal aerosols logical :: clim_modal_aero +integer :: iaermod_clim_modal_carma + integer :: mode_accum_idx = -1 ! index of accumulation mode integer :: mode_aitken_idx = -1 ! index of aitken mode integer :: mode_coarse_idx = -1 ! index of coarse mode @@ -132,12 +134,7 @@ module microp_aero logical :: separate_dust = .false. -type aero_state_t - class(aerosol_state), pointer :: obj=>null() -end type aero_state_t - class(aerosol_properties), pointer :: aero_props_obj=>null() -type(aero_state_t), pointer :: aero_state(:) => null() !========================================================================================= contains @@ -178,13 +175,15 @@ subroutine microp_aero_init(phys_state,pbuf2d) ! !----------------------------------------------------------------------- + use modal_aerosol_state_mod, only: modal_aerosol_state + type(physics_state), pointer :: phys_state(:) type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! local variables - integer :: iaer, ierr - integer :: m, n, nmodes, nspec - integer :: nbins + integer :: iaer + integer :: m, n, nspec + integer :: iaermod character(len=32) :: str32 character(len=*), parameter :: routine = 'microp_aero_init' @@ -192,6 +191,8 @@ subroutine microp_aero_init(phys_state,pbuf2d) type(physics_buffer_desc), pointer :: pbuf(:) integer :: c + class(aerosol_properties), pointer :: aero_props_bulk => null() + !----------------------------------------------------------------------- ! Query the PBL eddy scheme @@ -218,19 +219,25 @@ subroutine microp_aero_init(phys_state,pbuf2d) ! clim_modal_aero determines whether modal aerosols are used in the climate calculation. ! The modal aerosols can be either prognostic or prescribed. - call rad_cnst_get_info(0, nmodes=nmodes, nbins=nbins) - clim_modal_aero = (nmodes > 0) - clim_carma_aero = (nbins> 0) + clim_modal_aero = aerosol_instances_is_active('modal') + clim_carma_aero = aerosol_instances_is_active('carma') + iaermod_clim_modal_carma = -1 ast_idx = pbuf_get_index('AST') if (clim_modal_aero .or. clim_carma_aero) then cldo_idx = pbuf_get_index('CLDO') - if (clim_modal_aero) then - aero_props_obj => modal_aerosol_properties() - else if (clim_carma_aero) then - aero_props_obj => carma_aerosol_properties() - end if + ! Get modal/CARMA properties object from factory (factory owns the object) + do iaermod = 1, aerosol_instances_get_num_models() + aero_props_obj => aerosol_instances_get_props(iaermod, 0) + if (associated(aero_props_obj)) then + if (aero_props_obj%model_is('modal') .or. aero_props_obj%model_is('CARMA')) then + ! store idx for providing to dycore via aerosol_state_object... + iaermod_clim_modal_carma = iaermod + exit + end if + end if + end do call ndrop_init(aero_props_obj) end if @@ -238,20 +245,11 @@ subroutine microp_aero_init(phys_state,pbuf2d) dgnumwet_idx = pbuf_get_index('DGNUMWET') - allocate(aero_state(begchunk:endchunk)) - do c = begchunk,endchunk - pbuf => pbuf_get_chunk(pbuf2d, c) - aero_state(c)%obj => modal_aerosol_state( phys_state(c), pbuf ) - if (.not.associated(aero_state(c)%obj)) then - call endrun('microp_aero_init: construction of modal_aerosol_state object failed') - end if - end do - ! Init indices for specific modes/species ! mode index for specified mode types - do m = 1, nmodes - call rad_cnst_get_info(0, m, mode_type=str32) + do m = 1, aero_props_obj%nbins() + str32 = aero_props_obj%bin_name(m) select case (trim(str32)) case ('accum') mode_accum_idx = m @@ -283,26 +281,26 @@ subroutine microp_aero_init(phys_state,pbuf2d) ! species indices for specified types ! find indices for the dust and seasalt species in the coarse mode - call rad_cnst_get_info(0, mode_coarse_dst_idx, nspec=nspec) + nspec = aero_props_obj%nspecies(mode_coarse_dst_idx) do n = 1, nspec - call rad_cnst_get_info(0, mode_coarse_dst_idx, n, spec_type=str32) + call aero_props_obj%species_type(mode_coarse_dst_idx, n, str32) select case (trim(str32)) case ('dust') coarse_dust_idx = n end select end do - call rad_cnst_get_info(0, mode_coarse_slt_idx, nspec=nspec) + nspec = aero_props_obj%nspecies(mode_coarse_slt_idx) do n = 1, nspec - call rad_cnst_get_info(0, mode_coarse_slt_idx, n, spec_type=str32) + call aero_props_obj%species_type(mode_coarse_slt_idx, n, str32) select case (trim(str32)) case ('seasalt') coarse_nacl_idx = n end select end do if (mode_coarse_idx>0) then - call rad_cnst_get_info(0, mode_coarse_idx, nspec=nspec) + nspec = aero_props_obj%nspecies(mode_coarse_idx) do n = 1, nspec - call rad_cnst_get_info(0, mode_coarse_idx, n, spec_type=str32) + call aero_props_obj%species_type(mode_coarse_idx, n, str32) select case (trim(str32)) case ('sulfate') coarse_so4_idx = n @@ -320,15 +318,27 @@ subroutine microp_aero_init(phys_state,pbuf2d) else if (.not.clim_carma_aero) then ! Props needed for BAM number concentration calcs. - - call rad_cnst_get_info(0, naero=naer_all) + ! Find bulk properties object from factory + aero_props_bulk => null() + do iaermod = 1, aerosol_instances_get_num_models() + aero_props_bulk => aerosol_instances_get_props(iaermod, 0) + if (associated(aero_props_bulk)) then + if (aero_props_bulk%model_is('BAM')) exit + end if + aero_props_bulk => null() + end do + if (associated(aero_props_bulk)) then + naer_all = aero_props_bulk%nbins() + else + naer_all = 0 + end if allocate( & aername(naer_all), & num_to_mass_aer(naer_all) ) do iaer = 1, naer_all - call rad_cnst_get_aer_props(0, iaer, & - aername = aername(iaer), & + call aero_props_bulk%get(iaer, 1, & + specname = aername(iaer), & num_to_mass_aer = num_to_mass_aer(iaer) ) ! Look for sulfate, dust, and soot in this list (Bulk aerosol only) @@ -340,6 +350,9 @@ subroutine microp_aero_init(phys_state,pbuf2d) call ndrop_bam_init() + ! Set module-level props object for BAM (used by nucleate_ice_cam) + aero_props_obj => aero_props_bulk + end if call addfld('LCLOUD', (/ 'lev' /), 'A', ' ', 'Liquid cloud fraction used in stratus activation', sampled_on_subcycle=.true.) @@ -368,12 +381,18 @@ end subroutine microp_aero_init !========================================================================================= ! returns a pointer to an aerosol state object for a given chunk index +! compatibility: for use by the dycore function aerosol_state_object(lchnk) result(obj) + use aerosol_instances_mod, only: aerosol_instances_get_state integer,intent(in) :: lchnk ! local chunk index class(aerosol_state), pointer :: obj ! aerosol state object pointer for local chunk - obj => aero_state(lchnk)%obj + if (iaermod_clim_modal_carma > 0) then + obj => aerosol_instances_get_state(iaermod_clim_modal_carma, list_idx=0, lchnk=lchnk) + else + obj => null() + end if end function aerosol_state_object @@ -393,19 +412,9 @@ subroutine microp_aero_final integer :: c - if (associated(aero_props_obj)) then - deallocate(aero_props_obj) - end if + ! aerosol_instances_mod owns the props obj, so just nullify the pointer. nullify(aero_props_obj) - if (associated(aero_state)) then - do c = begchunk,endchunk - deallocate(aero_state(c)%obj) - end do - deallocate(aero_state) - nullify(aero_state) - end if - end subroutine microp_aero_final !========================================================================================= @@ -557,6 +566,9 @@ subroutine microp_aero_run ( & real(r8), allocatable :: factnum(:,:,:) ! activation fraction for aerosol number class(aerosol_state), pointer :: aero_state1_obj + type(aero_state_entry_t), allocatable :: aero_states1(:) + integer :: nstates1, iaermod + class(aerosol_properties), pointer :: props_tmp !------------------------------------------------------------------------------- @@ -577,18 +589,26 @@ subroutine microp_aero_run ( & call physics_ptend_init(ptend_all, state%psetcols, 'microp_aero') - ! create the aerosol state object - if (clim_modal_aero) then - aero_state1_obj => modal_aerosol_state( state1, pbuf ) - if (.not.associated(aero_state1_obj)) then - call endrun('microp_aero_run: construction of aero_state1_obj modal_aerosol_state object failed') - end if - else if (clim_carma_aero) then - aero_state1_obj => carma_aerosol_state( state1, pbuf ) - if (.not.associated(aero_state1_obj)) then - call endrun('microp_aero_run: construction of aero_state1_obj carma_aerosol_state object failed') + !REMOVECAM: when microp_aero is brought into SIMA intermediate state1 updates should split into separate + ! physics schemes, run tendency updaters, then the aerosol state is updated, so no need for factory pattern. + ! create aerosol state objects via factory + call aerosol_instances_create_states(list_idx=0, state=state1, pbuf=pbuf, aero_states=aero_states1, nstates=nstates1) + !REMOVECAM_END + + ! find the appropriate state object for the active aerosol model + do iaermod = 1, nstates1 + props_tmp => aerosol_instances_get_props(iaermod, 0) + if (clim_modal_aero .and. props_tmp%model_is('modal')) then + aero_state1_obj => aero_states1(iaermod)%obj + exit + else if (clim_carma_aero .and. props_tmp%model_is('CARMA')) then + aero_state1_obj => aero_states1(iaermod)%obj + exit + else if (.not.clim_modal_aero .and. .not.clim_carma_aero .and. props_tmp%model_is('BAM')) then + aero_state1_obj => aero_states1(iaermod)%obj + exit end if - end if + end do if (clim_modal_aero.or.clim_carma_aero) then @@ -622,13 +642,13 @@ subroutine microp_aero_run ( & if (clim_modal_aero) then ! mode number mixing ratios - call rad_cnst_get_mode_num(0, mode_coarse_dst_idx, 'a', state1, pbuf, num_coarse) + call aero_state1_obj%get_ambient_num(mode_coarse_dst_idx, num_coarse) ! mode specie mass m.r. - call rad_cnst_get_aer_mmr(0, mode_coarse_dst_idx, coarse_dust_idx, 'a', state1, pbuf, coarse_dust) - call rad_cnst_get_aer_mmr(0, mode_coarse_slt_idx, coarse_nacl_idx, 'a', state1, pbuf, coarse_nacl) + call aero_state1_obj%get_ambient_mmr(species_ndx=coarse_dust_idx, bin_ndx=mode_coarse_dst_idx, mmr=coarse_dust) + call aero_state1_obj%get_ambient_mmr(species_ndx=coarse_nacl_idx, bin_ndx=mode_coarse_slt_idx, mmr=coarse_nacl) if (mode_coarse_idx>0) then - call rad_cnst_get_aer_mmr(0, mode_coarse_idx, coarse_so4_idx, 'a', state1, pbuf, coarse_so4) + call aero_state1_obj%get_ambient_mmr(species_ndx=coarse_so4_idx, bin_ndx=mode_coarse_idx, mmr=coarse_so4) endif else @@ -638,7 +658,7 @@ subroutine microp_aero_run ( & maerosol(pcols,pver,naer_all)) do m = 1, naer_all - call rad_cnst_get_aer_mmr(0, m, state1, pbuf, aer_mmr) + call aero_state1_obj%get_ambient_mmr(species_ndx=1, bin_ndx=m, mmr=aer_mmr) maerosol(:ncol,:,m) = aer_mmr(:ncol,:)*rho(:ncol,:) if (m .eq. idxsul) then @@ -706,7 +726,7 @@ subroutine microp_aero_run ( & !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc !ICE Nucleation - if (associated(aero_props_obj).and.associated(aero_state1_obj)) then + if (associated(aero_props_obj) .and. associated(aero_state1_obj)) then call nucleate_ice_cam_calc(state1, wsubi, pbuf, deltatin, ptend_loc, aero_props_obj, aero_state1_obj) else call nucleate_ice_cam_calc(state1, wsubi, pbuf, deltatin, ptend_loc) @@ -887,11 +907,9 @@ subroutine microp_aero_run ( & deallocate(factnum) end if - if (associated(aero_state1_obj)) then - ! destroy the aerosol state object - deallocate(aero_state1_obj) - nullify(aero_state1_obj) - endif + ! destroy all aerosol state objects created for this chunk + nullify(aero_state1_obj) + call aerosol_instances_destroy_states(aero_states1) end subroutine microp_aero_run diff --git a/src/physics/cam/ndrop_bam.F90 b/src/physics/cam/ndrop_bam.F90 index 01ab3b5856..22d9aa6c78 100644 --- a/src/physics/cam/ndrop_bam.F90 +++ b/src/physics/cam/ndrop_bam.F90 @@ -12,7 +12,8 @@ module ndrop_bam use physconst, only: gravit, rair, tmelt, cpair, rh2o, & r_universal, mwh2o, rhoh2o, latvap -use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_props +use aerosol_instances_mod, only: aerosol_instances_get_props, aerosol_instances_get_num_models +use aerosol_properties_mod, only: aerosol_properties use shr_spfn_mod, only: erf => shr_spfn_erf, & erfc => shr_spfn_erfc @@ -79,18 +80,34 @@ subroutine ndrop_bam_init ! !----------------------------------------------------------------------- - integer :: l, m, iaer + integer :: l, m, iaer, iaermod real(r8) :: surften ! surface tension of water w/respect to air (N/m) real(r8) :: arg logical :: history_amwg + class(aerosol_properties), pointer :: aero_props_bam !------------------------------------------------------------------------------- call phys_getopts(history_amwg_out=history_amwg) ! Access the physical properties of the bulk aerosols that are affecting the climate - ! by using routines from the rad_constituents module. + ! by using the abstract aerosol properties interface. + + ! Find BAM properties object from factory + aero_props_bam => null() + do iaermod = 1, aerosol_instances_get_num_models() + aero_props_bam => aerosol_instances_get_props(iaermod, 0) + if (associated(aero_props_bam)) then + if (aero_props_bam%model_is('BAM')) exit + end if + aero_props_bam => null() + end do + + if (associated(aero_props_bam)) then + naer_all = aero_props_bam%nbins() + else + naer_all = 0 + end if - call rad_cnst_get_info(0, naero=naer_all) allocate( & aername(naer_all), & dryrad_aer(naer_all), & @@ -100,13 +117,13 @@ subroutine ndrop_bam_init num_to_mass_aer(naer_all) ) do iaer = 1, naer_all - call rad_cnst_get_aer_props(0, iaer, & - aername = aername(iaer), & - dryrad_aer = dryrad_aer(iaer), & - density_aer = density_aer(iaer), & - hygro_aer = hygro_aer(iaer), & - dispersion_aer = dispersion_aer(iaer), & - num_to_mass_aer = num_to_mass_aer(iaer) ) + call aero_props_bam%get(iaer, 1, & + specname = aername(iaer), & + dryrad = dryrad_aer(iaer), & + density = density_aer(iaer), & + hygro = hygro_aer(iaer), & + num_to_mass_aer = num_to_mass_aer(iaer)) + dispersion_aer(iaer) = exp(aero_props_bam%alogsig(iaer)) ! Look for sulfate aerosol in this list (Bulk aerosol only) if (trim(aername(iaer)) == 'SULFATE') idxsul = iaer diff --git a/src/physics/cam/nucleate_ice_cam.F90 b/src/physics/cam/nucleate_ice_cam.F90 index 774456311e..3cd7279b0b 100644 --- a/src/physics/cam/nucleate_ice_cam.F90 +++ b/src/physics/cam/nucleate_ice_cam.F90 @@ -15,7 +15,6 @@ module nucleate_ice_cam use physics_types, only: physics_state, physics_ptend, physics_ptend_init use physics_buffer, only: physics_buffer_desc use phys_control, only: use_hetfrz_classnuc -use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_old_tim_idx, & pbuf_get_index, pbuf_get_field, & @@ -169,7 +168,6 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) integer :: ierr integer :: ispc, ibin integer :: idxtmp - integer :: nmodes, nbins character(len=*), parameter :: routine = 'nucleate_ice_cam_init' logical :: history_cesm_forcing @@ -181,9 +179,11 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) ! clim_modal_aero determines whether modal or carma aerosols are used in the climate calculation. ! The modal aerosols can be either prognostic or prescribed. - call rad_cnst_get_info(0, nmodes=nmodes, nbins=nbins) - - clim_modal_carma = (nmodes > 0) .or. (nbins > 0) + if (present(aero_props)) then + clim_modal_carma = aero_props%model_is('MAM') .or. aero_props%model_is('CARMA') + else + clim_modal_carma = .false. + end if mincld = mincld_in bulk_scale = bulk_scale_in @@ -192,10 +192,6 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) if (clim_modal_carma.and.use_preexisting_ice) then - if (.not. present(aero_props)) then - call endrun(routine//' : aero_props must be present') - end if - ! constituent tendencies are calculated only if use_preexisting_ice is TRUE ! set lq for constituent tendencies -- @@ -336,14 +332,18 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) ! Props needed for BAM number concentration calcs. - call rad_cnst_get_info(0, naero=naer_all) + if (present(aero_props)) then + naer_all = aero_props%nbins() + else + naer_all = 0 + end if allocate( & aername(naer_all), & num_to_mass_aer(naer_all) ) do iaer = 1, naer_all - call rad_cnst_get_aer_props(0, iaer, & - aername = aername(iaer), & + call aero_props%get(iaer, 1, & + specname = aername(iaer), & num_to_mass_aer = num_to_mass_aer(iaer)) ! Look for sulfate, dust, and soot in this list (Bulk aerosol only) if (trim(aername(iaer)) == 'SULFATE') idxsul = iaer @@ -377,8 +377,8 @@ subroutine nucleate_ice_cam_calc( & type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(in) :: dtime type(physics_ptend), intent(out) :: ptend - class(aerosol_properties),optional, intent(in) :: aero_props - class(aerosol_state),optional, intent(in) :: aero_state + class(aerosol_properties), optional, intent(in) :: aero_props + class(aerosol_state), optional, intent(in) :: aero_state ! local workspace @@ -485,7 +485,7 @@ subroutine nucleate_ice_cam_calc( & ni => state%q(:,:,numice_idx) pmid => state%pmid - if (present(aero_props)) then + if (clim_modal_carma) then nbins = aero_props%nbins() nmaxspc = maxval(aero_props%nspecies()) @@ -509,7 +509,7 @@ subroutine nucleate_ice_cam_calc( & maerosol(pcols,pver,naer_all)) do m = 1, naer_all - call rad_cnst_get_aer_mmr(0, m, state, pbuf, aer_mmr) + call aero_state%get_ambient_mmr(species_ndx=1, bin_ndx=m, mmr=aer_mmr) maerosol(:ncol,:,m) = aer_mmr(:ncol,:)*rho(:ncol,:) if (m .eq. idxsul) then @@ -610,10 +610,6 @@ subroutine nucleate_ice_cam_calc( & if (clim_modal_carma) then - if (.not.(present(aero_props).and.present(aero_state))) then - call endrun('nucleate_ice_cam_calc: aero_props and aero_state must be present') - end if - ! collect number densities (#/cm^3) for dust, sulfate, and soot call aero_state%nuclice_get_numdens( aero_props, use_preexisting_ice, ncol, pver, rho, & dust_num_col, sulf_num_col, soot_num_col, sulf_num_tot_col ) @@ -717,7 +713,7 @@ subroutine nucleate_ice_cam_calc( & idxtmp = aer_cnst_idx(m,l) - call aero_state%get_ambient_mmr(l,m,amb_mmr) + call aero_state%get_ambient_mmr(species_ndx=l, bin_ndx=m, mmr=amb_mmr) call aero_state%get_cldbrne_mmr(l,m,cld_mmr) ! determine change in aerosol mass diff --git a/src/physics/cam/phys_debug.F90 b/src/physics/cam/phys_debug.F90 index 4ed47d3724..a80e60a90a 100644 --- a/src/physics/cam/phys_debug.F90 +++ b/src/physics/cam/phys_debug.F90 @@ -23,7 +23,8 @@ module phys_debug use cam_logfile, only: iulog use cam_history, only: addfld, add_default, outfld use constituents, only: pcnst, cnst_get_ind, cnst_name -use rad_constituents,only: rad_cnst_get_info, rad_cnst_get_mode_num_idx, rad_cnst_get_mam_mmr_idx +use radiative_aerosol, only: rad_aer_get_info +use aerosol_mmr_cam, only: rad_cnst_get_mode_num_idx, rad_cnst_get_mam_mmr_idx implicit none private @@ -83,11 +84,11 @@ subroutine phys_debug_state_init(tags) ! Set arrays to identify the modal aerosol constituents cnst_is_mam_num = .false. cnst_is_mam_mmr = .false. - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_aer_get_info(0, nmodes=nmodes) do i = 1, nmodes call rad_cnst_get_mode_num_idx(i, icnst) cnst_is_mam_num(icnst) = .true. - call rad_cnst_get_info(0, i, nspec=nspec) + call rad_aer_get_info(0, i, nspec=nspec) do j = 1, nspec call rad_cnst_get_mam_mmr_idx(i, j, icnst) cnst_is_mam_mmr(icnst) = .true. diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index ad0837ea9b..22dbfefa42 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -154,7 +154,7 @@ subroutine phys_register use cam_diagnostics, only: diag_register use cloud_diagnostics, only: cloud_diagnostics_register use cospsimulator_intr, only: cospsimulator_intr_register - use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not + use radiative_aerosol, only: rad_aer_get_info ! Added to query if it is a modal aero sim or not use radheat, only: radheat_register use subcol, only: subcol_register use subcol_utils, only: is_subcol_on, subcol_get_scheme @@ -267,7 +267,7 @@ subroutine phys_register call conv_water_register() ! Determine whether its a 'modal' aerosol simulation or not - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_aer_get_info(0, nmodes=nmodes) clim_modal_aero = (nmodes > 0) if (clim_modal_aero) then @@ -744,6 +744,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use wv_saturation, only: wv_sat_init use microp_driver, only: microp_driver_init use microp_aero, only: microp_aero_init + use aerosol_instances_mod, only: aerosol_instances_init, aerosol_instances_init_states use macrop_driver, only: macrop_driver_init use conv_water, only: conv_water_init use tracers, only: tracers_init @@ -753,6 +754,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use vertical_diffusion, only: vertical_diffusion_init use phys_debug_util, only: phys_debug_init use rad_constituents, only: rad_cnst_init + use radiative_aerosol, only: rad_aer_init use aer_rad_props, only: aer_rad_props_init use subcol, only: subcol_init use qbo, only: qbo_init @@ -859,7 +861,10 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call solar_data_init() ! Initialize rad constituents and their properties - call rad_cnst_init() + call rad_aer_init() ! aerosol init: physprop_init + mode/bin/list init + call aerosol_instances_init() ! create abstract aerosol factory objects + call aerosol_instances_init_states(phys_state, pbuf2d) ! create persistent per-chunk state objects + call rad_cnst_init() ! gas-specific init call radiation_init(pbuf2d) @@ -2176,12 +2181,16 @@ subroutine tphysbc (ztodt, state, & use dyn_tests_utils, only: vc_dycore use surface_emissions_mod,only: surface_emissions_set use elevated_emissions_mod,only: elevated_emissions_set + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + use aerosol_instances_mod, only: aerosol_instances_get_props, & + aerosol_instances_get_num_models, aerosol_instances_get_state ! Arguments real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) - type(physics_state), intent(inout) :: state + type(physics_state), intent(inout), target :: state type(physics_tend ), intent(inout) :: tend type(physics_buffer_desc), pointer :: pbuf(:) @@ -2283,11 +2292,20 @@ subroutine tphysbc (ztodt, state, & type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes real(r8) :: zero_tracers(pcols,pcnst) + ! For abstract aerosol interface (calcsize/wateruptake) + class(aerosol_properties), pointer :: aero_props + class(aerosol_state), pointer :: aero_state_obj + + integer :: iaermod_lcl + ! For aerosol budget diagnostics character(len=16) :: pname !! package name type(carma_diags_t), pointer :: carma_diags_obj !----------------------------------------------------------------------- + nullify(aero_props) + nullify(aero_state_obj) + carma_diags_obj => carma_diags_t() if (.not.associated(carma_diags_obj)) then call endrun('tphysbc: carma_diags_obj allocation failed') @@ -2926,19 +2944,30 @@ subroutine tphysbc (ztodt, state, & call t_startf('aerosol_wet_processes') if (clim_modal_aero) then + ! Find the modal aerosol model properties object. + do iaermod_lcl = 1, aerosol_instances_get_num_models() + aero_props => aerosol_instances_get_props(iaermod_lcl, list_idx=0) + if (associated(aero_props)) then + if (aero_props%model_is('MAM')) exit + end if + end do + !REMOVECAM - get persistent state from factory; under CAM-SIMA states will be passed as scheme inputs + aero_state_obj => aerosol_instances_get_state(iaermod_lcl, 0, state%lchnk) + !REMOVECAM_END + if (prog_modal_aero) then call physics_ptend_init(ptend, state%psetcols, 'aero_water_uptake', lq=wetdep_lq) ! Do calculations of mode radius and water uptake if: ! 1) modal aerosols are affecting the climate, or ! 2) prognostic modal aerosols are enabled - call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf, aero_props, aero_state_obj) ! for prognostic modal aerosols the transfer of mass between aitken and accumulation ! modes is done in conjunction with the dry radius calculation - call modal_aero_wateruptake_dr(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf, aero_props, aero_state_obj) call physics_update(state, ptend, ztodt, tend) else - call modal_aero_calcsize_diag(state, pbuf) - call modal_aero_wateruptake_dr(state, pbuf) + call modal_aero_calcsize_diag(state, pbuf, aero_props, aero_state_obj) + call modal_aero_wateruptake_dr(state, pbuf, aero_props, aero_state_obj) endif endif diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 index 824da411ab..5bdecc1de9 100644 --- a/src/physics/cam/rad_constituents.F90 +++ b/src/physics/cam/rad_constituents.F90 @@ -2,11 +2,15 @@ module rad_constituents !------------------------------------------------------------------------------------------------ ! -! Provide constituent distributions and properties to the radiation and -! cloud microphysics routines. +! Gas-only radiative constituent handling and cloud optics settings. ! -! The logic to control which constituents are used in the climate calculations -! and which are used in diagnostic radiation calculations is contained in this module. +! Provides: namelist I/O (shared gas+aerosol namelist), gas list init, +! gas MMR retrieval (state/pbuf), gas diagnostics output, and cloud optics +! public variables (iceopticsfile, liqopticsfile, etc.). +! +! Aerosol handling is in radiative_aerosol (facade) backed by +! radiative_aerosol_definitions (core definitions) and aerosol_mmr_cam +! (CAM-specific MMR retrieval). ! !------------------------------------------------------------------------------------------------ @@ -16,67 +20,61 @@ module rad_constituents use physconst, only: rga use physics_types, only: physics_state use phys_control, only: use_simple_phys -use constituents, only: cnst_get_ind use radconstants, only: nradgas, rad_gas_index -use phys_prop, only: physprop_accum_unique_files, physprop_init, & - physprop_get_id, ot_length use cam_history, only: addfld, fieldname_len, outfld, horiz_only -use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index - +use physics_buffer, only: physics_buffer_desc, pbuf_get_field use cam_abortutils, only: endrun use cam_logfile, only: iulog +! Import from radiative_aerosol_definitions (core definitions) +use radiative_aerosol_definitions, only: cs1, N_DIAG, n_rad_cnst, verbose, nl, & + rad_cnst_namelist_t, radcnst_namelist, active_calls, & + n_mode_str, n_bin_str, parse_rad_specifier + +!REMOVECAM +use aerosol_mmr_cam, only: get_cam_idx +!REMOVECAM_END + +use radiative_aerosol, only: rad_aer_readnl + implicit none private save -! Public interfaces +! Storage for gas components in the climate/diagnostic lists + +type :: gas_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=32) :: mass_name ! name for mass per layer field in history output + integer :: idx ! index from constituents or from pbuf +end type gas_t + +type :: gaslist_t + integer :: ngas + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + type(gas_t), pointer :: gas(:) ! dimension(ngas) where ngas = nradgas is from radconstants +end type gaslist_t + +type(gaslist_t), target :: gaslist(0:N_DIAG) ! gasses used in climate/diagnostic calculations + +! values for constituents with requested value of zero +real(r8), allocatable, target :: zero_cols(:,:) +! Public interfaces — routines in this module public :: & rad_cnst_readnl, &! read namelist values and parse rad_cnst_init, &! find optics files and all constituents - rad_cnst_get_info, &! return info about climate/diagnostic lists - rad_cnst_get_mode_idx, &! return mode index of specified mode type - rad_cnst_get_spec_idx, &! return specie index of specified specie type + rad_cnst_get_info, &! gas+aerosol info wrapper rad_cnst_get_gas, &! return pointer to mmr for gasses - rad_cnst_get_aer_mmr, &! return pointer to mmr for aerosols - rad_cnst_get_mam_mmr_idx, &! get constituent index of mam specie mmr (climate list only) - rad_cnst_get_aer_props, &! return physical properties for aerosols - rad_cnst_get_mode_props, &! return physical properties for aerosol modes - rad_cnst_get_mode_num, &! return mode number mixing ratio - rad_cnst_get_mode_num_idx, &! get constituent index of mode number m.r. (climate list only) - rad_cnst_out, &! output constituent diagnostics (mass per layer and column burden) - rad_cnst_get_call_list, &! return list of active climate/diagnostic calls to radiation - rad_cnst_get_bin_props_by_idx, & - rad_cnst_get_bin_mmr_by_idx, & - rad_cnst_get_info_by_bin, & - rad_cnst_get_info_by_bin_spec, & - rad_cnst_get_bin_props, & - rad_cnst_get_bin_num, & - rad_cnst_get_bin_num_idx, & - rad_cnst_get_carma_mmr_idx, & - rad_cnst_get_bin_mmr - -public :: rad_cnst_num_name - -integer, parameter :: cs1 = 256 -integer, public, parameter :: N_DIAG = 10 + rad_cnst_out ! output constituent diagnostics (mass per layer and column burden) + character(len=cs1), public :: iceopticsfile, liqopticsfile character(len=32), public :: icecldoptics,liqcldoptics logical, public :: oldcldoptics = .false. -! Private module data - -! max number of strings in mode definitions -integer, parameter :: n_mode_str = 120 - -! max number of strings in bin definitions -integer, parameter :: n_bin_str = 640 - -! max number of externally mixed entities in the climate/diag lists -integer, parameter :: n_rad_cnst = N_RAD_CNST - ! Namelist variables character(len=cs1), dimension(n_mode_str) :: mode_defs = ' ' character(len=cs1), dimension(n_bin_str) :: bin_defs = ' ' @@ -92,206 +90,8 @@ module rad_constituents character(len=cs1) :: rad_diag_9(n_rad_cnst) = ' ' character(len=cs1) :: rad_diag_10(n_rad_cnst) = ' ' -! type to provide access to the components of a mode -type :: 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 :: 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(modes_t), target :: modes ! mode definitions - -! type to provide access to the components of a bin -type :: 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 :: 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 - -type(bins_t), target :: bins ! mode definitions - -! type to provide access to the data parsed from the rad_climate and rad_diag_* strings -type :: 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 - -type(rad_cnst_namelist_t) :: namelist(0:N_DIAG) ! gas, bulk aerosol, and modal components used in - ! climate/diagnostic calculations - -logical :: active_calls(0:N_DIAG) ! active_calls(i) is true if the i-th call to radiation is - ! specified. Note that the 0th call is for the climate - ! calculation which is always made. - -! Storage for gas components in the climate/diagnostic lists - -type :: gas_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=32) :: mass_name ! name for mass per layer field in history output - integer :: idx ! index from constituents or from pbuf -end type gas_t - -type :: gaslist_t - integer :: ngas - character(len=2) :: list_id ! set to " " for climate list, or two character integer - ! (include leading zero) to identify diagnostic list - type(gas_t), pointer :: gas(:) ! dimension(ngas) where ngas = nradgas is from radconstants -end type gaslist_t - -type(gaslist_t), target :: gaslist(0:N_DIAG) ! gasses used in climate/diagnostic calculations - -! Storage for bulk aerosol components in the climate/diagnostic lists - -type :: 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 :: 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 - -type(aerlist_t), target :: aerosollist(0:N_DIAG) ! list of aerosols used in climate/diagnostic calcs - -! storage for modal aerosol components in the climate/diagnostic lists - -type :: 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 - -type(modelist_t), target :: ma_list(0:N_DIAG) ! list of aerosol modes used in climate/diagnostic calcs - -! storage for modal aerosol components in the climate/diagnostic lists - -type :: 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 - -type(binlist_t), target :: sa_list(0:N_DIAG) ! list of aerosol bins used in climate/diagnostic calcs - -! values for constituents with requested value of zero -real(r8), allocatable, target :: zero_cols(:,:) - -! define generic interface routines -interface rad_cnst_get_info - module procedure rad_cnst_get_info - module procedure rad_cnst_get_info_by_mode - module procedure rad_cnst_get_info_by_mode_spec - module procedure rad_cnst_get_info_by_spectype -end interface - -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 - -interface rad_cnst_get_aer_props - module procedure rad_cnst_get_aer_props_by_idx - module procedure rad_cnst_get_mam_props_by_idx -end interface - -logical :: verbose = .true. -character(len=1), parameter :: nl = achar(10) - -integer, parameter :: num_mode_types = 9 -integer, parameter :: num_spec_types = 8 -character(len=14), 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), parameter :: spec_type_names(num_spec_types) = (/ & - 'sulfate ', 'ammonium ', 'nitrate ', 'p-organic', & - 's-organic', 'black-c ', 'seasalt ', 'dust '/) - -integer, parameter :: num_bin_morphs = 2 -character(len=8), parameter :: bin_morph_names(num_bin_morphs) = & - (/ 'shell ', 'core ' /) - !============================================================================== contains -!============================================================================== subroutine rad_cnst_readnl(nlfile) @@ -306,7 +106,6 @@ subroutine rad_cnst_readnl(nlfile) ! Local variables integer :: unitn, ierr, i character(len=2) :: suffix - character(len=1), pointer :: ctype(:) character(len=*), parameter :: subname = 'rad_cnst_readnl' namelist /rad_cnst_nl/ mode_defs, & @@ -370,49 +169,44 @@ subroutine rad_cnst_readnl(nlfile) ! Parse the namelist input strings - ! Mode definition stings - call parse_mode_defs(mode_defs, modes) - - ! Bin definition stings - call parse_bin_defs(bin_defs, bins) - ! Lists of externally mixed entities for climate and diagnostic calculations do i = 0,N_DIAG select case (i) case(0) - call parse_rad_specifier(rad_climate, namelist(i)) + call parse_rad_specifier(rad_climate, radcnst_namelist(i)) case (1) - call parse_rad_specifier(rad_diag_1, namelist(i)) + call parse_rad_specifier(rad_diag_1, radcnst_namelist(i)) case (2) - call parse_rad_specifier(rad_diag_2, namelist(i)) + call parse_rad_specifier(rad_diag_2, radcnst_namelist(i)) case (3) - call parse_rad_specifier(rad_diag_3, namelist(i)) + call parse_rad_specifier(rad_diag_3, radcnst_namelist(i)) case (4) - call parse_rad_specifier(rad_diag_4, namelist(i)) + call parse_rad_specifier(rad_diag_4, radcnst_namelist(i)) case (5) - call parse_rad_specifier(rad_diag_5, namelist(i)) + call parse_rad_specifier(rad_diag_5, radcnst_namelist(i)) case (6) - call parse_rad_specifier(rad_diag_6, namelist(i)) + call parse_rad_specifier(rad_diag_6, radcnst_namelist(i)) case (7) - call parse_rad_specifier(rad_diag_7, namelist(i)) + call parse_rad_specifier(rad_diag_7, radcnst_namelist(i)) case (8) - call parse_rad_specifier(rad_diag_8, namelist(i)) + call parse_rad_specifier(rad_diag_8, radcnst_namelist(i)) case (9) - call parse_rad_specifier(rad_diag_9, namelist(i)) + call parse_rad_specifier(rad_diag_9, radcnst_namelist(i)) case (10) - call parse_rad_specifier(rad_diag_10, namelist(i)) + call parse_rad_specifier(rad_diag_10, radcnst_namelist(i)) end select enddo ! were there any constituents specified for the nth diagnostic call? ! if so, radiation will make a call with those consituents - active_calls(:) = (namelist(:)%ncnst > 0) + active_calls(:) = (radcnst_namelist(:)%ncnst > 0) - ! Initialize the gas and aerosol lists with the information from the - ! namelist. This is done here so that this information is available via - ! the query functions at the time when the register methods are called. + ! Aerosol init phase 1: parse mode/bin defs, accumulate physprop files, + ! set aerosol list_id fields, initialize aerosol lists + call rad_aer_readnl(mode_defs, bin_defs) - ! Set the list_id fields which distinquish the climate and diagnostic lists + ! Gas init phase 1: set gas list_id fields and populate gas lists + if (masterproc) write(iulog,*) nl//subname//': Radiation gas constituent lists:' do i = 0, N_DIAG if (active_calls(i)) then if (i > 0) then @@ -420,62 +214,18 @@ subroutine rad_cnst_readnl(nlfile) else suffix=' ' end if - aerosollist(i)%list_id = suffix - gaslist(i)%list_id = suffix - ma_list(i)%list_id = suffix - sa_list(i)%list_id = suffix - end if - end do - - ! Create a list of the unique set of filenames containing property data - - ! Start with the bulk aerosol species in the climate/diagnostic lists. - ! The physprop_accum_unique_files routine has the side effect of returning the number - ! of bulk aerosols in each list (they're identified by type='A'). - do i = 0, N_DIAG - if (active_calls(i)) then - call physprop_accum_unique_files(namelist(i)%radname, namelist(i)%type) - endif - enddo - - ! Add physprop files for the species from the mode definitions. - 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 + gaslist(i)%list_id = suffix - ! Add physprop files for the species from the bin definitions. - 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 the gas, bulk aerosol, and modal aerosol lists. This step splits the - ! input climate/diagnostic lists into the corresponding gas, bulk and modal aerosol - ! lists. - if (masterproc) write(iulog,*) nl//subname//': Radiation constituent lists:' - do i = 0, N_DIAG - if (active_calls(i)) then - call list_init1(namelist(i), gaslist(i), aerosollist(i), ma_list(i), sa_list(i)) + call gas_list_populate(radcnst_namelist(i), gaslist(i)) if (masterproc .and. verbose) then - call print_lists(gaslist(i), aerosollist(i), ma_list(i), sa_list(i)) + call print_gas_list(gaslist(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_cnst_readnl -!================================================================================================ - subroutine rad_cnst_init() ! The initialization of the gas and aerosol lists is finished by @@ -493,24 +243,11 @@ subroutine rad_cnst_init() allocate(zero_cols(pcols,pver)) zero_cols = 0._r8 - ! Allocate storage for the physical properties of each aerosol; read properties from - ! the data files. - call physprop_init() - - ! Start checking that specified radiative constituents are present in the constituent - ! or physics buffer arrays. - if (masterproc) write(iulog,*) nl//subname//': checking for radiative constituents' - - ! Finish initializing the mode definitions. - call init_mode_comps(modes) - - ! Finish initializing the bin definitions. - call init_bin_comps(bins) - - ! Finish initializing the gas, bulk aerosol, and mode lists. + ! Resolve constituent indices for gas lists + if (masterproc) write(iulog,*) nl//subname//': checking for radiative gas constituents' do i = 0, N_DIAG if (active_calls(i)) then - call list_init2(gaslist(i), aerosollist(i), ma_list(i), sa_list(i)) + call gas_list_resolve_cnst_idx(gaslist(i)) end if end do @@ -523,213 +260,116 @@ subroutine rad_cnst_init() enddo endif - ! Initialize history output of climate diagnostic quantities + ! Initialize gas history output for climate diagnostic quantities call rad_gas_diag_init(gaslist(0)) - call rad_aer_diag_init(aerosollist(0)) - end subroutine rad_cnst_init -!================================================================================================ - -subroutine rad_cnst_get_gas(list_idx, gasname, state, pbuf, mmr) +subroutine gas_list_populate(namelist, gaslist) - ! Return pointer to mass mixing ratio for the gas from the specified - ! climate or diagnostic list. + ! Populate gas list from parsed namelist data. + ! Must run at readnl time for consistency with aerosol list_populate. + ! Do NOT merge with gas_list_resolve_cnst_idx. - ! Arguments - integer, intent(in) :: list_idx ! index of the climate or a diagnostic list - character(len=*), intent(in) :: gasname - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), pointer :: mmr(:,:) + type(rad_cnst_namelist_t), intent(in) :: namelist + type(gaslist_t), intent(inout) :: gaslist ! Local variables - integer :: lchnk - integer :: igas - integer :: idx - character(len=1) :: source - type(gaslist_t), pointer :: list - character(len=*), parameter :: subname = 'rad_cnst_get_gas' + integer :: ii, igas, istat + character(len=*), parameter :: routine = 'gas_list_populate' !----------------------------------------------------------------------------- - if (list_idx >= 0 .and. list_idx <= N_DIAG) then - list => gaslist(list_idx) - else - write(iulog,*) subname//': list_idx =', list_idx - call endrun(subname//': list_idx out of bounds') - endif + ! nradgas is set by the radiative transfer code + gaslist%ngas = nradgas - lchnk = state%lchnk + allocate(gaslist%gas(gaslist%ngas), stat=istat) + if (istat /= 0) call endrun(routine//': allocate ERROR; gas list components') - ! Get index of gas in internal arrays. rad_gas_index will abort if the - ! specified gasname is not recognized by the radiative transfer code. - igas = rad_gas_index(trim(gasname)) + ! Initialize sources to zero (default for unspecified gases) + do igas = 1, gaslist%ngas + gaslist%gas(igas)%source = 'Z' + gaslist%gas(igas)%camname = ' ' + end do - ! Get data source - source = list%gas(igas)%source - idx = list%gas(igas)%idx - select case( source ) - case ('A') - mmr => state%q(:,:,idx) - case ('N') - call pbuf_get_field(pbuf, idx, mmr) - case ('Z') - mmr => zero_cols - end select + ! Populate gas entries from 'G' type namelist entries + do ii = 1, namelist%ncnst + if (namelist%type(ii) /= 'G') cycle -end subroutine rad_cnst_get_gas + if (masterproc .and. verbose) & + write(iulog,*) " rad namelist spec: "// trim(namelist%source(ii)) & + //":"//trim(namelist%camname(ii))//":"//trim(namelist%radname(ii)) + + ! rad_gas_index will abort on illegal names + igas = rad_gas_index(namelist%radname(ii)) + + gaslist%gas(igas)%source = namelist%source(ii) + gaslist%gas(igas)%camname = namelist%camname(ii) + end do + +end subroutine gas_list_populate !================================================================================================ -function rad_cnst_num_name(list_idx, spc_name_in, num_name_out, mode_out, spec_out ) result(found) - - ! 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 => ma_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 - - return - -end function +subroutine gas_list_resolve_cnst_idx(gaslist) + + ! Resolve constituent indices for gas list entries. + ! Must run at init time (after constituent registration). + ! Do NOT merge with gas_list_populate. + + type(gaslist_t), intent(inout) :: gaslist + + ! Local variables + integer :: i + character(len=*), parameter :: routine = 'gas_list_resolve_cnst_idx' + !----------------------------------------------------------------------------- + + do i = 1, gaslist%ngas + gaslist%gas(i)%idx = get_cam_idx(gaslist%gas(i)%source, gaslist%gas(i)%camname, routine) + end do + +end subroutine gas_list_resolve_cnst_idx !================================================================================================ -subroutine rad_cnst_get_info(list_idx, gasnames, aernames, & - use_data_o3, ngas, naero, nmodes, nbins) +subroutine rad_cnst_get_info(list_idx, gasnames, use_data_o3, ngas) - ! Return info about gas and aerosol lists + ! Gas variant of rad_cnst_get_info; + ! aerosol information moved to radiative_aerosol::rad_aer_get_info. ! Arguments - integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: list_idx character(len=64), optional, intent(out) :: gasnames(:) - character(len=64), optional, intent(out) :: aernames(:) logical, optional, intent(out) :: use_data_o3 - integer, optional, intent(out) :: naero integer, optional, intent(out) :: ngas - integer, optional, intent(out) :: nmodes - integer, optional, intent(out) :: nbins ! Local variables - type(gaslist_t), pointer :: g_list ! local pointer to gas list of interest - 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 - integer :: gaslen ! length of assumed shape array - integer :: igas ! index of a gas in the gas list - character(len=1) :: source ! A for state, N for pbuf, Z for zero - + type(gaslist_t), pointer :: g_list + integer :: i, igas, gaslen + character(len=1) :: source character(len=*), parameter :: subname = 'rad_cnst_get_info' !----------------------------------------------------------------------------- + ! Handle gas arguments locally g_list => gaslist(list_idx) - a_list => aerosollist(list_idx) - m_list => ma_list(list_idx) - s_list => sa_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 - ! number of gases in list if (present(ngas)) then ngas = g_list%ngas 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 - - ! names of gas in list if (present(gasnames)) then - - ! check that output array is long enough gaslen = size(gasnames) if (gaslen < g_list%ngas) then write(iulog,*) subname//': ERROR: ngas=', g_list%ngas, ' gaslen=', gaslen call endrun(subname//': ERROR: gasnames too short') end if - do i = 1, g_list%ngas gasnames(i) = g_list%gas(i)%camname end do - end if - ! Does the climate calculation use data ozone? if (present(use_data_o3)) then - - ! get index of O3 in gas list igas = rad_gas_index('O3') - - ! Get data source source = g_list%gas(igas)%source - use_data_o3 = .false. if (source == 'N') use_data_o3 = .true. endif @@ -738,3009 +378,188 @@ end subroutine rad_cnst_get_info !================================================================================================ -subroutine rad_cnst_get_info_by_mode(list_idx, m_idx, & - mode_type, num_name, num_name_cw, nspec) +subroutine rad_cnst_get_gas(list_idx, gasname, state, pbuf, mmr) - ! Return info about modal aerosol lists + ! Return pointer to mass mixing ratio for the gas from the specified + ! climate or diagnostic list. ! 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 + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=*), intent(in) :: gasname + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) ! Local variables - type(modelist_t), pointer :: m_list ! local pointer to mode list of interest - - integer :: nmodes - integer :: mm - - character(len=*), parameter :: subname = 'rad_cnst_get_info_by_mode' + integer :: lchnk + integer :: igas + integer :: idx + character(len=1) :: source + type(gaslist_t), pointer :: list + character(len=*), parameter :: subname = 'rad_cnst_get_gas' !----------------------------------------------------------------------------- - m_list => ma_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 + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + list => gaslist(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') endif - ! name of interstitial number mixing ratio - if (present(num_name)) then - num_name = modes%comps(mm)%camname_num_a - endif + lchnk = state%lchnk - ! name of cloud borne number mixing ratio - if (present(num_name_cw)) then - num_name_cw = modes%comps(mm)%camname_num_c - endif + ! Get index of gas in internal arrays. rad_gas_index will abort if the + ! specified gasname is not recognized by the radiative transfer code. + igas = rad_gas_index(trim(gasname)) -end subroutine rad_cnst_get_info_by_mode + ! Get data source + source = list%gas(igas)%source + idx = list%gas(igas)%idx + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + case ('Z') + mmr => zero_cols + end select -!================================================================================================ +end subroutine rad_cnst_get_gas -subroutine rad_cnst_get_info_by_bin(list_idx, m_idx, & - bin_name, num_name, num_name_cw, mmr_name, mmr_name_cw, nspec) +subroutine rad_cnst_out(list_idx, state, pbuf) - ! Return info about CARMA aerosol lists + ! Output the mass per layer, and total column burdens for gas + ! constituents in either the climate or diagnostic lists. + ! Aerosol output is now handled by rad_aer_diag_out in aerosol_mmr_cam. ! 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 + integer, intent(in) :: list_idx + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) ! Local variables - type(binlist_t), pointer :: s_list ! local pointer to mode list of interest - - integer :: nbins - integer :: mm - - character(len=*), parameter :: subname = 'rad_cnst_get_info_by_bin' + integer :: i, ngas, lchnk, ncol + integer :: idx + character(len=1) :: source + character(len=32) :: name, cbname + real(r8) :: mass(pcols,pver) + real(r8) :: cb(pcols) + real(r8), pointer :: mmr(:,:) + type(gaslist_t), pointer :: g_list + character(len=*), parameter :: subname = 'rad_cnst_out' !----------------------------------------------------------------------------- - s_list => sa_list(list_idx) + lchnk = state%lchnk + ncol = state%ncol - ! 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 + ! Associate pointer with requested gas list + g_list => gaslist(list_idx) - ! get index into the mode definition object - mm = s_list%idx(m_idx) + ngas = g_list%ngas + do i = 1, ngas - ! number of species in the mode - if (present(nspec)) then - nspec = bins%comps(mm)%nspec - endif + source = g_list%gas(i)%source + idx = g_list%gas(i)%idx + name = g_list%gas(i)%mass_name + cbname = 'cb_' // name(3:len_trim(name)) + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + end select - ! bin name - if (present(bin_name)) then - bin_name = bins%names(m_idx) - end if + mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga + call outfld(trim(name), mass, pcols, lchnk) - ! name of interstitial number mixing ratio - if (present(num_name)) then - num_name = bins%comps(mm)%camname_num_a - endif + cb(:ncol) = sum(mass(:ncol,:),2) + call outfld(trim(cbname), cb, pcols, lchnk) - ! 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_cnst_get_info_by_bin - -!================================================================================================ -subroutine rad_cnst_get_info_by_bin_spec(list_idx, m_idx, s_idx, & - spec_type, spec_morph, spec_name, spec_name_cw) - - ! 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_cnst_get_info_by_bin_spec' - !----------------------------------------------------------------------------- - - s_list => sa_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_cnst_get_info_by_bin_spec - -!================================================================================================ -subroutine rad_cnst_get_info_by_mode_spec(list_idx, m_idx, s_idx, & - spec_type, spec_name, spec_name_cw) - - ! 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_cnst_get_info_by_mode_spec' - !----------------------------------------------------------------------------- - - m_list => ma_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_cnst_get_info_by_mode_spec - -!================================================================================================ - -subroutine rad_cnst_get_info_by_spectype(list_idx, spectype, mode_idx, spec_idx) - - ! 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_cnst_get_info_by_spectype' - !----------------------------------------------------------------------------- - - m_list => ma_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_cnst_get_info_by_spectype - -!================================================================================================ - -function rad_cnst_get_mode_idx(list_idx, mode_type) result(mode_idx) - - ! 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_cnst_get_mode_idx' - !----------------------------------------------------------------------------- - - ! if mode type not found return -1 - mode_idx = -1 - - ! specified mode list - m_list => ma_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_cnst_get_mode_idx - -!================================================================================================ - -function rad_cnst_get_spec_idx(list_idx, mode_idx, spec_type) result(spec_idx) - - ! 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_cnst_get_spec_idx' - !----------------------------------------------------------------------------- - - ! if specie type not found return -1 - spec_idx = -1 - - ! modes in specified list - m_list => ma_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_cnst_get_spec_idx - -!================================================================================================ - -subroutine rad_cnst_get_call_list(call_list) - - ! Return info about which climate/diagnostic calculations are requested - - ! Arguments - logical, intent(out) :: call_list(0:N_DIAG) - !----------------------------------------------------------------------------- - - call_list(:) = active_calls(:) - -end subroutine rad_cnst_get_call_list - -!================================================================================================ - -subroutine rad_cnst_out(list_idx, state, pbuf) - - ! Output the mass per layer, and total column burdens for gas and aerosol - ! constituents in either the climate or diagnostic lists - - ! Arguments - integer, intent(in) :: list_idx - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - - ! Local variables - integer :: i, naer, ngas, lchnk, ncol - integer :: idx - character(len=1) :: source - character(len=32) :: name, cbname - real(r8) :: mass(pcols,pver) - real(r8) :: cb(pcols) - real(r8), pointer :: mmr(:,:) - type(aerlist_t), pointer :: aerlist - type(gaslist_t), pointer :: g_list - character(len=*), parameter :: subname = 'rad_cnst_out' - !----------------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - ! Associate pointer with requested aerosol list - if (list_idx >= 0 .and. list_idx <= N_DIAG) then - aerlist => aerosollist(list_idx) - else - write(iulog,*) subname//': list_idx = ', list_idx - call endrun(subname//': list_idx out of range') - endif - - naer = aerlist%numaerosols - do i = 1, naer - - source = aerlist%aer(i)%source - idx = aerlist%aer(i)%idx - name = aerlist%aer(i)%mass_name - ! construct name for column burden field by replacing the 'm_' prefix by 'cb_' - cbname = 'cb_' // name(3:len_trim(name)) - - select case( source ) - case ('A') - mmr => state%q(:,:,idx) - case ('N') - call pbuf_get_field(pbuf, idx, mmr) - end select - - mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga - call outfld(trim(name), mass, pcols, lchnk) - - cb(:ncol) = sum(mass(:ncol,:),2) - call outfld(trim(cbname), cb, pcols, lchnk) - - end do - - ! Associate pointer with requested gas list - g_list => gaslist(list_idx) - - ngas = g_list%ngas - do i = 1, ngas - - source = g_list%gas(i)%source - idx = g_list%gas(i)%idx - name = g_list%gas(i)%mass_name - cbname = 'cb_' // name(3:len_trim(name)) - select case( source ) - case ('A') - mmr => state%q(:,:,idx) - case ('N') - call pbuf_get_field(pbuf, idx, mmr) - end select - - mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga - call outfld(trim(name), mass, pcols, lchnk) - - cb(:ncol) = sum(mass(:ncol,:),2) - call outfld(trim(cbname), cb, pcols, lchnk) - - end do - -end subroutine rad_cnst_out - -!================================================================================================ -! Private methods -!================================================================================================ - -subroutine init_mode_comps(modes) - - ! Initialize the mode definitions by looking up the relevent indices in the - ! constituent and pbuf arrays, and getting the physprop IDs - - ! Arguments - type(modes_t), intent(inout) :: modes - - ! Local variables - integer :: m, ispec, nspec - - character(len=*), parameter :: routine = 'init_mode_comps' - !----------------------------------------------------------------------------- - - do m = 1, modes%nmodes - - ! indices for number mixing ratio components - modes%comps(m)%idx_num_a = get_cam_idx(modes%comps(m)%source_num_a, modes%comps(m)%camname_num_a, routine) - modes%comps(m)%idx_num_c = get_cam_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_cam_idx(modes%comps(m)%source_mmr_a(ispec), & - modes%comps(m)%camname_mmr_a(ispec), routine) - modes%comps(m)%idx_mmr_c(ispec) = get_cam_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 init_mode_comps - -!================================================================================================ - -subroutine init_bin_comps(bins) - - ! Initialize the mode definitions by looking up the relevent indices in the - ! constituent and pbuf arrays, and getting the physprop IDs - - ! Arguments - type(bins_t), intent(inout) :: bins - - ! Local variables - integer :: m, ispec, nspec - - character(len=*), parameter :: routine = 'init_bin_comps' - !----------------------------------------------------------------------------- - - do m = 1, bins%nbins - - ! indices for number mixing ratio components - bins%comps(m)%idx_num_a = get_cam_idx(bins%comps(m)%source_num_a, bins%comps(m)%camname_num_a, routine) - bins%comps(m)%idx_num_c = get_cam_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_cam_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_cam_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_cam_idx(bins%comps(m)%source_mmr_a(ispec), & - bins%comps(m)%camname_mmr_a(ispec), routine) - bins%comps(m)%idx_mmr_c(ispec) = get_cam_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 init_bin_comps - -!================================================================================================ - -integer function get_cam_idx(source, name, routine) - - ! get index of name in internal CAM array; either the constituent array - ! or the physics buffer - - character(len=*), intent(in) :: source - character(len=*), intent(in) :: name - character(len=*), intent(in) :: routine ! name of calling routine - - integer :: idx - integer :: errcode - !----------------------------------------------------------------------------- - - if (source(1:1) == 'N') then - - idx = pbuf_get_index(trim(name),errcode) - if (errcode < 0) then - call endrun(routine//' ERROR: cannot find physics buffer field '//trim(name)) - end if - - else if (source(1:1) == 'A') then - - call cnst_get_ind(trim(name), idx, abort=.false.) - if (idx < 0) then - call endrun(routine//' ERROR: cannot find constituent field '//trim(name)) - end if - - else if (source(1:1) == 'Z') then - - idx = -1 - - else - - call endrun(routine//' ERROR: invalid source for specie '//trim(name)) - - end if - - get_cam_idx = idx - -end function get_cam_idx - -!================================================================================================ - -subroutine list_init1(namelist, gaslist, aerlist, ma_list, sa_list) - - ! Initialize the gas and bulk and modal aerosol lists with the - ! entities specified in the climate or diagnostic lists. - - ! This first phase initialization just sets the information that - ! is available at the time the namelist is read. - - type(rad_cnst_namelist_t), intent(in) :: namelist ! parsed namelist input for climate or diagnostic lists - - type(gaslist_t), intent(inout) :: gaslist - type(aerlist_t), intent(inout) :: aerlist - type(modelist_t), intent(inout) :: ma_list - type(binlist_t), intent(inout) :: sa_list - - ! Local variables - integer :: ii, m, naero, nmodes, nbins - integer :: igas, ba_idx, ma_idx, sa_idx - integer :: istat - character(len=*), parameter :: routine = 'list_init1' - !----------------------------------------------------------------------------- - - ! nradgas is set by the radiative transfer code - gaslist%ngas = nradgas - - ! 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 - ma_list%nmodes = nmodes - sa_list%nbins = nbins - - ! allocate storage for the aerosol, gas, and mode lists - allocate( & - aerlist%aer(aerlist%numaerosols), & - gaslist%gas(gaslist%ngas), & - ma_list%idx(ma_list%nmodes), & - ma_list%physprop_files(ma_list%nmodes), & - ma_list%idx_props(ma_list%nmodes), & - sa_list%idx(sa_list%nbins), & - sa_list%physprop_files(sa_list%nbins), & - sa_list%idx_props(sa_list%nbins), & - stat=istat) - if (istat /= 0) call endrun(routine//': allocate ERROR; aero and gas list components') - - if (masterproc .and. verbose) then - if (len_trim(gaslist%list_id) == 0) then - write(iulog,*) nl//' '//routine//': namelist input for climate list' - else - write(iulog,*) nl//' '//routine//': namelist input for diagnostic list:'//gaslist%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 - - 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(routine//": 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 (gas, 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. - ma_list%idx(ma_idx) = -1 - do m = 1, modes%nmodes - if (trim(namelist%camname(ii)) == trim(modes%names(m))) then - ma_list%idx(ma_idx) = m - exit - end if - end do - if (ma_list%idx(ma_idx) == -1) & - call endrun(routine//' ERROR cannot find mode name '//trim(namelist%camname(ii))) - - ! Also save the name of the physprop file - ma_list%physprop_files(ma_idx) = namelist%radname(ii) - - else if (namelist%type(ii) == 'B') then - - ! Add to modal aerosol list - sa_idx = sa_idx + 1 - - ! Look through the bin definitions for the name of the specified bin. The - ! index into the modes object all the information relevent to the mode definition. - sa_list%idx(sa_idx) = -1 - do m = 1, bins%nbins - if (trim(namelist%camname(ii)) == trim(bins%names(m))) then - sa_list%idx(sa_idx) = m - exit - end if - end do - if (sa_list%idx(sa_idx) == -1) & - call endrun(routine//' ERROR cannot find bin name '//trim(namelist%camname(ii))) - - ! Also save the name of the physprop file - sa_list%physprop_files(sa_idx) = namelist%radname(ii) - - else - - ! Add to gas list - - ! The radiative transfer code requires the input of a specific set of gases - ! which is hardwired into the code. The CAM interface to the RT code uses - ! the names in the radconstants module to refer to these gases. The user - ! interface (namelist) also uses these names to identify the gases treated - ! by the RT code. We use the index order set in radconstants for convenience - ! only. - - ! First check that the gas name specified by the user is allowed. - ! rad_gas_index will abort on illegal names. - igas = rad_gas_index(namelist%radname(ii)) - - ! Set values in the igas index - gaslist%gas(igas)%source = namelist%source(ii) - gaslist%gas(igas)%camname = namelist%camname(ii) - - end if - end do - -end subroutine list_init1 - -!================================================================================================ - -subroutine list_init2(gaslist, aerlist, ma_list, sa_list) - - ! Final initialization phase gets the component indices in the constituent array - ! and the physics buffer, and indices into physprop module. - - type(gaslist_t), intent(inout) :: gaslist - type(aerlist_t), intent(inout) :: aerlist - type(modelist_t), intent(inout) :: ma_list - type(binlist_t), intent(inout) :: sa_list - - ! Local variables - integer :: i - character(len=*), parameter :: routine = 'list_init2' - !----------------------------------------------------------------------------- - - ! Loop over gases - do i = 1, gaslist%ngas - - ! locate the specie mixing ratio in the pbuf or state - gaslist%gas(i)%idx = get_cam_idx(gaslist%gas(i)%source, gaslist%gas(i)%camname, routine) - - end do - - ! Loop over bulk aerosols - do i = 1, aerlist%numaerosols - - ! locate the specie mixing ratio in the pbuf or state - aerlist%aer(i)%idx = get_cam_idx(aerlist%aer(i)%source, aerlist%aer(i)%camname, routine) - - ! 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, ma_list%nmodes - - ! get the physprop_id from the phys_prop module - ma_list%idx_props(i) = physprop_get_id(ma_list%physprop_files(i)) - - end do - - ! Loop over bins - do i = 1, sa_list%nbins - - ! get the physprop_id from the phys_prop module - sa_list%idx_props(i) = physprop_get_id(sa_list%physprop_files(i)) - - end do - -end subroutine list_init2 - -!================================================================================================ - -subroutine rad_gas_diag_init(glist) - -! Add diagnostic fields to the master fieldlist. - - type(gaslist_t), intent(inout) :: glist - - integer :: i, ngas - character(len=64) :: name - character(len=2) :: list_id - character(len=4) :: suffix - character(len=128):: long_name - character(len=32) :: long_name_description - !----------------------------------------------------------------------------- - - ngas = glist%ngas - if (ngas == 0) return - - ! Determine whether this is a climate or diagnostic list. - list_id = glist%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, ngas - - ! construct names for mass per layer diagnostics - name = 'm_' // trim(glist%gas(i)%camname) // trim(suffix) - glist%gas(i)%mass_name = name - long_name = trim(glist%gas(i)%camname)//' mass per layer'//long_name_description - call addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name)) - - ! construct names for column burden diagnostics - name = 'cb_' // trim(glist%gas(i)%camname) // trim(suffix) - long_name = trim(glist%gas(i)%camname)//' column burden'//long_name_description - call addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name)) - - ! error check for name length - if (len_trim(name) > fieldname_len) then - write(iulog,*) 'rad_gas_diag_init: '//trim(name)//' longer than ', fieldname_len, ' characters' - call endrun('rad_gas_diag_init: name too long: '//trim(name)) - end if - - end do - -end subroutine rad_gas_diag_init - -!================================================================================================ - -subroutine rad_aer_diag_init(alist) - -! Add diagnostic fields to the master fieldlist. - - 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 addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name)) - - ! 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 addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name)) - - ! error check for name length - if (len_trim(name) > fieldname_len) then - write(iulog,*) 'rad_aer_diag_init: '//trim(name)//' longer than ', fieldname_len, ' characters' - call endrun('rad_aer_diag_init: name too long: '//trim(name)) - end if - - end do - -end subroutine rad_aer_diag_init - - -!================================================================================================ - -subroutine parse_mode_defs(nl_in, modes) - - ! 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][:+]['] - ! - ! where the ':' separated fields are: - ! mode_name -- name of the mode. - ! mode_type -- type of mode. Valid values are from the MAM code. - ! = -- this line terminator identifies the initial string in a - ! mode definition - ! + -- this line terminator indicates that the mode definition is - ! continued in the next string - ! source_num_a -- Source of interstitial number mixing ratio, 'A', 'N', or 'Z' - ! camname_num_a -- the name of the interstitial number component. This name must be - ! registered in the constituent arrays when source=A or in the - ! physics buffer when source=N - ! source_num_c -- Source of cloud borne number mixing ratio, 'A', 'N', or 'Z' - ! camname_num_c -- the name of the cloud borne number component. This name must be - ! registered in the constituent arrays when source=A or in the - ! physics buffer when source=N - ! source_mmr_a -- Source of interstitial specie mass mixing ratio, 'A', 'N' or 'Z' - ! camname_mmr_a -- the name of the interstitial specie. This name must be - ! registered in the constituent arrays when source=A or in the - ! physics buffer when source=N - ! source_mmr_c -- Source of cloud borne specie mass mixing ratio, 'A', 'N' or 'Z' - ! camname_mmr_c -- the name of the cloud borne specie. This name must be - ! registered in the constituent arrays when source=A or in the - ! physics buffer when source=N - ! spec_type -- species type. Valid values far from the MAM code, except that - ! the value 'num_mr' designates a number mixing ratio and has no - ! associated field for the prop_file. There can only be one entry - ! with the num_mr type in a mode definition. - ! prop_file -- For aerosol species this is a filename, which is - ! identified by a ".nc" suffix. The file contains optical and - ! other physical properties of the aerosol. - ! - ! A mode definition must contain only 1 string for the number mixing ratio components - ! and at least 1 string for the species. - - - 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 :: routine = '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,*) routine//': ERROR: cannot allocate storage for modes. nmodes=', nmodes - call endrun(routine//': 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,*) routine//': ERROR: cannot allocate storage for species. nspec=', nspec - call endrun(routine//': 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 - !------------------------------------------------------------------------------------------------ - - ! internal subroutines used for error checking and reporting - - subroutine parse_error(msg, str) - - character(len=*), intent(in) :: msg - character(len=*), intent(in) :: str - - write(iulog,*) routine//': ERROR: '//msg - write(iulog,*) ' input string: '//trim(str) - call endrun(routine//': 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) - - ! Parse the bin definition specifiers. The specifiers are of the form: - ! - ! 'bin_name:=', - ! '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][:+]['] - ! - ! where the ':' separated fields are: - ! bin_name -- name of the bin. - ! = -- this line terminator identifies the initial string in a - ! mode definition - ! + -- this line terminator indicates that the mode definition is - ! continued in the next string - ! source_num_a -- Source of interstitial number mixing ratio, 'A', 'N', or 'Z' - ! camname_num_a -- the name of the interstitial number component. This name must be - ! registered in the constituent arrays when source=A or in the - ! physics buffer when source=N - ! source_num_c -- Source of cloud borne number mixing ratio, 'A', 'N', or 'Z' - ! camname_num_c -- the name of the cloud borne number component. This name must be - ! registered in the constituent arrays when source=A or in the - ! physics buffer when source=N - ! source_mmr_a -- Source of interstitial specie mass mixing ratio, 'A', 'N' or 'Z' - ! camname_mmr_a -- the name of the interstitial specie. This name must be - ! registered in the constituent arrays when source=A or in the - ! physics buffer when source=N - ! source_mmr_c -- Source of cloud borne specie mass mixing ratio, 'A', 'N' or 'Z' - ! camname_mmr_c -- the name of the cloud borne specie. This name must be - ! registered in the constituent arrays when source=A or in the - ! physics buffer when source=N - ! spec_type -- species type. Valid values are particle, shell, and core. - ! prop_file -- For aerosol species this is a filename, which is - ! identified by a ".nc" suffix. The file contains optical and - ! other physical properties of the aerosol. - ! - ! A bin definition must contain at least 1 string for the species and can contain - ! a maximum of 1 particle type. - - - 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 - logical :: particle_mr_found - integer :: m - integer :: istat - integer :: nbins, nstr, istr - integer :: mbeg, mcur - integer :: nspec, ispec - integer :: strlen, ibeg, iend, ipos - logical :: part_mr_found - character(len=*), parameter :: routine = '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,*) routine//': ERROR: cannot allocate storage for bins. nbins=', nbins - call endrun(routine//': 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,*) routine//': ERROR: cannot allocate storage for species. nspec=', nspec - call endrun(routine//': 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 - particle_mr_found = .false. ! keep track of whether particle mixing ratio component is found - 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 - !------------------------------------------------------------------------------------------------ - - ! internal subroutines used for error checking and reporting - - subroutine parse_error(msg, str) - - character(len=*), intent(in) :: msg - character(len=*), intent(in) :: str - - write(iulog,*) routine//': ERROR: '//msg - write(iulog,*) ' input string: '//trim(str) - call endrun(routine//': 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) - -!----------------------------------------------------------------------------- -! Private method for parsing the radiation namelist specifiers. The specifiers -! are of the form 'source_camname:radname' where: -! source -- either 'N' for pbuf (non-advected) or 'A' for state (advected) -! camname -- the name of a constituent that must be found in the constituent -! component of the state when source=A or in the physics buffer -! when source=N -! radname -- For gases this is a name that identifies the constituent to the -! radiative transfer codes. These names are contained in the -! radconstants module. For aerosols this is a filename, which is -! identified by a ".nc" suffix. The file contains optical and -! other physical properties of the aerosol. -! -! This code also identifies whether the constituent is a gas or an aerosol -! and adds that info to a structure that stores the parsed data. -!----------------------------------------------------------------------------- - - 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 rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, state, pbuf, mmr) - - ! Return pointer to mass mixing ratio 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 - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), pointer :: mmr(:,:) - - ! Local variables - integer :: lchnk - 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 => aerosollist(list_idx) - else - write(iulog,*) subname//': list_idx =', list_idx - call endrun(subname//': list_idx out of bounds') - endif - - lchnk = state%lchnk - - ! 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') - mmr => state%q(:,:,idx) - case ('N') - call pbuf_get_field(pbuf, idx, mmr) - 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, state, pbuf, mmr) - - ! Return pointer to mass mixing ratio for the modal aerosol specie 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=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), pointer :: mmr(:,:) - - ! Local variables - integer :: m_idx - integer :: idx - integer :: lchnk - 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 => ma_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 - - lchnk = state%lchnk - - select case( source ) - case ('A') - mmr => state%q(:,:,idx) - case ('N') - call pbuf_get_field(pbuf, idx, mmr) - 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, state, pbuf, mmr) - - ! Return pointer to mass mixing ratio for the modal aerosol specie 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=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), pointer :: mmr(:,:) - - ! Local variables - integer :: s_idx - integer :: idx - integer :: lchnk - 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 => sa_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 (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 - s_idx = slist%idx(bin_idx) - - ! Check for valid specie index - 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 - - ! Get data source - 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 - - lchnk = state%lchnk - - select case( source ) - case ('A') - mmr => state%q(:,:,idx) - case ('N') - call pbuf_get_field(pbuf, idx, mmr) - 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. - - ! This is a special routine to allow direct access to information in the - ! constituent array inside physics parameterizations that have been passed, - ! and are operating over the entire constituent array. The interstitial phase - ! is assumed since that's what is contained in the constituent array. - - ! Arguments - integer, intent(in) :: mode_idx ! mode index - integer, intent(in) :: spec_idx ! index of specie in the mode - integer, intent(out) :: idx ! index of specie in the constituent array - - ! Local variables - integer :: m_idx - type(modelist_t), pointer :: mlist - character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_idx' - !----------------------------------------------------------------------------- - - ! assume climate list (i.e., species are in the constituent array) - mlist => ma_list(0) - - ! 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 - - ! Assume data source is interstitial since that's what's in the constituent array - 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) - - ! Return constituent index of camra species mass mixing ratio for aerosol bins in - ! the climate list. - - ! This is a special routine to allow direct access to information in the - ! constituent array inside physics parameterizations that have been passed, - ! and are operating over the entire constituent array. The interstitial phase - ! is assumed since that's what is contained in the constituent array. - - ! Arguments - integer, intent(in) :: bin_idx ! bin index - integer, intent(in) :: spec_idx ! index of specie in the bin - integer, intent(out) :: idx ! index of specie in the constituent array - - ! Local variables - integer :: b_idx - type(binlist_t), pointer :: slist - character(len=*), parameter :: subname = 'rad_cnst_get_carma_mmr_idx' - !----------------------------------------------------------------------------- - - ! assume climate list (i.e., species are in the constituent array) - slist => sa_list(0) - - ! Check for valid bin 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 bin in the bin definition object - b_idx = slist%idx(bin_idx) - - ! Check for valid specie index - 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 - - ! Assume data source is interstitial since that's what's in the constituent array - 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, state, pbuf, mmr) - - ! Return pointer to mass mixing ratio for the aerosol 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 ! bin index - character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), pointer :: mmr(:,:) - - ! Local variables - integer :: m_idx - integer :: idx - integer :: lchnk - 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 => sa_list(list_idx) - else - write(iulog,*) subname//': list_idx =', list_idx - call endrun(subname//': list_idx out of bounds') - endif - - ! Check for valid bin 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 bin in the bin definition object - m_idx = slist%idx(bin_idx) - - ! Get data source - 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 - - lchnk = state%lchnk - - select case( source ) - case ('A') - mmr => state%q(:,:,idx) - case ('N') - call pbuf_get_field(pbuf, idx, mmr) - 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, state, pbuf, num) - - ! Return pointer to number mixing ratio for the aerosol 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=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), pointer :: num(:,:) - - ! Local variables - integer :: m_idx - integer :: idx - integer :: lchnk - 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 => ma_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) - - ! Get data source - 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 - - lchnk = state%lchnk - - select case( source ) - case ('A') - num => state%q(:,:,idx) - case ('N') - call pbuf_get_field(pbuf, idx, num) - 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, state, pbuf, num) - - ! Return pointer to number mixing ratio for the aerosol 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 ! bin index - character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), pointer :: num(:,:) - - ! Local variables - integer :: m_idx - integer :: idx - integer :: lchnk - 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 => sa_list(list_idx) - else - write(iulog,*) subname//': list_idx =', list_idx - call endrun(subname//': list_idx out of bounds') - endif - - ! Check for valid bin 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 bin in the bin definition object - m_idx = slist%idx(bin_idx) - - ! Get data source - 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 - - lchnk = state%lchnk - - select case( source ) - case ('A') - num => state%q(:,:,idx) - case ('N') - call pbuf_get_field(pbuf, idx, num) - 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) - - ! Return constituent index of mode number mixing ratio for the aerosol mode in - ! the climate list. - - ! This is a special routine to allow direct access to information in the - ! constituent array inside physics parameterizations that have been passed, - ! and are operating over the entire constituent array. The interstitial phase - ! is assumed since that's what is contained in the constituent array. - - ! Arguments - integer, intent(in) :: mode_idx ! mode index - integer, intent(out) :: cnst_idx ! constituent index - - ! Local variables - integer :: m_idx - character(len=1) :: source - type(modelist_t), pointer :: mlist - character(len=*), parameter :: subname = 'rad_cnst_get_mode_num' - !----------------------------------------------------------------------------- - - ! assume climate list - mlist => ma_list(0) - - ! 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 that source is 'A' which means the index is for the constituent array - 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 - - ! Return index in constituent array - 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) - - ! Return constituent index of bin number mixing ratio for the aerosol bin in - ! the climate list. - - ! This is a special routine to allow direct access to information in the - ! constituent array inside physics parameterizations that have been passed, - ! and are operating over the entire constituent array. The interstitial phase - ! is assumed since that's what is contained in the constituent array. - - ! Arguments - integer, intent(in) :: bin_idx ! bin index - integer, intent(out) :: cnst_idx ! constituent index - - ! Local variables - integer :: b_idx - character(len=1) :: source - type(binlist_t), pointer :: slist - character(len=*), parameter :: subname = 'rad_cnst_get_bin_num_idx' - !----------------------------------------------------------------------------- - - ! assume climate list - slist => sa_list(0) - - ! Check for valid bin 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 bin in the bin definition object - b_idx = slist%idx(bin_idx) - - ! Check that source is 'A' which means the index is for the constituent array - 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 - - ! Return index in constituent array - cnst_idx = bins%comps(b_idx)%idx_num_a - -end subroutine rad_cnst_get_bin_num_idx - -!================================================================================================ - -integer function rad_cnst_get_aer_idx(list_idx, aer_name) - - ! 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_cnst_get_aer_idx" - !------------------------------------------------------------------------- - - if (list_idx >= 0 .and. list_idx <= N_DIAG) then - aerlist => aerosollist(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_cnst_get_aer_idx = aer_idx - -end function rad_cnst_get_aer_idx - -!================================================================================================ - -subroutine rad_cnst_get_aer_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) - - ! Return requested properties for the aerosol from the specified - ! climate or diagnostic list. - - use phys_prop, only: physprop_get - - - ! 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 :: id - character(len=*), parameter :: subname = 'rad_cnst_get_aer_props_by_idx' - type(aerlist_t), pointer :: aerlist - !------------------------------------------------------------------------------------ - - if (list_idx >= 0 .and. list_idx <= N_DIAG) then - aerlist => aerosollist(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 - - id = aerlist%aer(aer_idx)%physprop_id - - if (present(opticstype)) call physprop_get(id, opticstype=opticstype) - - if (present(sw_hygro_ext)) call physprop_get(id, sw_hygro_ext=sw_hygro_ext) - if (present(sw_hygro_ssa)) call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa) - if (present(sw_hygro_asm)) call physprop_get(id, sw_hygro_asm=sw_hygro_asm) - if (present(lw_hygro_ext)) call physprop_get(id, lw_hygro_abs=lw_hygro_ext) - - if (present(sw_nonhygro_ext)) call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext) - if (present(sw_nonhygro_ssa)) call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa) - if (present(sw_nonhygro_asm)) call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm) - if (present(sw_nonhygro_scat)) call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat) - if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat) - if (present(lw_ext)) call physprop_get(id, lw_abs=lw_ext) - - if (present(refindex_aer_sw)) call physprop_get(id, refindex_aer_sw=refindex_aer_sw) - if (present(refindex_aer_lw)) call physprop_get(id, refindex_aer_lw=refindex_aer_lw) - - if (present(aername)) call physprop_get(id, aername=aername) - if (present(density_aer)) call physprop_get(id, density_aer=density_aer) - if (present(hygro_aer)) call physprop_get(id, hygro_aer=hygro_aer) - if (present(dryrad_aer)) call physprop_get(id, dryrad_aer=dryrad_aer) - if (present(dispersion_aer)) call physprop_get(id, dispersion_aer=dispersion_aer) - if (present(num_to_mass_aer)) call physprop_get(id, num_to_mass_aer=num_to_mass_aer) - - if (present(r_lw_abs)) call physprop_get(id, r_lw_abs=r_lw_abs) - if (present(r_sw_ext)) call physprop_get(id, r_sw_ext=r_sw_ext) - if (present(r_sw_scat)) call physprop_get(id, r_sw_scat=r_sw_scat) - if (present(r_sw_ascat)) call physprop_get(id, r_sw_ascat=r_sw_ascat) - if (present(mu)) call physprop_get(id, mu=mu) - -end subroutine rad_cnst_get_aer_props_by_idx - -!================================================================================================ - -subroutine rad_cnst_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) - - ! Return requested properties for the aerosol from the specified - ! climate or diagnostic list. - - use phys_prop, only: physprop_get - - ! 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, id - type(modelist_t), pointer :: mlist - character(len=*), parameter :: subname = 'rad_cnst_get_mam_props_by_idx' - !------------------------------------------------------------------------------------ - - if (list_idx >= 0 .and. list_idx <= N_DIAG) then - mlist => ma_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 - - id = modes%comps(m_idx)%idx_props(spec_idx) - - if (present(opticstype)) call physprop_get(id, opticstype=opticstype) - - if (present(sw_hygro_ext)) call physprop_get(id, sw_hygro_ext=sw_hygro_ext) - if (present(sw_hygro_ssa)) call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa) - if (present(sw_hygro_asm)) call physprop_get(id, sw_hygro_asm=sw_hygro_asm) - if (present(lw_hygro_ext)) call physprop_get(id, lw_hygro_abs=lw_hygro_ext) - - if (present(sw_nonhygro_ext)) call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext) - if (present(sw_nonhygro_ssa)) call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa) - if (present(sw_nonhygro_asm)) call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm) - if (present(sw_nonhygro_scat)) call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat) - if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat) - if (present(lw_ext)) call physprop_get(id, lw_abs=lw_ext) - - if (present(refindex_aer_sw)) call physprop_get(id, refindex_aer_sw=refindex_aer_sw) - if (present(refindex_aer_lw)) call physprop_get(id, refindex_aer_lw=refindex_aer_lw) - - if (present(r_lw_abs)) call physprop_get(id, r_lw_abs=r_lw_abs) - if (present(r_sw_ext)) call physprop_get(id, r_sw_ext=r_sw_ext) - if (present(r_sw_scat)) call physprop_get(id, r_sw_scat=r_sw_scat) - if (present(r_sw_ascat)) call physprop_get(id, r_sw_ascat=r_sw_ascat) - if (present(mu)) call physprop_get(id, mu=mu) - - if (present(aername)) call physprop_get(id, aername=aername) - if (present(density_aer)) call physprop_get(id, density_aer=density_aer) - if (present(hygro_aer)) call physprop_get(id, hygro_aer=hygro_aer) - if (present(dryrad_aer)) call physprop_get(id, dryrad_aer=dryrad_aer) - if (present(dispersion_aer)) call physprop_get(id, dispersion_aer=dispersion_aer) - if (present(num_to_mass_aer)) call physprop_get(id, num_to_mass_aer=num_to_mass_aer) - - if (present(spectype)) spectype = modes%comps(m_idx)%type(spec_idx) - -end subroutine rad_cnst_get_mam_props_by_idx - -!================================================================================================ - -subroutine rad_cnst_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) - - ! Return requested properties for the aerosol from the specified - ! climate or diagnostic list. - - use phys_prop, only: physprop_get - - ! 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, id - type(binlist_t), pointer :: slist - character(len=*), parameter :: subname = 'rad_cnst_get_bin_props_by_idx' - !------------------------------------------------------------------------------------ - - if (list_idx >= 0 .and. list_idx <= N_DIAG) then - slist => sa_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 - - id = bins%comps(m_idx)%idx_props(spec_idx) - - if (present(opticstype)) call physprop_get(id, opticstype=opticstype) - - if (present(sw_hygro_ext)) call physprop_get(id, sw_hygro_ext=sw_hygro_ext) - if (present(sw_hygro_ssa)) call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa) - if (present(sw_hygro_asm)) call physprop_get(id, sw_hygro_asm=sw_hygro_asm) - if (present(lw_hygro_ext)) call physprop_get(id, lw_hygro_abs=lw_hygro_ext) - - if (present(sw_nonhygro_ext)) call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext) - if (present(sw_nonhygro_ssa)) call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa) - if (present(sw_nonhygro_asm)) call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm) - if (present(sw_nonhygro_scat)) call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat) - if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat) - if (present(lw_ext)) call physprop_get(id, lw_abs=lw_ext) - - if (present(refindex_aer_sw)) call physprop_get(id, refindex_aer_sw=refindex_aer_sw) - if (present(refindex_aer_lw)) call physprop_get(id, refindex_aer_lw=refindex_aer_lw) - - if (present(r_lw_abs)) call physprop_get(id, r_lw_abs=r_lw_abs) - if (present(r_sw_ext)) call physprop_get(id, r_sw_ext=r_sw_ext) - if (present(r_sw_scat)) call physprop_get(id, r_sw_scat=r_sw_scat) - if (present(r_sw_ascat)) call physprop_get(id, r_sw_ascat=r_sw_ascat) - if (present(mu)) call physprop_get(id, mu=mu) - - if (present(aername)) call physprop_get(id, aername=aername) - if (present(density_aer)) call physprop_get(id, density_aer=density_aer) - if (present(hygro_aer)) call physprop_get(id, hygro_aer=hygro_aer) - if (present(dryrad_aer)) call physprop_get(id, dryrad_aer=dryrad_aer) - if (present(dispersion_aer)) call physprop_get(id, dispersion_aer=dispersion_aer) - if (present(num_to_mass_aer)) call physprop_get(id, 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_cnst_get_bin_props_by_idx - -!================================================================================================ - -subroutine rad_cnst_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) - - ! Return requested properties for the mode from the specified - ! climate or diagnostic list. - - use phys_prop, only: physprop_get - - ! 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 :: id - type(modelist_t), pointer :: mlist - character(len=*), parameter :: subname = 'rad_cnst_get_mode_props' - !------------------------------------------------------------------------------------ - - if (list_idx >= 0 .and. list_idx <= N_DIAG) then - mlist => ma_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 - id = mlist%idx_props(mode_idx) - - if (present(opticstype)) call physprop_get(id, opticstype=opticstype) - if (present(extpsw)) call physprop_get(id, extpsw=extpsw) - if (present(abspsw)) call physprop_get(id, abspsw=abspsw) - if (present(asmpsw)) call physprop_get(id, asmpsw=asmpsw) - if (present(absplw)) call physprop_get(id, absplw=absplw) - - if (present(refrtabsw)) call physprop_get(id, refrtabsw=refrtabsw) - if (present(refitabsw)) call physprop_get(id, refitabsw=refitabsw) - if (present(refrtablw)) call physprop_get(id, refrtablw=refrtablw) - if (present(refitablw)) call physprop_get(id, refitablw=refitablw) - - if (present(ncoef)) call physprop_get(id, ncoef=ncoef) - if (present(prefr)) call physprop_get(id, prefr=prefr) - if (present(prefi)) call physprop_get(id, prefi=prefi) - if (present(sigmag)) call physprop_get(id, sigmag=sigmag) - if (present(dgnum)) call physprop_get(id, dgnum=dgnum) - if (present(dgnumlo)) call physprop_get(id, dgnumlo=dgnumlo) - if (present(dgnumhi)) call physprop_get(id, dgnumhi=dgnumhi) - if (present(rhcrystal)) call physprop_get(id, rhcrystal=rhcrystal) - if (present(rhdeliques)) call physprop_get(id, rhdeliques=rhdeliques) - -end subroutine rad_cnst_get_mode_props - -!================================================================================================ +end subroutine rad_cnst_out -subroutine rad_cnst_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 ) +subroutine rad_gas_diag_init(glist) - ! Return requested properties for the bin from the specified - ! climate or diagnostic list. +! Add diagnostic fields to the master fieldlist. - use phys_prop, only: physprop_get + type(gaslist_t), intent(inout) :: glist - ! 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(:,:,:,:,:) ! Pengfei Yu Mar.30 - 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 + integer :: i, ngas + character(len=64) :: name + character(len=2) :: list_id + character(len=4) :: suffix + character(len=128):: long_name + character(len=32) :: long_name_description + !----------------------------------------------------------------------------- - ! Local variables - integer :: id - type(binlist_t), pointer :: slist - character(len=*), parameter :: subname = 'rad_cnst_get_bin_props' - !------------------------------------------------------------------------------------ + ngas = glist%ngas + if (ngas == 0) return - if (list_idx >= 0 .and. list_idx <= N_DIAG) then - slist => sa_list(list_idx) + ! Determine whether this is a climate or diagnostic list. + list_id = glist%list_id + if (len_trim(list_id) == 0) then + suffix = '_c' + long_name_description = ' used in climate calculation' 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') + suffix = '_d' // list_id + long_name_description = ' used in diagnostic calculation' end if - ! Get the physprop index for the requested bin - id = slist%idx_props(bin_idx) - - if (present(opticstype)) call physprop_get(id, opticstype=opticstype) - if (present(extpsw)) call physprop_get(id, extpsw2=extpsw) - if (present(abspsw)) call physprop_get(id, abspsw2=abspsw) - if (present(asmpsw)) call physprop_get(id, asmpsw2=asmpsw) - if (present(absplw)) call physprop_get(id, absplw2=absplw) - if (present(corefrac)) call physprop_get(id, corefrac=corefrac) - if (present(nfrac)) call physprop_get(id, nfrac=nfrac) - - if (present(sw_hygro_ext_wtp)) call physprop_get(id, sw_hygro_ext_wtp=sw_hygro_ext_wtp) - if (present(sw_hygro_ssa_wtp)) call physprop_get(id, sw_hygro_ssa_wtp=sw_hygro_ssa_wtp) - if (present(sw_hygro_asm_wtp)) call physprop_get(id, sw_hygro_asm_wtp=sw_hygro_asm_wtp) - if (present(lw_hygro_ext_wtp)) call physprop_get(id, lw_hygro_abs_wtp=lw_hygro_ext_wtp) - if (present(sw_hygro_coreshell_ext)) call physprop_get(id, sw_hygro_coreshell_ext=sw_hygro_coreshell_ext) - if (present(sw_hygro_coreshell_ssa)) call physprop_get(id, sw_hygro_coreshell_ssa=sw_hygro_coreshell_ssa) - if (present(sw_hygro_coreshell_asm)) call physprop_get(id, sw_hygro_coreshell_asm=sw_hygro_coreshell_asm) - if (present(lw_hygro_coreshell_ext)) call physprop_get(id, lw_hygro_coreshell_abs=lw_hygro_coreshell_ext) - if (present(wgtpct)) call physprop_get(id, wgtpct=wgtpct) - if (present(bcdust)) call physprop_get(id, bcdust=bcdust) - if (present(kap)) call physprop_get(id, kap=kap) - if (present(relh)) call physprop_get(id, relh=relh) - if (present(nwtp)) call physprop_get(id, nwtp=nwtp) - if (present(nbcdust)) call physprop_get(id, nbcdust=nbcdust) - if (present(nkap)) call physprop_get(id, nkap=nkap) - if (present(nrelh)) call physprop_get(id, nrelh=nrelh) - if (present(dryrad)) call physprop_get(id, dryrad_aer=dryrad) - -end subroutine rad_cnst_get_bin_props - -!================================================================================================ - -subroutine print_modes(modes) - - 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) - - type(bins_t), intent(inout) :: bins - - integer :: i, m - !--------------------------------------------------------------------------------------------- - - write(iulog,*)' Bin Definitions' - - do m = 1, bins%nbins + do i = 1, ngas - write(iulog,*) nl//' name=',trim(bins%names(m)) + ! construct names for mass per layer diagnostics + name = 'm_' // trim(glist%gas(i)%camname) // trim(suffix) + glist%gas(i)%mass_name = name + long_name = trim(glist%gas(i)%camname)//' mass per layer'//long_name_description + call addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name)) - do i = 1, bins%comps(m)%nspec + ! construct names for column burden diagnostics + name = 'cb_' // trim(glist%gas(i)%camname) // trim(suffix) + long_name = trim(glist%gas(i)%camname)//' column burden'//long_name_description + call addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name)) - 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 + ! error check for name length + if (len_trim(name) > fieldname_len) then + write(iulog,*) 'rad_gas_diag_init: '//trim(name)//' longer than ', fieldname_len, ' characters' + call endrun('rad_gas_diag_init: name too long: '//trim(name)) + end if end do -end subroutine print_bins +end subroutine rad_gas_diag_init !================================================================================================ -subroutine print_lists(gas_list, aer_list, ma_list, sa_list) +subroutine print_gas_list(glist) - ! Print summary of gas, bulk and modal aerosol lists. This is just the information - ! read from the namelist. + ! Print summary of gas list. use radconstants, only: gascnst=>gaslist - type(aerlist_t), intent(in) :: aer_list - type(gaslist_t), intent(in) :: gas_list - type(modelist_t), intent(in) :: ma_list - type(binlist_t), intent(in) :: sa_list + type(gaslist_t), intent(in) :: glist - integer :: i, id + integer :: i - if (len_trim(gas_list%list_id) == 0) then + if (len_trim(glist%list_id) == 0) then write(iulog,*) nl//' gas list for climate calculations' else - write(iulog,*) nl//' gas list for diag'//gas_list%list_id//' calculations' + write(iulog,*) nl//' gas list for diag'//glist%list_id//' calculations' end if do i = 1, nradgas - if (gas_list%gas(i)%source .eq. 'N') then - write(iulog,*) ' '//gas_list%gas(i)%source//':'//gascnst(i)//' has pbuf name:'//& - trim(gas_list%gas(i)%camname) - else if (gas_list%gas(i)%source .eq. 'A') then - write(iulog,*) ' '//gas_list%gas(i)%source//':'//gascnst(i)//' has constituents name:'//& - trim(gas_list%gas(i)%camname) + if (glist%gas(i)%source .eq. 'N') then + write(iulog,*) ' '//glist%gas(i)%source//':'//gascnst(i)//' has pbuf name:'//& + trim(glist%gas(i)%camname) + else if (glist%gas(i)%source .eq. 'A') then + write(iulog,*) ' '//glist%gas(i)%source//':'//gascnst(i)//' has constituents name:'//& + trim(glist%gas(i)%camname) endif enddo - 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(ma_list%list_id) == 0) then - write(iulog,*) nl//' modal aerosol list for climate calculations' - else - write(iulog,*) nl//' modal aerosol list for diag'//ma_list%list_id//' calculations' - end if - - do i = 1, ma_list%nmodes - id = ma_list%idx(i) - write(iulog,*) ' '//trim(modes%names(id)) - enddo - - if (len_trim(sa_list%list_id) == 0) then - write(iulog,*) nl//' bin aerosol list for climate calculations' - else - write(iulog,*) nl//' bin aerosol list for diag'//sa_list%list_id//' calculations' - end if - - do i = 1, sa_list%nbins - id = sa_list%idx(i) - write(iulog,*) ' '//trim(bins%names(id)) - enddo - -end subroutine print_lists +end subroutine print_gas_list !================================================================================================ + end module rad_constituents diff --git a/src/physics/cam/radiation_data.F90 b/src/physics/cam/radiation_data.F90 index c58fb9e1c6..7e2b9c0b64 100644 --- a/src/physics/cam/radiation_data.F90 +++ b/src/physics/cam/radiation_data.F90 @@ -7,7 +7,11 @@ module radiation_data use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only : pcols, pver, pverp, begchunk, endchunk use cam_history, only: addfld, add_default, horiz_only, outfld - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_gas, rad_cnst_get_aer_mmr + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_gas + use radiative_aerosol, only: rad_aer_get_info + !REMOVECAM + use aerosol_mmr_cam, only: rad_cnst_get_aer_mmr + !REMOVECAM_END use radconstants, only: nradgas, gaslist use cam_history_support, only: fieldname_len, fillvalue use spmd_utils, only: masterproc @@ -259,7 +263,8 @@ subroutine rad_data_init( pbuf2d ) call pbuf_set_field(pbuf2d, tropp_idx, -1.0_r8) endif - call rad_cnst_get_info(0, ngas=ngas, naero=naer, nmodes=nmodes) + call rad_cnst_get_info(0, ngas=ngas) + call rad_aer_get_info(0, naero=naer, nmodes=nmodes) ! The code to output the gases assumes that the rad_constituents module has ! ordered them in the same way that they are ordered in the "gaslist" array @@ -274,7 +279,7 @@ subroutine rad_data_init( pbuf2d ) if (naer > 0) then allocate( aernames(naer) ) - call rad_cnst_get_info(0, aernames=aernames) + call rad_aer_get_info(0, aernames=aernames) endif if (nmodes>0) then @@ -477,10 +482,10 @@ subroutine rad_data_init( pbuf2d ) call add_default (qaerwat_fldn(m), rad_data_histfile_num, ' ') ! get mode info - call rad_cnst_get_info(0, m, nspec=nspec) + call rad_aer_get_info(0, m, nspec=nspec) ! aerosol species loop do l = 1, nspec - call rad_cnst_get_info(0,m,l, spec_name=aername) + call rad_aer_get_info(0,m,l, spec_name=aername) name = 'rad_'//trim(aername) call addfld(trim(name), (/ 'lev' /), rad_data_avgflag, 'kg/kg', trim(long_name)) call add_default (trim(name), rad_data_histfile_num, ' ') @@ -706,10 +711,10 @@ subroutine rad_data_write( pbuf, state, cam_in, coszen ) call outfld( qaerwat_fldn(m), ptr, pcols, lchnk ) ! get mode info - call rad_cnst_get_info(0, m, nspec=nspec) + call rad_aer_get_info(0, m, nspec=nspec) ! aerosol species loop do l = 1, nspec - call rad_cnst_get_info(0,m,l, spec_name=aername) + call rad_aer_get_info(0,m,l, spec_name=aername) call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, mmr) name = 'rad_'//aername call outfld(trim(name), mmr, pcols, lchnk) @@ -1047,7 +1052,7 @@ subroutine get_rad_cnst_data(indata, state, pbuf2d, recno) use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc - use rad_constituents, only: rad_cnst_get_info + use radiative_aerosol, only: rad_aer_get_info implicit none @@ -1079,10 +1084,10 @@ subroutine get_rad_cnst_data(indata, state, pbuf2d, recno) do m = 1, nmodes ! get mode info - call rad_cnst_get_info(0, m, nspec=nspec) + call rad_aer_get_info(0, m, nspec=nspec) ! aerosol species loop do l = 1, nspec - call rad_cnst_get_info(0,m,l, spec_name=aername) + call rad_aer_get_info(0,m,l, spec_name=aername) call read_rad_mam_data( indata, aername, m, l, state, pbuf2d, recno ) end do end do @@ -1123,7 +1128,6 @@ end subroutine read_rad_gas_data !================================================================================= !================================================================================= subroutine read_rad_aer_data(indata, name, idx, state, pbuf2d, recno ) - use rad_constituents, only: rad_cnst_get_aer_mmr use drv_input_data, only: drv_input_data_read type(drv_input_data_t), intent(inout) :: indata @@ -1154,7 +1158,6 @@ end subroutine read_rad_aer_data !================================================================================= !================================================================================= subroutine read_rad_mam_data(indata, name, mode_idx, spec_idx, state, pbuf2d, recno ) - use rad_constituents, only: rad_cnst_get_aer_mmr use drv_input_data, only: drv_input_data_read type(drv_input_data_t), intent(inout) :: indata diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index 6a4f9d8cfa..75ac9714fe 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -16,8 +16,6 @@ module zm_conv_intr use zm_conv_momtran, only: zm_conv_momtran_run use cloud_fraction_fice, only: cloud_fraction_fice_run - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, & - rad_cnst_get_aer_props, rad_cnst_get_mode_props !, & use cam_abortutils, only: endrun use physconst, only: pi use spmd_utils, only: masterproc diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index a3f0c49fe6..45badc1ab0 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -149,7 +149,7 @@ subroutine phys_register use cam_diagnostics, only: diag_register use cloud_diagnostics, only: cloud_diagnostics_register use cospsimulator_intr, only: cospsimulator_intr_register - use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not + use radiative_aerosol, only: rad_aer_get_info ! Added to query if it is a modal aero sim or not use radheat, only: radheat_register use subcol, only: subcol_register use subcol_utils, only: is_subcol_on, subcol_get_scheme @@ -258,7 +258,7 @@ subroutine phys_register call conv_water_register() ! Determine whether its a 'modal' aerosol simulation or not - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_aer_get_info(0, nmodes=nmodes) clim_modal_aero = (nmodes > 0) if (clim_modal_aero) then @@ -740,6 +740,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use wv_saturation, only: wv_sat_init use microp_driver, only: microp_driver_init use microp_aero, only: microp_aero_init + use aerosol_instances_mod, only: aerosol_instances_init, aerosol_instances_init_states use macrop_driver, only: macrop_driver_init use conv_water, only: conv_water_init use tracers, only: tracers_init @@ -750,6 +751,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use phys_debug_util, only: phys_debug_init use phys_debug, only: phys_debug_state_init use rad_constituents, only: rad_cnst_init + use radiative_aerosol, only: rad_aer_init use aer_rad_props, only: aer_rad_props_init use subcol, only: subcol_init use qbo, only: qbo_init @@ -855,7 +857,10 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call solar_data_init() ! Initialize rad constituents and their properties - call rad_cnst_init() + call rad_aer_init() ! aerosol init: physprop_init + mode/bin/list init + call aerosol_instances_init() ! create abstract aerosol factory objects + call aerosol_instances_init_states(phys_state, pbuf2d) ! create persistent per-chunk state objects + call rad_cnst_init() ! gas-specific init call radiation_init(pbuf2d) @@ -1442,6 +1447,10 @@ subroutine tphysac (ztodt, cam_in, & use cam_budget, only: thermo_budget_history use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure use air_composition, only: cpairv, cp_or_cv_dycore + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + use aerosol_instances_mod, only: aerosol_instances_get_props, & + aerosol_instances_get_num_models, aerosol_instances_get_state ! ! Arguments ! @@ -1449,7 +1458,7 @@ subroutine tphysac (ztodt, cam_in, & type(cam_in_t), intent(inout) :: cam_in type(cam_out_t), intent(inout) :: cam_out - type(physics_state), intent(inout) :: state + type(physics_state), intent(inout), target :: state type(physics_tend ), intent(inout) :: tend type(physics_buffer_desc), pointer :: pbuf(:) @@ -1533,6 +1542,12 @@ subroutine tphysac (ztodt, cam_in, & real(r8) :: scaling(pcols,pver) logical :: moist_mixing_ratio_dycore + ! For abstract aerosol interface (calcsize/wateruptake) + class(aerosol_properties), pointer :: aero_props + class(aerosol_state), pointer :: aero_state_obj + + integer :: iaermod_lcl + ! physics buffer fields for total energy and mass adjustment integer itim_old, ifld @@ -1553,6 +1568,9 @@ subroutine tphysac (ztodt, cam_in, & integer errflg !----------------------------------------------------------------------- + nullify(aero_props) + nullify(aero_state_obj) + lchnk = state%lchnk ncol = state%ncol @@ -1957,19 +1975,30 @@ subroutine tphysac (ztodt, cam_in, & call t_startf('aerosol_wet_processes') if (clim_modal_aero) then + ! Find the modal aerosol model properties object. + do iaermod_lcl = 1, aerosol_instances_get_num_models() + aero_props => aerosol_instances_get_props(iaermod_lcl, list_idx=0) + if (associated(aero_props)) then + if (aero_props%model_is('MAM')) exit + end if + end do + !REMOVECAM - get persistent state from factory; under CAM-SIMA states will be passed as scheme inputs + aero_state_obj => aerosol_instances_get_state(iaermod_lcl, 0, state%lchnk) + !REMOVECAM_END + if (prog_modal_aero) then call physics_ptend_init(ptend, state%psetcols, 'aero_water_uptake', lq=wetdep_lq) ! Do calculations of mode radius and water uptake if: ! 1) modal aerosols are affecting the climate, or ! 2) prognostic modal aerosols are enabled - call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf, aero_props, aero_state_obj) ! for prognostic modal aerosols the transfer of mass between aitken and accumulation ! modes is done in conjunction with the dry radius calculation - call modal_aero_wateruptake_dr(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf, aero_props, aero_state_obj) call physics_update(state, ptend, ztodt, tend) else - call modal_aero_calcsize_diag(state, pbuf) - call modal_aero_wateruptake_dr(state, pbuf) + call modal_aero_calcsize_diag(state, pbuf, aero_props, aero_state_obj) + call modal_aero_wateruptake_dr(state, pbuf, aero_props, aero_state_obj) endif endif @@ -2629,12 +2658,18 @@ subroutine tphysbc (ztodt, state, & use dyn_tests_utils, only: vc_dycore use surface_emissions_mod,only: surface_emissions_set use elevated_emissions_mod,only: elevated_emissions_set + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + !REMOVECAM - aerosol_instances_mod is the CAM-specific factory; not needed when objects are passed in + use aerosol_instances_mod, only: aerosol_instances_get_props, & + aerosol_instances_get_num_models, aerosol_instances_get_state + !REMOVECAM_END ! Arguments real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) - type(physics_state), intent(inout) :: state + type(physics_state), intent(inout), target :: state type(physics_tend ), intent(inout) :: tend type(physics_buffer_desc), pointer :: pbuf(:) @@ -2720,7 +2755,16 @@ subroutine tphysbc (ztodt, state, & logical :: lq(pcnst) + ! For abstract aerosol interface (calcsize/wateruptake) + class(aerosol_properties), pointer :: aero_props + class(aerosol_state), pointer :: aero_state_obj + !REMOVECAM - factory-specific variables; under CAM-SIMA objects are passed as scheme inputs + integer :: iaermod_lcl + !REMOVECAM_END + !----------------------------------------------------------------------- + nullify(aero_props) + nullify(aero_state_obj) call t_startf('bc_init') @@ -2979,12 +3023,23 @@ subroutine tphysbc (ztodt, state, & end if !=================================================== - ! Run wet deposition routines to intialize aerosols + ! Run wet deposition routines to initialize aerosols !=================================================== if (clim_modal_aero) then - call modal_aero_calcsize_diag(state, pbuf) - call modal_aero_wateruptake_dr(state, pbuf) + ! Find the modal aerosol model properties object. + do iaermod_lcl = 1, aerosol_instances_get_num_models() + aero_props => aerosol_instances_get_props(iaermod_lcl, list_idx=0) + if (associated(aero_props)) then + if (aero_props%model_is('MAM')) exit + end if + end do + !REMOVECAM - get persistent state from factory; under CAM-SIMA states will be passed as scheme inputs + aero_state_obj => aerosol_instances_get_state(iaermod_lcl, 0, state%lchnk) + !REMOVECAM_END + + call modal_aero_calcsize_diag(state, pbuf, aero_props, aero_state_obj) + call modal_aero_wateruptake_dr(state, pbuf, aero_props, aero_state_obj) end if !=================================================== diff --git a/src/physics/camrt/radiation.F90 b/src/physics/camrt/radiation.F90 index f422fb78d2..f845ac8c41 100644 --- a/src/physics/camrt/radiation.F90 +++ b/src/physics/camrt/radiation.F90 @@ -789,6 +789,9 @@ subroutine radiation_tend( & use radsw, only: radcswmx use radlw, only: radclwmx use rad_constituents, only: rad_cnst_get_gas, rad_cnst_out + !REMOVECAM + use aerosol_mmr_cam, only: rad_aer_diag_out + !REMOVECAM_END use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw use interpolate_data, only: vertinterp use radiation_data, only: rad_data_write @@ -1158,8 +1161,9 @@ subroutine radiation_tend( & end if ! dolw - ! Output aerosol mmr + ! Output gas and aerosol diagnostics if (write_output) call rad_cnst_out(0, state, pbuf) + if (write_output) call rad_aer_diag_out(0, state, pbuf) ! Cloud cover diagnostics ! radsw can change pmxrgn and nmxrgn so cldsav needs to follow radsw diff --git a/src/physics/rrtmg/radiation.F90 b/src/physics/rrtmg/radiation.F90 index efc271b70d..715cc7ed01 100644 --- a/src/physics/rrtmg/radiation.F90 +++ b/src/physics/rrtmg/radiation.F90 @@ -17,9 +17,12 @@ module radiation use time_manager, only: get_nstep, is_first_restart_step, & get_curr_calday, get_step_size -use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, & - rad_cnst_get_gas, rad_cnst_out, oldcldoptics, & - liqcldoptics, icecldoptics +use radiative_aerosol_definitions, only: N_DIAG +use rad_constituents, only: rad_cnst_get_gas, rad_cnst_out, oldcldoptics, liqcldoptics, icecldoptics +use radiative_aerosol, only: rad_aer_get_call_list +!REMOVECAM +use aerosol_mmr_cam, only: rad_aer_diag_out +!REMOVECAM_END use radconstants, only: nswbands, nlwbands, rrtmg_sw_cloudsim_band, rrtmg_lw_cloudsim_band, & idx_sw_diag @@ -456,7 +459,7 @@ subroutine radiation_init(pbuf2d) endif ! get list of active radiation calls - call rad_cnst_get_call_list(active_calls) + call rad_aer_get_call_list(active_calls) ! Add shortwave radiation fields to history master field list. @@ -1197,7 +1200,7 @@ subroutine radiation_tend( & call get_variability(sfac) ! Get the active climate/diagnostic shortwave calculations - call rad_cnst_get_call_list(active_calls) + call rad_aer_get_call_list(active_calls) ! The climate (icall==0) calculation must occur last. do icall = N_DIAG, 0, -1 @@ -1244,14 +1247,15 @@ subroutine radiation_tend( & end if - ! Output aerosol mmr + ! Output gas and aerosol diagnostics call rad_cnst_out(0, state, pbuf) + call rad_aer_diag_out(0, state, pbuf) ! Longwave radiation computation if (dolw) then - call rad_cnst_get_call_list(active_calls) + call rad_aer_get_call_list(active_calls) ! The climate (icall==0) calculation must occur last. do icall = N_DIAG, 0, -1 diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 664b279399..de5f214915 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -20,7 +20,12 @@ module radiation use time_manager, only: get_nstep, is_first_step, is_first_restart_step, & get_curr_calday, get_step_size -use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, rad_cnst_out +use radiative_aerosol_definitions, only: N_DIAG +use rad_constituents, only: rad_cnst_out +use radiative_aerosol, only: rad_aer_get_call_list +!REMOVECAM +use aerosol_mmr_cam, only: rad_aer_diag_out +!REMOVECAM_END use radconstants, only: nradgas, gasnamelength, nswbands, nlwbands, & gaslist, radconstants_init @@ -550,7 +555,7 @@ subroutine radiation_init(pbuf2d) endif ! get list of active radiation calls - call rad_cnst_get_call_list(active_calls) + call rad_aer_get_call_list(active_calls) ! Add shortwave radiation fields to history master field list. @@ -1204,6 +1209,7 @@ subroutine radiation_tend( & ! Output the mass per layer, and total column burdens for gas and aerosol ! constituents in the climate list. call rad_cnst_out(0, state, pbuf) + call rad_aer_diag_out(0, state, pbuf) !========================! ! SHORTWAVE calculations ! From c6430f12fadd410c51a7f5aa20b40caeb4ff4abd Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 12 Mar 2026 13:16:18 -0400 Subject: [PATCH 02/22] fixup! phys_state subsetting cannot be assumed shape for chunking --- src/chemistry/aerosol/aerosol_instances_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/aerosol/aerosol_instances_mod.F90 b/src/chemistry/aerosol/aerosol_instances_mod.F90 index fb1e597862..85138da5e4 100644 --- a/src/chemistry/aerosol/aerosol_instances_mod.F90 +++ b/src/chemistry/aerosol/aerosol_instances_mod.F90 @@ -226,7 +226,7 @@ subroutine aerosol_instances_init_states(phys_state, pbuf2d) use ppgrid, only: begchunk, endchunk use cam_abortutils, only: endrun - type(physics_state), intent(in), target :: phys_state(:) + type(physics_state), intent(in), target :: phys_state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer :: iaermod, ilist, lchnk, istat From 60811a375b228c409537b6be44662f10309e2a1d Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 12 Mar 2026 18:20:02 -0400 Subject: [PATCH 03/22] cleanup: use public active_calls; clean use statements --- .../aerosol/aerosol_instances_mod.F90 | 21 ++++++------------- src/chemistry/aerosol/radiative_aerosol.F90 | 16 -------------- .../aerosol/radiative_aerosol_definitions.F90 | 11 ++++------ src/physics/cam/aer_rad_props.F90 | 3 --- src/physics/cam/aerosol_mmr_cam.F90 | 15 ------------- src/physics/cam/aerosol_optics_cam.F90 | 6 ++---- src/physics/cam/microp_aero.F90 | 10 ++------- src/physics/cam/rad_constituents.F90 | 3 --- src/physics/rrtmg/radiation.F90 | 13 +----------- src/physics/rrtmgp/radiation.F90 | 10 +-------- 10 files changed, 16 insertions(+), 92 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_instances_mod.F90 b/src/chemistry/aerosol/aerosol_instances_mod.F90 index 85138da5e4..f0527d6c73 100644 --- a/src/chemistry/aerosol/aerosol_instances_mod.F90 +++ b/src/chemistry/aerosol/aerosol_instances_mod.F90 @@ -58,10 +58,6 @@ module aerosol_instances_mod ! States store pointers to phys_state(c) and pbuf which persist for the run. type(aero_state_entry_t), allocatable, target :: aero_states_all(:,:,:) - ! Which diagnostic lists are active (0:N_DIAG). Promoted from local to module-level - ! so that init_states can reuse it. - logical, allocatable :: call_list_(:) - ! 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 @@ -74,7 +70,8 @@ module aerosol_instances_mod contains subroutine aerosol_instances_init() - use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_call_list + 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 @@ -110,14 +107,9 @@ subroutine aerosol_instances_init() call endrun(subname//'allocation error: aero_props_all') end if - allocate(call_list_(0:N_DIAG), stat=istat) - if (istat /= 0) then - call endrun(subname//'allocation error: call_list_') - end if - call rad_aer_get_call_list(call_list_) - do ilist = 0, N_DIAG - if (.not. call_list_(ilist)) cycle + ! 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) @@ -205,8 +197,6 @@ subroutine aerosol_instances_final() deallocate(aero_props_all) end if - if (allocated(call_list_)) deallocate(call_list_) - num_aero_models_ = 0 end subroutine aerosol_instances_final @@ -218,6 +208,7 @@ end subroutine aerosol_instances_final ! 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 @@ -241,7 +232,7 @@ subroutine aerosol_instances_init_states(phys_state, pbuf2d) end if do ilist = 0, N_DIAG - if (.not. call_list_(ilist)) cycle + if (.not. active_calls(ilist)) cycle do lchnk = begchunk, endchunk pbuf => pbuf_get_chunk(pbuf2d, lchnk) diff --git a/src/chemistry/aerosol/radiative_aerosol.F90 b/src/chemistry/aerosol/radiative_aerosol.F90 index 0bdaa9410e..e870dee7c4 100644 --- a/src/chemistry/aerosol/radiative_aerosol.F90 +++ b/src/chemistry/aerosol/radiative_aerosol.F90 @@ -32,7 +32,6 @@ module radiative_aerosol 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_get_call_list public :: rad_aer_num_name public :: rad_aer_get_mode_props public :: rad_aer_get_props @@ -577,21 +576,6 @@ end function rad_aer_get_spec_idx !================================================================================================ -subroutine rad_aer_get_call_list(call_list) - use radiative_aerosol_definitions, only: N_DIAG, active_calls - - ! Return info about which climate/diagnostic calculations are requested - - ! Arguments - logical, intent(out) :: call_list(0:N_DIAG) - !----------------------------------------------------------------------------- - - call_list(:) = active_calls(:) - -end subroutine rad_aer_get_call_list - -!================================================================================================ - integer function rad_aer_get_idx(list_idx, aer_name) use cam_abortutils, only: endrun use cam_logfile, only: iulog diff --git a/src/chemistry/aerosol/radiative_aerosol_definitions.F90 b/src/chemistry/aerosol/radiative_aerosol_definitions.F90 index 174f2163c0..a9812978df 100644 --- a/src/chemistry/aerosol/radiative_aerosol_definitions.F90 +++ b/src/chemistry/aerosol/radiative_aerosol_definitions.F90 @@ -712,14 +712,12 @@ subroutine parse_bin_defs(nl_in, bins) ! Local variables logical :: num_mr_found, mass_mr_found - logical :: particle_mr_found integer :: m integer :: istat - integer :: nbins, nstr, istr + integer :: nbins, nstr integer :: mbeg, mcur integer :: nspec, ispec - integer :: strlen, ibeg, iend, ipos - logical :: part_mr_found + integer :: strlen, iend, ipos character(len=*), parameter :: subname = 'parse_bin_defs' character(len=len(nl_in(1))) :: tmpstr character(len=1) :: tmp_src_a @@ -848,10 +846,9 @@ subroutine parse_bin_defs(nl_in, bins) tmpstr = nl_in(mcur) ! process bin component strings - particle_mr_found = .false. ! keep track of whether particle mixing ratio component is found 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 + 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 diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 82ad64e388..33f8a49388 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -10,12 +10,9 @@ module aer_rad_props use physconst, only: rga use physics_types, only: physics_state -use physics_buffer, only: physics_buffer_desc use radconstants, only: nswbands, nlwbands, idx_sw_diag -use phys_prop, only: nrh, ot_length use aerosol_instances_mod, only: aerosol_instances_get_num_models, & aerosol_instances_is_active -use wv_saturation, only: qsat use aerosol_optics_cam,only: aerosol_optics_cam_init, aerosol_optics_cam_sw, aerosol_optics_cam_lw use cam_history, only: fieldname_len, addfld, outfld, add_default, horiz_only use cam_history_support, only : fillvalue diff --git a/src/physics/cam/aerosol_mmr_cam.F90 b/src/physics/cam/aerosol_mmr_cam.F90 index 4191fb968a..d473d68ddd 100644 --- a/src/physics/cam/aerosol_mmr_cam.F90 +++ b/src/physics/cam/aerosol_mmr_cam.F90 @@ -253,7 +253,6 @@ subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, state, pbuf, mmr) real(r8), pointer :: mmr(:,:) ! Local variables - integer :: lchnk integer :: idx character(len=1) :: source type(aerlist_t), pointer :: aerlist @@ -267,8 +266,6 @@ subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, state, pbuf, mmr) call endrun(subname//': list_idx out of bounds') endif - lchnk = state%lchnk - ! 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 @@ -314,7 +311,6 @@ subroutine rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, stat ! Local variables integer :: m_idx integer :: idx - integer :: lchnk character(len=1) :: source type(modelist_t), pointer :: mlist character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_by_idx' @@ -354,8 +350,6 @@ subroutine rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, stat call endrun(subname//': unrecognized phase; must be "a" or "c"') end if - lchnk = state%lchnk - select case( source ) case ('A') mmr => state%q(:,:,idx) @@ -569,7 +563,6 @@ subroutine rad_cnst_get_bin_mmr(list_idx, bin_idx, phase, state, pbuf, mmr) ! Local variables integer :: m_idx integer :: idx - integer :: lchnk character(len=1) :: source type(binlist_t), pointer :: slist character(len=*), parameter :: subname = 'rad_cnst_get_bin_mmr' @@ -603,8 +596,6 @@ subroutine rad_cnst_get_bin_mmr(list_idx, bin_idx, phase, state, pbuf, mmr) call endrun(subname//': unrecognized phase; must be "a" or "c"') end if - lchnk = state%lchnk - select case( source ) case ('A') mmr => state%q(:,:,idx) @@ -640,7 +631,6 @@ subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num) ! Local variables integer :: m_idx integer :: idx - integer :: lchnk character(len=1) :: source type(modelist_t), pointer :: mlist character(len=*), parameter :: subname = 'rad_cnst_get_mode_num' @@ -674,8 +664,6 @@ subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num) call endrun(subname//': unrecognized phase; must be "a" or "c"') end if - lchnk = state%lchnk - select case( source ) case ('A') num => state%q(:,:,idx) @@ -711,7 +699,6 @@ subroutine rad_cnst_get_bin_num(list_idx, bin_idx, phase, state, pbuf, num) ! Local variables integer :: m_idx integer :: idx - integer :: lchnk character(len=1) :: source type(binlist_t), pointer :: slist character(len=*), parameter :: subname = 'rad_cnst_get_bin_num' @@ -745,8 +732,6 @@ subroutine rad_cnst_get_bin_num(list_idx, bin_idx, phase, state, pbuf, num) call endrun(subname//': unrecognized phase; must be "a" or "c"') end if - lchnk = state%lchnk - select case( source ) case ('A') num => state%q(:,:,idx) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index e072069947..d9f91fe585 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -12,7 +12,6 @@ module aerosol_optics_cam use cam_abortutils, only: endrun use spmd_utils, only: masterproc use radiative_aerosol_definitions, only: N_DIAG - use radiative_aerosol, only: rad_aer_get_call_list use cam_history, only: addfld, add_default, outfld, horiz_only, fieldname_len use cam_history_support, only: fillvalue @@ -121,6 +120,7 @@ end subroutine aerosol_optics_cam_readnl !=============================================================================== subroutine aerosol_optics_cam_init + use radiative_aerosol_definitions, only: active_calls use phys_control, only: phys_getopts use ioFileMod, only: getfil @@ -128,7 +128,6 @@ subroutine aerosol_optics_cam_init integer :: iaermod, istat, ilist, i integer :: num_aero_models - logical :: call_list(0:n_diag) real(r8) :: lwavlen_lo(nlwbands), lwavlen_hi(nlwbands) integer :: m, n, cnt @@ -172,10 +171,9 @@ subroutine aerosol_optics_cam_init lw10um_indx = i ! index corresponding to 10 microns end if end do - call rad_aer_get_call_list(call_list) do ilist = 0, n_diag - if (call_list(ilist)) then + if (active_calls(ilist)) then call addfld ('EXTINCT'//diag(ilist), (/ 'lev' /), 'A','/m',& 'Aerosol extinction 550 nm, day only', flag_xyfill=.true.) call addfld ('EXTINCTUV'//diag(ilist), (/ 'lev' /), 'A','/m',& diff --git a/src/physics/cam/microp_aero.F90 b/src/physics/cam/microp_aero.F90 index 85bf43f88c..c340445bf7 100644 --- a/src/physics/cam/microp_aero.F90 +++ b/src/physics/cam/microp_aero.F90 @@ -23,14 +23,13 @@ module microp_aero use shr_kind_mod, only: r8=>shr_kind_r8 use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, pverp, begchunk, endchunk +use ppgrid, only: pcols, pver, pverp use ref_pres, only: top_lev => trop_cloud_top_lev use physconst, only: rair use constituents, only: cnst_get_ind use physics_types, only: physics_state, physics_ptend, physics_ptend_init, physics_ptend_sum, & physics_state_copy, physics_update -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field, & - pbuf_get_chunk +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field use phys_control, only: phys_getopts, use_hetfrz_classnuc use aerosol_instances_mod, only: aerosol_instances_get_num_models, & aerosol_instances_is_active, & @@ -175,8 +174,6 @@ subroutine microp_aero_init(phys_state,pbuf2d) ! !----------------------------------------------------------------------- - use modal_aerosol_state_mod, only: modal_aerosol_state - type(physics_state), pointer :: phys_state(:) type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -188,8 +185,6 @@ subroutine microp_aero_init(phys_state,pbuf2d) character(len=32) :: str32 character(len=*), parameter :: routine = 'microp_aero_init' logical :: history_amwg - type(physics_buffer_desc), pointer :: pbuf(:) - integer :: c class(aerosol_properties), pointer :: aero_props_bulk => null() @@ -557,7 +552,6 @@ subroutine microp_aero_run ( & real(r8) :: wsub(pcols,pver) ! diagnosed sub-grid vertical velocity st. dev. (m/s) real(r8) :: wsubi(pcols,pver) ! diagnosed sub-grid vertical velocity ice (m/s) - real(r8) :: nucboas real(r8) :: wght diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 index 5bdecc1de9..c72b430e01 100644 --- a/src/physics/cam/rad_constituents.F90 +++ b/src/physics/cam/rad_constituents.F90 @@ -391,7 +391,6 @@ subroutine rad_cnst_get_gas(list_idx, gasname, state, pbuf, mmr) real(r8), pointer :: mmr(:,:) ! Local variables - integer :: lchnk integer :: igas integer :: idx character(len=1) :: source @@ -406,8 +405,6 @@ subroutine rad_cnst_get_gas(list_idx, gasname, state, pbuf, mmr) call endrun(subname//': list_idx out of bounds') endif - lchnk = state%lchnk - ! Get index of gas in internal arrays. rad_gas_index will abort if the ! specified gasname is not recognized by the radiative transfer code. igas = rad_gas_index(trim(gasname)) diff --git a/src/physics/rrtmg/radiation.F90 b/src/physics/rrtmg/radiation.F90 index 715cc7ed01..c8d7e98380 100644 --- a/src/physics/rrtmg/radiation.F90 +++ b/src/physics/rrtmg/radiation.F90 @@ -17,9 +17,8 @@ module radiation use time_manager, only: get_nstep, is_first_restart_step, & get_curr_calday, get_step_size -use radiative_aerosol_definitions, only: N_DIAG +use radiative_aerosol_definitions, only: N_DIAG, active_calls use rad_constituents, only: rad_cnst_get_gas, rad_cnst_out, oldcldoptics, liqcldoptics, icecldoptics -use radiative_aerosol, only: rad_aer_get_call_list !REMOVECAM use aerosol_mmr_cam, only: rad_aer_diag_out !REMOVECAM_END @@ -375,7 +374,6 @@ subroutine radiation_init(pbuf2d) ! local variables integer :: icall - logical :: active_calls(0:N_DIAG) integer :: nstep ! current timestep number logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_vdiag ! output the variables used by the AMWG variability diag package @@ -458,9 +456,6 @@ subroutine radiation_init(pbuf2d) sampling_seq='rad_lwsw', flag_xyfill=.true.) endif - ! get list of active radiation calls - call rad_aer_get_call_list(active_calls) - ! Add shortwave radiation fields to history master field list. do icall = 0, N_DIAG @@ -855,7 +850,6 @@ subroutine radiation_tend( & real(r8) :: sfac(1:nswbands) ! time varying scaling factors due to Solar Spectral Irrad at 1 A.U. per band integer :: icall ! index through climate/diagnostic radiation calls - logical :: active_calls(0:N_DIAG) ! Aerosol radiative properties real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth @@ -1199,9 +1193,6 @@ subroutine radiation_tend( & call get_variability(sfac) - ! Get the active climate/diagnostic shortwave calculations - call rad_aer_get_call_list(active_calls) - ! The climate (icall==0) calculation must occur last. do icall = N_DIAG, 0, -1 @@ -1255,8 +1246,6 @@ subroutine radiation_tend( & if (dolw) then - call rad_aer_get_call_list(active_calls) - ! The climate (icall==0) calculation must occur last. do icall = N_DIAG, 0, -1 diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index de5f214915..6eb0135df1 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -20,9 +20,8 @@ module radiation use time_manager, only: get_nstep, is_first_step, is_first_restart_step, & get_curr_calday, get_step_size -use radiative_aerosol_definitions, only: N_DIAG +use radiative_aerosol_definitions, only: N_DIAG, active_calls use rad_constituents, only: rad_cnst_out -use radiative_aerosol, only: rad_aer_get_call_list !REMOVECAM use aerosol_mmr_cam, only: rad_aer_diag_out !REMOVECAM_END @@ -163,10 +162,6 @@ module radiation integer :: band2gpt_sw(2,nswbands) -! active_calls is set by a rad_constituents method after parsing namelist input -! for the rad_climate and rad_diag_N entries. -logical :: active_calls(0:N_DIAG) - ! Physics buffer indices integer :: qrs_idx = 0 integer :: qrl_idx = 0 @@ -554,9 +549,6 @@ subroutine radiation_init(pbuf2d) sampling_seq='rad_lwsw', flag_xyfill=.true.) endif - ! get list of active radiation calls - call rad_aer_get_call_list(active_calls) - ! Add shortwave radiation fields to history master field list. do icall = 0, N_DIAG From 48871c64c6186a54eae383d19dda67710528196b Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 11 Mar 2026 19:11:23 -0400 Subject: [PATCH 04/22] Refactor aerosol_optics_cam to extract portable aerosol_optics_core Draft optics some cleanup; move parameter 1.3 to be shared cleanup aerosol_optics_core Fix build; cleanup Make diag arguments non-optional --- src/chemistry/aerosol/aerosol_optics_core.F90 | 405 ++++++++++ src/physics/cam/aerosol_optics_cam.F90 | 715 ++++++++---------- 2 files changed, 708 insertions(+), 412 deletions(-) create mode 100644 src/chemistry/aerosol/aerosol_optics_core.F90 diff --git a/src/chemistry/aerosol/aerosol_optics_core.F90 b/src/chemistry/aerosol/aerosol_optics_core.F90 new file mode 100644 index 0000000000..391dc1379a --- /dev/null +++ b/src/chemistry/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/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index d9f91fe585..289b4aa514 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -27,14 +27,7 @@ module aerosol_optics_cam 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 hygroscopic_aerosol_optics_mod, only: hygroscopic_aerosol_optics - use hygro_aerosol_optics_mod, only: hygro_aerosol_optics - use insoluble_aerosol_optics_mod, only: insoluble_aerosol_optics - use volcrad_aerosol_optics_mod, only: volcrad_aerosol_optics + use aerosol_optics_core, only: aerosol_optics_sw_bin, aerosol_optics_lw_bin use aer_vis_diag_mod, only: aer_vis_diag_out @@ -512,6 +505,8 @@ end subroutine aerosol_optics_cam_final !=============================================================================== subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, wa, ga, fa) + use aerosol_optics_core, only: dustaspherical_opts + ! calculates aerosol sw radiative properties integer, intent(in) :: list_idx ! index of the climate or a diagnostic list @@ -531,24 +526,17 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, integer :: ibin, nbins integer :: iwav, ilev - integer :: icol, istat + integer :: icol integer :: lchnk, ncol integer :: num_aero_models character(len=aero_name_len) :: modetype logical :: coarse_dust_mode ! coarse dust mode for different MAM versions - class(aerosol_optics), pointer :: aero_optics - real(r8) :: dopaer(pcols) real(r8) :: mass(pcols,pver) real(r8) :: air_density(pcols,pver) - real(r8), allocatable :: pext(:) ! parameterized specific extinction (m2/kg) - real(r8), allocatable :: pabs(:) ! parameterized specific absorption (m2/kg) - real(r8), allocatable :: palb(:) ! parameterized single scattering albedo - real(r8), allocatable :: pasm(:) ! parameterized asymmetry factor - real(r8) :: relh(pcols,pver) real(r8) :: sate(pcols,pver) ! saturation vapor pressure real(r8) :: satq(pcols,pver) ! saturation specific humidity @@ -625,8 +613,8 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, ! total species AOD real(r8) :: dustaod(pcols), sulfaod(pcols), bcaod(pcols), & pomaod(pcols), soaaod(pcols), ssltaod(pcols) - real(r8) :: dustaod0(pcols) ! single-level dust AOD assuming spherical dust in coarse mode. dmleung 20 Oct 2025 - real(r8) :: dopaer0(pcols) ! single-level total AOD assuming spherical dust in coarse mode. dmleung 20 Oct 2025 + real(r8) :: dustaod0(pcols) ! single-level dust AOD assuming spherical dust in coarse mode + real(r8) :: dopaer0(pcols) ! single-level total AOD assuming spherical dust in coarse mode real(r8) :: aodvisst(pcols) ! stratospheric extinction optical depth real(r8) :: aoduvst(pcols) ! stratospheric extinction optical depth in uv real(r8) :: aodnirst(pcols) ! stratospheric extinction optical depth in nir @@ -639,13 +627,17 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, integer :: idx ! index to pbuf for geometric radius character(len=16) :: pbuf_fld - real(r8), parameter :: dustaspherical_opts = 1.3_r8 ! dmleung 20 Oct 2025 - ! Jasper Kok et al. (2017) Fig. 1d: 20-60 % higher mass extinction efficiency (scattering and absorption) - ! because dust is aspherical. This is currently not captured by a spherical assumption in the optical calculation - ! (the look up table is taken from the mode_defs namelist variable). So, we create a factor to represent - ! asphericity for now. Asphericity is strong for D > 1 um (coarse mode). + ! Per-bin optics arrays from portable core + real(r8) :: tau_bin(pcols,pver,nswbands) + real(r8) :: ssa_bin(pcols,pver,nswbands) + real(r8) :: asm_bin(pcols,pver,nswbands) + real(r8) :: pabs_vis(pcols,pver) ! specific absorption at vis band (from core, for BFB diagnostics) + real(r8) :: dopaer0_vis(pcols,pver) ! pre-asphericity tau at vis band (from core, for BFB diagnostics) - nullify(aero_optics) + integer :: ispec + + character(len=512) :: errmsg + integer :: errflg lchnk = state%lchnk ncol = state%ncol @@ -693,32 +685,12 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, bcaod = 0.0_r8 ssltaod = 0.0_r8 - ! dmleung ++ - ! single-level variables - dustaod0 = 0.0_r8 ! dmleung added 20 Oct 2025 + dustaod0 = 0.0_r8 dopaer0 = 0.0_r8 - ! dmleung -- num_aero_models = aerosol_instances_get_num_models() if (num_aero_models<1) return - allocate(pext(ncol), stat=istat) - if (istat/=0) then - call endrun(prefix//'array allocation error: pext') - end if - allocate(pabs(ncol), stat=istat) - if (istat/=0) then - call endrun(prefix//'array allocation error: pabs') - end if - allocate(palb(ncol), stat=istat) - if (istat/=0) then - call endrun(prefix//'array allocation error: palb') - end if - allocate(pasm(ncol), stat=istat) - if (istat/=0) then - call endrun(prefix//'array allocation error: pasm') - end if - ! calculate relative humidity for table lookup into rh grid call qsat(state%t(:ncol,:), state%pmid(:ncol,:), sate(:ncol,:), satq(:ncol,:), ncol, pver) relh(:ncol,:) = state%q(1:ncol,:,1) / satq(:ncol,:) @@ -739,7 +711,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, binloop: do ibin = 1, nbins - ! MAM coarse mode + ! Determine coarse dust mode for diagnostics if (aeroprops%model_is('MAM')) then modetype = aeroprops%bin_name(bin_ndx=ibin) coarse_dust_mode = (modetype=='coarse' .or. modetype=='coarse_dust') @@ -752,108 +724,272 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, aodbin(:) = 0.0_r8 taubam(:,:) = 0._r8 + ! Only for volcanic_radius, get geometric_radius from pbuf + ! (host-model specific) into optional argument. + nullify(geometric_radius) 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, pver, nswbands, nlwbands, crefwsw, crefwlw) - case('hygroscopic_coreshell') - aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, & - ibin, ncol, pver, relh(:ncol,:)) - case('hygroscopic_wtp') - aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, & - ibin, ncol, pver, sulfwtpct(:ncol,:)) - case('hygro') - ! Short-wave hygroscopic aerosol, Long-wave non-hygroscopic - ! aerosol optical properties - aero_optics=>hygro_aerosol_optics(aeroprops, aerostate, & - ibin, ncol, pver, numrh, relh(:ncol,:)) - case('hygroscopic') - ! Short-wave and long-wave hygroscopic aerosol properties - aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, ibin, & - ncol, pver, numrh, relh(:ncol,:)) - - case('nonhygro', 'insoluble') - aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, ibin) - case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3','volcanic_radius5') - ! construct name of radius physics buffer field pbuf_fld = 'VOLC_RAD_GEOM ' if (len_trim(opticstype)>15) then pbuf_fld = trim(pbuf_fld)//opticstype(16:16) endif - - ! get microphysical properties for volcanic aerosols idx = pbuf_get_index(pbuf_fld) call pbuf_get_field(pbuf, idx, geometric_radius) - - ! construct aerosol optics object - aero_optics=>volcrad_aerosol_optics(aeroprops, aerostate, & - ibin, ncol, pver, geometric_radius(:ncol,:)) - - case default - call endrun(prefix//'optics method not recognized: '//trim(opticstype)) end select - if (associated(aero_optics)) then - - wetvol(:ncol,:pver) = aerostate%wet_volume(aeroprops, ibin, ncol, pver) - watervol(:ncol,:pver) = aerostate%water_volume(aeroprops, ibin, ncol, pver) - - wavelength: do iwav = 1, nswbands - - vertical: do ilev = top_lev, pver - - ! The function sw_props combines the Mie theory-generated lookup table and the volume-averaged refractive index to generate - ! optical/radiative properties (pext, pabs, palb, pasm) of the aerosol mixture in this mode/bin. - call aero_optics%sw_props(ncol, ilev, iwav, pext, pabs, palb, pasm ) - - call init_diags - - column: do icol = 1,ncol - - dopaer(icol) = pext(icol)*mass(icol,ilev) ! aerosol optical depth of layer ilev - - ! dmleung 20 Oct 2025 ++ - ! added dust asphericity impacts on enhancing dust AOD. Modified after Longlei Li (Cornell University). - ! the theory is that 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), - ! Smaller desert dust cooling effect estimated from analysis of dust size and abundance + ! Call portable aerosol optics driver: + if (associated(geometric_radius)) then + ! volcanic_radius: + call aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & + ncol, pver, top_lev, nswbands, nlwbands, numrh, & + idx_sw_diag, & + relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & + geometric_radius=geometric_radius(:ncol,:), & + tau_bin=tau_bin(:ncol,:,:), ssa_bin=ssa_bin(:ncol,:,:), asm_bin=asm_bin(:ncol,:,:), & + pabs_vis=pabs_vis(:ncol,:), dopaer0_vis=dopaer0_vis(:ncol,:), & + errmsg=errmsg, errflg=errflg) + else + ! all other types: + call aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & + ncol, pver, top_lev, nswbands, nlwbands, numrh, & + idx_sw_diag, & + relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & + tau_bin=tau_bin(:ncol,:,:), ssa_bin=ssa_bin(:ncol,:,:), asm_bin=asm_bin(:ncol,:,:), & + pabs_vis=pabs_vis(:ncol,:), dopaer0_vis=dopaer0_vis(:ncol,:), & + errmsg=errmsg, errflg=errflg) + end if - call update_diags( is_coarse_dust=coarse_dust_mode ) ! dopaer is updated in update_diags. + if(errflg /= 0) then + call endrun(prefix//errmsg) + end if - ! dmleung: update_diags updated dopaer(icol) as a diagnostic. - ! Aerosol optical and radiative properties are subsequently modified given dopaer update in update_diags. - ! To the first-order approximation, palb and pasm (SSA and asymmetry factor) remain roughly the same in the - ! 1-10 um upon introducing asphericity; changes in wa, ga, and fa are thus due to only AOD changes given dust asphericty. - ! ref: Fig. 2a-d of Yue Huang et al. (2023), - ! Single-scattering properties of ellipsoidal dust aerosols constrained by measured dust shape distributions - tauxar(icol,ilev,iwav) = tauxar(icol,ilev,iwav) + dopaer(icol) ! aerosol optical depth at layer ilev - wa(icol,ilev,iwav) = wa(icol,ilev,iwav) + dopaer(icol)*palb(icol) ! single scattering albedo at layer ilev - ga(icol,ilev,iwav) = ga(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol) ! asymmetry factor at layer ilev - fa(icol,ilev,iwav) = fa(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol)*pasm(icol) ! forward scattered fraction at layer ilev - ! dmleung -- + ! Accumulate into total physics arrays. + wavelength: do iwav = 1, nswbands + vertical: do ilev = top_lev, pver + column: do icol = 1, ncol + ! aerosol optical depth at layer ilev: + tauxar(icol,ilev,iwav) = tauxar(icol,ilev,iwav) + tau_bin(icol,ilev,iwav) + + ! single scattering albedo at layer ilev: + wa(icol,ilev,iwav) = wa(icol,ilev,iwav) + tau_bin(icol,ilev,iwav)*ssa_bin(icol,ilev,iwav) + + ! asymmetry factor at layer ilev: + ga(icol,ilev,iwav) = ga(icol,ilev,iwav) + tau_bin(icol,ilev,iwav)*ssa_bin(icol,ilev,iwav)*asm_bin(icol,ilev,iwav) + + ! forward scattered fraction at layer ilev: + fa(icol,ilev,iwav) = fa(icol,ilev,iwav) + tau_bin(icol,ilev,iwav)*ssa_bin(icol,ilev,iwav)*asm_bin(icol,ilev,iwav)*asm_bin(icol,ilev,iwav) + end do column + end do vertical + end do wavelength + + ! CAM diagnostics: + ! Get wet/water volumes for diagnostic species partitioning + wetvol(:ncol,:pver) = aerostate%wet_volume(aeroprops, ibin, ncol, pver) + watervol(:ncol,:pver) = aerostate%water_volume(aeroprops, ibin, ncol, pver) + + ! Diagnostic accumulation using tau_bin (asphericity already applied by core) + do iwav = 1, nswbands + do ilev = top_lev, pver + + ! Initialize per-species diagnostic accumulators for this (iwav, ilev) + dustvol(:ncol) = 0._r8 + 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 + + do icol = 1, ncol + ! dopaer is tau_bin with asphericity already applied + dopaer(icol) = tau_bin(icol,ilev,iwav) + + if (iwav==idx_uv_diag) then + aoduv(icol) = aoduv(icol) + dopaer(icol) + extinctuv(icol,ilev) = extinctuv(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) + if (ilev<=troplev(icol)) then + aoduvst(icol) = aoduvst(icol) + dopaer(icol) + end if + + else if (iwav==idx_sw_diag) then ! vis + + ! Species partitioning for per-species AOD diagnostics + ! (re-runs species loop — same data as core computed for asphericity) + 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) + + burden(icol) = burden(icol) + specmmr(icol,ilev)*mass(icol,ilev) + + vol(icol) = specmmr(icol,ilev)/specdens + + select case ( trim(spectype) ) + case('dust') + dustvol(icol) = vol(icol) + burdendust(icol) = burdendust(icol) + specmmr(icol,ilev)*mass(icol,ilev) + if (associated(specrefindex)) then + scatdust(icol) = vol(icol) * specrefindex(iwav)%re + absdust(icol) =-vol(icol) * specrefindex(iwav)%im + end if + hygrodust(icol)= vol(icol)*hygro_aer + case('black-c') + burdenbc(icol) = burdenbc(icol) + specmmr(icol,ilev)*mass(icol,ilev) + if (associated(specrefindex)) then + scatbc(icol) = vol(icol) * specrefindex(iwav)%re + absbc(icol) =-vol(icol) * specrefindex(iwav)%im + end if + hygrobc(icol)= vol(icol)*hygro_aer + case('sulfate') + burdenso4(icol) = burdenso4(icol) + specmmr(icol,ilev)*mass(icol,ilev) + if (associated(specrefindex)) then + scatsulf(icol) = vol(icol) * specrefindex(iwav)%re + abssulf(icol) =-vol(icol) * specrefindex(iwav)%im + end if + hygrosulf(icol)= vol(icol)*hygro_aer + case('p-organic') + burdenpom(icol) = burdenpom(icol) + specmmr(icol,ilev)*mass(icol,ilev) + if (associated(specrefindex)) then + scatpom(icol) = vol(icol) * specrefindex(iwav)%re + abspom(icol) =-vol(icol) * specrefindex(iwav)%im + end if + hygropom(icol)= vol(icol)*hygro_aer + case('s-organic') + burdensoa(icol) = burdensoa(icol) + specmmr(icol,ilev)*mass(icol,ilev) + if (associated(specrefindex)) then + scatsoa(icol) = vol(icol) * specrefindex(iwav)%re + abssoa(icol) = -vol(icol) * specrefindex(iwav)%im + end if + hygrosoa(icol)= vol(icol)*hygro_aer + case('seasalt') + burdenseasalt(icol) = burdenseasalt(icol) + specmmr(icol,ilev)*mass(icol,ilev) + if (associated(specrefindex)) then + scatsslt(icol) = vol(icol) * specrefindex(iwav)%re + abssslt(icol) = -vol(icol) * specrefindex(iwav)%im + end if + hygrosslt(icol)= vol(icol)*hygro_aer + end select + end do + + 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(iwav)%re + absh2o = -watervol(icol,ilev)*crefwsw(iwav)%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 + + scatsulf(icol) = (scatsulf(icol) + scath2o*hygrosulf(icol)/sumhygro)/sumscat + abssulf(icol) = (abssulf(icol) + absh2o*hygrosulf(icol)/sumhygro)/sumabs + + scatpom(icol) = (scatpom(icol) + scath2o*hygropom(icol)/sumhygro)/sumscat + abspom(icol) = (abspom(icol) + absh2o*hygropom(icol)/sumhygro)/sumabs + + scatsoa(icol) = (scatsoa(icol) + scath2o*hygrosoa(icol)/sumhygro)/sumscat + abssoa(icol) = (abssoa(icol) + absh2o*hygrosoa(icol)/sumhygro)/sumabs + + scatbc(icol)= (scatbc(icol) + scath2o*hygrobc(icol)/sumhygro)/sumscat + absbc(icol) = (absbc(icol) + absh2o*hygrobc(icol)/sumhygro)/sumabs + + scatsslt(icol) = (scatsslt(icol) + scath2o*hygrosslt(icol)/sumhygro)/sumscat + abssslt(icol) = (abssslt(icol) + absh2o*hygrosslt(icol)/sumhygro)/sumabs + + ! Use dopaer0_vis (pre-asphericity) and pabs_vis from core for BFB diagnostic accumulation. + ! dopaer already has asphericity applied (from core); dopaer0 is the pre-asphericity value. + dopaer0(icol) = dopaer0_vis(icol,ilev) + + ! Per-species AOD diagnostics use dopaer0 (pre-asphericity) and ssa_bin (=palb). + ! In the original code, species AOD was computed before asphericity was applied to dopaer. + aodabsbc(icol) = aodabsbc(icol) + absbc(icol)*dopaer0(icol)*(1.0_r8-ssa_bin(icol,ilev,iwav)) + + aodc = (abssulf(icol)*(1.0_r8 - ssa_bin(icol,ilev,iwav)) + ssa_bin(icol,ilev,iwav)*scatsulf(icol))*dopaer0(icol) + sulfaod(icol) = sulfaod(icol) + aodc + + aodc = (abspom(icol)*(1.0_r8 - ssa_bin(icol,ilev,iwav)) + ssa_bin(icol,ilev,iwav)*scatpom(icol))*dopaer0(icol) + pomaod(icol) = pomaod(icol) + aodc + + aodc = (abssoa(icol)*(1.0_r8 - ssa_bin(icol,ilev,iwav)) + ssa_bin(icol,ilev,iwav)*scatsoa(icol))*dopaer0(icol) + soaaod(icol) = soaaod(icol) + aodc + + aodc = (absbc(icol)*(1.0_r8 - ssa_bin(icol,ilev,iwav)) + ssa_bin(icol,ilev,iwav)*scatbc(icol))*dopaer0(icol) + bcaod(icol) = bcaod(icol) + aodc + + aodc = (abssslt(icol)*(1.0_r8 - ssa_bin(icol,ilev,iwav)) + ssa_bin(icol,ilev,iwav)*scatsslt(icol))*dopaer0(icol) + ssltaod(icol) = ssltaod(icol) + aodc + + aodc = (absdust(icol)*(1.0_r8 - ssa_bin(icol,ilev,iwav)) + ssa_bin(icol,ilev,iwav)*scatdust(icol))*dopaer0(icol) + dustaod(icol) = dustaod(icol) + aodc + + ! dustaod0 is the single-level spherical dust AOD + dustaod0(icol) = aodc + + ! Diagnostic dustaodbin and dustaod asphericity adjustment + if (coarse_dust_mode) then + dustaodbin(icol) = dustaodbin(icol) + dopaer0(icol)*dustvol(icol)/wetvol(icol,ilev) * dustaspherical_opts + dustaod(icol) = dustaod(icol) - dustaod0(icol) + dustaod0(icol)*dustaspherical_opts + else + dustaodbin(icol) = dustaodbin(icol) + dopaer(icol)*dustvol(icol)/wetvol(icol,ilev) + end if + + ! Absorption diagnostics using pabs_vis from core (BFB with original code) + aodvis(icol) = aodvis(icol) + dopaer(icol) + aodabs(icol) = aodabs(icol) + mass(icol,ilev) * pabs_vis(icol,ilev) * dopaer(icol)/dopaer0(icol) + extinct(icol,ilev) = extinct(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) + absorb(icol,ilev) = absorb(icol,ilev) + air_density(icol,ilev) * pabs_vis(icol,ilev) * dopaer(icol)/dopaer0(icol) + ssavis(icol) = ssavis(icol) + dopaer(icol)*ssa_bin(icol,ilev,iwav) + asymvis(icol) = asymvis(icol) + dopaer(icol)*asm_bin(icol,ilev,iwav) + asymext(icol,ilev) = asymext(icol,ilev) + dopaer(icol)*asm_bin(icol,ilev,iwav)*air_density(icol,ilev)/mass(icol,ilev) + + aodbin(icol) = aodbin(icol) + dopaer(icol) + + end if + + if (ilev<=troplev(icol)) then + aodvisst(icol) = aodvisst(icol) + dopaer(icol) + end if + + else if (iwav==idx_nir_diag) then + aodnir(icol) = aodnir(icol) + dopaer(icol) + extinctnir(icol,ilev) = extinctnir(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) - end do column + if (ilev<=troplev(icol)) then + aodnirst(icol) = aodnirst(icol) + dopaer(icol) + end if - if (aeroprops%model_is('BAM').and.iwav==idx_sw_diag) then - taubam(:ncol,ilev) = dopaer(:ncol) end if - end do vertical - - end do wavelength - - else - call endrun(prefix//'aero_optics object pointer not associated') - end if + aodtot(icol) = aodtot(icol) + dopaer(icol) - deallocate(aero_optics) - nullify(aero_optics) + end do ! icol + end do ! ilev + end do ! iwav + ! BAM diagnostics if (aeroprops%model_is('BAM')) then + taubam(:ncol,top_lev:pver) = tau_bin(:ncol,top_lev:pver,idx_sw_diag) bam_cnt = bam_cnt+1 call aer_vis_diag_out(lchnk, ncol, nnite, idxnite, bam_cnt, taubam, & list_idx, troplev) @@ -866,224 +1002,8 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, call output_tot_diags - deallocate(pext) - deallocate(pabs) - deallocate(palb) - deallocate(pasm) - contains - !=============================================================================== - subroutine init_diags - dustvol(:ncol) = 0._r8 - 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 - end subroutine init_diags - - !=============================================================================== - subroutine update_diags( is_coarse_dust ) - - logical, intent(in) :: is_coarse_dust - - integer :: ispec - - if (iwav==idx_uv_diag) then - aoduv(icol) = aoduv(icol) + dopaer(icol) - extinctuv(icol,ilev) = extinctuv(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) - if (ilev<=troplev(icol)) then - aoduvst(icol) = aoduvst(icol) + dopaer(icol) - end if - - else if (iwav==idx_sw_diag) then ! vis - - ! 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) - - burden(icol) = burden(icol) + specmmr(icol,ilev)*mass(icol,ilev) - - vol(icol) = specmmr(icol,ilev)/specdens - - select case ( trim(spectype) ) - case('dust') - dustvol(icol) = vol(icol) - burdendust(icol) = burdendust(icol) + specmmr(icol,ilev)*mass(icol,ilev) - if (associated(specrefindex)) then - scatdust(icol) = vol(icol) * specrefindex(iwav)%re - absdust(icol) =-vol(icol) * specrefindex(iwav)%im - end if - hygrodust(icol)= vol(icol)*hygro_aer - case('black-c') - burdenbc(icol) = burdenbc(icol) + specmmr(icol,ilev)*mass(icol,ilev) - if (associated(specrefindex)) then - scatbc(icol) = vol(icol) * specrefindex(iwav)%re - absbc(icol) =-vol(icol) * specrefindex(iwav)%im - end if - hygrobc(icol)= vol(icol)*hygro_aer - case('sulfate') - burdenso4(icol) = burdenso4(icol) + specmmr(icol,ilev)*mass(icol,ilev) - if (associated(specrefindex)) then - scatsulf(icol) = vol(icol) * specrefindex(iwav)%re - abssulf(icol) =-vol(icol) * specrefindex(iwav)%im - end if - hygrosulf(icol)= vol(icol)*hygro_aer - case('p-organic') - burdenpom(icol) = burdenpom(icol) + specmmr(icol,ilev)*mass(icol,ilev) - if (associated(specrefindex)) then - scatpom(icol) = vol(icol) * specrefindex(iwav)%re - abspom(icol) =-vol(icol) * specrefindex(iwav)%im - end if - hygropom(icol)= vol(icol)*hygro_aer - case('s-organic') - burdensoa(icol) = burdensoa(icol) + specmmr(icol,ilev)*mass(icol,ilev) - if (associated(specrefindex)) then - scatsoa(icol) = vol(icol) * specrefindex(iwav)%re - abssoa(icol) = -vol(icol) * specrefindex(iwav)%im - end if - hygrosoa(icol)= vol(icol)*hygro_aer - case('seasalt') - burdenseasalt(icol) = burdenseasalt(icol) + specmmr(icol,ilev)*mass(icol,ilev) - if (associated(specrefindex)) then - scatsslt(icol) = vol(icol) * specrefindex(iwav)%re - abssslt(icol) = -vol(icol) * specrefindex(iwav)%im - end if - hygrosslt(icol)= vol(icol)*hygro_aer - end select - end do - - 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(iwav)%re - absh2o = -watervol(icol,ilev)*crefwsw(iwav)%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 - - scatsulf(icol) = (scatsulf(icol) + scath2o*hygrosulf(icol)/sumhygro)/sumscat - abssulf(icol) = (abssulf(icol) + absh2o*hygrosulf(icol)/sumhygro)/sumabs - - scatpom(icol) = (scatpom(icol) + scath2o*hygropom(icol)/sumhygro)/sumscat - abspom(icol) = (abspom(icol) + absh2o*hygropom(icol)/sumhygro)/sumabs - - scatsoa(icol) = (scatsoa(icol) + scath2o*hygrosoa(icol)/sumhygro)/sumscat - abssoa(icol) = (abssoa(icol) + absh2o*hygrosoa(icol)/sumhygro)/sumabs - - scatbc(icol)= (scatbc(icol) + scath2o*hygrobc(icol)/sumhygro)/sumscat - absbc(icol) = (absbc(icol) + absh2o*hygrobc(icol)/sumhygro)/sumabs - - scatsslt(icol) = (scatsslt(icol) + scath2o*hygrosslt(icol)/sumhygro)/sumscat - abssslt(icol) = (abssslt(icol) + absh2o*hygrosslt(icol)/sumhygro)/sumabs - - - aodabsbc(icol) = aodabsbc(icol) + absbc(icol)*dopaer(icol)*(1.0_r8-palb(icol)) - - - aodc = (abssulf(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatsulf(icol))*dopaer(icol) - sulfaod(icol) = sulfaod(icol) + aodc - - aodc = (abspom(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatpom(icol))*dopaer(icol) - pomaod(icol) = pomaod(icol) + aodc - - aodc = (abssoa(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatsoa(icol))*dopaer(icol) - soaaod(icol) = soaaod(icol) + aodc - - aodc = (absbc(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatbc(icol))*dopaer(icol) - bcaod(icol) = bcaod(icol) + aodc - - aodc = (abssslt(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatsslt(icol))*dopaer(icol) - ssltaod(icol) = ssltaod(icol) + aodc - - ! dmleung 20 Oct 2025 ++ - aodc = (absdust(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatdust(icol))*dopaer(icol) - dustaod(icol) = dustaod(icol) + aodc - - ! dustaod0(icol) is a single-level dust AOD, aodc is single-level dust AOD. - dustaod0(icol) = aodc ! dust AOD accumulator given spherical dust. The spherical dustaod0 is created to - ! combine with aspherical dustaod to modify dopaer in aerosol_optics_cam_sw. - - ! use single-layer dopaer(icol) to update single-layer dopaer0(icol). - dopaer0(icol) = dopaer(icol) ! dopaer0 stores total AOD assuming aspherical dust. - - ! if we are using MAM and this is a coarse dust mode, scale up dust AOD by 30 %. - if (is_coarse_dust) then - - ! update column-level variables - dustaodbin(icol) = dustaodbin(icol) + dopaer(icol)*dustvol(icol)/wetvol(icol,ilev) * dustaspherical_opts ! update mode/bin-specific dust AOD - - ! dustaod is a column-level dust AOD accumulator, while dustaod0 is the single-level spherical dust AOD - dustaod(icol) = dustaod(icol) - dustaod0(icol) + dustaod0(icol)*dustaspherical_opts ! dustaod is now dust AOD based on aspherical dust - !with asphericity effect on thickening AOD. - - ! update single-layer variable: dopaer - dopaer(icol) = dopaer(icol) - dustaod0(icol) + dustaod0(icol)*dustaspherical_opts ! Total AOD accounting for dust asphericity - else - ! update column-level dust AOD accumulator - dustaodbin(icol) = dustaodbin(icol) + dopaer(icol)*dustvol(icol)/wetvol(icol,ilev) - end if - ! dmleung -- - - ! dmleung 20 Oct 2025 ++ - ! Then, all these diagnostics are outputted based on the modified dust AOD. - ! We simply apply dopaer/dopaer0 (>1 for coarse mode) to the absorption diagnostics. - aodvis(icol) = aodvis(icol) + dopaer(icol) - aodabs(icol) = aodabs(icol) + mass(icol,ilev) * pabs(icol) * dopaer(icol)/dopaer0(icol) ! dmleung - extinct(icol,ilev) = extinct(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) - absorb(icol,ilev) = absorb(icol,ilev) + air_density(icol,ilev) * pabs(icol) * dopaer(icol)/dopaer0(icol) ! dmleung - ssavis(icol) = ssavis(icol) + dopaer(icol)*palb(icol) - asymvis(icol) = asymvis(icol) + dopaer(icol)*pasm(icol) - asymext(icol,ilev) = asymext(icol,ilev) + dopaer(icol)*pasm(icol)*air_density(icol,ilev)/mass(icol,ilev) - - aodbin(icol) = aodbin(icol) + dopaer(icol) - - end if - - if (ilev<=troplev(icol)) then - aodvisst(icol) = aodvisst(icol) + dopaer(icol) - end if - ! dmleung -- - - else if (iwav==idx_nir_diag) then - aodnir(icol) = aodnir(icol) + dopaer(icol) - extinctnir(icol,ilev) = extinctnir(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) - - if (ilev<=troplev(icol)) then - aodnirst(icol) = aodnirst(icol) + dopaer(icol) - end if - - end if - - aodtot(icol) = aodtot(icol) + dopaer(icol) - - end subroutine update_diags - !=============================================================================== subroutine output_bin_diags @@ -1247,29 +1167,24 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) real(r8), intent(inout) :: tauxar(pcols,pver,nlwbands) ! layer absorption optical depth - - real(r8) :: dopaer(pcols) real(r8) :: mass(pcols,pver) character(len=*), parameter :: prefix = 'aerosol_optics_cam_lw: ' integer :: ibin, nbins integer :: iwav, ilev - integer :: ncol, icol, istat + integer :: ncol, icol integer :: num_aero_models - class(aerosol_optics), pointer :: aero_optics class(aerosol_state), pointer :: aerostate class(aerosol_properties), pointer :: aeroprops - real(r8), allocatable :: pabs(:) - real(r8) :: relh(pcols,pver) real(r8) :: sate(pcols,pver) ! saturation vapor pressure real(r8) :: satq(pcols,pver) ! saturation specific humidity real(r8) :: sulfwtpct(pcols,pver) ! sulf weight percent - character(len=32) :: opticstype + character(len=ot_length) :: opticstype integer :: iaermod real(r8), pointer :: geometric_radius(:,:) @@ -1277,22 +1192,23 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) character(len=16) :: pbuf_fld real(r8) :: lwabs(pcols,pver) + + ! Per-bin optics arrays from portable core + real(r8) :: tau_lw_bin(pcols,pver,nlwbands) + real(r8) :: absorp_bin(pcols,pver,nlwbands) + + character(len=512) :: errmsg + integer :: errflg + lwabs = 0._r8 tauxar = 0._r8 - nullify(aero_optics) - num_aero_models = aerosol_instances_get_num_models() ncol = state%ncol mass(:ncol,:) = state%pdeldry(:ncol,:)*rga - allocate(pabs(ncol), stat=istat) - if (istat/=0) then - call endrun(prefix//'array allocation error: pabs') - end if - ! calculate relative humidity for table lookup into rh grid call qsat(state%t(:ncol,:), state%pmid(:ncol,:), sate(:ncol,:), satq(:ncol,:), ncol, pver) relh(:ncol,:) = state%q(1:ncol,:,1) / satq(:ncol,:) @@ -1310,73 +1226,50 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) binloop: do ibin = 1, nbins + ! Get volcanic geometric_radius from pbuf if needed (CAM-specific) + nullify(geometric_radius) 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, pver, nswbands, nlwbands, crefwsw, crefwlw) - case('hygroscopic_coreshell') - aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, & - ibin, ncol, pver, relh(:ncol,:)) - case('hygroscopic_wtp') - aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, & - ibin, ncol, pver, sulfwtpct(:ncol,:)) - - case('hygroscopic') - aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, ibin, & - ncol, pver, numrh, relh(:ncol,:)) - - case('hygro') - aero_optics=>hygro_aerosol_optics(aeroprops, aerostate, ibin, & - ncol, pver, numrh, relh(:ncol,:)) - - case('nonhygro', 'insoluble') - aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, ibin) - case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3','volcanic_radius5') - - ! construct name of radius physics buffer field pbuf_fld = 'VOLC_RAD_GEOM ' if (len_trim(opticstype)>15) then pbuf_fld = trim(pbuf_fld)//opticstype(16:16) endif - - ! get microphysical properties for volcanic aerosols idx = pbuf_get_index(pbuf_fld) call pbuf_get_field(pbuf, idx, geometric_radius) - - ! construct aerosol optics object - aero_optics=>volcrad_aerosol_optics(aeroprops, aerostate, & - ibin, ncol, pver, geometric_radius(:ncol,:)) - - case default - call endrun(prefix//'optics method not recognized: '//trim(opticstype)) end select - if (associated(aero_optics)) then - - wavelength: do iwav = 1, nlwbands - - vertical: do ilev = 1, pver - call aero_optics%lw_props(ncol, ilev, iwav, pabs ) - - column: do icol = 1, ncol - dopaer(icol) = pabs(icol) * mass(icol,ilev) - tauxar(icol,ilev,iwav) = tauxar(icol,ilev,iwav) + dopaer(icol) - lwabs(icol,ilev) = lwabs(icol,ilev) + pabs(icol) - end do column - - end do vertical - - end do wavelength - + ! Call portable aerosol optics driver: + if (associated(geometric_radius)) then + ! volcanic_radius: + call aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & + ncol, pver, nswbands, nlwbands, numrh, & + relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & + geometric_radius=geometric_radius(:ncol,:), & + tau_lw_bin=tau_lw_bin(:ncol,:,:), absorp_bin=absorp_bin(:ncol,:,:), & + errmsg=errmsg, errflg=errflg) else - call endrun(prefix//'aero_optics object pointer not associated') + ! other types: + call aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & + ncol, pver, nswbands, nlwbands, numrh, & + relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & + tau_lw_bin=tau_lw_bin(:ncol,:,:), absorp_bin=absorp_bin(:ncol,:,:), & + errmsg=errmsg, errflg=errflg) end if - deallocate(aero_optics) - nullify(aero_optics) + if (errflg /= 0) then + call endrun(prefix//errmsg) + end if + + ! Accumulate into total arrays + wavelength: do iwav = 1, nlwbands + vertical: do ilev = 1, pver + column: do icol = 1, ncol + tauxar(icol,ilev,iwav) = tauxar(icol,ilev,iwav) + tau_lw_bin(icol,ilev,iwav) + lwabs(icol,ilev) = lwabs(icol,ilev) + absorp_bin(icol,ilev,iwav) + end do column + end do vertical + end do wavelength end do binloop end do aeromodel @@ -1387,8 +1280,6 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) call outfld('AODABSLW'//diag(list_idx), tauxar(:,:,lw10um_indx), pcols, state%lchnk) end if - deallocate(pabs) - end subroutine aerosol_optics_cam_lw !=============================================================================== From 5f200d9af72acb3650fb062ab112cb30fe574f65 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 12 Mar 2026 23:41:58 -0400 Subject: [PATCH 05/22] Unify names for aerosol_mmr_cam to make port easier to CAM-SIMA. --- src/chemistry/aerosol/radiative_aerosol.F90 | 12 ++++----- src/physics/cam/aerosol_mmr_cam.F90 | 28 ++++++++++----------- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/chemistry/aerosol/radiative_aerosol.F90 b/src/chemistry/aerosol/radiative_aerosol.F90 index e870dee7c4..aa233c4283 100644 --- a/src/chemistry/aerosol/radiative_aerosol.F90 +++ b/src/chemistry/aerosol/radiative_aerosol.F90 @@ -1285,8 +1285,8 @@ subroutine rad_aer_init() 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_cam_init, & - resolve_mode_cam_idx, resolve_bin_cam_idx, resolve_bulk_cam_idx, & + use aerosol_mmr_cam, only: aerosol_mmr_init, & + resolve_mode_idx, resolve_bin_idx, resolve_bulk_idx, & rad_aer_diag_init !REMOVECAM_END @@ -1295,21 +1295,21 @@ subroutine rad_aer_init() !----------------------------------------------------------------------------- ! Initialize a zero target for the 'Z' type of aerosol MMR. - call aerosol_mmr_cam_init() + 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_cam_idx(modes) - call resolve_bin_cam_idx(bins) + 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_cam_idx(bulk_aerosol_list(i)) + 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 diff --git a/src/physics/cam/aerosol_mmr_cam.F90 b/src/physics/cam/aerosol_mmr_cam.F90 index d473d68ddd..cbc711c760 100644 --- a/src/physics/cam/aerosol_mmr_cam.F90 +++ b/src/physics/cam/aerosol_mmr_cam.F90 @@ -22,10 +22,10 @@ module aerosol_mmr_cam ! values for constituents with requested value of zero real(r8), allocatable, target :: zero_cols(:,:) -public :: aerosol_mmr_cam_init ! allocate zero_cols +public :: aerosol_mmr_init ! allocate zero_cols public :: get_cam_idx -public :: resolve_mode_cam_idx, resolve_bin_cam_idx -public :: resolve_bulk_cam_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 @@ -42,14 +42,14 @@ module aerosol_mmr_cam contains !============================================================================== -subroutine aerosol_mmr_cam_init() +subroutine aerosol_mmr_init() use ppgrid, only: pcols, pver ! Allocate zero_cols array (must be called after ppgrid is set up) if (.not. allocated(zero_cols)) then allocate(zero_cols(pcols,pver)) zero_cols = 0._r8 end if -end subroutine aerosol_mmr_cam_init +end subroutine aerosol_mmr_init !================================================================================================ @@ -100,7 +100,7 @@ end function get_cam_idx !=========================== -subroutine resolve_mode_cam_idx(modes) +subroutine resolve_mode_idx(modes) ! Initialize the mode definitions by looking up the relevent indices in the ! constituent and pbuf arrays, and getting the physprop IDs @@ -115,7 +115,7 @@ subroutine resolve_mode_cam_idx(modes) ! Local variables integer :: m, ispec, nspec - character(len=*), parameter :: routine = 'resolve_mode_cam_idx' + character(len=*), parameter :: routine = 'resolve_mode_idx' !----------------------------------------------------------------------------- do m = 1, modes%nmodes @@ -149,11 +149,11 @@ subroutine resolve_mode_cam_idx(modes) end do -end subroutine resolve_mode_cam_idx +end subroutine resolve_mode_idx !=========================== -subroutine resolve_bin_cam_idx(bins) +subroutine resolve_bin_idx(bins) ! Initialize the bin definitions by looking up the relevent indices in the ! constituent and pbuf arrays, and getting the physprop IDs @@ -168,7 +168,7 @@ subroutine resolve_bin_cam_idx(bins) ! Local variables integer :: m, ispec, nspec - character(len=*), parameter :: routine = 'resolve_bin_cam_idx' + character(len=*), parameter :: routine = 'resolve_bin_idx' !----------------------------------------------------------------------------- do m = 1, bins%nbins @@ -208,11 +208,11 @@ subroutine resolve_bin_cam_idx(bins) end do -end subroutine resolve_bin_cam_idx +end subroutine resolve_bin_idx !=========================== -subroutine resolve_bulk_cam_idx(aerlist) +subroutine resolve_bulk_idx(aerlist) ! Resolve host-specific indices for bulk aerosols. ! Must be called before list_resolve_physprops (which resolves physprop IDs). @@ -223,14 +223,14 @@ subroutine resolve_bulk_cam_idx(aerlist) type(aerlist_t), intent(inout) :: aerlist integer :: i - character(len=*), parameter :: routine = 'resolve_bulk_cam_idx' + character(len=*), parameter :: routine = 'resolve_bulk_idx' !----------------------------------------------------------------------------- do i = 1, aerlist%numaerosols aerlist%aer(i)%idx = get_cam_idx(aerlist%aer(i)%source, aerlist%aer(i)%camname, routine) end do -end subroutine resolve_bulk_cam_idx +end subroutine resolve_bulk_idx !================================================================================================ From 9ac36ddca74d73a66822114768fd54b9b5f82ded Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 13 Mar 2026 11:35:41 -0400 Subject: [PATCH 06/22] Clarify num_to_mass_aer, dryrad for modal, sectional; fix null pointer use in aerosol_optics_core. --- src/chemistry/aerosol/aerosol_optics_core.F90 | 2 ++ .../aerosol/carma_aerosol_properties_mod.F90 | 15 +++++++++------ .../aerosol/modal_aerosol_properties_mod.F90 | 11 ++++++----- 3 files changed, 17 insertions(+), 11 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_optics_core.F90 b/src/chemistry/aerosol/aerosol_optics_core.F90 index 391dc1379a..2b3f331b7a 100644 --- a/src/chemistry/aerosol/aerosol_optics_core.F90 +++ b/src/chemistry/aerosol/aerosol_optics_core.F90 @@ -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/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index d3fd480f3e..d384559f1b 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -3,7 +3,7 @@ module carma_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_bin_props_by_idx, & - rad_aer_get_info_by_bin, rad_aer_get_info_by_bin_spec, rad_aer_get_bin_props + rad_aer_get_info_by_bin, rad_aer_get_info_by_bin_spec use infnan, only: nan, assignment(=) implicit none @@ -266,6 +266,7 @@ 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) + use cam_abortutils, only: endrun class(carma_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -278,7 +279,7 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, & 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) -- not meaningful for CARMA + real(r8), optional, intent(out) :: dryrad ! dry radius (m) if (present(density)) then call rad_aer_get_bin_props_by_idx(self%list_idx_, bin_ndx, species_ndx, density_aer=density) @@ -307,13 +308,13 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, & end if if (present(num_to_mass_aer)) then - ! num_to_mass_aer not meaningful for sectional aerosols: - num_to_mass_aer = 0.0_r8 + ! num_to_mass_aer for sectional aerosols should not be read from file + call endrun('carma_aerosol_properties_mod%get: num_to_mass_aer should not be read from file for sectional aerosols') end if if (present(dryrad)) then - ! dryrad is not meaningful for sectional aerosols: - dryrad = 0.0_r8 + ! dryrad for sectional aerosols should not be read from file + call endrun('carma_aerosol_properties_mod%get: dryrad should not be read from file for sectional aerosols') end if end subroutine get @@ -330,6 +331,8 @@ subroutine optics_params(self, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absp 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 radiative_aerosol, only: rad_aer_get_bin_props + class(carma_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index 3e85c26262..4c76a0c2a0 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -410,6 +410,7 @@ 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) + use cam_abortutils, only: endrun class(modal_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -422,7 +423,7 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, & 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) -- not meaningful for modal + 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, & @@ -437,13 +438,13 @@ subroutine get(self, bin_ndx, species_ndx, density, hygro, & end if if (present(num_to_mass_aer)) then - ! num_to_mass_aer not meaningful for modal aerosols: - num_to_mass_aer = 0.0_r8 + ! 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 is not meaningful for modal aerosols: - dryrad = 0.0_r8 + ! 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 From 73aa9d20ce336262251383207b223fb3e18e91af Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Sun, 15 Mar 2026 23:37:39 -0400 Subject: [PATCH 07/22] Sync radiative_aerosol_definitions.F90 with version in CAM-SIMA --- .../aerosol/radiative_aerosol_definitions.F90 | 418 +++++++++--------- 1 file changed, 221 insertions(+), 197 deletions(-) diff --git a/src/chemistry/aerosol/radiative_aerosol_definitions.F90 b/src/chemistry/aerosol/radiative_aerosol_definitions.F90 index a9812978df..bf0c7b1559 100644 --- a/src/chemistry/aerosol/radiative_aerosol_definitions.F90 +++ b/src/chemistry/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 From a78c9aa4808bd1375142f16852f2994a8f71629a Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 19 Mar 2026 22:57:48 -0400 Subject: [PATCH 08/22] Address review comments --- .../aerosol/aerosol_instances_mod.F90 | 28 ++++++-- .../aerosol/aerosol_properties_mod.F90 | 70 +++++++++++-------- .../aerosol/bulk_aerosol_properties_mod.F90 | 2 +- .../aerosol/modal_aerosol_properties_mod.F90 | 2 +- src/physics/cam/aerosol_optics_cam.F90 | 2 + 5 files changed, 67 insertions(+), 37 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_instances_mod.F90 b/src/chemistry/aerosol/aerosol_instances_mod.F90 index f0527d6c73..4f1f7c2b5f 100644 --- a/src/chemistry/aerosol/aerosol_instances_mod.F90 +++ b/src/chemistry/aerosol/aerosol_instances_mod.F90 @@ -69,6 +69,16 @@ module aerosol_instances_mod logical :: bulk_active_ = .false. contains + ! Determine which aerosol models are active (modal, CARMA, bulk) and + ! create persistent aerosol_properties objects for each (model, list) pair. + ! Must be called after the radiative aerosol module has parsed aerosol definitions. + ! + ! NOTE: A model is "globally active" if the climate list (list 0) has > 0 entries + ! for aerosol with that representation, but individual diagnostic lists + ! may have zero entries — in that case the corresponding properties slot is left null. + ! + ! Callers that use lists other than the climate list thus need to check if the aerosol + ! model for that combination of (aero_model, list) is associated or not. subroutine aerosol_instances_init() use radiative_aerosol, only: rad_aer_get_info use radiative_aerosol_definitions, only: active_calls @@ -136,19 +146,25 @@ subroutine aerosol_instances_init() end subroutine aerosol_instances_init + ! Return a pointer to the aerosol_properties object for the given aerosol + ! model index and radiation list. Returns null when the model has no + ! entries in the specified list (see aerosol_instances_init). function aerosol_instances_get_props(iaermod, list_idx) result(props) - integer, intent(in) :: iaermod - integer, intent(in) :: list_idx + integer, intent(in) :: iaermod ! aerosol model index (1..num_aero_models) + integer, intent(in) :: list_idx ! radiation list index (0=climate, 1..N_DIAG) class(aerosol_properties), pointer :: props props => aero_props_all(iaermod, list_idx)%obj end function aerosol_instances_get_props + ! Return the number of aerosol models active at runtime. pure integer function aerosol_instances_get_num_models() aerosol_instances_get_num_models = num_aero_models_ end function aerosol_instances_get_num_models + ! Return .true. if the named aerosol model ('modal', 'carma', or 'bulk') + ! has any entries in the climate list. logical function aerosol_instances_is_active(model_name) character(len=*), intent(in) :: model_name @@ -264,10 +280,12 @@ subroutine aerosol_instances_init_states(phys_state, pbuf2d) end subroutine aerosol_instances_init_states + ! Return a pointer to the persistent aerosol_state object for the given + ! aerosol model index, radiation list, and chunk. function aerosol_instances_get_state(iaermod, list_idx, lchnk) result(astate) - integer, intent(in) :: iaermod - integer, intent(in) :: list_idx - integer, intent(in) :: lchnk + integer, intent(in) :: iaermod ! aerosol model index (1..num_aero_models) + integer, intent(in) :: list_idx ! radiation list index (0=climate, 1..N_DIAG) + integer, intent(in) :: lchnk ! chunk index (begchunk..endchunk) class(aerosol_state), pointer :: astate astate => aero_states_all(iaermod, list_idx, lchnk)%obj diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index eb1d89d6f8..d8436c0c9b 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -488,25 +488,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 +539,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 +700,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 +714,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 +728,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 +742,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 +756,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 !------------------------------------------------------------------------------ diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index efa6b43b0d..f4213d6b68 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/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/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index 4c76a0c2a0..b5448f38e9 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -1011,7 +1011,7 @@ end subroutine resuspension_resize !------------------------------------------------------------------------------ subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, & error_code, error_string) - use infnan, only: nan, assignment(=) + 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 diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 289b4aa514..b613a967e8 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -701,6 +701,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, aeromodel: do iaermod = 1,num_aero_models aeroprops => aerosol_instances_get_props(iaermod, list_idx) + ! Null when a globally active model has no entries in this diagnostic list. if (.not. associated(aeroprops)) cycle aeromodel aerostate => aerosol_instances_get_state(iaermod, list_idx, lchnk) @@ -1217,6 +1218,7 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) aeromodel: do iaermod = 1,num_aero_models aeroprops => aerosol_instances_get_props(iaermod, list_idx) + ! Null when a globally active model has no entries in this diagnostic list. if (.not. associated(aeroprops)) cycle aeromodel aerostate => aerosol_instances_get_state(iaermod, list_idx, state%lchnk) From d68d2d8166085d037d8e7d9ff6c8807c6877bdd9 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 24 Mar 2026 17:50:00 -0400 Subject: [PATCH 09/22] Remove strange dash that crept into comments --- src/chemistry/aerosol/aerosol_instances_mod.F90 | 2 +- src/chemistry/aerosol/radiative_aerosol.F90 | 6 ++++-- src/physics/cam/aerosol_optics_cam.F90 | 2 +- src/physics/cam/rad_constituents.F90 | 8 ++++---- 4 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_instances_mod.F90 b/src/chemistry/aerosol/aerosol_instances_mod.F90 index 4f1f7c2b5f..56c731a090 100644 --- a/src/chemistry/aerosol/aerosol_instances_mod.F90 +++ b/src/chemistry/aerosol/aerosol_instances_mod.F90 @@ -75,7 +75,7 @@ module aerosol_instances_mod ! ! NOTE: A model is "globally active" if the climate list (list 0) has > 0 entries ! for aerosol with that representation, but individual diagnostic lists - ! may have zero entries — in that case the corresponding properties slot is left null. + ! may have zero entries. In that case the corresponding properties slot is left null. ! ! Callers that use lists other than the climate list thus need to check if the aerosol ! model for that combination of (aero_model, list) is associated or not. diff --git a/src/chemistry/aerosol/radiative_aerosol.F90 b/src/chemistry/aerosol/radiative_aerosol.F90 index aa233c4283..570e1bb0d5 100644 --- a/src/chemistry/aerosol/radiative_aerosol.F90 +++ b/src/chemistry/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 subroutines +! Formerly rad_cnst queries that are related to aerosol +! have been moved to the rad_aer prefix. public :: rad_aer_get_info public :: rad_aer_get_info_by_mode, rad_aer_get_info_by_mode_spec public :: rad_aer_get_info_by_spectype @@ -1230,7 +1232,7 @@ subroutine rad_aer_readnl(mode_defs, bin_defs) 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/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index b613a967e8..290754573b 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -829,7 +829,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, else if (iwav==idx_sw_diag) then ! vis ! Species partitioning for per-species AOD diagnostics - ! (re-runs species loop — same data as core computed for asphericity) + ! (re-runs species loop to compute for asphericity) do ispec = 1, aeroprops%nspecies(ibin) call aeroprops%get(ibin, ispec, density=specdens, & spectype=spectype, refindex_sw=specrefindex, hygro=hygro_aer) diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 index c72b430e01..27afe0f076 100644 --- a/src/physics/cam/rad_constituents.F90 +++ b/src/physics/cam/rad_constituents.F90 @@ -63,12 +63,12 @@ module rad_constituents ! values for constituents with requested value of zero real(r8), allocatable, target :: zero_cols(:,:) -! Public interfaces — routines in this module +! Public interfaces (only gas related remain): public :: & - rad_cnst_readnl, &! read namelist values and parse + rad_cnst_readnl, &! read namelist values and parse; also calls radiative_aerosol "readnl" rad_cnst_init, &! find optics files and all constituents - rad_cnst_get_info, &! gas+aerosol info wrapper - rad_cnst_get_gas, &! return pointer to mmr for gasses + rad_cnst_get_info, &! gas info wrapper + rad_cnst_get_gas, &! return pointer to mmr for gases rad_cnst_out ! output constituent diagnostics (mass per layer and column burden) character(len=cs1), public :: iceopticsfile, liqopticsfile From 7103f75351fa8bfaaa2458750748d24616a23858 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 24 Mar 2026 17:56:08 -0400 Subject: [PATCH 10/22] Fix and update comments throughout. --- .../aerosol/aerosol_instances_mod.F90 | 30 ++++++++++++------- src/physics/cam/aerosol_mmr_cam.F90 | 4 +-- src/physics/cam/rad_constituents.F90 | 19 ++++++------ 3 files changed, 31 insertions(+), 22 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_instances_mod.F90 b/src/chemistry/aerosol/aerosol_instances_mod.F90 index 56c731a090..8697d0f83c 100644 --- a/src/chemistry/aerosol/aerosol_instances_mod.F90 +++ b/src/chemistry/aerosol/aerosol_instances_mod.F90 @@ -51,17 +51,22 @@ module aerosol_instances_mod class(aerosol_state), pointer :: obj => null() end type aero_state_entry_t - ! Module holds aerosol properties objects, dimensioned (iaermod, 0:N_DIAG). + ! Persistent 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). + ! 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.) + ! 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. @@ -71,14 +76,17 @@ module aerosol_instances_mod contains ! Determine which aerosol models are active (modal, CARMA, bulk) and ! create persistent aerosol_properties objects for each (model, list) pair. - ! Must be called after the radiative aerosol module has parsed aerosol definitions. + ! Must be called after the radiative aerosol module + ! has parsed aerosol definitions. ! - ! NOTE: A model is "globally active" if the climate list (list 0) has > 0 entries - ! for aerosol with that representation, but individual diagnostic lists - ! may have zero entries. In that case the corresponding properties slot is left null. + ! NOTE: A model is "globally active" if the climate list (list 0) has > 0 + ! entries for aerosol with that representation, but individual diagnostic + ! lists may have zero entries. In that case the corresponding properties + ! slot is left null. ! - ! Callers that use lists other than the climate list thus need to check if the aerosol - ! model for that combination of (aero_model, list) is associated or not. + ! Callers that use lists other than the climate list thus need to check + ! if the aerosol model for that combination of (aero_model, list) + ! is associated or not. subroutine aerosol_instances_init() use radiative_aerosol, only: rad_aer_get_info use radiative_aerosol_definitions, only: active_calls diff --git a/src/physics/cam/aerosol_mmr_cam.F90 b/src/physics/cam/aerosol_mmr_cam.F90 index cbc711c760..9a6e9b6243 100644 --- a/src/physics/cam/aerosol_mmr_cam.F90 +++ b/src/physics/cam/aerosol_mmr_cam.F90 @@ -11,7 +11,6 @@ module aerosol_mmr_cam implicit none private -save ! define generic interface for MMR retrieval interface rad_cnst_get_aer_mmr @@ -24,7 +23,8 @@ module aerosol_mmr_cam public :: aerosol_mmr_init ! allocate zero_cols public :: get_cam_idx -public :: resolve_mode_idx, resolve_bin_idx +public :: resolve_mode_idx +public :: resolve_bin_idx public :: resolve_bulk_idx public :: rad_cnst_get_aer_mmr public :: rad_cnst_get_mam_mmr_idx diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 index 27afe0f076..8cc65a4ae8 100644 --- a/src/physics/cam/rad_constituents.F90 +++ b/src/physics/cam/rad_constituents.F90 @@ -8,9 +8,9 @@ module rad_constituents ! gas MMR retrieval (state/pbuf), gas diagnostics output, and cloud optics ! public variables (iceopticsfile, liqopticsfile, etc.). ! -! Aerosol handling is in radiative_aerosol (facade) backed by -! radiative_aerosol_definitions (core definitions) and aerosol_mmr_cam -! (CAM-specific MMR retrieval). +! Aerosol handling is moved to the radiative_aerosol module. +! Shared definitions between radiatively active gases and aerosol are in +! radiative_aerosol_definitions (core definitions). ! !------------------------------------------------------------------------------------------------ @@ -32,12 +32,6 @@ module rad_constituents rad_cnst_namelist_t, radcnst_namelist, active_calls, & n_mode_str, n_bin_str, parse_rad_specifier -!REMOVECAM -use aerosol_mmr_cam, only: get_cam_idx -!REMOVECAM_END - -use radiative_aerosol, only: rad_aer_readnl - implicit none private save @@ -101,6 +95,11 @@ subroutine rad_cnst_readnl(nlfile) use units, only: getunit, freeunit use mpishorthand + + ! Call the underlying "readnl" routine in the radiative aerosol module + ! that was split off from rad_constituents. + use radiative_aerosol, only: rad_aer_readnl + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables @@ -311,6 +310,8 @@ end subroutine gas_list_populate !================================================================================================ subroutine gas_list_resolve_cnst_idx(gaslist) + ! CAM index lookup (non-portable): + use aerosol_mmr_cam, only: get_cam_idx ! Resolve constituent indices for gas list entries. ! Must run at init time (after constituent registration). From 867ddfbce1c45645c0607a52621c4c336b2f384e Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 24 Mar 2026 18:37:42 -0400 Subject: [PATCH 11/22] Use pointer optional argument as suggested by @fvitt; update comment further for idx_sw_diag duplication loop --- src/chemistry/aerosol/aerosol_optics_core.F90 | 32 +++++---- .../aerosol/volcrad_aerosol_optics_mod.F90 | 2 +- src/physics/cam/aerosol_optics_cam.F90 | 69 ++++++++----------- 3 files changed, 47 insertions(+), 56 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_optics_core.F90 b/src/chemistry/aerosol/aerosol_optics_core.F90 index 2b3f331b7a..63d47f8496 100644 --- a/src/chemistry/aerosol/aerosol_optics_core.F90 +++ b/src/chemistry/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/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 b/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 index 2ae41a5bcd..58059706a5 100644 --- a/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 +++ b/src/chemistry/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 diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 290754573b..aaed842f50 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -740,27 +740,17 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, call pbuf_get_field(pbuf, idx, geometric_radius) end select - ! Call portable aerosol optics driver: - if (associated(geometric_radius)) then - ! volcanic_radius: - call aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & - ncol, pver, top_lev, nswbands, nlwbands, numrh, & - idx_sw_diag, & - relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & - geometric_radius=geometric_radius(:ncol,:), & - tau_bin=tau_bin(:ncol,:,:), ssa_bin=ssa_bin(:ncol,:,:), asm_bin=asm_bin(:ncol,:,:), & - pabs_vis=pabs_vis(:ncol,:), dopaer0_vis=dopaer0_vis(:ncol,:), & - errmsg=errmsg, errflg=errflg) - else - ! all other types: - call aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & - ncol, pver, top_lev, nswbands, nlwbands, numrh, & - idx_sw_diag, & - relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & - tau_bin=tau_bin(:ncol,:,:), ssa_bin=ssa_bin(:ncol,:,:), asm_bin=asm_bin(:ncol,:,:), & - pabs_vis=pabs_vis(:ncol,:), dopaer0_vis=dopaer0_vis(:ncol,:), & - errmsg=errmsg, errflg=errflg) - end if + ! Call portable aerosol optics driver. + ! geometric_radius is a null pointer for non-volcanic types; + ! the optional pointer dummy checks associated() internally. + call aerosol_optics_sw_bin(aeroprops, aerostate, ibin, & + ncol, pver, top_lev, nswbands, nlwbands, numrh, & + idx_sw_diag, & + relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & + geometric_radius=geometric_radius, & + tau_bin=tau_bin(:ncol,:,:), ssa_bin=ssa_bin(:ncol,:,:), asm_bin=asm_bin(:ncol,:,:), & + pabs_vis=pabs_vis(:ncol,:), dopaer0_vis=dopaer0_vis(:ncol,:), & + errmsg=errmsg, errflg=errflg) if(errflg /= 0) then call endrun(prefix//errmsg) @@ -828,8 +818,15 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, else if (iwav==idx_sw_diag) then ! vis - ! Species partitioning for per-species AOD diagnostics - ! (re-runs species loop to compute for asphericity) + ! Decompose bin optical properties into per-species + ! contributions for AOD diagnostics (e.g., dustaod, bcaod). + ! Uses the same volume-weighted refractive index method as + ! the asphericity calculation in aerosol_optics_core, but + ! for all species and all bins (not just coarse dust). + ! + ! The below block is for diagnostics only. + ! To edit the computation, change the code in + ! species loop in aerosol_optics_core.F90. do ispec = 1, aeroprops%nspecies(ibin) call aeroprops%get(ibin, ispec, density=specdens, & spectype=spectype, refindex_sw=specrefindex, hygro=hygro_aer) @@ -1241,23 +1238,15 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) call pbuf_get_field(pbuf, idx, geometric_radius) end select - ! Call portable aerosol optics driver: - if (associated(geometric_radius)) then - ! volcanic_radius: - call aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & - ncol, pver, nswbands, nlwbands, numrh, & - relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & - geometric_radius=geometric_radius(:ncol,:), & - tau_lw_bin=tau_lw_bin(:ncol,:,:), absorp_bin=absorp_bin(:ncol,:,:), & - errmsg=errmsg, errflg=errflg) - else - ! other types: - call aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & - ncol, pver, nswbands, nlwbands, numrh, & - relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & - tau_lw_bin=tau_lw_bin(:ncol,:,:), absorp_bin=absorp_bin(:ncol,:,:), & - errmsg=errmsg, errflg=errflg) - end if + ! Call portable aerosol optics driver. + ! geometric_radius is a null pointer for non-volcanic types; + ! the optional pointer dummy checks associated() internally. + call aerosol_optics_lw_bin(aeroprops, aerostate, ibin, & + ncol, pver, nswbands, nlwbands, numrh, & + relh(:ncol,:), sulfwtpct(:ncol,:), mass(:ncol,:), crefwsw, crefwlw, & + geometric_radius=geometric_radius, & + tau_lw_bin=tau_lw_bin(:ncol,:,:), absorp_bin=absorp_bin(:ncol,:,:), & + errmsg=errmsg, errflg=errflg) if (errflg /= 0) then call endrun(prefix//errmsg) From 545ddbf1195a5b3718aa3468ec6096772a8c3ba1 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 24 Mar 2026 20:35:38 -0400 Subject: [PATCH 12/22] Remove dead code in modal_aero_data (migrated into modal_aerosol_state) --- src/chemistry/aerosol/modal_aero_data.F90 | 16 +--------------- .../aerosol/modal_aerosol_state_mod.F90 | 12 ++++++++++-- 2 files changed, 11 insertions(+), 17 deletions(-) diff --git a/src/chemistry/aerosol/modal_aero_data.F90 b/src/chemistry/aerosol/modal_aero_data.F90 index 3245dbdb68..456213b2f0 100644 --- a/src/chemistry/aerosol/modal_aero_data.F90 +++ b/src/chemistry/aerosol/modal_aero_data.F90 @@ -58,7 +58,6 @@ module modal_aero_data real(r8), public, protected, allocatable :: dgnum_amode(:) real(r8), public, protected, allocatable :: dgnumlo_amode(:) real(r8), public, protected, allocatable :: dgnumhi_amode(:) - integer, public, protected, allocatable :: mode_size_order(:) ! input sigmag_amode real(r8), public, protected, allocatable :: sigmag_amode(:) @@ -175,7 +174,6 @@ subroutine modal_aero_data_reg mcalcwater_amode(:) = 0 endif allocate(dgnum_amode(ntot_amode)) - allocate(mode_size_order(ntot_amode)) allocate(dgnumlo_amode(ntot_amode)) allocate(dgnumhi_amode(ntot_amode)) allocate(sigmag_amode(ntot_amode)) @@ -408,7 +406,7 @@ subroutine modal_aero_data_init(pbuf2d) !-------------------------------------------------------------- ! ... local variables !-------------------------------------------------------------- - integer :: l, m, i, lchnk, tmp + integer :: l, m, i, lchnk integer :: qArrIndex complex(r8), pointer :: refindex_aer_sw(:), & @@ -427,8 +425,6 @@ subroutine modal_aero_data_init(pbuf2d) sigmag=sigmag_amode(m), dgnum=dgnum_amode(m), dgnumlo=dgnumlo_amode(m), & dgnumhi=dgnumhi_amode(m), rhcrystal=rhcrystal_amode(m), rhdeliques=rhdeliques_amode(m)) - mode_size_order(m) = m - ! compute frequently used parameters: ln(sigmag), ! volume-to-number and volume-to-surface conversions, ... alnsg_amode(m) = log( sigmag_amode(m) ) @@ -446,16 +442,6 @@ subroutine modal_aero_data_init(pbuf2d) end do - do i = 1, ntot_amode-1 ! order from largest to smallest - do m = 2, ntot_amode - if (dgnum_amode(mode_size_order(m-1)) could be replaced with modetype checks + ! lptr_* -> could be replaced with aero_props%species_type() loop check. + ! state%q -> could be replaced with self%get_ambient_mmr. + ! lmassptr_amode == nacl/dust_a_amode -> could be replaced with %species_type(). + use modal_aero_data, only: modeptr_coarse + use modal_aero_data, only: modeptr_pcarbon, modeptr_finedust, modeptr_coardust + use modal_aero_data, only: lptr_dust_a_amode, lptr_nacl_a_amode + use modal_aero_data, only: lmassptr_amode + !REMOVECAM_END class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: ibin ! bin index From 73c88317352427962908324050f873663e8e4f94 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 25 Mar 2026 11:32:03 -0400 Subject: [PATCH 13/22] Fix palb, pasm comment? in aerosol_optics_mod.F90 --- src/chemistry/aerosol/aerosol_optics_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_optics_mod.F90 b/src/chemistry/aerosol/aerosol_optics_mod.F90 index ae2a04bfb1..be4deedef1 100644 --- a/src/chemistry/aerosol/aerosol_optics_mod.F90 +++ b/src/chemistry/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 372fa296903f5df49a6bc1808c641a7529e698f9 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 1 Apr 2026 18:59:28 -0400 Subject: [PATCH 14/22] Address review comments --- src/chemistry/aerosol/radiative_aerosol.F90 | 21 +- .../aerosol/radiative_aerosol_definitions.F90 | 186 +++++++++++------- src/physics/cam/nucleate_ice_cam.F90 | 18 +- src/physics/cam/rad_constituents.F90 | 39 ++-- 4 files changed, 158 insertions(+), 106 deletions(-) diff --git a/src/chemistry/aerosol/radiative_aerosol.F90 b/src/chemistry/aerosol/radiative_aerosol.F90 index 570e1bb0d5..c171c09c88 100644 --- a/src/chemistry/aerosol/radiative_aerosol.F90 +++ b/src/chemistry/aerosol/radiative_aerosol.F90 @@ -1137,7 +1137,7 @@ 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 +1148,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 +1159,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 +1170,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 @@ -1193,17 +1193,18 @@ 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 shr_kind_mod, only: shr_kind_cl use phys_prop, only: physprop_accum_unique_files use spmd_utils, only: masterproc use radiative_aerosol_definitions, only: & - cs1, verbose, N_DIAG, modes, bins, & + 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(:) + character(len=shr_kind_cl), intent(inout) :: mode_defs(:) + character(len=shr_kind_cl), intent(inout) :: bin_defs(:) ! Local variables integer :: i diff --git a/src/chemistry/aerosol/radiative_aerosol_definitions.F90 b/src/chemistry/aerosol/radiative_aerosol_definitions.F90 index bf0c7b1559..81a277c3bc 100644 --- a/src/chemistry/aerosol/radiative_aerosol_definitions.F90 +++ b/src/chemistry/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 @@ -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 diff --git a/src/physics/cam/nucleate_ice_cam.F90 b/src/physics/cam/nucleate_ice_cam.F90 index 3cd7279b0b..86b2633802 100644 --- a/src/physics/cam/nucleate_ice_cam.F90 +++ b/src/physics/cam/nucleate_ice_cam.F90 @@ -485,24 +485,25 @@ subroutine nucleate_ice_cam_calc( & ni => state%q(:,:,numice_idx) pmid => state%pmid + rho(:ncol,:) = pmid(:ncol,:)/(rair*t(:ncol,:)) + if (clim_modal_carma) then + if (.not.(present(aero_props).and.present(aero_state))) then + call endrun('nucleate_ice_cam_calc: aero_props and aero_state must be present when MAM/CARMA is active') + end if + nbins = aero_props%nbins() nmaxspc = maxval(aero_props%nspecies()) allocate(size_wght(ncol,pver,nbins,nmaxspc)) allocate(amb_num_bins(ncol,pver,nbins)) + + ! initiate ice nucleation tendencies + call physics_ptend_init(ptend, state%psetcols, 'nucleatei', lq=lq) else nbins = 0 nmaxspc = 0 - endif - rho(:ncol,:) = pmid(:ncol,:)/(rair*t(:ncol,:)) - - if (clim_modal_carma) then - - call physics_ptend_init(ptend, state%psetcols, 'nucleatei', lq=lq) - - else ! init number/mass arrays for bulk aerosols allocate( & naer2(pcols,pver,naer_all), & @@ -519,6 +520,7 @@ subroutine nucleate_ice_cam_calc( & end if end do + ! initiate ice nucleation tendencies for bulk aerosol call physics_ptend_init(ptend, state%psetcols, 'nucleatei') end if diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 index 8cc65a4ae8..4e91f599fb 100644 --- a/src/physics/cam/rad_constituents.F90 +++ b/src/physics/cam/rad_constituents.F90 @@ -15,6 +15,7 @@ module rad_constituents !------------------------------------------------------------------------------------------------ use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_kind_mod, only: shr_kind_cl use spmd_utils, only: masterproc use ppgrid, only: pcols, pver use physconst, only: rga @@ -28,7 +29,7 @@ module rad_constituents use cam_logfile, only: iulog ! Import from radiative_aerosol_definitions (core definitions) -use radiative_aerosol_definitions, only: cs1, N_DIAG, n_rad_cnst, verbose, nl, & +use radiative_aerosol_definitions, only: N_DIAG, n_rad_cnst, verbose, newline, & rad_cnst_namelist_t, radcnst_namelist, active_calls, & n_mode_str, n_bin_str, parse_rad_specifier @@ -65,24 +66,24 @@ module rad_constituents rad_cnst_get_gas, &! return pointer to mmr for gases rad_cnst_out ! output constituent diagnostics (mass per layer and column burden) -character(len=cs1), public :: iceopticsfile, liqopticsfile +character(len=shr_kind_cl), public :: iceopticsfile, liqopticsfile character(len=32), public :: icecldoptics,liqcldoptics logical, public :: oldcldoptics = .false. ! Namelist variables -character(len=cs1), dimension(n_mode_str) :: mode_defs = ' ' -character(len=cs1), dimension(n_bin_str) :: bin_defs = ' ' -character(len=cs1) :: rad_climate(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_1(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_2(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_3(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_4(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_5(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_6(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_7(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_8(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_9(n_rad_cnst) = ' ' -character(len=cs1) :: rad_diag_10(n_rad_cnst) = ' ' +character(len=shr_kind_cl), dimension(n_mode_str) :: mode_defs = ' ' +character(len=shr_kind_cl), dimension(n_bin_str) :: bin_defs = ' ' +character(len=shr_kind_cl) :: rad_climate(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_1(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_2(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_3(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_4(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_5(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_6(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_7(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_8(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_9(n_rad_cnst) = ' ' +character(len=shr_kind_cl) :: rad_diag_10(n_rad_cnst) = ' ' !============================================================================== contains @@ -205,7 +206,7 @@ subroutine rad_cnst_readnl(nlfile) call rad_aer_readnl(mode_defs, bin_defs) ! Gas init phase 1: set gas list_id fields and populate gas lists - if (masterproc) write(iulog,*) nl//subname//': Radiation gas constituent lists:' + if (masterproc) write(iulog,*) newline//subname//': Radiation gas constituent lists:' do i = 0, N_DIAG if (active_calls(i)) then if (i > 0) then @@ -243,7 +244,7 @@ subroutine rad_cnst_init() zero_cols = 0._r8 ! Resolve constituent indices for gas lists - if (masterproc) write(iulog,*) nl//subname//': checking for radiative gas constituents' + if (masterproc) write(iulog,*) newline//subname//': checking for radiative gas constituents' do i = 0, N_DIAG if (active_calls(i)) then call gas_list_resolve_cnst_idx(gaslist(i)) @@ -540,9 +541,9 @@ subroutine print_gas_list(glist) integer :: i if (len_trim(glist%list_id) == 0) then - write(iulog,*) nl//' gas list for climate calculations' + write(iulog,*) newline//' gas list for climate calculations' else - write(iulog,*) nl//' gas list for diag'//glist%list_id//' calculations' + write(iulog,*) newline//' gas list for diag'//glist%list_id//' calculations' end if do i = 1, nradgas From 7442ca06c76e25982c9b0c2eb23c227e19d7de1f Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 1 Apr 2026 19:01:43 -0400 Subject: [PATCH 15/22] Update src/chemistry/aerosol/aerosol_state_mod.F90 Co-authored-by: Francis Vitt --- src/chemistry/aerosol/aerosol_state_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index 367aee96dc..568f2e4828 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -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 From 1f0e160272e471ea3470af29a71ebb3ccd2b6455 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 1 Apr 2026 19:02:13 -0400 Subject: [PATCH 16/22] Update src/physics/cam/nucleate_ice_cam.F90 Co-authored-by: Francis Vitt --- src/physics/cam/nucleate_ice_cam.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/nucleate_ice_cam.F90 b/src/physics/cam/nucleate_ice_cam.F90 index 86b2633802..f1ff733815 100644 --- a/src/physics/cam/nucleate_ice_cam.F90 +++ b/src/physics/cam/nucleate_ice_cam.F90 @@ -716,7 +716,7 @@ subroutine nucleate_ice_cam_calc( & idxtmp = aer_cnst_idx(m,l) call aero_state%get_ambient_mmr(species_ndx=l, bin_ndx=m, mmr=amb_mmr) - call aero_state%get_cldbrne_mmr(l,m,cld_mmr) + call aero_state%get_cldbrne_mmr(species_ndx=l, bin_ndx=m, mmr=cld_mmr) ! determine change in aerosol mass delmmr = 0._r8 From 4f190f019b22c36f26dcf1eb4c06687368b758f9 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 1 Apr 2026 19:02:30 -0400 Subject: [PATCH 17/22] Update src/chemistry/aerosol/aerosol_state_mod.F90 Co-authored-by: Francis Vitt --- src/chemistry/aerosol/aerosol_state_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index 568f2e4828..641ae41f9e 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -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 From cf78638fa59922f935eb02452626a241c7878717 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 1 Apr 2026 19:38:39 -0400 Subject: [PATCH 18/22] generalized optics_params method instead of concrete duplicate implementations --- .../aerosol/aerosol_properties_mod.F90 | 213 ++++++++++++------ .../aerosol/bulk_aerosol_properties_mod.F90 | 187 +-------------- .../aerosol/carma_aerosol_properties_mod.F90 | 180 +-------------- .../aerosol/modal_aerosol_properties_mod.F90 | 195 +--------------- src/chemistry/aerosol/radiative_aerosol.F90 | 193 ++++++++-------- 5 files changed, 261 insertions(+), 707 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index d8436c0c9b..8aab8f728b 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/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 @@ -855,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/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index f4213d6b68..11577b5cff 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -9,7 +9,8 @@ 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 radiative_aerosol, only: rad_aer_get_info, rad_aer_get_props, & + rad_aer_bulk_physprop_id use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) implicit none @@ -37,7 +38,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 +222,15 @@ 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) class(bulk_aerosol_properties), intent(in) :: self - integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: bin_ndx + + physprop_id = rad_aer_bulk_physprop_id(self%list_idx_, 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 + end function physprop_id !------------------------------------------------------------------------------ ! returns radius^3 (m3) of a given bin number diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index d384559f1b..ce908f0292 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -3,7 +3,8 @@ module carma_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_bin_props_by_idx, & - rad_aer_get_info_by_bin, rad_aer_get_info_by_bin_spec + rad_aer_get_info_by_bin, rad_aer_get_info_by_bin_spec, & + rad_aer_bin_physprop_id use infnan, only: nan, assignment(=) implicit none @@ -29,7 +30,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 @@ -320,180 +321,15 @@ 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 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 ) - - use radiative_aerosol, only: rad_aer_get_bin_props - + integer function physprop_id(self, bin_ndx) class(carma_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(:,:) - - if (present(extpsw)) then - nullify(extpsw) - end if - if (present(abspsw)) then - nullify(abspsw) - end if - if (present(asmpsw)) then - nullify(asmpsw) - end if - if (present(absplw)) then - nullify(absplw) - end if - if (present(refrtabsw)) then - nullify(refrtabsw) - end if - if (present(refitabsw)) then - nullify(refitabsw) - end if - if (present(refrtablw)) then - nullify(refrtablw) - end if - if (present(refitablw)) then - nullify(refitablw) - end if - if (present(ncoef)) then - ncoef = huge(1) - end if - if (present(prefr)) then - prefr = huge(1) - end if - if (present(prefi)) then - prefi = huge(1) - end if + integer, intent(in) :: bin_ndx - call rad_aer_get_bin_props(self%list_idx_,bin_ndx, & - opticstype=opticstype, & - 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_ext_wtp=lw_hygro_ext_wtp, & - wgtpct=wgtpct, & - nwtp=nwtp, & - 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_ext=lw_hygro_coreshell_ext, & - corefrac=corefrac, & - bcdust=bcdust, & - kap=kap, & - relh=relh, & - nbcdust=nbcdust, & - nkap=nkap, & - nrelh=nrelh, & - nfrac=nfrac ) - - - ! hygroscopic - if (present(sw_hygroscopic_ext)) then - nullify(sw_hygroscopic_ext) - end if - if (present(sw_hygroscopic_ssa)) then - nullify(sw_hygroscopic_ssa) - end if - if (present(sw_hygroscopic_asm)) then - nullify(sw_hygroscopic_asm) - end if - if (present(lw_hygroscopic_ext)) then - nullify(lw_hygroscopic_ext) - end if - - ! non-hygroscopic (insoluble) - if (present(sw_insoluble_ext)) then - nullify(sw_insoluble_ext) - end if - if (present(sw_insoluble_ssa)) then - nullify(sw_insoluble_ssa) - end if - if (present(sw_insoluble_asm)) then - nullify(sw_insoluble_asm) - end if - if (present(lw_insoluble_ext)) then - nullify(lw_insoluble_ext) - end if - - ! volcanic radius - if (present(r_sw_ext)) then - nullify(r_sw_ext) - end if - if (present(r_sw_scat)) then - nullify(r_sw_scat) - end if - if (present(r_sw_ascat)) then - nullify(r_sw_ascat) - end if - if (present(r_lw_abs)) then - nullify(r_lw_abs) - end if - if (present(r_mu)) then - nullify(r_mu) - end if + physprop_id = rad_aer_bin_physprop_id(self%list_idx_, bin_ndx) - end subroutine optics_params + end function physprop_id !------------------------------------------------------------------------------ ! returns radius^3 (m3) of a given bin number diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index b5448f38e9..3c731a26ee 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -2,7 +2,8 @@ module modal_aerosol_properties_mod use shr_kind_mod, only: r8 => shr_kind_r8 use physconst, only: pi use aerosol_properties_mod, only: aerosol_properties, aero_name_len - use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_mode_props, rad_aer_get_props + use radiative_aerosol, only: rad_aer_get_info, rad_aer_get_mode_props, rad_aer_get_props, & + rad_aer_mode_physprop_id implicit none @@ -42,7 +43,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 @@ -450,195 +451,15 @@ 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 (mode) 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) class(modal_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_mode_props(self%list_idx_, bin_ndx, & - opticstype=opticstype, & - 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 - if (present(sw_hygro_ext_wtp)) then - nullify(sw_hygro_ext_wtp) - end if - if (present(sw_hygro_ssa_wtp)) then - nullify(sw_hygro_ssa_wtp) - end if - if (present(sw_hygro_asm_wtp)) then - nullify(sw_hygro_asm_wtp) - end if - if (present(lw_hygro_ext_wtp)) then - nullify(lw_hygro_ext_wtp) - end if - if (present(wgtpct)) then - nullify(wgtpct) - end if - if (present(nwtp)) then - nwtp = -1 - end if + integer, intent(in) :: bin_ndx - ! hygrocoreshell table parameters - if (present(sw_hygro_coreshell_ext)) then - nullify(sw_hygro_coreshell_ext) - end if - if (present(sw_hygro_coreshell_ssa)) then - nullify(sw_hygro_coreshell_ssa) - end if - if (present(sw_hygro_coreshell_asm)) then - nullify(sw_hygro_coreshell_asm) - end if - if (present(lw_hygro_coreshell_ext)) then - nullify(lw_hygro_coreshell_ext) - end if - if (present(corefrac)) then - nullify(corefrac) - end if - if (present(bcdust)) then - nullify(bcdust) - end if - if (present(kap)) then - nullify(kap) - end if - if (present(relh)) then - nullify(relh) - end if - if (present(nfrac)) then - nfrac = -1 - end if - if (present(nbcdust)) then - nbcdust = -1 - end if - if (present(nkap)) then - nkap = -1 - end if - if (present(nrelh)) then - nrelh = -1 - end if - - ! hygroscopic - if (present(sw_hygroscopic_ext)) then - nullify(sw_hygroscopic_ext) - end if - if (present(sw_hygroscopic_ssa)) then - nullify(sw_hygroscopic_ssa) - end if - if (present(sw_hygroscopic_asm)) then - nullify(sw_hygroscopic_asm) - end if - if (present(lw_hygroscopic_ext)) then - nullify(lw_hygroscopic_ext) - end if - - ! non-hygroscopic (insoluble) - if (present(sw_insoluble_ext)) then - nullify(sw_insoluble_ext) - end if - if (present(sw_insoluble_ssa)) then - nullify(sw_insoluble_ssa) - end if - if (present(sw_insoluble_asm)) then - nullify(sw_insoluble_asm) - end if - if (present(lw_insoluble_ext)) then - nullify(lw_insoluble_ext) - end if - - ! volcanic radius - if (present(r_sw_ext)) then - nullify(r_sw_ext) - end if - if (present(r_sw_scat)) then - nullify(r_sw_scat) - end if - if (present(r_sw_ascat)) then - nullify(r_sw_ascat) - end if - if (present(r_lw_abs)) then - nullify(r_lw_abs) - end if - if (present(r_mu)) then - nullify(r_mu) - end if + physprop_id = rad_aer_mode_physprop_id(self%list_idx_, bin_ndx) - end subroutine optics_params + end function physprop_id !------------------------------------------------------------------------------ ! returns radius^3 (m3) of a given bin number diff --git a/src/chemistry/aerosol/radiative_aerosol.F90 b/src/chemistry/aerosol/radiative_aerosol.F90 index c171c09c88..275609dde0 100644 --- a/src/chemistry/aerosol/radiative_aerosol.F90 +++ b/src/chemistry/aerosol/radiative_aerosol.F90 @@ -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 @@ -1038,103 +1040,6 @@ 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: newline, aerlist_t, modelist_t, binlist_t, modes, bins @@ -1326,4 +1231,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 From c6fbc254fa17aed102349bd08bcf5c326274a901 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 1 Apr 2026 19:56:00 -0400 Subject: [PATCH 19/22] remove modal_aero_data dependency in modal_aero_state_mod: refactor convcld_actfrac --- src/chemistry/aerosol/aero_wetdep_cam.F90 | 2 +- src/chemistry/aerosol/aerosol_state_mod.F90 | 3 +- .../aerosol/bulk_aerosol_state_mod.F90 | 3 +- .../aerosol/carma_aerosol_state_mod.F90 | 2 +- .../aerosol/modal_aerosol_state_mod.F90 | 55 ++++++++++--------- 5 files changed, 35 insertions(+), 30 deletions(-) diff --git a/src/chemistry/aerosol/aero_wetdep_cam.F90 b/src/chemistry/aerosol/aero_wetdep_cam.F90 index b059f7e4bc..cbb345f8d3 100644 --- a/src/chemistry/aerosol/aero_wetdep_cam.F90 +++ b/src/chemistry/aerosol/aero_wetdep_cam.F90 @@ -606,7 +606,7 @@ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) qqcw_in(:ncol,:) = qqcw(mm)%fld(:ncol,:) end if - f_act_conv(:ncol,:) = aero_state%convcld_actfrac( m, l, ncol, pver) + f_act_conv(:ncol,:) = aero_state%convcld_actfrac( aero_props, m, l, ncol, pver) name = aname end if diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index 641ae41f9e..14f3680c0e 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -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/chemistry/aerosol/bulk_aerosol_state_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 index 55a5e369a3..b5ee8240f5 100644 --- a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 @@ -387,9 +387,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 diff --git a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 index d40ac7f8e6..de13bb9efd 100644 --- a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 @@ -258,7 +258,7 @@ subroutine get_states( self, aero_props, raer, qqcw ) 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(ispc,ibin, qqcw(indx)%fld) + call self%get_cldbrne_mmr(species_ndx=ispc, bin_ndx=ibin, mmr=qqcw(indx)%fld) end do end do diff --git a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 index 456b8e2362..c43b2236d7 100644 --- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -205,7 +205,7 @@ subroutine get_states( self, aero_props, raer, qqcw ) 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(ispc,ibin, qqcw(indx)%fld) + call self%get_cldbrne_mmr(species_ndx=ispc, bin_ndx=ibin, mmr=qqcw(indx)%fld) end do end do @@ -627,20 +627,10 @@ end function wet_diameter !------------------------------------------------------------------------------ ! prescribed aerosol activation fraction for convective cloud !------------------------------------------------------------------------------ - function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) - - !REMOVECAM - direct state%q access and modal_aero_data dependency - ! modeptr_* -> could be replaced with modetype checks - ! lptr_* -> could be replaced with aero_props%species_type() loop check. - ! state%q -> could be replaced with self%get_ambient_mmr. - ! lmassptr_amode == nacl/dust_a_amode -> could be replaced with %species_type(). - use modal_aero_data, only: modeptr_coarse - use modal_aero_data, only: modeptr_pcarbon, modeptr_finedust, modeptr_coardust - use modal_aero_data, only: lptr_dust_a_amode, lptr_nacl_a_amode - use modal_aero_data, only: lmassptr_amode - !REMOVECAM_END + 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 @@ -651,20 +641,32 @@ function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) real(r8) :: f_act_conv_coarse(ncol,nlev) real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl real(r8) :: tmpdust, tmpnacl - integer :: lcoardust, lcoarnacl - integer :: i,k + 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 (modeptr_coarse > 0) then - lcoardust = lptr_dust_a_amode(modeptr_coarse) - lcoarnacl = lptr_nacl_a_amode(modeptr_coarse) - if ((lcoardust > 0) .and. (lcoarnacl > 0)) then + 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, self%state%q(i,k,lcoardust) ) - tmpnacl = max( 0.0_r8, self%state%q(i,k,lcoarnacl) ) + 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) @@ -674,9 +676,9 @@ function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) end if end if - if (ibin == modeptr_pcarbon) then + if (trim(bin_type) == 'primary_carbon') then frac = 0.0_r8 - else if ((ibin == modeptr_finedust) .or. (ibin == modeptr_coardust)) then + else if ((trim(bin_type) == 'fine_dust') .or. (trim(bin_type) == 'coarse_dust')) then frac = 0.4_r8 else frac = 0.8_r8 @@ -688,12 +690,13 @@ function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) ! 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 (ibin == modeptr_coarse) then + if (trim(bin_type) == 'coarse') then frac = f_act_conv_coarse if (ispc>0) then - if (lmassptr_amode(ispc,ibin) == lptr_dust_a_amode(ibin)) then + call aero_props%species_type(ibin, ispc, spectype) + if (trim(spectype) == 'dust') then frac = f_act_conv_coarse_dust - else if (lmassptr_amode(ispc,ibin) == lptr_nacl_a_amode(ibin)) then + else if (trim(spectype) == 'seasalt') then frac = f_act_conv_coarse_nacl end if end if From ec0784f12cdd709471096a62b4fcc7f8486b6826 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 1 Apr 2026 20:23:15 -0400 Subject: [PATCH 20/22] Fix typo throughout --- src/chemistry/aerosol/aerosol_state_mod.F90 | 4 ++-- src/chemistry/aerosol/bulk_aerosol_state_mod.F90 | 4 ++-- src/chemistry/aerosol/carma_aerosol_state_mod.F90 | 4 ++-- .../aerosol/hygrowghtpct_aerosol_optics_mod.F90 | 10 +++++----- src/chemistry/aerosol/modal_aerosol_state_mod.F90 | 4 ++-- 5 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index 14f3680c0e..3b8feb339e 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/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 diff --git a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 index b5ee8240f5..2380e6f375 100644 --- a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 @@ -403,12 +403,12 @@ function convcld_actfrac(self, aero_props, 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/chemistry/aerosol/carma_aerosol_state_mod.F90 b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 index de13bb9efd..e2b52f14ba 100644 --- a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 @@ -444,12 +444,12 @@ subroutine water_uptake(self, aero_props, bin_idx, ncol, nlev, dgnumwet, qaerwat end subroutine water_uptake !------------------------------------------------------------------------------ - ! aerosol weight precent of H2SO4/H2O solution + ! aerosol weight percent of H2SO4/H2O solution !------------------------------------------------------------------------------ function wgtpct(self, ncol, nlev) result(wtp) class(carma_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(:,:) = carma_get_wght_pct(ncol,nlev,self%state) diff --git a/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 index 617f0d81b2..5f7ad9b7c0 100644 --- a/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 +++ b/src/chemistry/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/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 index c43b2236d7..89c9688a4d 100644 --- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -705,12 +705,12 @@ function convcld_actfrac(self, aero_props, 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(modal_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) From a8d344c95ad697ce18bf55982c44c6e9ceba4ead Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Apr 2026 12:33:06 -0400 Subject: [PATCH 21/22] Apply list_idx changes to new code in cam6_4_162 --- src/chemistry/aerosol/bulk_aerosol_state_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 index 91d588a900..b161f2552b 100644 --- a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 @@ -331,7 +331,7 @@ function dry_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) real(r8) :: dens ! kg/m3 call aero_props%get(bin_idx, 1, density=dens) - call self%get_ambient_mmr(list_idx, 1, bin_idx, mmr) + call self%get_ambient_mmr(species_ndx=1, bin_ndx=bin_ndx, mmr=mmr) vol(:ncol,:nlev) = mmr(:ncol,:nlev)/dens @@ -351,8 +351,8 @@ function wet_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) real(r8) :: vol(ncol,nlev) ! m3/kg - vol = self%dry_volume(aero_props, list_idx, bin_idx, ncol, nlev) & - + self%water_volume(aero_props, list_idx, bin_idx, ncol, nlev) + vol = self%dry_volume(aero_props, bin_idx, ncol, nlev) & + + self%water_volume(aero_props, bin_idx, ncol, nlev) end function wet_volume From 5819264dfda8e4dce72fe083e5a63603a7405415 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Apr 2026 14:02:01 -0400 Subject: [PATCH 22/22] Fix bin_ndx -> bin_idx (this module mixes both) --- src/chemistry/aerosol/bulk_aerosol_state_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 index b161f2552b..38c13f372c 100644 --- a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 @@ -331,7 +331,7 @@ function dry_volume(self, aero_props, bin_idx, ncol, nlev) result(vol) real(r8) :: dens ! kg/m3 call aero_props%get(bin_idx, 1, density=dens) - call self%get_ambient_mmr(species_ndx=1, bin_ndx=bin_ndx, mmr=mmr) + call self%get_ambient_mmr(species_ndx=1, bin_ndx=bin_idx, mmr=mmr) vol(:ncol,:nlev) = mmr(:ncol,:nlev)/dens