From e3029c159c2b943ff4e6a356d7f51955549ed840 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Sat, 13 Sep 2025 16:06:58 -0600 Subject: [PATCH 01/23] Initial changes --- .../aerosol/bulk_aerosol_properties_mod.F90 | 617 ++++++++++++++++++ .../aerosol/bulk_aerosol_state_mod.F90 | 426 ++++++++++++ .../hygroscopic_aerosol_optics_mod.F90 | 144 ++++ .../aerosol/insoluble_aerosol_optics_mod.F90 | 107 +++ 4 files changed, 1294 insertions(+) create mode 100644 src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 create mode 100644 src/chemistry/aerosol/bulk_aerosol_state_mod.F90 create mode 100644 src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 create mode 100644 src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 new file mode 100644 index 0000000000..16d6c03d52 --- /dev/null +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -0,0 +1,617 @@ +module bulk_aerosol_properties_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + 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 + + implicit none + + private + + public :: bulk_aerosol_properties + + type, extends(aerosol_properties) :: bulk_aerosol_properties + + private + + ! integer :: num_aerosols = 0 + ! character(len=64), allocatable :: aernames(:) + + contains + + procedure :: number_transported + procedure :: get + procedure :: amcube + procedure :: actfracs + procedure :: num_names + procedure :: mmr_names + procedure :: amb_num_name + procedure :: amb_mmr_name + procedure :: species_type + procedure :: icenuc_updates_num + procedure :: icenuc_updates_mmr + procedure :: apply_number_limits + procedure :: hetfrz_species + procedure :: optics_params + procedure :: nbins_rlist + procedure :: nspecies_per_bin_rlist + procedure :: alogsig_rlist + procedure :: soluble + procedure :: min_mass_mean_rad + procedure :: bin_name + procedure :: scav_diam + procedure :: resuspension_resize + procedure :: rebin_bulk_fluxes + procedure :: hydrophilic + + final :: destructor + + end type bulk_aerosol_properties + + interface bulk_aerosol_properties + procedure :: constructor + end interface bulk_aerosol_properties + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor() result(newobj) + + type(bulk_aerosol_properties), pointer :: newobj + + integer,allocatable :: nspecies(:) + real(r8),allocatable :: alogsig(:) + real(r8),allocatable :: f1(:) + integer :: ierr, naero + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + call rad_cnst_get_info(0, naero=naero) + + !newobj%num_aerosols = naero + + + allocate( nspecies(naero),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( alogsig(naero),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( f1(naero),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + nspecies(:) = 1 + + alogsig(:) = log(2._r8) + f1(:) = 1._r8 + + call newobj%initialize(naero, naero, nspecies, nspecies, alogsig, f1, f1, ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + deallocate(nspecies) + deallocate(alogsig) + deallocate(f1) + +! allocate(newobj%aernames(newobj%num_aerosols),stat=ierr ) +! if( ierr /= 0 ) then +! nullify(newobj) +! return +! end if +! +! call rad_cnst_get_info(0, aernames=newobj%aernames) + + + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(bulk_aerosol_properties), intent(inout) :: self + +! deallocate(self%aernames) + + end subroutine destructor + + + !------------------------------------------------------------------------------ + ! returns number of transported aerosol constituents + !------------------------------------------------------------------------------ + integer function number_transported(self) + class(bulk_aerosol_properties), intent(in) :: self + ! to be implemented later + number_transported = -1 + end function number_transported + + + !------------------------------------------------------------------------ + ! returns aerosol properties: + ! density + ! hygroscopicity + ! species type + ! species name + ! short wave species refractive indices + ! long wave species refractive indices + ! species morphology + !------------------------------------------------------------------------ + subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & + spectype, specname, specmorph, refindex_sw, refindex_lw) + + 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 + character(len=*), optional, intent(out) :: specname ! species name + character(len=*), optional, intent(out) :: specmorph ! species morphology + complex(r8), pointer, optional, intent(out) :: refindex_sw(:) ! short wave species refractive indices + complex(r8), pointer, optional, intent(out) :: refindex_lw(:) ! long wave species refractive indices + + end subroutine get + + !------------------------------------------------------------------------ + ! returns optics type and table parameters + !------------------------------------------------------------------------ + subroutine optics_params(self, list_ndx, 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, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) + + + 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 + + ! 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(:,:) + real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) + real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) + + ! non-hygroscopic + 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 :: lw_nonhygro_ext(:) + + ! refactive index table parameters + call rad_cnst_get_aer_props(list_ndx, bin_ndx, & + opticstype=opticstype, & + sw_hygro_ext=sw_hygroscopic_ext, & + sw_hygro_ssa=sw_hygroscopic_ssa, & + sw_hygro_asm=sw_hygroscopic_asm, & + sw_nonhygro_ext=sw_nonhygro_ext, & + sw_nonhygro_ssa=sw_nonhygro_ssa, & + sw_nonhygro_asm=sw_nonhygro_asm, & + lw_ext=lw_nonhygro_ext ) + + if (present(extpsw)) then + nullify(extpsw) + endif + + if (present(abspsw)) then + nullify(abspsw) + endif + if (present(asmpsw)) then + nullify(asmpsw) + endif + if (present(absplw)) then + nullify(absplw) + endif + if (present(refrtabsw)) then + nullify(refrtabsw) + endif + if (present(refitabsw)) then + nullify(refitabsw) + endif + if (present(refrtablw)) then + nullify(refrtablw) + endif + if (present(refitablw)) then + nullify(refitablw) + endif + if (present(ncoef)) then + ncoef = -huge(1) + endif + if (present(prefr)) then + prefr = -huge(1) + endif + if (present(prefi)) then + prefi = -huge(1) + endif + if (present(sw_hygro_ext_wtp)) then + nullify(sw_hygro_ext_wtp) + endif + if (present(sw_hygro_ssa_wtp)) then + nullify(sw_hygro_ssa_wtp) + endif + if (present(sw_hygro_asm_wtp)) then + nullify(sw_hygro_asm_wtp) + endif + if (present(lw_hygro_ext_wtp)) then + nullify(lw_hygro_ext_wtp) + endif + if (present(wgtpct)) then + nullify(wgtpct) + endif + if (present(nwtp)) then + nwtp = -huge(1) + endif + + if (present(sw_hygro_coreshell_ext)) then + nullify(sw_hygro_coreshell_ext) + endif + if (present(sw_hygro_coreshell_ssa)) then + nullify(sw_hygro_coreshell_ssa) + endif + if (present(sw_hygro_coreshell_asm)) then + nullify(sw_hygro_coreshell_asm) + endif + if (present(lw_hygro_coreshell_ext)) then + nullify(lw_hygro_coreshell_ext) + endif + if (present(corefrac)) then + nullify(corefrac) + endif + if (present(bcdust)) then + nullify(bcdust) + endif + if (present(kap)) then + nullify(kap) + endif + if (present(relh)) then + nullify(relh) + endif + + if (present(nfrac)) then + nfrac = -huge(1) + endif + if (present(nbcdust)) then + nbcdust = -huge(1) + endif + if (present(nkap)) then + nkap = -huge(1) + endif + if (present(nrelh)) then + nrelh = -huge(1) + endif + + end subroutine optics_params + + + !------------------------------------------------------------------------------ + ! returns radius^3 (m3) of a given bin number + !------------------------------------------------------------------------------ + pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(in) :: volconc ! volume conc (m3/m3) + real(r8), intent(in) :: numconc ! number conc (1/m3) + + end function amcube + + !------------------------------------------------------------------------------ + ! returns mass and number activation fractions + !------------------------------------------------------------------------------ + subroutine actfracs(self, bin_ndx, smc, smax, fn, fm ) + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8),intent(in) :: smc ! critical supersaturation for particles of bin radius + real(r8),intent(in) :: smax ! maximum supersaturation for multiple competing aerosols + real(r8),intent(out) :: fn ! activation fraction for aerosol number + real(r8),intent(out) :: fm ! activation fraction for aerosol mass + + end subroutine actfracs + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine num_names(self, bin_ndx, name_a, name_c) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol number dens + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol number dens + + end subroutine num_names + + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol MMR + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol MMR + + end subroutine mmr_names + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine amb_num_name(self, bin_ndx, name) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens + + end subroutine amb_num_name + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine amb_mmr_name(self, bin_ndx, species_ndx, name) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR + + end subroutine amb_mmr_name + + !------------------------------------------------------------------------ + ! returns species type + !------------------------------------------------------------------------ + subroutine species_type(self, bin_ndx, species_ndx, spectype) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: spectype ! species type + + end subroutine species_type + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to given aerosol bin number + !------------------------------------------------------------------------------ + function icenuc_updates_num(self, bin_ndx) result(res) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + logical :: res + + res = .false. + + end function icenuc_updates_num + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to a given species within a bin + !------------------------------------------------------------------------------ + function icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + logical :: res + + res = .false. + end function icenuc_updates_mmr + + !------------------------------------------------------------------------------ + ! apply max / min to number concentration + !------------------------------------------------------------------------------ + subroutine apply_number_limits( self, naerosol, vaerosol, istart, istop, m ) + class(bulk_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:) ! number conc (1/m3) + real(r8), intent(in) :: vaerosol(:) ! volume conc (m3/m3) + integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + integer, intent(in) :: m ! mode or bin index + + end subroutine apply_number_limits + + !------------------------------------------------------------------------------ + ! returns TRUE if species `spc_ndx` in aerosol subset `bin_ndx` contributes to + ! the particles' ability to act as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_species(self, bin_ndx, spc_ndx) result(res) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: spc_ndx ! species number + + logical :: res + + res = .false. + end function hetfrz_species + + !------------------------------------------------------------------------------ + ! returns TRUE if soluble + !------------------------------------------------------------------------------ + logical function soluble(self,bin_ndx) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + soluble=.false. + + end function soluble + + + !------------------------------------------------------------------------------ + ! returns minimum mass mean radius (meters) + !------------------------------------------------------------------------------ + function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + real(r8) :: minrad ! meters + + minrad = 0._r8 + + end function min_mass_mean_rad + + !------------------------------------------------------------------------------ + ! returns 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 + !------------------------------------------------------------------------------ + function nspecies_per_bin_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 + + 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 + + res = -huge(1._r8) + + 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 + + + call rad_cnst_get_info(list_ndx, naero=naer) + + allocate( names(naer)) + + call rad_cnst_get_info(list_ndx, aernames=names) + + name = names(bin_ndx) + + deallocate(names) + + end function bin_name + + !------------------------------------------------------------------------------ + ! returns scavenging diameter (cm) for a given aerosol bin number + !------------------------------------------------------------------------------ + function scav_diam(self, bin_ndx) result(diam) + + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: diam + + diam = -huge(1._r8) + + end function scav_diam + + !------------------------------------------------------------------------------ + ! adjust aerosol concentration tendencies to create larger sizes of aerosols + ! during resuspension + !------------------------------------------------------------------------------ + subroutine resuspension_resize(self, dcondt) + + class(bulk_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + + dcondt = -huge(1._r8) + + end subroutine resuspension_resize + + !------------------------------------------------------------------------------ + ! returns bulk deposition fluxes of the specified species type + ! rebinned to specified diameter limits + !------------------------------------------------------------------------------ + subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, & + error_code, error_string) + + class(bulk_aerosol_properties), intent(in) :: self + character(len=*),intent(in) :: bulk_type ! aerosol type to rebin + real(r8), intent(in) :: dep_fluxes(:) ! kg/m2 + real(r8), intent(in) :: diam_edges(:) ! meters + real(r8), intent(out) :: bulk_fluxes(:) ! kg/m2 + integer, intent(out) :: error_code ! error code (0 if no error) + character(len=*), intent(out) :: error_string ! error string + + end subroutine rebin_bulk_fluxes + + !------------------------------------------------------------------------------ + ! Returns TRUE if bin is hydrophilic, otherwise FALSE + !------------------------------------------------------------------------------ + logical function hydrophilic(self, bin_ndx) + class(bulk_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + end function hydrophilic + +end module bulk_aerosol_properties_mod diff --git a/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 new file mode 100644 index 0000000000..4289adb086 --- /dev/null +++ b/src/chemistry/aerosol/bulk_aerosol_state_mod.F90 @@ -0,0 +1,426 @@ +module bulk_aerosol_state_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use rad_constituents, only: rad_cnst_get_aer_mmr + use cam_abortutils, only: endrun + + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + + use aerosol_state_mod, only: aerosol_state, ptr2d_t + use aerosol_properties_mod, only: aerosol_properties + + implicit none + + type, extends(aerosol_state) :: bulk_aerosol_state + private + + type(physics_state), pointer :: state => null() + type(physics_buffer_desc), pointer :: pbuf(:) => null() + + contains + + procedure :: get_transported + procedure :: set_transported + procedure :: ambient_total_bin_mmr + procedure :: get_ambient_mmr_0list + procedure :: get_ambient_mmr_rlist + procedure :: get_cldbrne_mmr + procedure :: get_ambient_num + procedure :: get_cldbrne_num + procedure :: get_states + procedure :: icenuc_size_wght_arr + procedure :: icenuc_size_wght_val + procedure :: icenuc_type_wght + procedure :: update_bin + procedure :: hetfrz_size_wght + procedure :: hygroscopicity + procedure :: water_uptake + procedure :: dry_volume + procedure :: wet_volume + procedure :: water_volume + procedure :: wet_diameter + procedure :: convcld_actfrac + procedure :: wgtpct + + final :: destructor + + end type bulk_aerosol_state + + interface bulk_aerosol_state + procedure :: constructor + end interface bulk_aerosol_state + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(state,pbuf) result(newobj) + type(physics_state), target :: state + type(physics_buffer_desc), pointer :: pbuf(:) + type(bulk_aerosol_state), pointer :: newobj + + integer :: ierr + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%state => state + newobj%pbuf => pbuf + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(bulk_aerosol_state), intent(inout) :: self + + nullify(self%state) + nullify(self%pbuf) + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! sets transported components + ! This aerosol model with the state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine set_transported( self, transported_array ) + class(bulk_aerosol_state), intent(inout) :: self + real(r8), intent(in) :: transported_array(:,:,:) + ! to be implemented later + end subroutine set_transported + + !------------------------------------------------------------------------------ + ! returns transported components + ! This returns to current state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine get_transported( self, transported_array ) + class(bulk_aerosol_state), intent(in) :: self + real(r8), intent(out) :: transported_array(:,:,:) + ! to be implemented later + end subroutine get_transported + + !------------------------------------------------------------------------ + ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer) + !------------------------------------------------------------------------ + function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot) + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + + real(r8) :: mmr_tot ! mass mixing ratios totaled for all species + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call self%get_ambient_mmr(1, bin_ndx, mmr) + + mmr_tot = mmr(col_ndx, lyr_ndx) + + end function ambient_total_bin_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol mass mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_mmr_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) + 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) + + end subroutine get_ambient_mmr_rlist + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call endrun('ERROR: bulk_aerosol_state_mod%get_cldbrne_mmr not yet implemented') + + end subroutine get_cldbrne_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_num(self, bin_ndx, num) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) ! number densities + + nullify(num) + + call endrun('ERROR: bulk_aerosol_state_mod%get_ambient_num not yet implemented') + + end subroutine get_ambient_num + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_num(self, bin_ndx, num) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) + + nullify(num) + + call endrun('ERROR: bulk_aerosol_state_mod%get_cldbrne_num not yet implemented') + + end subroutine get_cldbrne_num + + !------------------------------------------------------------------------------ + ! returns interstitial and cloud-borne aerosol states + !------------------------------------------------------------------------------ + subroutine get_states( self, aero_props, raer, qqcw ) + class(bulk_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + type(ptr2d_t), intent(out) :: raer(:) + type(ptr2d_t), intent(out) :: qqcw(:) + + call endrun('ERROR: bulk_aerosol_state_mod%get_states not yet implemented') + + end subroutine get_states + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght(:,:) + + call endrun('ERROR: bulk_aerosol_state_mod%icenuc_size_wght_arr not yet implemented') + + end subroutine icenuc_size_wght_arr + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin, column and vertical layer + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght + + call endrun('ERROR: bulk_aerosol_state_mod%icenuc_size_wght_val not yet implemented') + + end subroutine icenuc_size_wght_val + + !------------------------------------------------------------------------------ + ! returns aerosol type weights for a given aerosol type and bin + !------------------------------------------------------------------------------ + subroutine icenuc_type_wght(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: wght(:,:) ! type weights + logical, optional, intent(in) :: cloud_borne ! if TRUE cloud-borne aerosols are used + ! otherwise ambient aerosols are used + + call endrun('ERROR: bulk_aerosol_state_mod%icenuc_type_wght not yet implemented') + + end subroutine icenuc_type_wght + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend ) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + real(r8),intent(in) :: delmmr_sum ! mass mixing ratio change summed over all species in bin + real(r8),intent(in) :: delnum_sum ! number mixing ratio change summed over all species in bin + integer, intent(in) :: tnd_ndx ! tendency index + real(r8),intent(in) :: dtime ! time step size (sec) + real(r8),intent(inout) :: tend(:,:,:) ! tendency + + call endrun('ERROR: bulk_aerosol_state_mod%update_bin not yet implemented') + + end subroutine update_bin + + !------------------------------------------------------------------------------ + ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act + ! as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + real(r8) :: wght(ncol,nlev) + + call endrun('ERROR: bulk_aerosol_state_mod%hetfrz_size_wght not yet implemented') + + end function hetfrz_size_wght + + !------------------------------------------------------------------------------ + ! returns hygroscopicity for a given radiation diagnostic list number and + ! bin number + !------------------------------------------------------------------------------ + subroutine hygroscopicity(self, list_ndx, 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) + + call endrun('ERROR: bulk_aerosol_state_mod%hygroscopicity not yet implemented') + + end subroutine hygroscopicity + + !------------------------------------------------------------------------------ + ! returns aerosol wet diameter and aerosol water concentration for a given + ! radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + subroutine water_uptake(self, aero_props, list_idx, 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 + real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) + real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) + + call endrun('ERROR: bulk_aerosol_state_mod%water_uptake not yet implemented') + + end subroutine water_uptake + + !------------------------------------------------------------------------------ + ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function dry_volume(self, aero_props, list_idx, 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 + + real(r8) :: vol(ncol,nlev) ! m3/kg + + vol = -huge(1._r8) + + end function dry_volume + + !------------------------------------------------------------------------------ + ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function wet_volume(self, aero_props, list_idx, 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 + + real(r8) :: vol(ncol,nlev) ! m3/kg + + vol = -huge(1._r8) + + end function wet_volume + + !------------------------------------------------------------------------------ + ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function water_volume(self, aero_props, list_idx, 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 + + real(r8) :: vol(ncol,nlev) ! m3/kg + + vol = -huge(1._r8) + + end function water_volume + + !------------------------------------------------------------------------------ + ! aerosol wet diameter + !------------------------------------------------------------------------------ + function wet_diameter(self, bin_idx, ncol, nlev) result(diam) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: diam(ncol,nlev) + + call endrun('ERROR: bulk_aerosol_state_mod%wet_diameter not yet implemented') + + end function wet_diameter + + !------------------------------------------------------------------------------ + ! prescribed aerosol activation fraction for convective cloud + !------------------------------------------------------------------------------ + function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) + + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: ispc ! species index + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: frac(ncol,nlev) + + call endrun('ERROR: bulk_aerosol_state_mod%convcld_actfrac not yet implemented') + + end function convcld_actfrac + + !------------------------------------------------------------------------------ + ! aerosol weight precent of H2SO4/H2O solution + !------------------------------------------------------------------------------ + function wgtpct(self, ncol, nlev) result(wtp) + class(bulk_aerosol_state), intent(in) :: self + integer, intent(in) :: ncol, nlev + real(r8) :: wtp(ncol,nlev) ! weight precent of H2SO4/H2O solution for given icol, ilev + + wtp = -huge(1._r8) + + end function wgtpct + +end module bulk_aerosol_state_mod diff --git a/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 new file mode 100644 index 0000000000..84e327ff79 --- /dev/null +++ b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 @@ -0,0 +1,144 @@ +module hygroscopic_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + use aerosol_optics_mod, only: aerosol_optics + use aerosol_properties_mod, only: aerosol_properties + + implicit none + + private + + public :: hygroscopic_aerosol_optics + + type, extends(aerosol_optics) :: hygroscopic_aerosol_optics + + ! aerosol optics properties tables (from physprops files) + real(r8), pointer :: ext_sw(:,:) + real(r8), pointer :: ssa_sw(:,:) + real(r8), pointer :: asm_sw(:,:) + real(r8), pointer :: abs_lw(:) + + ! from state + real(r8), allocatable :: wrh(:,:) ! (-) weighting on left side values ! (pcols,pver) + integer , allocatable :: krh(:,:) ! index into rh mesh + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type hygroscopic_aerosol_optics + + interface hygroscopic_aerosol_optics + procedure :: constructor + end interface hygroscopic_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, ilist, ibin, ncols, nlevs, numrh, relhum) result(newobj) + class(aerosol_properties),intent(in), target :: aero_props ! aerosol_properties 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) + + type(hygroscopic_aerosol_optics), pointer :: newobj + + real(r8) :: rhtrunc(ncols,nlevs) + integer :: ierr + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%wrh(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%krh(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + +! NOTE should try to use table_interp_mod utility !!! + rhtrunc(1:ncols,1:nlevs) = min(relhum(1:ncols,1:nlevs),1._r8) + newobj%krh(1:ncols,1:nlevs) = min(floor( rhtrunc(1:ncols,1:nlevs) * numrh ) + 1, numrh - 1) ! index into rh mesh + newobj%wrh(1:ncols,1:nlevs) = rhtrunc(1:ncols,1:nlevs) * numrh - newobj%krh(1:ncols,1:nlevs) ! (-) weighting on left side values + + ! optical properties tables + call aero_props%optics_params(ilist, ibin, & + sw_hygroscopic_ext=newobj%ext_sw, & + sw_hygroscopic_ssa=newobj%ssa_sw, & + sw_hygroscopic_asm=newobj%asm_sw, & + lw_nonhygro_ext=newobj%abs_lw ) + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(hygroscopic_aerosol_optics), intent(in) :: self + + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + pext(icol) = (1._r8 + self%wrh(icol,ilev)) * self%ext_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%ext_sw(self%krh(icol,ilev), iwav) + palb(icol) = (1._r8 + self%wrh(icol,ilev)) * self%ssa_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%ssa_sw(self%krh(icol,ilev), iwav) + pasm(icol) = (1._r8 + self%wrh(icol,ilev)) * self%asm_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%asm_sw(self%krh(icol,ilev), iwav) + + pabs(icol) = pext(icol) * ( 1._r8 - palb(icol) ) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(hygroscopic_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + pabs(:ncol) = self%abs_lw(iwav) + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(hygroscopic_aerosol_optics), intent(inout) :: self + + deallocate(self%wrh) + deallocate(self%krh) + + end subroutine destructor + +end module hygroscopic_aerosol_optics_mod diff --git a/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 new file mode 100644 index 0000000000..93ce412467 --- /dev/null +++ b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 @@ -0,0 +1,107 @@ +module insoluble_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + use aerosol_optics_mod, only: aerosol_optics + use aerosol_properties_mod, only: aerosol_properties + + implicit none + + private + + public :: insoluble_aerosol_optics + + type, extends(aerosol_optics) :: insoluble_aerosol_optics + real(r8), pointer :: lw_abs(:) + real(r8), pointer :: sw_ext(:) + real(r8), pointer :: sw_ssa(:) + real(r8), pointer :: sw_asm(:) + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type insoluble_aerosol_optics + + interface insoluble_aerosol_optics + procedure :: constructor + end interface insoluble_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, ilist, ibin) result(newobj) + + class(aerosol_properties),intent(in), target :: aero_props ! aerosol_properties object + integer, intent(in) :: ilist ! climate or a diagnostic list number + integer, intent(in) :: ibin ! bin number + + type(insoluble_aerosol_optics), pointer :: newobj + + integer :: ierr + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + ! get mode properties + call aero_props%optics_params(ilist, ibin, & + sw_nonhygro_ext=newobj%sw_ext, & + sw_nonhygro_ssa=newobj%sw_ssa, & + sw_nonhygro_asm=newobj%sw_asm, & + lw_nonhygro_ext=newobj%lw_abs ) + + end function constructor + + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(insoluble_aerosol_optics), intent(inout) :: self + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(insoluble_aerosol_optics), intent(in) :: self + + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + pext(:ncol) = self%sw_ext(iwav) + palb(:ncol) = self%sw_ssa(iwav) + pasm(:ncol) = self%sw_asm(iwav) + + pabs(:ncol) = pext(:ncol) * ( 1._r8 - palb(:ncol) ) + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(insoluble_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + pabs(:ncol) = self%lw_abs(iwav) + + end subroutine lw_props + +end module insoluble_aerosol_optics_mod From a48d2d7c1f0c464b6c4d10575c6cff4bcbd50147 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Sat, 13 Sep 2025 16:17:12 -0600 Subject: [PATCH 02/23] initial changes modified: src/chemistry/aerosol/aerosol_properties_mod.F90 modified: src/chemistry/aerosol/carma_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_properties_mod.F90 modified: src/physics/cam/aer_rad_props.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/aerosol_properties_mod.F90 | 21 ++- .../aerosol/carma_aerosol_properties_mod.F90 | 43 ++++- .../aerosol/modal_aerosol_properties_mod.F90 | 41 +++- src/physics/cam/aer_rad_props.F90 | 175 +----------------- src/physics/cam/aerosol_optics_cam.F90 | 64 ++++++- 5 files changed, 162 insertions(+), 182 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index e7cea68ad4..38b3f28383 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -101,7 +101,7 @@ end function aero_number_transported ! species morphology !------------------------------------------------------------------------ subroutine aero_props_get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & - spectype, specname, specmorph, refindex_sw, refindex_lw) + spectype, specname, specmorph, refindex_sw, refindex_lw) import :: aerosol_properties, r8 class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -124,7 +124,9 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps 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 ) + corefrac, bcdust, kap, relh, nfrac, nbcdust, nkap, nrelh, & + sw_hygroscopic_ext, sw_hygroscopic_ssa, sw_hygroscopic_asm, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) import :: aerosol_properties, r8 @@ -169,6 +171,17 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps 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(:,:) + real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) + real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) + + ! non-hygroscopic + 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 :: lw_nonhygro_ext(:) + end subroutine aero_optics_params !------------------------------------------------------------------------ @@ -375,12 +388,12 @@ 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) - import :: aerosol_properties, r8 + 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=32) name + character(len=aero_name_len) :: name end function aero_bin_name diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index 222ea38c34..f5e1c6d71c 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -318,7 +318,11 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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 ) + corefrac, bcdust, kap, relh, nfrac, nbcdust, nkap, nrelh, & + sw_hygroscopic_ext, sw_hygroscopic_ssa, sw_hygroscopic_asm, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) + + class(carma_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -361,6 +365,17 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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(:,:) + real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) + real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) + + ! non-hygroscopic + 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 :: lw_nonhygro_ext(:) + if (present(extpsw)) then nullify(extpsw) end if @@ -416,6 +431,32 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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 + + ! non-hygroscopic + if (present(sw_nonhygro_ext)) then + nullify(sw_nonhygro_ext) + end if + if (present(sw_nonhygro_ssa)) then + nullify(sw_nonhygro_ssa) + end if + if (present(sw_nonhygro_asm)) then + nullify(sw_nonhygro_asm) + end if + if (present(lw_nonhygro_ext)) then + nullify(lw_nonhygro_ext) + end if + end subroutine optics_params !------------------------------------------------------------------------------ diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index 828b54ed99..639b6a146e 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -398,7 +398,10 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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 ) + corefrac, bcdust, kap, relh, nfrac, nbcdust, nkap, nrelh, & + sw_hygroscopic_ext, sw_hygroscopic_ssa, sw_hygroscopic_asm, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) + class(modal_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -441,6 +444,17 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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(:,:) + real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) + real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) + + ! non-hygroscopic + 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 :: lw_nonhygro_ext(:) + ! refactive index table parameters call rad_cnst_get_mode_props(list_ndx, bin_ndx, & opticstype=opticstype, & @@ -514,6 +528,31 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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 + + ! non-hygroscopic + if (present(sw_nonhygro_ext)) then + nullify(sw_nonhygro_ext) + end if + if (present(sw_nonhygro_ssa)) then + nullify(sw_nonhygro_ssa) + end if + if (present(sw_nonhygro_asm)) then + nullify(sw_nonhygro_asm) + end if + if (present(lw_nonhygro_ext)) then + nullify(lw_nonhygro_ext) + end if + end subroutine optics_params !------------------------------------------------------------------------------ diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 33ecc9056f..4ed34adfd2 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -102,11 +102,11 @@ subroutine aer_rad_props_init() odv_names(i) = 'ODV_'//trim(aernames(i)) call add_default (odv_names(i), 1, ' ') end do - endif + endif - if (nmodes>0 .or. nbins>0) then + if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then call aerosol_optics_cam_init() - end if + end if deallocate(aernames) @@ -221,7 +221,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes, nbins=nbins) ! Contributions from modal and bin aerosols. - if (nmodes>0 .or. nbins>0) then + if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then call aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, & tau, tau_w, tau_w_g, tau_w_f) else @@ -236,73 +236,6 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & !REMOVECAM_END call tropopause_find_cam(state, troplev) - ! Contributions from bulk aerosols. - do iaerosol = 1, numaerosols - - ! get bulk aerosol mass mixing ratio - call rad_cnst_get_aer_mmr(list_idx, iaerosol, state, pbuf, aermmr) - aermass(1:ncol,1:top_lev-1) = 0._r8 - aermass(1:ncol,top_lev:pver) = aermmr(1:ncol,top_lev:pver) * mmr_to_mass(1:ncol,top_lev:pver) - - ! get optics type - call rad_cnst_get_aer_props(list_idx, iaerosol, opticstype=opticstype) - - select case (trim(opticstype)) - case('hygro','hygroscopic','hygroscopi') - ! get optical properties for hygroscopic aerosols - call rad_cnst_get_aer_props(list_idx, iaerosol, sw_hygro_ext=h_ext, sw_hygro_ssa=h_ssa, sw_hygro_asm=h_asm) - call get_hygro_rad_props(ncol, krh, wrh, aermass, h_ext, h_ssa, h_asm, ta, tw, twg, twf) - tau (1:ncol,1:pver,:) = tau (1:ncol,1:pver,:) + ta (1:ncol,:,:) - tau_w (1:ncol,1:pver,:) = tau_w (1:ncol,1:pver,:) + tw (1:ncol,:,:) - tau_w_g(1:ncol,1:pver,:) = tau_w_g(1:ncol,1:pver,:) + twg(1:ncol,:,:) - tau_w_f(1:ncol,1:pver,:) = tau_w_f(1:ncol,1:pver,:) + twf(1:ncol,:,:) - - case('nonhygro','insoluble ') - ! get optical properties for non-hygroscopic aerosols - call rad_cnst_get_aer_props(list_idx, iaerosol, sw_nonhygro_ext=n_ext, sw_nonhygro_ssa=n_ssa, & - sw_nonhygro_asm=n_asm) - - call get_nonhygro_rad_props(ncol, aermass, n_ext, n_ssa, n_asm, ta, tw, twg, twf) - tau (1:ncol,1:pver,:) = tau (1:ncol,1:pver,:) + ta (1:ncol,:,:) - tau_w (1:ncol,1:pver,:) = tau_w (1:ncol,1:pver,:) + tw (1:ncol,:,:) - tau_w_g(1:ncol,1:pver,:) = tau_w_g(1:ncol,1:pver,:) + twg(1:ncol,:,:) - tau_w_f(1:ncol,1:pver,:) = tau_w_f(1:ncol,1:pver,:) + twf(1:ncol,:,:) - - case('volcanic') - ! get optical properties for volcanic aerosols - call rad_cnst_get_aer_props(list_idx, iaerosol, sw_nonhygro_ext=n_ext, sw_nonhygro_scat=n_scat, & - sw_nonhygro_ascat=n_ascat) - - call get_volcanic_rad_props(ncol, aermass, n_ext, n_scat, n_ascat, ta, tw, twg, twf) - tau (1:ncol,1:pver,:) = tau (1:ncol,1:pver,:) + ta (1:ncol,:,:) - tau_w (1:ncol,1:pver,:) = tau_w (1:ncol,1:pver,:) + tw (1:ncol,:,:) - tau_w_g(1:ncol,1:pver,:) = tau_w_g(1:ncol,1:pver,:) + twg(1:ncol,:,:) - tau_w_f(1:ncol,1:pver,:) = tau_w_f(1:ncol,1:pver,:) + twf(1:ncol,:,:) - - case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3') - pbuf_fld = 'VOLC_RAD_GEOM ' - if (len_trim(opticstype)>15) then - pbuf_fld = trim(pbuf_fld)//opticstype(16:16) - endif - ! get optical properties for volcanic aerosols - call rad_cnst_get_aer_props(list_idx, iaerosol, r_sw_ext=r_ext, r_sw_scat=r_scat, r_sw_ascat=r_ascat, mu=r_mu) - call get_volcanic_radius_rad_props(ncol, aermass, pbuf_fld, pbuf, r_ext, r_scat, r_ascat, r_mu, ta, tw, twg, twf) - tau (1:ncol,1:pver,:) = tau (1:ncol,1:pver,:) + ta (1:ncol,:,:) - tau_w (1:ncol,1:pver,:) = tau_w (1:ncol,1:pver,:) + tw (1:ncol,:,:) - tau_w_g(1:ncol,1:pver,:) = tau_w_g(1:ncol,1:pver,:) + twg(1:ncol,:,:) - tau_w_f(1:ncol,1:pver,:) = tau_w_f(1:ncol,1:pver,:) + twf(1:ncol,:,:) - - case('zero') - ! no effect of "zero" aerosols, so update nothing - case default - call endrun('aer_rad_props_sw: unsupported opticstype :'//trim(opticstype)//':') - end select - - ! diagnostic output of individual aerosol optical properties - ! currently implemented for climate list only - call aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaerosol, ta(:,:,idx_sw_diag), list_idx, troplev) - - enddo ! diagnostic output of total aerosol optical properties ! currently implemented for climate list only @@ -378,110 +311,12 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes, nbins=nbins) ! Contributions from modal and sectional aerosols. - if (nmodes>0 .or. nbins>0) then + if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then call aerosol_optics_cam_lw(list_idx, state, pbuf, odap_aer) else odap_aer = 0._r8 end if - ! Contributions from bulk aerosols. - if (numaerosols > 0) then - - ! compute mixing ratio to mass conversion - do k = 1, pver - mmr_to_mass(:ncol,k) = rga * state%pdeldry(:ncol,k) - end do - - ! calculate relative humidity for table lookup into rh grid - do k = 1, pver - call qsat(state%t(1:ncol,k), state%pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol) - end do - rh(1:ncol,1:pver) = state%q(1:ncol,1:pver,1) / qs(1:ncol,1:pver) - - rhtrunc(1:ncol,1:pver) = min(rh(1:ncol,1:pver),1._r8) - krh(1:ncol,1:pver) = min(floor( rhtrunc(1:ncol,1:pver) * nrh ) + 1, nrh - 1) ! index into rh mesh - wrh(1:ncol,1:pver) = rhtrunc(1:ncol,1:pver) * nrh - krh(1:ncol,1:pver) ! (-) weighting on left side values - - end if - - ! Loop over bulk aerosols in list. - do iaerosol = 1, numaerosols - - ! get aerosol mass mixing ratio - call rad_cnst_get_aer_mmr(list_idx, iaerosol, state, pbuf, aermmr) - aermass(1:ncol,1:top_lev-1) = 0._r8 - aermass(1:ncol,top_lev:pver) = aermmr(1:ncol,top_lev:pver) * mmr_to_mass(1:ncol,top_lev:pver) - - ! get optics type - call rad_cnst_get_aer_props(list_idx, iaerosol, opticstype=opticstype) - select case (trim(opticstype)) - case('hygroscopic') - ! get optical properties for hygroscopic aerosols - call rad_cnst_get_aer_props(list_idx, iaerosol, lw_hygro_ext=lw_hygro_abs) - do bnd_idx = 1, nlwbands - do k = 1, pver - do i = 1, ncol - odap_aer(i, k, bnd_idx) = odap_aer(i, k, bnd_idx) + & - aermass(i, k) * & - ((1 + wrh(i,k)) * lw_hygro_abs(krh(i,k)+1,bnd_idx) & - - wrh(i,k) * lw_hygro_abs(krh(i,k), bnd_idx)) - end do - end do - end do - case('insoluble','nonhygro','hygro','volcanic') - ! get optical properties for hygroscopic aerosols - call rad_cnst_get_aer_props(list_idx, iaerosol, lw_ext=lw_abs) - do bnd_idx = 1, nlwbands - do k = 1, pver - do i = 1, ncol - odap_aer(i,k,bnd_idx) = odap_aer(i,k,bnd_idx) + lw_abs(bnd_idx)*aermass(i,k) - end do - end do - end do - - case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3') - pbuf_fld = 'VOLC_RAD_GEOM ' - if (len_trim(opticstype)>15) then - pbuf_fld = trim(pbuf_fld)//opticstype(16:16) - endif - - ! get optical properties for hygroscopic aerosols - call rad_cnst_get_aer_props(list_idx, iaerosol, r_lw_abs=r_lw_abs, mu=r_mu) - ! get microphysical properties for volcanic aerosols - idx = pbuf_get_index(pbuf_fld) - call pbuf_get_field(pbuf, idx, geometric_radius ) - - ! interpolate in radius - ! caution: clip the table with no warning when outside bounds - nmu = size(r_mu) - r_mu_max = r_mu(nmu) - r_mu_min = r_mu(1) - do i = 1, ncol - do k = 1, pver - if(geometric_radius(i,k) > 0._r8) then - mu(i,k) = log(geometric_radius(i,k)) - else - mu(i,k) = 0._r8 - endif - mutrunc = max(min(mu(i,k),r_mu_max),r_mu_min) - kmu = max(min(1 + (mutrunc-r_mu_min)/(r_mu_max-r_mu_min)*(nmu-1),nmu-1._r8),1._r8) - wmu = max(min( (mutrunc -r_mu(kmu)) / (r_mu(kmu+1) - r_mu(kmu)) ,1._r8),0._r8) - do bnd_idx = 1, nlwbands - odap_aer(i,k,bnd_idx) = odap_aer(i,k,bnd_idx) + & - aermass(i,k) * & - ((1._r8 - wmu) * r_lw_abs(bnd_idx, kmu ) + & - (wmu) * r_lw_abs(bnd_idx, kmu+1)) - end do - end do - end do - - case('zero') - ! zero aerosols types have no optical effect, so do nothing. - case default - call endrun('aer_rad_props_lw: unsupported opticstype: '//trim(opticstype)) - end select - end do - end subroutine aer_rad_props_lw !============================================================================== diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 9ea02e5d9f..ff0c267e48 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -4,7 +4,7 @@ module aerosol_optics_cam use cam_logfile, only: iulog use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_uv_diag, idx_nir_diag use radconstants, only: get_lw_spectral_boundaries - use phys_prop, only: ot_length + use phys_prop, only: ot_length, numrh=>nrh use physics_types,only: physics_state use physics_buffer,only: physics_buffer_desc use ppgrid, only: pcols, pver @@ -21,15 +21,19 @@ module aerosol_optics_cam 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 bulk_aerosol_properties_mod, only: bulk_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 + 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 hygroscopic_aerosol_optics_mod, only: hygroscopic_aerosol_optics + use insoluble_aerosol_optics_mod, only: insoluble_aerosol_optics implicit none @@ -59,6 +63,8 @@ module aerosol_optics_cam 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 @@ -132,6 +138,7 @@ subroutine aerosol_optics_cam_init character(len=*), parameter :: prefix = 'aerosol_optics_cam_init: ' integer :: nmodes=0, nbins=0, iaermod, istat, ilist, i + integer :: nbulk_aerosols=0 logical :: call_list(0:n_diag) real(r8) :: lwavlen_lo(nlwbands), lwavlen_hi(nlwbands) @@ -151,9 +158,10 @@ subroutine aerosol_optics_cam_init num_aero_models = 0 - call rad_cnst_get_info(0, nmodes=nmodes, nbins=nbins) + 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 ! count aerosol models if (modal_active) then @@ -162,6 +170,9 @@ subroutine aerosol_optics_cam_init 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) @@ -180,9 +191,16 @@ subroutine aerosol_optics_cam_init 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 + if (water_refindex_file=='NONE') then - call endrun(prefix//'water_refindex_file must be specified') + if (modal_active .or. carma_active) then + call endrun(prefix//'water_refindex_file must be specified') + end if else call getfil(water_refindex_file, locfile) call read_water_refindex(locfile) @@ -643,6 +661,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, real(r8) :: specdens character(len=32) :: spectype ! species type real(r8), pointer :: specmmr(:,:) + real(r8), pointer :: aerommr(:,:) real(r8) :: hygro_aer ! real(r8) :: scath2o, absh2o, sumscat, sumabs, sumhygro @@ -722,6 +741,10 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, 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 @@ -740,6 +763,10 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, call endrun(prefix//'array allocation error: pasm') end if + call qsat(state%t(:ncol,:), state%pmid(:ncol,:), sate(:ncol,:), satq(:ncol,:), ncol, pver) + relh(:ncol,:) = state%q(1:ncol,:,1) / satq(:ncol,:) + relh(:ncol,:) = max(1.e-20_r8,relh(:ncol,:)) + aeromodel: do iaermod = 1,num_aero_models aeroprops => aero_props(iaermod)%obj @@ -757,7 +784,6 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, aodbin(:) = 0.0_r8 call aeroprops%optics_params(list_idx, ibin, opticstype=opticstype) - select case (trim(opticstype)) case('modal') ! refractive method aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & @@ -772,6 +798,16 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, case('hygroscopic_wtp') aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & ibin, ncol, pver, sulfwtpct(:ncol,:)) + case('hygroscopic','hygro') + aero_optics=>hygroscopic_aerosol_optics(aeroprops, list_idx, ibin, ncol, pver, numrh, relh(:ncol,:)) + call aerostate%get_ambient_mmr(list_idx, ibin, 1, aerommr) + mass = mass * aerommr ! aerosol mass for BAM + + case('nonhygro', 'insoluble') + aero_optics=>insoluble_aerosol_optics(aeroprops, list_idx, ibin) + call aerostate%get_ambient_mmr(list_idx, ibin, 1, aerommr) + mass = mass * aerommr ! aerosol mass for BAM + case default call endrun(prefix//'optics method not recognized') end select @@ -796,7 +832,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, ga(icol,ilev,iwav) = ga(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol) fa(icol,ilev,iwav) = fa(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol)*pasm(icol) - call update_diags + call update_diags() end do column @@ -1165,7 +1201,8 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) real(r8) :: dopaer(pcols) real(r8) :: mass(pcols,pver) - + real(r8), pointer :: aerommr(:,:) + character(len=*), parameter :: prefix = 'aerosol_optics_cam_lw: ' integer :: ibin, nbins @@ -1210,6 +1247,10 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) 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 ncol = state%ncol @@ -1247,6 +1288,17 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) case('hygroscopic_wtp') aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & ibin, ncol, pver, sulfwtpct(:ncol,:)) + + case('hygroscopic','hygro') + aero_optics=>hygroscopic_aerosol_optics(aeroprops, list_idx, ibin, ncol, pver, numrh, relh(:ncol,:)) + call aerostate%get_ambient_mmr(list_idx, ibin, 1, aerommr) + mass = mass * aerommr ! aerosol mass for BAM + + case('nonhygro', 'insoluble') + aero_optics=>insoluble_aerosol_optics(aeroprops, list_idx, ibin) + call aerostate%get_ambient_mmr(list_idx, ibin, 1, aerommr) + mass = mass * aerommr ! aerosol mass for BAM + case default call endrun(prefix//'optics method not recognized') end select From 544cf8fa9057c4d7c422862b8d79fcd110594c2f Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Sun, 14 Sep 2025 13:24:43 -0600 Subject: [PATCH 03/23] restore bam optics diagnostics new file: src/physics/cam/bam_optics_diags_mod.F90 modified: src/physics/cam/aer_rad_props.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- src/physics/cam/aer_rad_props.F90 | 66 +-------------- src/physics/cam/aerosol_optics_cam.F90 | 14 +++- src/physics/cam/bam_optics_diags_mod.F90 | 101 +++++++++++++++++++++++ 3 files changed, 114 insertions(+), 67 deletions(-) create mode 100644 src/physics/cam/bam_optics_diags_mod.F90 diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 4ed34adfd2..e141c4b91c 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -23,6 +23,7 @@ module aer_rad_props use ref_pres, only: clim_modal_aero_top_lev use cam_abortutils, only: endrun +use bam_optics_diags_mod, only: bam_optics_diags_init, bam_optics_diags_out implicit none private @@ -35,10 +36,6 @@ module aer_rad_props aer_rad_props_sw, & ! return SW optical props of aerosols aer_rad_props_lw ! return LW optical props of aerosols -! Private data -character(len=fieldname_len), pointer :: odv_names(:) ! outfld names for visible OD - - !============================================================================== contains !============================================================================== @@ -82,28 +79,13 @@ subroutine aer_rad_props_init() allocate(aernames(numaerosols)) call rad_cnst_get_info(0, aernames=aernames, nmodes=nmodes, nbins=nbins) - ! diagnostic output for bulk aerosols - ! create outfld names for visible OD - allocate(odv_names(numaerosols)) - do i = 1, numaerosols - odv_names(i) = 'ODV_'//trim(aernames(i)) - call addfld (odv_names(i), horiz_only, 'A', '1', & - trim(aernames(i))//' optical depth in visible band', flag_xyfill=.true.) - end do + call bam_optics_diags_init() ! Determine default fields if (history_amwg .or. history_dust ) then call add_default ('AEROD_v', 1, ' ') endif - if ( history_aero_optics ) then - call add_default ('AEROD_v', 1, ' ') - do i = 1, numaerosols - odv_names(i) = 'ODV_'//trim(aernames(i)) - call add_default (odv_names(i), 1, ' ') - end do - endif - if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then call aerosol_optics_cam_init() end if @@ -239,7 +221,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & ! diagnostic output of total aerosol optical properties ! currently implemented for climate list only - call aer_vis_diag_out(lchnk, ncol, nnite, idxnite, 0, tau(:,:,idx_sw_diag), list_idx, troplev) + call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, 0, tau(:,:,idx_sw_diag), list_idx, troplev) end subroutine aer_rad_props_sw @@ -526,48 +508,6 @@ subroutine get_volcanic_rad_props(ncol, mass, ext, scat, ascat, & end subroutine get_volcanic_rad_props !============================================================================== - -subroutine aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, troplev) - - ! output aerosol optical depth for the visible band - - integer, intent(in) :: lchnk - integer, intent(in) :: ncol ! number of columns - integer, intent(in) :: nnite ! number of night columns - integer, intent(in) :: idxnite(:) ! local column indices of night columns - integer, intent(in) :: iaer ! aerosol index -- if 0 then tau is a total for all aerosols - real(r8), intent(in) :: tau(:,:) ! aerosol optical depth for the visible band - integer, intent(in) :: diag_idx ! identifies whether the aerosol optics - ! is for the climate calc or a diagnostic calc - integer, intent(in) :: troplev(:) ! tropopause level - - ! Local variables - integer :: i - real(r8) :: tmp(pcols), tmp2(pcols) - !----------------------------------------------------------------------------- - - ! currently only implemented for climate calc - if (diag_idx > 0) return - - ! compute total column aerosol optical depth - tmp(1:ncol) = sum(tau(1:ncol,:), 2) - ! use fillvalue to indicate night columns - do i = 1, nnite - tmp(idxnite(i)) = fillvalue - end do - - if (iaer > 0) then - call outfld(odv_names(iaer), tmp, pcols, lchnk) - else - call outfld('AEROD_v', tmp, pcols, lchnk) - do i = 1, ncol - tmp2(i) = sum(tau(i,:troplev(i))) - end do - call outfld('AODvstrt', tmp2, pcols, lchnk) - end if - -end subroutine aer_vis_diag_out - !============================================================================== end module aer_rad_props diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index ff0c267e48..d219549d14 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -35,6 +35,8 @@ module aerosol_optics_cam use hygroscopic_aerosol_optics_mod, only: hygroscopic_aerosol_optics use insoluble_aerosol_optics_mod, only: insoluble_aerosol_optics + use bam_optics_diags_mod, only: bam_optics_diags_active, bam_optics_diags_out + implicit none private @@ -195,7 +197,6 @@ subroutine aerosol_optics_cam_init iaermod = iaermod+1 aero_props(iaermod)%obj => bulk_aerosol_properties() end if - if (water_refindex_file=='NONE') then if (modal_active .or. carma_active) then @@ -766,7 +767,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, call qsat(state%t(:ncol,:), state%pmid(:ncol,:), sate(:ncol,:), satq(:ncol,:), ncol, pver) relh(:ncol,:) = state%q(1:ncol,:,1) / satq(:ncol,:) relh(:ncol,:) = max(1.e-20_r8,relh(:ncol,:)) - + aeromodel: do iaermod = 1,num_aero_models aeroprops => aero_props(iaermod)%obj @@ -846,7 +847,12 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, deallocate(aero_optics) nullify(aero_optics) - call output_bin_diags + if (bam_optics_diags_active) then + call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, ibin, tauxar(:,:,idx_sw_diag), & + list_idx, troplev) + endif + + call output_bin_diags() end do binloop end do aeromodel @@ -1202,7 +1208,7 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) real(r8) :: dopaer(pcols) real(r8) :: mass(pcols,pver) real(r8), pointer :: aerommr(:,:) - + character(len=*), parameter :: prefix = 'aerosol_optics_cam_lw: ' integer :: ibin, nbins diff --git a/src/physics/cam/bam_optics_diags_mod.F90 b/src/physics/cam/bam_optics_diags_mod.F90 new file mode 100644 index 0000000000..e52680c883 --- /dev/null +++ b/src/physics/cam/bam_optics_diags_mod.F90 @@ -0,0 +1,101 @@ +module bam_optics_diags_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_history, only: fieldname_len, addfld, outfld, add_default, horiz_only + use cam_history_support, only : fillvalue + use rad_constituents, only: rad_cnst_get_info + use ppgrid, only: pcols, pver + use phys_control, only: phys_getopts + + implicit none + + private + public :: bam_optics_diags_active + public :: bam_optics_diags_init + public :: bam_optics_diags_out + + integer :: numaerosols=0 + character(len=fieldname_len), pointer :: odv_names(:) ! outfld names for visible OD + logical :: bam_optics_diags_active = .false. + +contains + + !============================================================================== + subroutine bam_optics_diags_init() + + integer :: i + character(len=64), allocatable :: aernames(:) + logical :: history_aero_optics ! Output aerosol optics diagnostics + + ! number of bulk aerosols in climate list + call rad_cnst_get_info(0, naero=numaerosols) + + bam_optics_diags_active = numaerosols>0 + + if (.not.bam_optics_diags_active) return + + ! get names of bulk aerosols + allocate(aernames(numaerosols)) + call rad_cnst_get_info(0, aernames=aernames) + + call phys_getopts( history_aero_optics_out = history_aero_optics ) + + ! diagnostic output for bulk aerosols + ! create outfld names for visible OD + allocate(odv_names(numaerosols)) + do i = 1, numaerosols + odv_names(i) = 'ODV_'//trim(aernames(i)) + call addfld (odv_names(i), horiz_only, 'A', '1', & + trim(aernames(i))//' optical depth in visible band', flag_xyfill=.true.) + call add_default(odv_names(i), 1, ' ') + end do + + end subroutine bam_optics_diags_init + + + !============================================================================== + subroutine bam_optics_diags_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, troplev) + + ! output aerosol optical depth for the visible band + + integer, intent(in) :: lchnk + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(:) ! local column indices of night columns + integer, intent(in) :: iaer ! aerosol index -- if 0 then tau is a total for all aerosols + real(r8), intent(in) :: tau(:,:) ! aerosol optical depth for the visible band + integer, intent(in) :: diag_idx ! identifies whether the aerosol optics + ! is for the climate calc or a diagnostic calc + integer, intent(in) :: troplev(:) ! tropopause level + + ! Local variables + integer :: i + real(r8) :: tmp(pcols), tmp2(pcols) + !----------------------------------------------------------------------------- + + if (.not.bam_optics_diags_active) return + + ! currently only implemented for climate calc + if (diag_idx > 0) return + + ! compute total column aerosol optical depth + tmp(1:ncol) = sum(tau(1:ncol,:), 2) + ! use fillvalue to indicate night columns + do i = 1, nnite + tmp(idxnite(i)) = fillvalue + end do + + if (iaer > 0) then + call outfld(odv_names(iaer), tmp, pcols, lchnk) + else + call outfld('AEROD_v', tmp, pcols, lchnk) + do i = 1, ncol + tmp2(i) = sum(tau(i,:troplev(i))) + end do + call outfld('AODvstrt', tmp2, pcols, lchnk) + end if + + end subroutine bam_optics_diags_out + + !============================================================================== + +end module bam_optics_diags_mod From 48080388b54251b4a06d8e22a9c1f9f53f9c6f6f Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 16 Sep 2025 19:47:37 -0600 Subject: [PATCH 04/23] some corrections modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/bulk_aerosol_properties_mod.F90 | 10 ----- .../hygrocoreshell_aerosol_optics_mod.F90 | 2 +- .../hygroscopic_aerosol_optics_mod.F90 | 16 ++++++-- .../aerosol/insoluble_aerosol_optics_mod.F90 | 16 ++++++-- src/physics/cam/aerosol_optics_cam.F90 | 39 +++++++++++-------- 5 files changed, 48 insertions(+), 35 deletions(-) diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index 16d6c03d52..f991a810c5 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -107,16 +107,6 @@ function constructor() result(newobj) deallocate(alogsig) deallocate(f1) -! allocate(newobj%aernames(newobj%num_aerosols),stat=ierr ) -! if( ierr /= 0 ) then -! nullify(newobj) -! return -! end if -! -! call rad_cnst_get_info(0, aernames=newobj%aernames) - - - 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..6443d3cc7e 100644 --- a/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 @@ -204,7 +204,7 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor - integer :: icol + integer :: icol type(table_interp_wghts) :: rhwghts(ncol) type(table_interp_wghts) :: cfwghts(ncol) diff --git a/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 index 84e327ff79..8f206dc952 100644 --- a/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 @@ -3,6 +3,7 @@ module hygroscopic_aerosol_optics_mod use aerosol_optics_mod, only: aerosol_optics use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state implicit none @@ -22,6 +23,9 @@ module hygroscopic_aerosol_optics_mod real(r8), allocatable :: wrh(:,:) ! (-) weighting on left side values ! (pcols,pver) integer , allocatable :: krh(:,:) ! index into rh mesh + ! aerosol mass mixing ratio + real(r8), pointer :: mmr(:,:) + contains procedure :: sw_props @@ -39,8 +43,10 @@ module hygroscopic_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, ilist, ibin, ncols, nlevs, numrh, relhum) result(newobj) - class(aerosol_properties),intent(in), target :: aero_props ! aerosol_properties object + function constructor(aero_props, aero_state, ilist, 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 @@ -81,6 +87,8 @@ function constructor(aero_props, ilist, ibin, ncols, nlevs, numrh, relhum) res sw_hygroscopic_asm=newobj%asm_sw, & lw_nonhygro_ext=newobj%abs_lw ) + call aero_state%get_ambient_mmr(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + end function constructor !------------------------------------------------------------------------------ @@ -108,6 +116,8 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) - self%wrh(icol,ilev) * self%ssa_sw(self%krh(icol,ilev), iwav) pasm(icol) = (1._r8 + self%wrh(icol,ilev)) * self%asm_sw(self%krh(icol,ilev)+1,iwav) & - self%wrh(icol,ilev) * self%asm_sw(self%krh(icol,ilev), iwav) + + pext(icol) = pext(icol) * self%mmr(icol,ilev) pabs(icol) = pext(icol) * ( 1._r8 - palb(icol) ) @@ -126,7 +136,7 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) integer, intent(in) :: iwav ! wave length index real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) - pabs(:ncol) = self%abs_lw(iwav) + pabs(:ncol) = self%abs_lw(iwav) * self%mmr(:ncol,ilev) end subroutine lw_props diff --git a/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 index 93ce412467..ab73ca38c3 100644 --- a/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 @@ -3,6 +3,7 @@ module insoluble_aerosol_optics_mod use aerosol_optics_mod, only: aerosol_optics use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state implicit none @@ -15,6 +16,10 @@ module insoluble_aerosol_optics_mod real(r8), pointer :: sw_ext(:) real(r8), pointer :: sw_ssa(:) real(r8), pointer :: sw_asm(:) + + ! aerosol mass mixing ratio + real(r8), pointer :: mmr(:,:) + contains procedure :: sw_props @@ -32,9 +37,10 @@ module insoluble_aerosol_optics_mod !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - function constructor(aero_props, ilist, ibin) result(newobj) + function constructor(aero_props, aero_state, ilist, ibin) result(newobj) - class(aerosol_properties),intent(in), target :: aero_props ! aerosol_properties object + 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 @@ -55,6 +61,8 @@ function constructor(aero_props, ilist, ibin) result(newobj) sw_nonhygro_asm=newobj%sw_asm, & lw_nonhygro_ext=newobj%lw_abs ) + call aero_state%get_ambient_mmr(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + end function constructor @@ -81,7 +89,7 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor - pext(:ncol) = self%sw_ext(iwav) + pext(:ncol) = self%sw_ext(iwav) * self%mmr(:ncol,ilev) palb(:ncol) = self%sw_ssa(iwav) pasm(:ncol) = self%sw_asm(iwav) @@ -100,7 +108,7 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) integer, intent(in) :: iwav ! wave length index real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) - pabs(:ncol) = self%lw_abs(iwav) + pabs(:ncol) = self%lw_abs(iwav) * self%mmr(:ncol,ilev) end subroutine lw_props diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index d219549d14..c424acd753 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -155,8 +155,9 @@ subroutine aerosol_optics_cam_init character(len=cl) :: locfile call phys_getopts(history_amwg_out = history_amwg, & - history_aero_optics_out = history_aero_optics, & + ! history_aero_optics_out = history_aero_optics, & history_dust_out = history_dust ) + history_aero_optics=.false. num_aero_models = 0 @@ -573,6 +574,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, real(r8), intent(inout) :: ga(pcols,0:pver,nswbands) ! asymmetry factor real(r8), intent(inout) :: fa(pcols,0:pver,nswbands) ! forward scattered fraction + real(r8) :: taubam(pcols,0:pver) character(len=*), parameter :: prefix = 'aerosol_optics_cam_sw: ' integer :: ibin, nbins @@ -783,8 +785,10 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, dustaodbin(:) = 0._r8 burden(:) = 0._r8 aodbin(:) = 0.0_r8 + taubam(:,:) = 0._r8 call aeroprops%optics_params(list_idx, ibin, opticstype=opticstype) + select case (trim(opticstype)) case('modal') ! refractive method aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & @@ -800,14 +804,11 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & ibin, ncol, pver, sulfwtpct(:ncol,:)) case('hygroscopic','hygro') - aero_optics=>hygroscopic_aerosol_optics(aeroprops, list_idx, ibin, ncol, pver, numrh, relh(:ncol,:)) - call aerostate%get_ambient_mmr(list_idx, ibin, 1, aerommr) - mass = mass * aerommr ! aerosol mass for BAM + aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, list_idx, & + ibin, ncol, pver, numrh, relh(:ncol,:)) case('nonhygro', 'insoluble') - aero_optics=>insoluble_aerosol_optics(aeroprops, list_idx, ibin) - call aerostate%get_ambient_mmr(list_idx, ibin, 1, aerommr) - mass = mass * aerommr ! aerosol mass for BAM + aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, list_idx, ibin) case default call endrun(prefix//'optics method not recognized') @@ -827,17 +828,24 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, call init_diags column: do icol = 1,ncol - dopaer(icol) = pext(icol)*mass(icol,ilev) + dopaer(icol) = pext(icol) * mass(icol,ilev) tauxar(icol,ilev,iwav) = tauxar(icol,ilev,iwav) + dopaer(icol) wa(icol,ilev,iwav) = wa(icol,ilev,iwav) + dopaer(icol)*palb(icol) ga(icol,ilev,iwav) = ga(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol) fa(icol,ilev,iwav) = fa(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol)*pasm(icol) - call update_diags() + + ! call update_diags() + end do column + if (bam_optics_diags_active.and.iwav==idx_sw_diag) then + taubam(:ncol,ilev) = dopaer(:ncol) + end if + end do vertical + end do wavelength else @@ -848,11 +856,11 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, nullify(aero_optics) if (bam_optics_diags_active) then - call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, ibin, tauxar(:,:,idx_sw_diag), & + call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, ibin, taubam, & list_idx, troplev) endif - call output_bin_diags() + ! call output_bin_diags() end do binloop end do aeromodel @@ -1296,14 +1304,11 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) ibin, ncol, pver, sulfwtpct(:ncol,:)) case('hygroscopic','hygro') - aero_optics=>hygroscopic_aerosol_optics(aeroprops, list_idx, ibin, ncol, pver, numrh, relh(:ncol,:)) - call aerostate%get_ambient_mmr(list_idx, ibin, 1, aerommr) - mass = mass * aerommr ! aerosol mass for BAM + aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & + ncol, pver, numrh, relh(:ncol,:)) case('nonhygro', 'insoluble') - aero_optics=>insoluble_aerosol_optics(aeroprops, list_idx, ibin) - call aerostate%get_ambient_mmr(list_idx, ibin, 1, aerommr) - mass = mass * aerommr ! aerosol mass for BAM + aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, list_idx, ibin) case default call endrun(prefix//'optics method not recognized') From 34a1de24760c8e1c835fcbb21b6fdde19b3e6e29 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Sat, 20 Sep 2025 13:11:32 -0600 Subject: [PATCH 05/23] corrections for rrtmg optics new file: src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/aerosol_properties_mod.F90 modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/carma_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_properties_mod.F90 modified: src/physics/cam/aer_rad_props.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/aerosol_properties_mod.F90 | 3 +- .../aerosol/bulk_aerosol_properties_mod.F90 | 11 +- .../aerosol/carma_aerosol_properties_mod.F90 | 8 +- .../aerosol/hygro_aerosol_optics_mod.F90 | 158 ++++++++++++++++++ .../hygroscopic_aerosol_optics_mod.F90 | 24 ++- .../aerosol/modal_aerosol_properties_mod.F90 | 8 +- src/physics/cam/aer_rad_props.F90 | 149 +++++------------ src/physics/cam/aerosol_optics_cam.F90 | 28 ++-- 8 files changed, 256 insertions(+), 133 deletions(-) create mode 100644 src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index 38b3f28383..397768c535 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -125,7 +125,7 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps 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, & + sw_hygroscopic_ext, sw_hygroscopic_ssa, sw_hygroscopic_asm, lw_hygroscopic_ext, & sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) import :: aerosol_properties, r8 @@ -175,6 +175,7 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps real(r8), optional, pointer :: sw_hygroscopic_ext(:,:) real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) + real(r8), optional, pointer :: lw_hygroscopic_ext(:,:) ! non-hygroscopic real(r8), optional, pointer :: sw_nonhygro_ext(:) diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index f991a810c5..f050b0252e 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -74,9 +74,6 @@ function constructor() result(newobj) call rad_cnst_get_info(0, naero=naero) - !newobj%num_aerosols = naero - - allocate( nspecies(naero),stat=ierr ) if( ierr /= 0 ) then nullify(newobj) @@ -164,7 +161,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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, & + sw_hygroscopic_ext, sw_hygroscopic_ssa, sw_hygroscopic_asm, lw_hygroscopic_ext, & sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) @@ -213,6 +210,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as real(r8), optional, pointer :: sw_hygroscopic_ext(:,:) real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) + real(r8), optional, pointer :: lw_hygroscopic_ext(:,:) ! non-hygroscopic real(r8), optional, pointer :: sw_nonhygro_ext(:) @@ -226,6 +224,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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_nonhygro_ext, & sw_nonhygro_ssa=sw_nonhygro_ssa, & sw_nonhygro_asm=sw_nonhygro_asm, & @@ -494,7 +493,7 @@ function nbins_rlist(self, list_ndx) result(res) integer :: res call rad_cnst_get_info(list_ndx, naero=res) - + end function nbins_rlist !------------------------------------------------------------------------------ @@ -537,7 +536,7 @@ function bin_name(self, list_ndx, bin_ndx) result(name) character(len=aero_name_len) :: name character(len=64), allocatable :: names(:) integer :: naer - + call rad_cnst_get_info(list_ndx, naero=naer) diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index f5e1c6d71c..e8c9e09a00 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -319,7 +319,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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, & + sw_hygroscopic_ext, sw_hygroscopic_ssa, sw_hygroscopic_asm, lw_hygroscopic_ext, & sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) @@ -369,6 +369,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as real(r8), optional, pointer :: sw_hygroscopic_ext(:,:) real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) + real(r8), optional, pointer :: lw_hygroscopic_ext(:,:) ! non-hygroscopic real(r8), optional, pointer :: sw_nonhygro_ext(:) @@ -442,8 +443,11 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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 + ! non-hygroscopic if (present(sw_nonhygro_ext)) then nullify(sw_nonhygro_ext) end if diff --git a/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 new file mode 100644 index 0000000000..151102833a --- /dev/null +++ b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 @@ -0,0 +1,158 @@ +module hygro_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + use aerosol_optics_mod, only: aerosol_optics + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + + implicit none + + private + + public :: hygro_aerosol_optics + + type, extends(aerosol_optics) :: hygro_aerosol_optics + + ! aerosol optics properties tables (from physprops files) + real(r8), pointer :: ext_sw(:,:) => null() + real(r8), pointer :: ssa_sw(:,:) => null() + real(r8), pointer :: asm_sw(:,:) => null() + real(r8), pointer :: abs_lw(:) => null() + + ! from state + real(r8), allocatable :: wrh(:,:) ! (-) weighting on left side values ! (pcols,pver) + integer , allocatable :: krh(:,:) ! index into rh mesh + + ! aerosol mass mixing ratio + real(r8), pointer :: mmr(:,:) + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type hygro_aerosol_optics + + interface hygro_aerosol_optics + procedure :: constructor + end interface hygro_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ilist, 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) + + type(hygro_aerosol_optics), pointer :: newobj + + real(r8) :: rhtrunc(ncols,nlevs) + integer :: ierr + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%wrh(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%krh(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + +! NOTE should try to use table_interp_mod utility !!! + rhtrunc(1:ncols,1:nlevs) = min(relhum(1:ncols,1:nlevs),1._r8) + newobj%krh(1:ncols,1:nlevs) = min(floor( rhtrunc(1:ncols,1:nlevs) * numrh ) + 1, numrh - 1) ! index into rh mesh + newobj%wrh(1:ncols,1:nlevs) = rhtrunc(1:ncols,1:nlevs) * numrh - newobj%krh(1:ncols,1:nlevs) ! (-) weighting on left side values + + ! optical properties tables + call aero_props%optics_params(ilist, ibin, & + sw_hygroscopic_ext=newobj%ext_sw, & + sw_hygroscopic_ssa=newobj%ssa_sw, & + sw_hygroscopic_asm=newobj%asm_sw, & + lw_nonhygro_ext=newobj%abs_lw ) + + print*,'FVDBG.constructor...shape(newobj%abs_lw): ',shape(newobj%abs_lw) + + call aero_state%get_ambient_mmr(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(hygro_aerosol_optics), intent(in) :: self + + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + pext(icol) = (1._r8 + self%wrh(icol,ilev)) * self%ext_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%ext_sw(self%krh(icol,ilev), iwav) + palb(icol) = (1._r8 + self%wrh(icol,ilev)) * self%ssa_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%ssa_sw(self%krh(icol,ilev), iwav) + pasm(icol) = (1._r8 + self%wrh(icol,ilev)) * self%asm_sw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%asm_sw(self%krh(icol,ilev), iwav) + + pext(icol) = pext(icol) * self%mmr(icol,ilev) + + pabs(icol) = pext(icol) * ( 1._r8 - palb(icol) ) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(hygro_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + integer :: icol + + pabs(:ncol) = self%abs_lw(iwav) * self%mmr(:ncol,ilev) + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(hygro_aerosol_optics), intent(inout) :: self + + deallocate(self%wrh) + deallocate(self%krh) + + end subroutine destructor + +end module hygro_aerosol_optics_mod diff --git a/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 index 8f206dc952..a0d706c644 100644 --- a/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 @@ -14,10 +14,10 @@ module hygroscopic_aerosol_optics_mod type, extends(aerosol_optics) :: hygroscopic_aerosol_optics ! aerosol optics properties tables (from physprops files) - real(r8), pointer :: ext_sw(:,:) - real(r8), pointer :: ssa_sw(:,:) - real(r8), pointer :: asm_sw(:,:) - real(r8), pointer :: abs_lw(:) + real(r8), pointer :: ext_sw(:,:) => null() + real(r8), pointer :: ssa_sw(:,:) => null() + real(r8), pointer :: asm_sw(:,:) => null() + real(r8), pointer :: abs_lw(:,:) => null() ! from state real(r8), allocatable :: wrh(:,:) ! (-) weighting on left side values ! (pcols,pver) @@ -85,10 +85,10 @@ function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, numrh, r sw_hygroscopic_ext=newobj%ext_sw, & sw_hygroscopic_ssa=newobj%ssa_sw, & sw_hygroscopic_asm=newobj%asm_sw, & - lw_nonhygro_ext=newobj%abs_lw ) + lw_hygroscopic_ext=newobj%abs_lw ) call aero_state%get_ambient_mmr(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) - + end function constructor !------------------------------------------------------------------------------ @@ -116,7 +116,7 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) - self%wrh(icol,ilev) * self%ssa_sw(self%krh(icol,ilev), iwav) pasm(icol) = (1._r8 + self%wrh(icol,ilev)) * self%asm_sw(self%krh(icol,ilev)+1,iwav) & - self%wrh(icol,ilev) * self%asm_sw(self%krh(icol,ilev), iwav) - + pext(icol) = pext(icol) * self%mmr(icol,ilev) pabs(icol) = pext(icol) * ( 1._r8 - palb(icol) ) @@ -136,7 +136,15 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) integer, intent(in) :: iwav ! wave length index real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) - pabs(:ncol) = self%abs_lw(iwav) * self%mmr(:ncol,ilev) + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + pabs(icol) = (1._r8 + self%wrh(icol,ilev)) * self%abs_lw(self%krh(icol,ilev)+1,iwav) & + - self%wrh(icol,ilev) * self%abs_lw(self%krh(icol,ilev), iwav) + + pabs(icol) = pabs(icol) * self%mmr(icol,ilev) + end do end subroutine lw_props diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index 639b6a146e..c80b34eb9f 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -399,7 +399,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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, & + sw_hygroscopic_ext, sw_hygroscopic_ssa, sw_hygroscopic_asm, lw_hygroscopic_ext, & sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) @@ -448,6 +448,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as real(r8), optional, pointer :: sw_hygroscopic_ext(:,:) real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) + real(r8), optional, pointer :: lw_hygroscopic_ext(:,:) ! non-hygroscopic real(r8), optional, pointer :: sw_nonhygro_ext(:) @@ -538,8 +539,11 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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 + ! non-hygroscopic if (present(sw_nonhygro_ext)) then nullify(sw_nonhygro_ext) end if diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index e141c4b91c..725928aa11 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -36,6 +36,13 @@ module aer_rad_props aer_rad_props_sw, & ! return SW optical props of aerosols aer_rad_props_lw ! return LW optical props of aerosols + + character(len=32) :: sw_ta_name(nswbands) + character(len=32) :: sw_wa_name(nswbands) + character(len=32) :: sw_ga_name(nswbands) + character(len=32) :: sw_fa_name(nswbands) + character(len=32) :: lw_ta_name(nlwbands) + !============================================================================== contains !============================================================================== @@ -54,6 +61,8 @@ subroutine aer_rad_props_init() integer :: nmodes ! number of aerosol modes integer :: nbins ! number of aerosol bins + character(len=2) :: numch + !---------------------------------------------------------------------------- call phys_getopts( history_aero_optics_out = history_aero_optics, & @@ -82,7 +91,7 @@ subroutine aer_rad_props_init() call bam_optics_diags_init() ! Determine default fields - if (history_amwg .or. history_dust ) then + if (history_amwg .or. history_dust .or. history_aero_optics) then call add_default ('AEROD_v', 1, ' ') endif @@ -92,6 +101,28 @@ subroutine aer_rad_props_init() deallocate(aernames) + do i = 1,nswbands + write(numch,'(I2.2)') i + sw_ta_name(i) = 'TASW'//numch + sw_wa_name(i) = 'WASW'//numch + sw_ga_name(i) = 'GASW'//numch + sw_fa_name(i) = 'FASW'//numch + call addfld(sw_ta_name(i), (/'lev'/), 'A',' ', 'SW TAU '//numch, flag_xyfill=.true.) + call addfld(sw_wa_name(i), (/'lev'/), 'A',' ', 'SW WA '//numch, flag_xyfill=.true.) + call addfld(sw_ga_name(i), (/'lev'/), 'A',' ', 'SW GA '//numch, flag_xyfill=.true.) + call addfld(sw_fa_name(i), (/'lev'/), 'A',' ', 'SW FA '//numch, flag_xyfill=.true.) + call add_default (sw_ta_name(i), 2, ' ') + call add_default (sw_wa_name(i), 2, ' ') + call add_default (sw_ga_name(i), 2, ' ') + call add_default (sw_fa_name(i), 2, ' ') + end do + do i = 1,nlwbands + write(numch,'(I2.2)') i + lw_ta_name(i) = 'TALW'//numch + call addfld(lw_ta_name(i), (/'lev'/), 'A',' ', 'LW TAU '//numch, flag_xyfill=.true.) + call add_default (lw_ta_name(i), 2, ' ') + end do + end subroutine aer_rad_props_init !============================================================================== @@ -120,7 +151,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & integer :: ncol integer :: lchnk - integer :: k ! index + integer :: i,k ! index integer :: troplev(pcols) ! optical props for each aerosol @@ -157,7 +188,6 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & real(r8) :: rh(pcols,pver) real(r8) :: rhtrunc(pcols,pver) real(r8) :: wrh(pcols,pver) - integer :: krh(pcols,pver) integer :: numaerosols ! number of bulk aerosols in climate/diagnostic list integer :: nmodes ! number of aerosol modes in climate/diagnostic list @@ -189,16 +219,6 @@ 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 - ! calculate relative humidity for table lookup into rh grid - do k = 1, pver - call qsat(state%t(1:ncol,k), state%pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol) - end do - rh(1:ncol,1:pver) = state%q(1:ncol,1:pver,1) / qs(1:ncol,1:pver) - - rhtrunc(1:ncol,1:pver) = min(rh(1:ncol,1:pver),1._r8) - krh(1:ncol,1:pver) = min(floor( rhtrunc(1:ncol,1:pver) * nrh ) + 1, nrh - 1) ! index into rh mesh - wrh(1:ncol,1:pver) = rhtrunc(1:ncol,1:pver) * nrh - krh(1:ncol,1:pver) ! (-) weighting on left side values - ! 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) @@ -223,6 +243,13 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & ! currently implemented for climate list only call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, 0, tau(:,:,idx_sw_diag), list_idx, troplev) + do i = 1,nswbands + call outfld(sw_ta_name(i), tau(1:ncol,1:pver,i), ncol, lchnk ) + call outfld(sw_wa_name(i), tau_w(1:ncol,1:pver,i), ncol, lchnk ) + call outfld(sw_ga_name(i), tau_w_g(1:ncol,1:pver,i), ncol, lchnk ) + call outfld(sw_fa_name(i), tau_w_f(1:ncol,1:pver,i), ncol, lchnk ) + end do + end subroutine aer_rad_props_sw !============================================================================== @@ -270,20 +297,6 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) real(r8) :: r_mu_min, r_mu_max, wmu, mutrunc integer :: nmu, kmu - ! for table lookup into rh grid - real(r8) :: es(pcols,pver) ! saturation vapor pressure - real(r8) :: qs(pcols,pver) ! saturation specific humidity - real(r8) :: rh(pcols,pver) - real(r8) :: rhtrunc(pcols,pver) - real(r8) :: wrh(pcols,pver) - integer :: krh(pcols,pver) - - ! aerosol (vertical) mass path and extinction - ! aerosol masses - real(r8), pointer :: aermmr(:,:) ! mass mixing ratio of aerosols - real(r8) :: mmr_to_mass(pcols,pver) ! conversion factor for mmr to mass - real(r8) :: aermass(pcols,pver) ! mass of aerosols - character(len=16) :: pbuf_fld !----------------------------------------------------------------------------- @@ -292,6 +305,8 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! 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 call aerosol_optics_cam_lw(list_idx, state, pbuf, odap_aer) @@ -299,88 +314,16 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) odap_aer = 0._r8 end if + do i = 1,nlwbands + call outfld(lw_ta_name(i), odap_aer(1:ncol,1:pver,i), ncol, state%lchnk) + end do + end subroutine aer_rad_props_lw !============================================================================== ! Private methods !============================================================================== -subroutine get_hygro_rad_props(ncol, krh, wrh, mass, ext, ssa, asm, & - tau, tau_w, tau_w_g, tau_w_f) - - ! Arguments - integer, intent(in) :: ncol - integer, intent(in) :: krh(pcols,pver) ! index for linear interpolation of optics on rh - real(r8), intent(in) :: wrh(pcols,pver) ! weight for linear interpolation of optics on rh - real(r8), intent(in) :: mass(pcols,pver) - real(r8), intent(in) :: ext(:,:) - real(r8), intent(in) :: ssa(:,:) - real(r8), intent(in) :: asm(:,:) - - real(r8), intent(out) :: tau (pcols,pver,nswbands) - real(r8), intent(out) :: tau_w (pcols,pver,nswbands) - real(r8), intent(out) :: tau_w_g(pcols,pver,nswbands) - real(r8), intent(out) :: tau_w_f(pcols,pver,nswbands) - - ! Local variables - real(r8) :: ext1, ssa1, asm1 - integer :: icol, ilev, iswband - !----------------------------------------------------------------------------- - - do iswband = 1, nswbands - do icol = 1, ncol - do ilev = 1, pver - ext1 = (1 + wrh(icol,ilev)) * ext(krh(icol,ilev)+1,iswband) & - - wrh(icol,ilev) * ext(krh(icol,ilev), iswband) - ssa1 = (1 + wrh(icol,ilev)) * ssa(krh(icol,ilev)+1,iswband) & - - wrh(icol,ilev) * ssa(krh(icol,ilev), iswband) - asm1 = (1 + wrh(icol,ilev)) * asm(krh(icol,ilev)+1,iswband) & - - wrh(icol,ilev) * asm(krh(icol,ilev), iswband) - - tau (icol, ilev, iswband) = mass(icol, ilev) * ext1 - tau_w (icol, ilev, iswband) = mass(icol, ilev) * ext1 * ssa1 - tau_w_g(icol, ilev, iswband) = mass(icol, ilev) * ext1 * ssa1 * asm1 - tau_w_f(icol, ilev, iswband) = mass(icol, ilev) * ext1 * ssa1 * asm1 * asm1 - enddo - enddo - enddo - -end subroutine get_hygro_rad_props - -!============================================================================== - -subroutine get_nonhygro_rad_props(ncol, mass, ext, ssa, asm, & - tau, tau_w, tau_w_g, tau_w_f) - - ! Arguments - integer, intent(in) :: ncol - real(r8), intent(in) :: mass(pcols, pver) - real(r8), intent(in) :: ext(:) - real(r8), intent(in) :: ssa(:) - real(r8), intent(in) :: asm(:) - - real(r8), intent(out) :: tau (pcols, pver, nswbands) - real(r8), intent(out) :: tau_w (pcols, pver, nswbands) - real(r8), intent(out) :: tau_w_g(pcols, pver, nswbands) - real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) - - ! Local variables - integer :: iswband - real(r8) :: ext1, ssa1, asm1 - !----------------------------------------------------------------------------- - - do iswband = 1, nswbands - ext1 = ext(iswband) - ssa1 = ssa(iswband) - asm1 = asm(iswband) - tau (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext1 - tau_w (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext1 * ssa1 - tau_w_g(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext1 * ssa1 * asm1 - tau_w_f(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext1 * ssa1 * asm1 * asm1 - enddo - -end subroutine get_nonhygro_rad_props - !============================================================================== subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ext, r_scat, r_ascat, r_mu, & diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index c424acd753..9d5a97f35e 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -33,6 +33,7 @@ module aerosol_optics_cam 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 bam_optics_diags_mod, only: bam_optics_diags_active, bam_optics_diags_out @@ -766,6 +767,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, 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,:) relh(:ncol,:) = max(1.e-20_r8,relh(:ncol,:)) @@ -794,16 +796,15 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & ncol, pver, nswbands, nlwbands, crefwsw, crefwlw) case('hygroscopic_coreshell') - ! 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,:) - relh(:ncol,:) = max(1.e-20_r8,relh(:ncol,:)) aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, list_idx, & ibin, ncol, pver, relh(:ncol,:)) case('hygroscopic_wtp') aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & ibin, ncol, pver, sulfwtpct(:ncol,:)) - case('hygroscopic','hygro') + case('hygro') + aero_optics=>hygro_aerosol_optics(aeroprops, aerostate, list_idx, & + ibin, ncol, pver, numrh, relh(:ncol,:)) + case('hygroscopic') aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, list_idx, & ibin, ncol, pver, numrh, relh(:ncol,:)) @@ -1275,6 +1276,11 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) 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,:) + relh(:ncol,:) = max(1.e-20_r8,relh(:ncol,:)) + aeromodel: do iaermod = 1,num_aero_models aeroprops => aero_props(iaermod)%obj @@ -1293,20 +1299,20 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & ncol, pver, nswbands, nlwbands, crefwsw, crefwlw) case('hygroscopic_coreshell') - ! 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,:) - relh(:ncol,:) = max(1.e-20_r8,relh(:ncol,:)) aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, list_idx, & ibin, ncol, pver, relh(:ncol,:)) case('hygroscopic_wtp') aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & ibin, ncol, pver, sulfwtpct(:ncol,:)) - case('hygroscopic','hygro') + case('hygroscopic') aero_optics=>hygroscopic_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & ncol, pver, numrh, relh(:ncol,:)) + case('hygro') + aero_optics=>hygro_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & + ncol, pver, numrh, relh(:ncol,:)) + case('nonhygro', 'insoluble') aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, list_idx, ibin) @@ -1322,7 +1328,7 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) call aero_optics%lw_props(ncol, ilev, iwav, pabs ) column: do icol = 1, ncol - dopaer(icol) = pabs(icol)*mass(icol,ilev) + 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 From 6aeadbdd5d31da965a86331d9d8c90ea414c2d35 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Sat, 20 Sep 2025 16:36:11 -0600 Subject: [PATCH 06/23] unify diags modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 modified: src/physics/cam/aer_rad_props.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/bulk_aerosol_properties_mod.F90 | 73 +++++++++++++++++++ .../aerosol/hygro_aerosol_optics_mod.F90 | 2 - src/physics/cam/aer_rad_props.F90 | 10 +-- src/physics/cam/aerosol_optics_cam.F90 | 4 +- 4 files changed, 80 insertions(+), 9 deletions(-) diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index f050b0252e..ec0e1f81e0 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -1,5 +1,7 @@ module bulk_aerosol_properties_mod use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use string_utils, only : to_lower use aerosol_properties_mod, only: aerosol_properties, aero_name_len @@ -151,6 +153,56 @@ subroutine get(self, bin_ndx, species_ndx, list_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 + 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) + end if + + if (present(hygro)) then + call rad_cnst_get_aer_props(ilist, bin_ndx, hygro_aer=hygro) + end if + if (present(spectype)) then + + call rad_cnst_get_aer_props(ilist, bin_ndx, aername=aername) + + select case ( to_lower( aername(:4) ) ) + case('dust') + spectype = 'dust' + case('sulf') + spectype = 'sulfate' + case('bcar','bcph') + spectype = 'black-c' + case('ocar','ocph') + spectype = 'p-organic' + case('sslt','seas') + spectype = 'seasalt' + case default + spectype = 'UNKNOWN' + call endrun('ERROR: bulk_aerosol_properties_mod%get spectype aername not recognized') + end select + + end if + if (present(specmorph)) then + call endrun('ERROR: bulk_aerosol_properties_mod%get specmorph not yet implemented') + end if + if (present(specname)) then + call rad_cnst_get_aer_props(ilist, 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) + end if + if (present(refindex_lw)) then + call rad_cnst_get_aer_props(ilist, bin_ndx, refindex_aer_lw=refindex_lw) + end if + end subroutine get !------------------------------------------------------------------------ @@ -334,6 +386,9 @@ pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) real(r8), intent(in) :: volconc ! volume conc (m3/m3) real(r8), intent(in) :: numconc ! number conc (1/m3) + ! call endrun('ERROR: bulk_aerosol_properties_mod%amcube not yet implemented') + amcube = -huge(1._r8) + end function amcube !------------------------------------------------------------------------------ @@ -348,6 +403,8 @@ subroutine actfracs(self, bin_ndx, smc, smax, fn, fm ) real(r8),intent(out) :: fn ! activation fraction for aerosol number real(r8),intent(out) :: fm ! activation fraction for aerosol mass + call endrun('ERROR: bulk_aerosol_properties_mod%actfracs not yet implemented') + end subroutine actfracs !------------------------------------------------------------------------ @@ -359,6 +416,8 @@ 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 endrun('ERROR: bulk_aerosol_properties_mod%num_names not yet implemented') + end subroutine num_names @@ -372,6 +431,8 @@ 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 endrun('ERROR: bulk_aerosol_properties_mod%mmr_names not yet implemented') + end subroutine mmr_names !------------------------------------------------------------------------ @@ -382,6 +443,8 @@ 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 endrun('ERROR: bulk_aerosol_properties_mod%amb_num_name not yet implemented') + end subroutine amb_num_name !------------------------------------------------------------------------ @@ -393,6 +456,8 @@ 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 endrun('ERROR: bulk_aerosol_properties_mod%amb_mmr_name not yet implemented') + end subroutine amb_mmr_name !------------------------------------------------------------------------ @@ -404,6 +469,8 @@ subroutine species_type(self, bin_ndx, species_ndx, spectype) integer, intent(in) :: species_ndx ! species number character(len=*), intent(out) :: spectype ! species type + call endrun('ERROR: bulk_aerosol_properties_mod%species_type not yet implemented') + end subroutine species_type !------------------------------------------------------------------------------ @@ -441,6 +508,8 @@ subroutine apply_number_limits( self, naerosol, vaerosol, istart, istop, m ) integer, intent(in) :: istop ! stop column index integer, intent(in) :: m ! mode or bin index + call endrun('ERROR: bulk_aerosol_properties_mod%apply_number_limits not yet implemented') + end subroutine apply_number_limits !------------------------------------------------------------------------------ @@ -592,6 +661,8 @@ subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxe integer, intent(out) :: error_code ! error code (0 if no error) character(len=*), intent(out) :: error_string ! error string + call endrun('ERROR: bulk_aerosol_properties_mod%rebin_bulk_fluxes not yet implemented') + end subroutine rebin_bulk_fluxes !------------------------------------------------------------------------------ @@ -601,6 +672,8 @@ logical function hydrophilic(self, bin_ndx) class(bulk_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number + call endrun('ERROR: bulk_aerosol_properties_mod%hydrophilic not yet implemented') + end function hydrophilic end module bulk_aerosol_properties_mod diff --git a/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 index 151102833a..9188427db0 100644 --- a/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 @@ -87,8 +87,6 @@ function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, numrh, r sw_hygroscopic_asm=newobj%asm_sw, & lw_nonhygro_ext=newobj%abs_lw ) - print*,'FVDBG.constructor...shape(newobj%abs_lw): ',shape(newobj%abs_lw) - call aero_state%get_ambient_mmr(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) end function constructor diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 725928aa11..4b419b691a 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -111,16 +111,16 @@ subroutine aer_rad_props_init() call addfld(sw_wa_name(i), (/'lev'/), 'A',' ', 'SW WA '//numch, flag_xyfill=.true.) call addfld(sw_ga_name(i), (/'lev'/), 'A',' ', 'SW GA '//numch, flag_xyfill=.true.) call addfld(sw_fa_name(i), (/'lev'/), 'A',' ', 'SW FA '//numch, flag_xyfill=.true.) - call add_default (sw_ta_name(i), 2, ' ') - call add_default (sw_wa_name(i), 2, ' ') - call add_default (sw_ga_name(i), 2, ' ') - call add_default (sw_fa_name(i), 2, ' ') + ! call add_default (sw_ta_name(i), 2, ' ') + ! call add_default (sw_wa_name(i), 2, ' ') + ! call add_default (sw_ga_name(i), 2, ' ') + ! call add_default (sw_fa_name(i), 2, ' ') end do do i = 1,nlwbands write(numch,'(I2.2)') i lw_ta_name(i) = 'TALW'//numch call addfld(lw_ta_name(i), (/'lev'/), 'A',' ', 'LW TAU '//numch, flag_xyfill=.true.) - call add_default (lw_ta_name(i), 2, ' ') + ! call add_default (lw_ta_name(i), 2, ' ') end do end subroutine aer_rad_props_init diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 9d5a97f35e..e49da8bdc8 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -836,7 +836,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, fa(icol,ilev,iwav) = fa(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol)*pasm(icol) - ! call update_diags() + call update_diags() end do column @@ -861,7 +861,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, list_idx, troplev) endif - ! call output_bin_diags() + call output_bin_diags() end do binloop end do aeromodel From 6850dd7780698aec05a41d3353787bc013ed12a4 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Sun, 21 Sep 2025 16:18:44 -0600 Subject: [PATCH 07/23] volcanic aerosol optical props new file: src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/aerosol_properties_mod.F90 modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/carma_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_properties_mod.F90 modified: src/physics/cam/aer_rad_props.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/aerosol_properties_mod.F90 | 21 +- .../aerosol/bulk_aerosol_properties_mod.F90 | 25 ++- .../aerosol/carma_aerosol_properties_mod.F90 | 29 ++- .../aerosol/modal_aerosol_properties_mod.F90 | 28 ++- .../aerosol/volcrad_aerosol_optics_mod.F90 | 198 ++++++++++++++++++ src/physics/cam/aer_rad_props.F90 | 31 ++- src/physics/cam/aerosol_optics_cam.F90 | 77 +++++-- 7 files changed, 377 insertions(+), 32 deletions(-) create mode 100644 src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index 397768c535..387f655a31 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -74,6 +74,7 @@ module aerosol_properties_mod procedure(aero_resuspension_resize), deferred :: resuspension_resize procedure(aero_rebin_bulk_fluxes), deferred :: rebin_bulk_fluxes procedure(aero_hydrophilic), deferred :: hydrophilic + procedure :: is_bulk procedure :: final=>aero_props_final end type aerosol_properties @@ -126,7 +127,8 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps 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_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_mu, r_lw_abs ) import :: aerosol_properties, r8 @@ -183,6 +185,13 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps real(r8), optional, pointer :: sw_nonhygro_asm(:) real(r8), optional, pointer :: lw_nonhygro_ext(:) + ! 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 !------------------------------------------------------------------------ @@ -724,4 +733,14 @@ pure real(r8) function pom_equivso4_factor(self) end function pom_equivso4_factor + !------------------------------------------------------------------------------ + ! returns TRUE if bulk aerosol representation + !------------------------------------------------------------------------------ + pure logical function is_bulk(self) + class(aerosol_properties), intent(in) :: self + + is_bulk = .false. + + end function is_bulk + 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 ec0e1f81e0..d82a095936 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -46,6 +46,7 @@ module bulk_aerosol_properties_mod procedure :: resuspension_resize procedure :: rebin_bulk_fluxes procedure :: hydrophilic + procedure :: is_bulk final :: destructor @@ -214,7 +215,8 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_mu, r_lw_abs ) class(bulk_aerosol_properties), intent(in) :: self @@ -270,6 +272,13 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as real(r8), optional, pointer :: sw_nonhygro_asm(:) real(r8), optional, pointer :: lw_nonhygro_ext(:) + ! 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_cnst_get_aer_props(list_ndx, bin_ndx, & opticstype=opticstype, & @@ -280,7 +289,9 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as sw_nonhygro_ext=sw_nonhygro_ext, & sw_nonhygro_ssa=sw_nonhygro_ssa, & sw_nonhygro_asm=sw_nonhygro_asm, & - lw_ext=lw_nonhygro_ext ) + lw_ext=lw_nonhygro_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) @@ -676,4 +687,14 @@ logical function hydrophilic(self, bin_ndx) end function hydrophilic + !------------------------------------------------------------------------------ + ! returns TRUE if bulk aerosol representation + !------------------------------------------------------------------------------ + pure logical function is_bulk(self) + class(bulk_aerosol_properties), intent(in) :: self + + is_bulk = .true. + + end function is_bulk + end module bulk_aerosol_properties_mod diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index e8c9e09a00..7980039313 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -320,9 +320,8 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) - - + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_mu, r_lw_abs ) class(carma_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -377,6 +376,13 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as real(r8), optional, pointer :: sw_nonhygro_asm(:) real(r8), optional, pointer :: lw_nonhygro_ext(:) + ! 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 @@ -461,6 +467,23 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as nullify(lw_nonhygro_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 + end subroutine optics_params !------------------------------------------------------------------------------ diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index c80b34eb9f..e142b211d0 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -400,8 +400,8 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext) - + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_mu, r_lw_abs ) class(modal_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -456,6 +456,13 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as real(r8), optional, pointer :: sw_nonhygro_asm(:) real(r8), optional, pointer :: lw_nonhygro_ext(:) + ! 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_cnst_get_mode_props(list_ndx, bin_ndx, & opticstype=opticstype, & @@ -557,6 +564,23 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as nullify(lw_nonhygro_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 + end subroutine optics_params !------------------------------------------------------------------------------ diff --git a/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 b/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 new file mode 100644 index 0000000000..4a568168b9 --- /dev/null +++ b/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 @@ -0,0 +1,198 @@ +module volcrad_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + use aerosol_optics_mod, only: aerosol_optics + use aerosol_properties_mod, only: aerosol_properties + use aerosol_state_mod, only: aerosol_state + + implicit none + + private + + public :: volcrad_aerosol_optics + + type, extends(aerosol_optics) :: volcrad_aerosol_optics + + ! aerosol optics properties tables (from physprops files) + real(r8), pointer :: r_sw_ext(:,:) => null() + real(r8), pointer :: r_sw_scat(:,:) => null() + real(r8), pointer :: r_sw_ascat(:,:) => null() + real(r8), pointer :: r_lw_abs(:,:) => null() + real(r8), pointer :: r_mu(:) + + ! from state + real(r8), allocatable :: wmu(:,:) ! (-) weighting on left side values ! (pcols,pver) + integer , allocatable :: kmu(:,:) ! index into rh mesh + + ! aerosol mass mixing ratio + real(r8), pointer :: mmr(:,:) + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type volcrad_aerosol_optics + + interface volcrad_aerosol_optics + procedure :: constructor + end interface volcrad_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ilist, 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) + + type(volcrad_aerosol_optics), pointer :: newobj + + integer :: ierr, nmu, i, k + real(r8) :: r_mu_min, r_mu_max, mutrunc, mu + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%wmu(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%kmu(ncols,nlevs), stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + ! optical properties tables + call aero_props%optics_params(ilist, 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) + + +! NOTE should try to use table_interp_mod utility !!! + + nmu = size(newobj%r_mu) + r_mu_max = newobj%r_mu(nmu) + r_mu_min = newobj%r_mu(1) + + do i = 1, ncols + do k = 1, nlevs + if(geometric_radius(i,k) > 0._r8) then + mu = log(geometric_radius(i,k)) + else + mu = 0._r8 + endif + + ASSOCIATE ( kmu=>newobj%kmu(i,k), wmu=>newobj%wmu(i,k), r_mu=>newobj%r_mu ) + + mutrunc = max(min(mu,r_mu_max),r_mu_min) + kmu = max(min(1 + (mutrunc-r_mu_min)/(r_mu_max-r_mu_min)*(nmu-1),nmu-1._r8),1._r8) + wmu = max(min( (mutrunc -r_mu(kmu)) / (r_mu(kmu+1) - r_mu(kmu)) ,1._r8),0._r8) + + END ASSOCIATE + + end do + end do + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(volcrad_aerosol_optics), intent(in) :: self + + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + real(r8) :: scat(ncol) + real(r8) :: ascat(ncol) + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + + pext(icol) = ((1._r8 - self%wmu(icol,ilev)) * self%r_sw_ext(iwav, self%kmu(icol,ilev) ) + & + (self%wmu(icol,ilev)) * self%r_sw_ext(iwav, self%kmu(icol,ilev)+1)) + + scat(icol) = ((1._r8 - self%wmu(icol,ilev)) * self%r_sw_scat(iwav, self%kmu(icol,ilev) ) + & + (self%wmu(icol,ilev)) * self%r_sw_scat(iwav, self%kmu(icol,ilev)+1)) + + ascat(icol) = ((1._r8 - self%wmu(icol,ilev)) * self%r_sw_ascat(iwav, self%kmu(icol,ilev) ) + & + (self%wmu(icol,ilev)) * self%r_sw_ascat(iwav, self%kmu(icol,ilev)+1)) + + + palb(icol) = scat(icol) / pext(icol) + + if (scat(icol)>0._r8) then + pasm(icol) = ascat(icol) / scat(icol) + else + pasm(icol) = 0._r8 + end if + + pext(icol) = pext(icol) * self%mmr(icol,ilev) + + pabs(icol) = pext(icol) * ( 1._r8 - palb(icol) ) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(volcrad_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + integer :: icol + + ! interpolate the properties tables + do icol = 1, ncol + pabs(icol) = ((1._r8 - self%wmu(icol,ilev)) * self%r_lw_abs(iwav, self%kmu(icol,ilev) ) + & + (self%wmu(icol,ilev)) * self%r_lw_abs(iwav, self%kmu(icol,ilev)+1)) + pabs(icol) = pabs(icol) * self%mmr(icol,ilev) + end do + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(volcrad_aerosol_optics), intent(inout) :: self + + deallocate(self%wmu) + deallocate(self%kmu) + + end subroutine destructor + +end module volcrad_aerosol_optics_mod diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 4b419b691a..be394a6ce2 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -79,6 +79,12 @@ subroutine aer_rad_props_init() call addfld ('AODvstrt', horiz_only, 'A', '1', & 'Stratospheric Aerosol Optical Depth in visible band', flag_xyfill=.true.) + call addfld ('AEROD_LW1', horiz_only, 'A', '1', 'longwave diag', flag_xyfill=.true.) + call addfld ('AEROD_LWint', horiz_only, 'A', '1', 'longwave diag', flag_xyfill=.true.) + + call add_default ('AEROD_LW1', 1, ' ') + call add_default ('AEROD_LWint', 1, ' ') + ! Contributions to AEROD_v from individual aerosols (climate species). ! number of bulk aerosols in climate list @@ -93,6 +99,7 @@ subroutine aer_rad_props_init() ! Determine default fields if (history_amwg .or. history_dust .or. history_aero_optics) then call add_default ('AEROD_v', 1, ' ') + call add_default ('AODvstrt', 1, ' ') endif if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then @@ -111,16 +118,16 @@ subroutine aer_rad_props_init() call addfld(sw_wa_name(i), (/'lev'/), 'A',' ', 'SW WA '//numch, flag_xyfill=.true.) call addfld(sw_ga_name(i), (/'lev'/), 'A',' ', 'SW GA '//numch, flag_xyfill=.true.) call addfld(sw_fa_name(i), (/'lev'/), 'A',' ', 'SW FA '//numch, flag_xyfill=.true.) - ! call add_default (sw_ta_name(i), 2, ' ') - ! call add_default (sw_wa_name(i), 2, ' ') - ! call add_default (sw_ga_name(i), 2, ' ') - ! call add_default (sw_fa_name(i), 2, ' ') + call add_default (sw_ta_name(i), 2, ' ') + call add_default (sw_wa_name(i), 2, ' ') + call add_default (sw_ga_name(i), 2, ' ') + call add_default (sw_fa_name(i), 2, ' ') end do do i = 1,nlwbands write(numch,'(I2.2)') i lw_ta_name(i) = 'TALW'//numch call addfld(lw_ta_name(i), (/'lev'/), 'A',' ', 'LW TAU '//numch, flag_xyfill=.true.) - ! call add_default (lw_ta_name(i), 2, ' ') + call add_default (lw_ta_name(i), 2, ' ') end do end subroutine aer_rad_props_init @@ -297,10 +304,14 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) real(r8) :: r_mu_min, r_mu_max, wmu, mutrunc integer :: nmu, kmu + real(r8) :: tmp(pcols,pver) + character(len=16) :: pbuf_fld !----------------------------------------------------------------------------- + integer :: lchnk ncol = state%ncol + lchnk= state%lchnk ! 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) @@ -314,6 +325,16 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) odap_aer = 0._r8 end if + tmp(:ncol,:) = odap_aer(:ncol,:,1) + call outfld('AEROD_LW1',odap_aer(:,:,1), pcols, lchnk) + + do i = 1,ncol + do k = 1,pver + tmp(i,k) = sum(odap_aer(i,k,:)) + end do + end do + call outfld('AEROD_LWint',odap_aer(:,:,1), pcols, lchnk) + do i = 1,nlwbands call outfld(lw_ta_name(i), odap_aer(1:ncol,1:pver,i), ncol, state%lchnk) end do diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index e49da8bdc8..00e68693d9 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -6,7 +6,7 @@ module aerosol_optics_cam use radconstants, only: get_lw_spectral_boundaries use phys_prop, only: ot_length, numrh=>nrh use physics_types,only: physics_state - use physics_buffer,only: physics_buffer_desc + use physics_buffer,only: physics_buffer_desc, pbuf_get_field, pbuf_get_index use ppgrid, only: pcols, pver use physconst, only: rga, rair use cam_abortutils, only: endrun @@ -35,6 +35,7 @@ module aerosol_optics_cam 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 bam_optics_diags_mod, only: bam_optics_diags_active, bam_optics_diags_out @@ -145,7 +146,7 @@ subroutine aerosol_optics_cam_init logical :: call_list(0:n_diag) real(r8) :: lwavlen_lo(nlwbands), lwavlen_hi(nlwbands) - integer :: m, n + integer :: m, n, cnt character(len=fieldname_len) :: fldname character(len=128) :: lngname @@ -156,9 +157,8 @@ subroutine aerosol_optics_cam_init character(len=cl) :: locfile call phys_getopts(history_amwg_out = history_amwg, & - ! history_aero_optics_out = history_aero_optics, & + history_aero_optics_out = history_aero_optics, & history_dust_out = history_dust ) - history_aero_optics=.false. num_aero_models = 0 @@ -323,6 +323,8 @@ subroutine aerosol_optics_cam_init call endrun(prefix//'array allocation error: aoddustdn_fields') end if + cnt=0 + do n = 1,num_aero_models allocate(burden_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) @@ -353,7 +355,9 @@ subroutine aerosol_optics_cam_init do m = 1, aero_props(n)%obj%nbins() - write(fldname,'(a,i2.2)') 'BURDEN', m + cnt = cnt+1 + + write(fldname,'(a,i2.2)') 'BURDEN', cnt burden_fields(n)%name(m) = fldname write(lngname,'(a,i2.2)') 'Aerosol burden bin ', m call addfld (fldname, horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) @@ -369,7 +373,7 @@ subroutine aerosol_optics_cam_init call add_default (fldname, 1, ' ') end if - write(fldname,'(a,i2.2)') 'AODDUST', m + write(fldname,'(a,i2.2)') 'AODDUST', cnt aoddust_fields(n)%name(m) = fldname write(lngname,'(a,i2,a)') 'Aerosol optical depth, day only, 550 nm mode ',m,' from dust' call addfld (aoddust_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) @@ -377,7 +381,7 @@ subroutine aerosol_optics_cam_init call add_default (fldname, 1, ' ') end if - write(fldname,'(a,i2.2)') 'BURDENdn', m + write(fldname,'(a,i2.2)') 'BURDENdn', cnt burdendn_fields(n)%name(m) = fldname write(lngname,'(a,i2)') 'Aerosol burden, day night, bin ', m call addfld (burdendn_fields(n)%name(m), horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) @@ -393,7 +397,7 @@ subroutine aerosol_optics_cam_init call add_default (fldname, 1, ' ') end if - write(fldname,'(a,i2.2)') 'AODdnDUST', m + write(fldname,'(a,i2.2)') 'AODdnDUST', cnt aoddustdn_fields(n)%name(m) = fldname write(lngname,'(a,i2,a)') 'Aerosol optical depth 550 nm, day night, bin ',m,' from dust' call addfld (aoddustdn_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) @@ -682,7 +686,11 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, real(r8) :: ssavis(pcols) integer :: troplev(pcols) - integer :: i, k + integer :: i, k, bam_cnt + + real(r8), pointer :: geometric_radius(:,:) + integer :: idx ! index to pbuf for geometric radius + character(len=16) :: pbuf_fld nullify(aero_optics) @@ -772,6 +780,8 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, relh(:ncol,:) = state%q(1:ncol,:,1) / satq(:ncol,:) relh(:ncol,:) = max(1.e-20_r8,relh(:ncol,:)) + bam_cnt = 0 + aeromodel: do iaermod = 1,num_aero_models aeroprops => aero_props(iaermod)%obj @@ -811,8 +821,20 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, case('nonhygro', 'insoluble') aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, list_idx, ibin) + case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3') + 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 ) + + aero_optics=>volcrad_aerosol_optics(aeroprops, aerostate, list_idx, & + ibin, ncol, pver, geometric_radius(:ncol,:)) + case default - call endrun(prefix//'optics method not recognized') + call endrun(prefix//'optics method not recognized: '//trim(opticstype)) end select if (associated(aero_optics)) then @@ -835,9 +857,9 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, ga(icol,ilev,iwav) = ga(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol) fa(icol,ilev,iwav) = fa(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol)*pasm(icol) - - call update_diags() - + if (.not.aeroprops%is_bulk()) then + call update_diags() + end if end do column @@ -856,12 +878,13 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, deallocate(aero_optics) nullify(aero_optics) - if (bam_optics_diags_active) then - call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, ibin, taubam, & + if (aeroprops%is_bulk()) then + bam_cnt = bam_cnt+1 + call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, bam_cnt, taubam, & list_idx, troplev) - endif - - call output_bin_diags() + else + call output_bin_diags() + end if end do binloop end do aeromodel @@ -1242,6 +1265,10 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) character(len=32) :: opticstype integer :: iaermod + real(r8), pointer :: geometric_radius(:,:) + integer :: idx ! index to pbuf for geometric radius + character(len=16) :: pbuf_fld + real(r8) :: lwabs(pcols,pver) lwabs = 0._r8 tauxar = 0._r8 @@ -1316,8 +1343,20 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) case('nonhygro', 'insoluble') aero_optics=>insoluble_aerosol_optics(aeroprops, aerostate, list_idx, ibin) + case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3') + 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 ) + + aero_optics=>volcrad_aerosol_optics(aeroprops, aerostate, list_idx, & + ibin, ncol, pver, geometric_radius(:ncol,:)) + case default - call endrun(prefix//'optics method not recognized') + call endrun(prefix//'optics method not recognized: '//trim(opticstype)) end select if (associated(aero_optics)) then From 403844c664aa17b21d0f76247ecf40fe48ff1d2b Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 23 Sep 2025 14:15:50 -0600 Subject: [PATCH 08/23] restore default history output modified: src/physics/cam/aer_rad_props.F90 modified: src/physics/cam/bam_optics_diags_mod.F90 --- src/physics/cam/aer_rad_props.F90 | 16 ++++++++-------- src/physics/cam/bam_optics_diags_mod.F90 | 2 +- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index be394a6ce2..9442712387 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -82,8 +82,8 @@ subroutine aer_rad_props_init() call addfld ('AEROD_LW1', horiz_only, 'A', '1', 'longwave diag', flag_xyfill=.true.) call addfld ('AEROD_LWint', horiz_only, 'A', '1', 'longwave diag', flag_xyfill=.true.) - call add_default ('AEROD_LW1', 1, ' ') - call add_default ('AEROD_LWint', 1, ' ') +! call add_default ('AEROD_LW1', 1, ' ') +! call add_default ('AEROD_LWint', 1, ' ') ! Contributions to AEROD_v from individual aerosols (climate species). @@ -99,7 +99,7 @@ subroutine aer_rad_props_init() ! Determine default fields if (history_amwg .or. history_dust .or. history_aero_optics) then call add_default ('AEROD_v', 1, ' ') - call add_default ('AODvstrt', 1, ' ') +! call add_default ('AODvstrt', 1, ' ') endif if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then @@ -118,16 +118,16 @@ subroutine aer_rad_props_init() call addfld(sw_wa_name(i), (/'lev'/), 'A',' ', 'SW WA '//numch, flag_xyfill=.true.) call addfld(sw_ga_name(i), (/'lev'/), 'A',' ', 'SW GA '//numch, flag_xyfill=.true.) call addfld(sw_fa_name(i), (/'lev'/), 'A',' ', 'SW FA '//numch, flag_xyfill=.true.) - call add_default (sw_ta_name(i), 2, ' ') - call add_default (sw_wa_name(i), 2, ' ') - call add_default (sw_ga_name(i), 2, ' ') - call add_default (sw_fa_name(i), 2, ' ') + ! call add_default (sw_ta_name(i), 2, ' ') + ! call add_default (sw_wa_name(i), 2, ' ') + ! call add_default (sw_ga_name(i), 2, ' ') + ! call add_default (sw_fa_name(i), 2, ' ') end do do i = 1,nlwbands write(numch,'(I2.2)') i lw_ta_name(i) = 'TALW'//numch call addfld(lw_ta_name(i), (/'lev'/), 'A',' ', 'LW TAU '//numch, flag_xyfill=.true.) - call add_default (lw_ta_name(i), 2, ' ') + ! call add_default (lw_ta_name(i), 2, ' ') end do end subroutine aer_rad_props_init diff --git a/src/physics/cam/bam_optics_diags_mod.F90 b/src/physics/cam/bam_optics_diags_mod.F90 index e52680c883..8f5557d70e 100644 --- a/src/physics/cam/bam_optics_diags_mod.F90 +++ b/src/physics/cam/bam_optics_diags_mod.F90 @@ -72,7 +72,7 @@ subroutine bam_optics_diags_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx real(r8) :: tmp(pcols), tmp2(pcols) !----------------------------------------------------------------------------- - if (.not.bam_optics_diags_active) return +! if (.not.bam_optics_diags_active) return ! currently only implemented for climate calc if (diag_idx > 0) return From 5d04c873c3611c9a00cd62ca2d7eb09d499f25da Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 24 Sep 2025 05:55:25 -0600 Subject: [PATCH 09/23] code cleanup; use modal aerosol top level modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 modified: src/physics/cam/aer_rad_props.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/bulk_aerosol_properties_mod.F90 | 6 +- src/physics/cam/aer_rad_props.F90 | 309 +----------------- src/physics/cam/aerosol_optics_cam.F90 | 15 +- 3 files changed, 20 insertions(+), 310 deletions(-) diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index d82a095936..f4389b291a 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -177,17 +177,17 @@ subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & select case ( to_lower( aername(:4) ) ) case('dust') spectype = 'dust' - case('sulf') + case('sulf','volc') spectype = 'sulfate' case('bcar','bcph') spectype = 'black-c' case('ocar','ocph') spectype = 'p-organic' - case('sslt','seas') + case('sslt','seas','ssam','sscm') spectype = 'seasalt' case default spectype = 'UNKNOWN' - call endrun('ERROR: bulk_aerosol_properties_mod%get spectype aername not recognized') + call endrun('ERROR: bulk_aerosol_properties_mod%get aername not recognized : '//aername) end select end if diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 9442712387..47cec6e018 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -19,8 +19,6 @@ module aer_rad_props 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 -! Placed here due to PGI bug. -use ref_pres, only: clim_modal_aero_top_lev use cam_abortutils, only: endrun use bam_optics_diags_mod, only: bam_optics_diags_init, bam_optics_diags_out @@ -29,20 +27,11 @@ module aer_rad_props private save -integer :: top_lev = 1 - public :: & aer_rad_props_init, & aer_rad_props_sw, & ! return SW optical props of aerosols aer_rad_props_lw ! return LW optical props of aerosols - - character(len=32) :: sw_ta_name(nswbands) - character(len=32) :: sw_wa_name(nswbands) - character(len=32) :: sw_ga_name(nswbands) - character(len=32) :: sw_fa_name(nswbands) - character(len=32) :: lw_ta_name(nlwbands) - !============================================================================== contains !============================================================================== @@ -50,28 +39,18 @@ module aer_rad_props subroutine aer_rad_props_init() use phys_control, only: phys_getopts - - integer :: i integer :: numaerosols ! number of aerosols - character(len=64), pointer :: aernames(:) ! aerosol names 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 - logical :: prog_modal_aero ! Prognostic modal aerosols present integer :: nmodes ! number of aerosol modes integer :: nbins ! number of aerosol bins - character(len=2) :: numch - !---------------------------------------------------------------------------- call phys_getopts( history_aero_optics_out = history_aero_optics, & history_amwg_out = history_amwg, & - history_dust_out = history_dust, & - prog_modal_aero_out = prog_modal_aero ) - - ! Limit modal aerosols with top_lev here. - if (prog_modal_aero) top_lev = clim_modal_aero_top_lev + history_dust_out = history_dust ) call addfld ('AEROD_v ', horiz_only, 'A', '1', & 'Total Aerosol Optical Depth in visible band', flag_xyfill=.true.) @@ -79,57 +58,22 @@ subroutine aer_rad_props_init() call addfld ('AODvstrt', horiz_only, 'A', '1', & 'Stratospheric Aerosol Optical Depth in visible band', flag_xyfill=.true.) - call addfld ('AEROD_LW1', horiz_only, 'A', '1', 'longwave diag', flag_xyfill=.true.) - call addfld ('AEROD_LWint', horiz_only, 'A', '1', 'longwave diag', flag_xyfill=.true.) - -! call add_default ('AEROD_LW1', 1, ' ') -! call add_default ('AEROD_LWint', 1, ' ') - ! Contributions to AEROD_v from individual aerosols (climate species). ! number of bulk aerosols in climate list - call rad_cnst_get_info(0, naero=numaerosols) - - ! get names of bulk aerosols - allocate(aernames(numaerosols)) - call rad_cnst_get_info(0, aernames=aernames, nmodes=nmodes, nbins=nbins) + call rad_cnst_get_info(0, naero=numaerosols, nmodes=nmodes, nbins=nbins) call bam_optics_diags_init() ! Determine default fields if (history_amwg .or. history_dust .or. history_aero_optics) then call add_default ('AEROD_v', 1, ' ') -! call add_default ('AODvstrt', 1, ' ') endif if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then call aerosol_optics_cam_init() end if - deallocate(aernames) - - do i = 1,nswbands - write(numch,'(I2.2)') i - sw_ta_name(i) = 'TASW'//numch - sw_wa_name(i) = 'WASW'//numch - sw_ga_name(i) = 'GASW'//numch - sw_fa_name(i) = 'FASW'//numch - call addfld(sw_ta_name(i), (/'lev'/), 'A',' ', 'SW TAU '//numch, flag_xyfill=.true.) - call addfld(sw_wa_name(i), (/'lev'/), 'A',' ', 'SW WA '//numch, flag_xyfill=.true.) - call addfld(sw_ga_name(i), (/'lev'/), 'A',' ', 'SW GA '//numch, flag_xyfill=.true.) - call addfld(sw_fa_name(i), (/'lev'/), 'A',' ', 'SW FA '//numch, flag_xyfill=.true.) - ! call add_default (sw_ta_name(i), 2, ' ') - ! call add_default (sw_wa_name(i), 2, ' ') - ! call add_default (sw_ga_name(i), 2, ' ') - ! call add_default (sw_fa_name(i), 2, ' ') - end do - do i = 1,nlwbands - write(numch,'(I2.2)') i - lw_ta_name(i) = 'TALW'//numch - call addfld(lw_ta_name(i), (/'lev'/), 'A',' ', 'LW TAU '//numch, flag_xyfill=.true.) - ! call add_default (lw_ta_name(i), 2, ' ') - end do - end subroutine aer_rad_props_init !============================================================================== @@ -144,7 +88,6 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list type(physics_state), intent(in), target :: state - type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in) :: nnite ! number of night columns integer, intent(in) :: idxnite(:) ! local column indices of night columns @@ -158,69 +101,19 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & integer :: ncol integer :: lchnk - integer :: i,k ! index integer :: troplev(pcols) - ! optical props for each aerosol - ! hygroscopic - real(r8), pointer :: h_ext(:,:) - real(r8), pointer :: h_ssa(:,:) - real(r8), pointer :: h_asm(:,:) - ! non-hygroscopic - real(r8), pointer :: n_ext(:) - real(r8), pointer :: n_ssa(:) - real(r8), pointer :: n_asm(:) - real(r8), pointer :: n_scat(:) - real(r8), pointer :: n_ascat(:) - ! radius-dependent - real(r8), pointer :: r_ext(:,:) ! radius-dependent mass-specific extinction - real(r8), pointer :: r_scat(:,:) - real(r8), pointer :: r_ascat(:,:) - real(r8), pointer :: r_mu(:) ! log(radius) domain variable for r_ext, r_scat, r_ascat - - ! radiative properties for each aerosol - real(r8) :: ta (pcols,pver,nswbands) - real(r8) :: tw (pcols,pver,nswbands) - real(r8) :: twf(pcols,pver,nswbands) - real(r8) :: twg(pcols,pver,nswbands) - - ! aerosol masses - real(r8), pointer :: aermmr(:,:) ! mass mixing ratio of aerosols - real(r8) :: mmr_to_mass(pcols,pver) ! conversion factor for mmr to mass - real(r8) :: aermass(pcols,pver) ! mass of aerosols - - ! for table lookup into rh grid - real(r8) :: es(pcols,pver) ! saturation vapor pressure - real(r8) :: qs(pcols,pver) ! saturation specific humidity - real(r8) :: rh(pcols,pver) - real(r8) :: rhtrunc(pcols,pver) - real(r8) :: wrh(pcols,pver) - 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 :: iaerosol ! index into bulk aerosol list - character(len=ot_length) :: opticstype ! hygro or nonhygro - character(len=16) :: pbuf_fld !----------------------------------------------------------------------------- ncol = state%ncol lchnk = state%lchnk - ! compute mixing ratio to mass conversion - do k = 1, pver - mmr_to_mass(:ncol,k) = rga * state%pdeldry(:ncol,k) - enddo - - ! initialize to conditions that would cause failure - tau (:,:,:) = -100._r8 - tau_w (:,:,:) = -100._r8 - tau_w_g (:,:,:) = -100._r8 - tau_w_f (:,:,:) = -100._r8 - ! top layer (ilev = 0) has no aerosol (ie tau = 0) - ! also initialize rest of layers to accumulate od's + ! also initialize rest of layers to accumulate optical depths tau (1:ncol,:,:) = 0._r8 tau_w (1:ncol,:,:) = 0._r8 tau_w_g(1:ncol,:,:) = 0._r8 @@ -233,11 +126,6 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then call aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, & tau, tau_w, tau_w_g, tau_w_f) - else - tau (1:ncol,:,:) = 0._r8 - tau_w (1:ncol,:,:) = 0._r8 - tau_w_g(1:ncol,:,:) = 0._r8 - tau_w_f(1:ncol,:,:) = 0._r8 end if !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists @@ -245,32 +133,20 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & !REMOVECAM_END call tropopause_find_cam(state, troplev) - ! diagnostic output of total aerosol optical properties ! currently implemented for climate list only call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, 0, tau(:,:,idx_sw_diag), list_idx, troplev) - do i = 1,nswbands - call outfld(sw_ta_name(i), tau(1:ncol,1:pver,i), ncol, lchnk ) - call outfld(sw_wa_name(i), tau_w(1:ncol,1:pver,i), ncol, lchnk ) - call outfld(sw_ga_name(i), tau_w_g(1:ncol,1:pver,i), ncol, lchnk ) - call outfld(sw_fa_name(i), tau_w_f(1:ncol,1:pver,i), ncol, lchnk ) - end do - end subroutine aer_rad_props_sw !============================================================================== -subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) +subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! Purpose: Compute aerosol transmissions needed in absorptivity/ - ! emissivity calculations - - ! lw extinction is the same representation for all - ! species. If this changes, this routine will need to do something - ! similar to the sw with routines like get_hygro_lw_abs + ! emissivity calculations - use physics_buffer, only : pbuf_get_field, pbuf_get_index, physics_buffer_desc + use physics_buffer, only : physics_buffer_desc ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list @@ -281,37 +157,11 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! Local variables - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index - integer :: ncol ! number of columns 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 :: iaerosol ! index into bulk aerosol list - character(len=ot_length) :: opticstype ! hygro or nonhygro - - ! optical props for each aerosol - real(r8), pointer :: lw_abs(:) - real(r8), pointer :: lw_hygro_abs(:,:) - real(r8), pointer :: geometric_radius(:,:) - ! volcanic lookup table - real(r8), pointer :: r_lw_abs(:,:) ! radius dependent mass-specific absorption coefficient - real(r8), pointer :: r_mu(:) ! log(geometric_mean_radius) domain samples of r_lw_abs(:,:) - integer :: idx ! index to pbuf for geometric radius - real(r8) :: mu(pcols,pver) ! log(geometric_radius) - real(r8) :: r_mu_min, r_mu_max, wmu, mutrunc - integer :: nmu, kmu - - real(r8) :: tmp(pcols,pver) - - character(len=16) :: pbuf_fld !----------------------------------------------------------------------------- - integer :: lchnk - - ncol = state%ncol - lchnk= state%lchnk ! 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) @@ -321,157 +171,10 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! Contributions from modal and sectional aerosols. if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then call aerosol_optics_cam_lw(list_idx, state, pbuf, odap_aer) - else - odap_aer = 0._r8 end if - tmp(:ncol,:) = odap_aer(:ncol,:,1) - call outfld('AEROD_LW1',odap_aer(:,:,1), pcols, lchnk) - - do i = 1,ncol - do k = 1,pver - tmp(i,k) = sum(odap_aer(i,k,:)) - end do - end do - call outfld('AEROD_LWint',odap_aer(:,:,1), pcols, lchnk) - - do i = 1,nlwbands - call outfld(lw_ta_name(i), odap_aer(1:ncol,1:pver,i), ncol, state%lchnk) - end do - end subroutine aer_rad_props_lw -!============================================================================== -! Private methods -!============================================================================== - -!============================================================================== - -subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ext, r_scat, r_ascat, r_mu, & - tau, tau_w, tau_w_g, tau_w_f) - - - use physics_buffer, only : pbuf_get_field, pbuf_get_index - - ! Arguments - integer, intent(in) :: ncol - real(r8), intent(in) :: mass(pcols, pver) - character(len=*) :: pbuf_radius_name - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(in) :: r_ext(:,:) - real(r8), intent(in) :: r_scat(:,:) - real(r8), intent(in) :: r_ascat(:,:) - real(r8), intent(in) :: r_mu(:) ! log(radius) domain of mass-specific optics - - real(r8), intent(out) :: tau (pcols, pver, nswbands) - real(r8), intent(out) :: tau_w (pcols, pver, nswbands) - real(r8), intent(out) :: tau_w_g(pcols, pver, nswbands) - real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) - - ! Local variables - integer :: iswband - real(r8) :: g - - integer :: idx ! index to radius in physics buffer - real(r8), pointer :: geometric_radius(:,:) ! geometric mean radius of volcanic aerosol - real(r8) :: mu(pcols,pver) ! log(geometric mean radius of volcanic aerosol) - integer :: kmu, nmu - real(r8) :: wmu, mutrunc, r_mu_max, r_mu_min - - ! interpolated values from table - real(r8) :: ext(nswbands) - real(r8) :: scat(nswbands) - real(r8) :: ascat(nswbands) - - integer :: i, k ! column level iterator - !----------------------------------------------------------------------------- - - tau =0._r8 - tau_w =0._r8 - tau_w_g=0._r8 - tau_w_f=0._r8 - - ! get microphysical properties for volcanic aerosols - idx = pbuf_get_index(pbuf_radius_name) - call pbuf_get_field(pbuf, idx, geometric_radius ) - - ! interpolate in radius - ! caution: clip the table with no warning when outside bounds - nmu = size(r_mu) - r_mu_max = r_mu(nmu) - r_mu_min = r_mu(1) - do i = 1, ncol - do k = 1, pver - if(geometric_radius(i,k) > 0._r8) then - mu(i,k) = log(geometric_radius(i,k)) - else - mu(i,k) = 0._r8 - endif - mutrunc = max(min(mu(i,k),r_mu_max),r_mu_min) - kmu = max(min(1 + (mutrunc-r_mu_min)/(r_mu_max-r_mu_min)*(nmu-1),nmu-1._r8),1._r8) - wmu = max(min( (mutrunc -r_mu(kmu)) / (r_mu(kmu+1) - r_mu(kmu)) ,1._r8),0._r8) - do iswband = 1, nswbands - ext(iswband) = & - ((1._r8 - wmu) * r_ext(iswband, kmu ) + & - (wmu) * r_ext(iswband, kmu+1)) - scat(iswband) = & - ((1._r8 - wmu) * r_scat(iswband, kmu ) + & - (wmu) * r_scat(iswband, kmu+1)) - ascat(iswband) = & - ((1._r8 - wmu) * r_ascat(iswband, kmu ) + & - (wmu) * r_ascat(iswband, kmu+1)) - if (scat(iswband).gt.0._r8) then - g = ascat(iswband)/scat(iswband) - else - g=0._r8 - endif - tau (i,k,iswband) = mass(i,k) * ext(iswband) - tau_w (i,k,iswband) = mass(i,k) * scat(iswband) - tau_w_g(i,k,iswband) = mass(i,k) * ascat(iswband) - tau_w_f(i,k,iswband) = mass(i,k) * g * ascat(iswband) - end do - enddo - enddo - -end subroutine get_volcanic_radius_rad_props - -!============================================================================== - -subroutine get_volcanic_rad_props(ncol, mass, ext, scat, ascat, & - tau, tau_w, tau_w_g, tau_w_f) - - ! Arguments - integer, intent(in) :: ncol - real(r8), intent(in) :: mass(pcols, pver) - real(r8), intent(in) :: ext(:) - real(r8), intent(in) :: scat(:) - real(r8), intent(in) :: ascat(:) - - real(r8), intent(out) :: tau (pcols, pver, nswbands) - real(r8), intent(out) :: tau_w (pcols, pver, nswbands) - real(r8), intent(out) :: tau_w_g(pcols, pver, nswbands) - real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) - - ! Local variables - integer :: iswband - real(r8) :: g - !----------------------------------------------------------------------------- - - do iswband = 1, nswbands - if (scat(iswband).gt.0._r8) then - g = ascat(iswband)/scat(iswband) - else - g=0._r8 - endif - tau (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext(iswband) - tau_w (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * scat(iswband) - tau_w_g(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ascat(iswband) - tau_w_f(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * g * ascat(iswband) - enddo - -end subroutine get_volcanic_rad_props - -!============================================================================== !============================================================================== end module aer_rad_props diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 00e68693d9..6361522ed4 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -15,6 +15,7 @@ module aerosol_optics_cam use cam_history, only: addfld, add_default, outfld, horiz_only, fieldname_len use cam_history_support, only: fillvalue + use ref_pres, only: clim_modal_aero_top_lev use tropopause, only : tropopause_findChemTrop use wv_saturation, only: qsat @@ -86,6 +87,8 @@ module aerosol_optics_cam type(out_name), allocatable :: aodbindn_fields(:) type(out_name), allocatable :: aoddustdn_fields(:) + integer :: top_lev = 1 + contains !=============================================================================== @@ -153,12 +156,17 @@ subroutine aerosol_optics_cam_init logical :: history_aero_optics ! output aerosol optics diagnostics logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_dust ! output dust diagnostics + logical :: prog_modal_aero ! prognostic modal aerosols present character(len=cl) :: locfile call phys_getopts(history_amwg_out = history_amwg, & history_aero_optics_out = history_aero_optics, & - history_dust_out = history_dust ) + history_dust_out = history_dust, & + prog_modal_aero_out = prog_modal_aero ) + + ! Limit modal aerosols with top_lev here. + if (prog_modal_aero) top_lev = clim_modal_aero_top_lev num_aero_models = 0 @@ -669,7 +677,6 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, real(r8) :: specdens character(len=32) :: spectype ! species type real(r8), pointer :: specmmr(:,:) - real(r8), pointer :: aerommr(:,:) real(r8) :: hygro_aer ! real(r8) :: scath2o, absh2o, sumscat, sumabs, sumhygro @@ -686,7 +693,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, real(r8) :: ssavis(pcols) integer :: troplev(pcols) - integer :: i, k, bam_cnt + integer :: bam_cnt real(r8), pointer :: geometric_radius(:,:) integer :: idx ! index to pbuf for geometric radius @@ -703,6 +710,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, call tropopause_findChemTrop(state, troplev) mass(:ncol,:) = state%pdeldry(:ncol,:)*rga + mass(:ncol,1:top_lev-1) = 0._r8 air_density(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) aodvis = 0._r8 @@ -1239,7 +1247,6 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) real(r8) :: dopaer(pcols) real(r8) :: mass(pcols,pver) - real(r8), pointer :: aerommr(:,:) character(len=*), parameter :: prefix = 'aerosol_optics_cam_lw: ' From 6bf05724381e930406e8055ccf769727fe3dfec5 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 24 Sep 2025 09:07:49 -0600 Subject: [PATCH 10/23] rename bam diags module renamed: src/physics/cam/bam_optics_diags_mod.F90 -> src/physics/cam/aer_vis_diag_mod.F90 modified: src/physics/cam/aer_rad_props.F90 modified: src/physics/cam/aer_vis_diag_mod.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- src/physics/cam/aer_rad_props.F90 | 6 ++--- ...ics_diags_mod.F90 => aer_vis_diag_mod.F90} | 25 +++++++------------ src/physics/cam/aerosol_optics_cam.F90 | 6 ++--- 3 files changed, 15 insertions(+), 22 deletions(-) rename src/physics/cam/{bam_optics_diags_mod.F90 => aer_vis_diag_mod.F90} (84%) diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 47cec6e018..7decd84d18 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -21,7 +21,7 @@ module aer_rad_props use cam_history_support, only : fillvalue use cam_abortutils, only: endrun -use bam_optics_diags_mod, only: bam_optics_diags_init, bam_optics_diags_out +use aer_vis_diag_mod, only: aer_vis_diag_init, aer_vis_diag_out implicit none private @@ -63,7 +63,7 @@ subroutine aer_rad_props_init() ! number of bulk aerosols in climate list call rad_cnst_get_info(0, naero=numaerosols, nmodes=nmodes, nbins=nbins) - call bam_optics_diags_init() + call aer_vis_diag_init() ! Determine default fields if (history_amwg .or. history_dust .or. history_aero_optics) then @@ -135,7 +135,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & ! diagnostic output of total aerosol optical properties ! currently implemented for climate list only - call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, 0, tau(:,:,idx_sw_diag), list_idx, troplev) + call aer_vis_diag_out(lchnk, ncol, nnite, idxnite, 0, tau(:,:,idx_sw_diag), list_idx, troplev) end subroutine aer_rad_props_sw diff --git a/src/physics/cam/bam_optics_diags_mod.F90 b/src/physics/cam/aer_vis_diag_mod.F90 similarity index 84% rename from src/physics/cam/bam_optics_diags_mod.F90 rename to src/physics/cam/aer_vis_diag_mod.F90 index 8f5557d70e..9235f70144 100644 --- a/src/physics/cam/bam_optics_diags_mod.F90 +++ b/src/physics/cam/aer_vis_diag_mod.F90 @@ -1,4 +1,4 @@ -module bam_optics_diags_mod +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 use cam_history_support, only : fillvalue @@ -9,18 +9,16 @@ module bam_optics_diags_mod implicit none private - public :: bam_optics_diags_active - public :: bam_optics_diags_init - public :: bam_optics_diags_out + public :: aer_vis_diag_init + public :: aer_vis_diag_out integer :: numaerosols=0 character(len=fieldname_len), pointer :: odv_names(:) ! outfld names for visible OD - logical :: bam_optics_diags_active = .false. contains !============================================================================== - subroutine bam_optics_diags_init() + subroutine aer_vis_diag_init() integer :: i character(len=64), allocatable :: aernames(:) @@ -29,9 +27,7 @@ subroutine bam_optics_diags_init() ! number of bulk aerosols in climate list call rad_cnst_get_info(0, naero=numaerosols) - bam_optics_diags_active = numaerosols>0 - - if (.not.bam_optics_diags_active) return + if (numaerosols<1) return ! get names of bulk aerosols allocate(aernames(numaerosols)) @@ -49,11 +45,10 @@ subroutine bam_optics_diags_init() call add_default(odv_names(i), 1, ' ') end do - end subroutine bam_optics_diags_init - + end subroutine aer_vis_diag_init !============================================================================== - subroutine bam_optics_diags_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, troplev) + subroutine aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, troplev) ! output aerosol optical depth for the visible band @@ -72,8 +67,6 @@ subroutine bam_optics_diags_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx real(r8) :: tmp(pcols), tmp2(pcols) !----------------------------------------------------------------------------- -! if (.not.bam_optics_diags_active) return - ! currently only implemented for climate calc if (diag_idx > 0) return @@ -94,8 +87,8 @@ subroutine bam_optics_diags_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx call outfld('AODvstrt', tmp2, pcols, lchnk) end if - end subroutine bam_optics_diags_out + end subroutine aer_vis_diag_out !============================================================================== -end module bam_optics_diags_mod +end module aer_vis_diag_mod diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 6361522ed4..d9318eee04 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -38,7 +38,7 @@ module aerosol_optics_cam use insoluble_aerosol_optics_mod, only: insoluble_aerosol_optics use volcrad_aerosol_optics_mod, only: volcrad_aerosol_optics - use bam_optics_diags_mod, only: bam_optics_diags_active, bam_optics_diags_out + use aer_vis_diag_mod, only: aer_vis_diag_out implicit none @@ -871,7 +871,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, end do column - if (bam_optics_diags_active.and.iwav==idx_sw_diag) then + if (aeroprops%is_bulk().and.iwav==idx_sw_diag) then taubam(:ncol,ilev) = dopaer(:ncol) end if @@ -888,7 +888,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, if (aeroprops%is_bulk()) then bam_cnt = bam_cnt+1 - call bam_optics_diags_out(lchnk, ncol, nnite, idxnite, bam_cnt, taubam, & + call aer_vis_diag_out(lchnk, ncol, nnite, idxnite, bam_cnt, taubam, & list_idx, troplev) else call output_bin_diags() From 19018cc77f723ef1d58d628793f74faa0a07f760 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 24 Sep 2025 10:07:46 -0600 Subject: [PATCH 11/23] add BAM debug diags modified: src/physics/cam/aer_rad_props.F90 --- src/physics/cam/aer_rad_props.F90 | 67 +++++++++++++++++++++++++++++-- 1 file changed, 64 insertions(+), 3 deletions(-) diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 7decd84d18..435c94f7b1 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -32,6 +32,15 @@ module aer_rad_props aer_rad_props_sw, & ! return SW optical props of aerosols aer_rad_props_lw ! return LW optical props of aerosols +! debug diags +character(len=32) :: sw_ta_name(nswbands) +character(len=32) :: sw_wa_name(nswbands) +character(len=32) :: sw_ga_name(nswbands) +character(len=32) :: sw_fa_name(nswbands) +character(len=32) :: lw_ta_name(nlwbands) + +logical :: bam_debug = .false. + !============================================================================== contains !============================================================================== @@ -46,6 +55,8 @@ subroutine aer_rad_props_init() integer :: nmodes ! number of aerosol modes integer :: nbins ! number of aerosol bins + character(len=2) :: numch + integer :: i !---------------------------------------------------------------------------- call phys_getopts( history_aero_optics_out = history_aero_optics, & @@ -72,6 +83,38 @@ subroutine aer_rad_props_init() if (numaerosols>0 .or. nmodes>0 .or. nbins>0) then call aerosol_optics_cam_init() + endif + + bam_debug = numaerosols>0 .and. history_aero_optics + + ! for BAM debugging + if (bam_debug) then + call add_default ('AEROD_v', 2, ' ') + call add_default ('AODvstrt', 2, ' ') + + ! debug diags + do i = 1,nswbands + write(numch,'(I2.2)') i + sw_ta_name(i) = 'TASW'//numch + sw_wa_name(i) = 'WASW'//numch + sw_ga_name(i) = 'GASW'//numch + sw_fa_name(i) = 'FASW'//numch + call addfld(sw_ta_name(i), (/'lev'/), 'A',' ', 'SW TAU for wave band '//numch, flag_xyfill=.true.) + call addfld(sw_wa_name(i), (/'lev'/), 'A',' ', 'SW WA for wave band '//numch, flag_xyfill=.true.) + call addfld(sw_ga_name(i), (/'lev'/), 'A',' ', 'SW GA for wave band '//numch, flag_xyfill=.true.) + call addfld(sw_fa_name(i), (/'lev'/), 'A',' ', 'SW FA for wave band '//numch, flag_xyfill=.true.) + call add_default (sw_ta_name(i), 2, ' ') + call add_default (sw_wa_name(i), 2, ' ') + call add_default (sw_ga_name(i), 2, ' ') + call add_default (sw_fa_name(i), 2, ' ') + end do + do i = 1,nlwbands + write(numch,'(I2.2)') i + lw_ta_name(i) = 'TALW'//numch + call addfld(lw_ta_name(i), (/'lev'/), 'A',' ', 'LW TAU for wave band '//numch, flag_xyfill=.true.) + call add_default (lw_ta_name(i), 2, ' ') + end do + end if end subroutine aer_rad_props_init @@ -106,7 +149,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & 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 = state%ncol @@ -137,6 +180,16 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & ! currently implemented for climate list only call aer_vis_diag_out(lchnk, ncol, nnite, idxnite, 0, tau(:,:,idx_sw_diag), list_idx, troplev) + ! debug diags + if (bam_debug) then + do i = 1,nswbands + call outfld(sw_ta_name(i), tau(1:ncol,1:pver,i), ncol, lchnk ) + call outfld(sw_wa_name(i), tau_w(1:ncol,1:pver,i), ncol, lchnk ) + call outfld(sw_ga_name(i), tau_w_g(1:ncol,1:pver,i), ncol, lchnk ) + call outfld(sw_fa_name(i), tau_w_f(1:ncol,1:pver,i), ncol, lchnk ) + end do + end if + end subroutine aer_rad_props_sw !============================================================================== @@ -144,7 +197,7 @@ end subroutine aer_rad_props_sw subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! Purpose: Compute aerosol transmissions needed in absorptivity/ - ! emissivity calculations + ! emissivity calculations use physics_buffer, only : physics_buffer_desc @@ -160,7 +213,7 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) 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 @@ -173,6 +226,14 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) call aerosol_optics_cam_lw(list_idx, state, pbuf, odap_aer) end if + ! debug diags + if (bam_debug) then + ncol = state%ncol + do i = 1,nlwbands + call outfld(lw_ta_name(i), odap_aer(1:ncol,1:pver,i), ncol, state%lchnk) + end do + end if + end subroutine aer_rad_props_lw !============================================================================== From 499f920aa844db2868f05126d1fa3d630c4f43fc Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 25 Sep 2025 11:53:15 -0600 Subject: [PATCH 12/23] top level correction modified: src/physics/cam/aerosol_optics_cam.F90 --- src/physics/cam/aerosol_optics_cam.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index d9318eee04..388cc5a5c6 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -166,7 +166,11 @@ subroutine aerosol_optics_cam_init prog_modal_aero_out = prog_modal_aero ) ! Limit modal aerosols with top_lev here. - if (prog_modal_aero) top_lev = clim_modal_aero_top_lev + if (prog_modal_aero) then + top_lev = clim_modal_aero_top_lev + else + top_lev = 1 + endif num_aero_models = 0 @@ -710,7 +714,6 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, call tropopause_findChemTrop(state, troplev) mass(:ncol,:) = state%pdeldry(:ncol,:)*rga - mass(:ncol,1:top_lev-1) = 0._r8 air_density(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) aodvis = 0._r8 @@ -720,6 +723,9 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, absorb = 0._r8 aodtot = 0._r8 tauxar = 0._r8 + wa = 0._r8 + ga = 0._r8 + fa = 0._r8 extinct = 0._r8 extinctnir = 0._r8 extinctuv = 0._r8 @@ -852,7 +858,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, wavelength: do iwav = 1, nswbands - vertical: do ilev = 1, pver + vertical: do ilev = top_lev, pver call aero_optics%sw_props(ncol, ilev, iwav, pext, pabs, palb, pasm ) From 5c640c9e386f694c89a5a2ec36deff46a3d3b0b1 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 25 Sep 2025 13:03:49 -0600 Subject: [PATCH 13/23] add comments and misc cleanup modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 modified: src/physics/cam/aer_vis_diag_mod.F90 --- .../aerosol/bulk_aerosol_properties_mod.F90 | 5 --- .../aerosol/hygro_aerosol_optics_mod.F90 | 4 +++ .../hygrocoreshell_aerosol_optics_mod.F90 | 2 +- .../hygroscopic_aerosol_optics_mod.F90 | 3 ++ .../aerosol/insoluble_aerosol_optics_mod.F90 | 3 ++ .../aerosol/volcrad_aerosol_optics_mod.F90 | 32 +++++++++++-------- src/physics/cam/aer_vis_diag_mod.F90 | 3 ++ 7 files changed, 32 insertions(+), 20 deletions(-) diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index f4389b291a..f78ea5f0cb 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -17,9 +17,6 @@ module bulk_aerosol_properties_mod private - ! integer :: num_aerosols = 0 - ! character(len=64), allocatable :: aernames(:) - contains procedure :: number_transported @@ -114,8 +111,6 @@ end function constructor subroutine destructor(self) type(bulk_aerosol_properties), intent(inout) :: self -! deallocate(self%aernames) - end subroutine destructor diff --git a/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 index 9188427db0..38b3da8927 100644 --- a/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 @@ -1,3 +1,7 @@ +!------------------------------------------------------------------------------- +! Short-wave hygroscopic aerosol, Long-wave non-hygroscopic +! aerosol optical properties +!------------------------------------------------------------------------------- module hygro_aerosol_optics_mod use shr_kind_mod, only: r8 => shr_kind_r8 diff --git a/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 index 6443d3cc7e..3e78f5a8c9 100644 --- a/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 @@ -204,7 +204,7 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor - integer :: icol + integer :: icol type(table_interp_wghts) :: rhwghts(ncol) type(table_interp_wghts) :: cfwghts(ncol) diff --git a/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 index a0d706c644..3fa1d01f0e 100644 --- a/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 @@ -1,3 +1,6 @@ +!------------------------------------------------------------------------------- +! Short-wave and long-wave hygroscopic aerosol properties +!------------------------------------------------------------------------------- module hygroscopic_aerosol_optics_mod use shr_kind_mod, only: r8 => shr_kind_r8 diff --git a/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 index ab73ca38c3..5fd7b1c2ba 100644 --- a/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 @@ -1,3 +1,6 @@ +!------------------------------------------------------------------------------- +! Insoluble (non-hygrostatic) aerosol optical properties +!------------------------------------------------------------------------------- module insoluble_aerosol_optics_mod use shr_kind_mod, only: r8 => shr_kind_r8 diff --git a/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 b/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 index 4a568168b9..45227dd363 100644 --- a/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 @@ -1,3 +1,7 @@ +!------------------------------------------------------------------------------- +! Geometric mean radius parameterized optical properties for volcanic +! stratospheric aerosols +!------------------------------------------------------------------------------- module volcrad_aerosol_optics_mod use shr_kind_mod, only: r8 => shr_kind_r8 @@ -93,24 +97,24 @@ function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, geometri r_mu_max = newobj%r_mu(nmu) r_mu_min = newobj%r_mu(1) - do i = 1, ncols - do k = 1, nlevs - if(geometric_radius(i,k) > 0._r8) then - mu = log(geometric_radius(i,k)) - else - mu = 0._r8 - endif + do i = 1, ncols + do k = 1, nlevs + if(geometric_radius(i,k) > 0._r8) then + mu = log(geometric_radius(i,k)) + else + mu = 0._r8 + endif - ASSOCIATE ( kmu=>newobj%kmu(i,k), wmu=>newobj%wmu(i,k), r_mu=>newobj%r_mu ) + ASSOCIATE ( kmu=>newobj%kmu(i,k), wmu=>newobj%wmu(i,k), r_mu=>newobj%r_mu ) - mutrunc = max(min(mu,r_mu_max),r_mu_min) - kmu = max(min(1 + (mutrunc-r_mu_min)/(r_mu_max-r_mu_min)*(nmu-1),nmu-1._r8),1._r8) - wmu = max(min( (mutrunc -r_mu(kmu)) / (r_mu(kmu+1) - r_mu(kmu)) ,1._r8),0._r8) + mutrunc = max(min(mu,r_mu_max),r_mu_min) + kmu = max(min(1 + (mutrunc-r_mu_min)/(r_mu_max-r_mu_min)*(nmu-1),nmu-1._r8),1._r8) + wmu = max(min( (mutrunc -r_mu(kmu)) / (r_mu(kmu+1) - r_mu(kmu)) ,1._r8),0._r8) - END ASSOCIATE + END ASSOCIATE - end do - end do + end do + end do end function constructor diff --git a/src/physics/cam/aer_vis_diag_mod.F90 b/src/physics/cam/aer_vis_diag_mod.F90 index 9235f70144..7b84a0ea32 100644 --- a/src/physics/cam/aer_vis_diag_mod.F90 +++ b/src/physics/cam/aer_vis_diag_mod.F90 @@ -1,3 +1,6 @@ +!------------------------------------------------------------------------------- +! output aerosol optical depths for the visible band +!------------------------------------------------------------------------------- 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 From 95d14d465fb0bf49c6ef9f2c0d72e08a8ae9c815 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 7 Oct 2025 11:31:40 -0600 Subject: [PATCH 14/23] add comments, implement suluble / hydrophilic methods modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 --- .../aerosol/bulk_aerosol_properties_mod.F90 | 62 +++++++++++++------ 1 file changed, 44 insertions(+), 18 deletions(-) diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index f78ea5f0cb..dacf3f8d23 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -1,3 +1,7 @@ +!-------------------------------------------------------------------------------- +! For bulk aerosol representation. +! Here each aerosol is treated as a separate bin. +!-------------------------------------------------------------------------------- module bulk_aerosol_properties_mod use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun @@ -6,6 +10,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 infnan, only: nan, assignment(=) implicit none @@ -74,6 +79,7 @@ function constructor() result(newobj) call rad_cnst_get_info(0, naero=naero) + ! Here treat each aerosol as a separate bin allocate( nspecies(naero),stat=ierr ) if( ierr /= 0 ) then nullify(newobj) @@ -90,19 +96,26 @@ function constructor() result(newobj) return end if + ! 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) f1(:) = 1._r8 - call newobj%initialize(naero, naero, nspecies, nspecies, alogsig, f1, f1, ierr) + ! 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) + + deallocate(nspecies) + deallocate(alogsig) + deallocate(f1) + if( ierr /= 0 ) then nullify(newobj) return end if - deallocate(nspecies) - deallocate(alogsig) - deallocate(f1) end function constructor @@ -113,7 +126,6 @@ subroutine destructor(self) end subroutine destructor - !------------------------------------------------------------------------------ ! returns number of transported aerosol constituents !------------------------------------------------------------------------------ @@ -381,7 +393,6 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as end subroutine optics_params - !------------------------------------------------------------------------------ ! returns radius^3 (m3) of a given bin number !------------------------------------------------------------------------------ @@ -392,8 +403,7 @@ pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) real(r8), intent(in) :: volconc ! volume conc (m3/m3) real(r8), intent(in) :: numconc ! number conc (1/m3) - ! call endrun('ERROR: bulk_aerosol_properties_mod%amcube not yet implemented') - amcube = -huge(1._r8) + amcube = nan ! to be implemented later if needed end function amcube @@ -409,6 +419,7 @@ subroutine actfracs(self, bin_ndx, smc, smax, fn, fm ) real(r8),intent(out) :: fn ! activation fraction for aerosol number real(r8),intent(out) :: fm ! activation fraction for aerosol mass + ! to be implemented later if needed call endrun('ERROR: bulk_aerosol_properties_mod%actfracs not yet implemented') end subroutine actfracs @@ -422,11 +433,11 @@ 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 + ! to be implemented later if needed call endrun('ERROR: bulk_aerosol_properties_mod%num_names not yet implemented') end subroutine num_names - !------------------------------------------------------------------------ ! returns constituents names of aerosol mass mixing ratios !------------------------------------------------------------------------ @@ -437,6 +448,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 + ! to be implemented later if needed call endrun('ERROR: bulk_aerosol_properties_mod%mmr_names not yet implemented') end subroutine mmr_names @@ -449,6 +461,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 + ! to be implemented later if needed call endrun('ERROR: bulk_aerosol_properties_mod%amb_num_name not yet implemented') end subroutine amb_num_name @@ -462,6 +475,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 + ! to be implemented later if needed call endrun('ERROR: bulk_aerosol_properties_mod%amb_mmr_name not yet implemented') end subroutine amb_mmr_name @@ -471,11 +485,11 @@ end subroutine amb_mmr_name !------------------------------------------------------------------------ subroutine species_type(self, bin_ndx, species_ndx, spectype) class(bulk_aerosol_properties), intent(in) :: self - integer, intent(in) :: bin_ndx ! bin number - integer, intent(in) :: species_ndx ! species number + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number character(len=*), intent(out) :: spectype ! species type - call endrun('ERROR: bulk_aerosol_properties_mod%species_type not yet implemented') + call self%get(bin_ndx, species_ndx, spectype=spectype) end subroutine species_type @@ -487,6 +501,7 @@ function icenuc_updates_num(self, bin_ndx) result(res) integer, intent(in) :: bin_ndx ! bin number logical :: res + ! to be implemented later if needed res = .false. end function icenuc_updates_num @@ -500,6 +515,7 @@ function icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) integer, intent(in) :: species_ndx ! species number logical :: res + ! to be implemented later if needed res = .false. end function icenuc_updates_mmr @@ -529,6 +545,7 @@ function hetfrz_species(self, bin_ndx, spc_ndx) result(res) logical :: res + ! to be implemented later if needed res = .false. end function hetfrz_species @@ -539,10 +556,17 @@ logical function soluble(self,bin_ndx) class(bulk_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number - soluble=.false. + character(len=20) :: aername + logical :: primary_carbon ! primary carbons (CB1 and OC1) are hydrophobic - end function soluble + call rad_cnst_get_aer_props(0, bin_ndx, aername=aername) + + aername = to_lower(aername) + primary_carbon = (aername=='bcpho') .or. (aername=='ocpho') + soluble = .not. primary_carbon + + end function soluble !------------------------------------------------------------------------------ ! returns minimum mass mean radius (meters) @@ -596,7 +620,8 @@ function alogsig_rlist(self, list_ndx, bin_ndx) result(res) real(r8) :: res - res = -huge(1._r8) + ! to be implemented later if needed + res = nan end function alogsig_rlist @@ -635,7 +660,7 @@ function scav_diam(self, bin_ndx) result(diam) real(r8) :: diam - diam = -huge(1._r8) + diam = nan ! to be implemented later if needed end function scav_diam @@ -648,7 +673,7 @@ subroutine resuspension_resize(self, dcondt) class(bulk_aerosol_properties), intent(in) :: self real(r8), intent(inout) :: dcondt(:) - dcondt = -huge(1._r8) + dcondt = nan ! to be implemented later if needed end subroutine resuspension_resize @@ -667,6 +692,7 @@ subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxe integer, intent(out) :: error_code ! error code (0 if no error) character(len=*), intent(out) :: error_string ! error string + ! to be implemented later if needed call endrun('ERROR: bulk_aerosol_properties_mod%rebin_bulk_fluxes not yet implemented') end subroutine rebin_bulk_fluxes @@ -678,7 +704,7 @@ logical function hydrophilic(self, bin_ndx) class(bulk_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number - call endrun('ERROR: bulk_aerosol_properties_mod%hydrophilic not yet implemented') + hydrophilic = self%soluble(bin_ndx) end function hydrophilic From 15752c5a2add5f309c8df131fb00b5fe28cf3fe3 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 7 Oct 2025 17:13:47 -0600 Subject: [PATCH 15/23] change nonhygro to insoluble, add comments modified: src/chemistry/aerosol/aerosol_properties_mod.F90 modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/carma_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_properties_mod.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/aerosol_properties_mod.F90 | 22 +++++------ .../aerosol/bulk_aerosol_properties_mod.F90 | 28 +++++++------- .../aerosol/carma_aerosol_properties_mod.F90 | 38 +++++++++---------- .../aerosol/hygro_aerosol_optics_mod.F90 | 4 +- .../aerosol/insoluble_aerosol_optics_mod.F90 | 10 ++--- .../aerosol/modal_aerosol_properties_mod.F90 | 38 +++++++++---------- src/physics/cam/aerosol_optics_cam.F90 | 5 ++- 7 files changed, 74 insertions(+), 71 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index 387f655a31..127a8758dc 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -127,7 +127,7 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps 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_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_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 @@ -174,16 +174,16 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps integer, optional, intent(out) :: nrelh ! relative humidity dimension size ! hygroscopic - real(r8), optional, pointer :: sw_hygroscopic_ext(:,:) - real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) - real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) - real(r8), optional, pointer :: lw_hygroscopic_ext(:,:) - - ! non-hygroscopic - 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 :: lw_nonhygro_ext(:) + 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(:,:) diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index dacf3f8d23..d6a7eef6e7 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -222,7 +222,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_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 ) @@ -268,16 +268,16 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as integer, optional, intent(out) :: nrelh ! relative humidity dimension size ! hygroscopic - real(r8), optional, pointer :: sw_hygroscopic_ext(:,:) - real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) - real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) - real(r8), optional, pointer :: lw_hygroscopic_ext(:,:) + 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 - 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 :: lw_nonhygro_ext(:) + ! 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(:,:) @@ -293,10 +293,10 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as sw_hygro_ssa=sw_hygroscopic_ssa, & sw_hygro_asm=sw_hygroscopic_asm, & lw_hygro_ext=lw_hygroscopic_ext, & - sw_nonhygro_ext=sw_nonhygro_ext, & - sw_nonhygro_ssa=sw_nonhygro_ssa, & - sw_nonhygro_asm=sw_nonhygro_asm, & - lw_ext=lw_nonhygro_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 ) diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index 7980039313..1f0c4d9287 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -320,7 +320,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext, & + sw_insoluble_ext, sw_insoluble_ssa, sw_insoluble_asm, lw_insoluble_ext, & r_sw_ext, r_sw_scat, r_sw_ascat, r_mu, r_lw_abs ) class(carma_aerosol_properties), intent(in) :: self @@ -365,16 +365,16 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as integer, optional, intent(out) :: nrelh ! relative humidity dimension size ! hygroscopic - real(r8), optional, pointer :: sw_hygroscopic_ext(:,:) - real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) - real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) - real(r8), optional, pointer :: lw_hygroscopic_ext(:,:) + 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 - 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 :: lw_nonhygro_ext(:) + ! 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(:,:) @@ -453,18 +453,18 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as nullify(lw_hygroscopic_ext) end if - ! non-hygroscopic - if (present(sw_nonhygro_ext)) then - nullify(sw_nonhygro_ext) + ! non-hygroscopic (insoluble) + if (present(sw_insoluble_ext)) then + nullify(sw_insoluble_ext) end if - if (present(sw_nonhygro_ssa)) then - nullify(sw_nonhygro_ssa) + if (present(sw_insoluble_ssa)) then + nullify(sw_insoluble_ssa) end if - if (present(sw_nonhygro_asm)) then - nullify(sw_nonhygro_asm) + if (present(sw_insoluble_asm)) then + nullify(sw_insoluble_asm) end if - if (present(lw_nonhygro_ext)) then - nullify(lw_nonhygro_ext) + if (present(lw_insoluble_ext)) then + nullify(lw_insoluble_ext) end if ! volcanic radius diff --git a/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 index 38b3da8927..d6bf3d4c4e 100644 --- a/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 @@ -1,5 +1,5 @@ !------------------------------------------------------------------------------- -! Short-wave hygroscopic aerosol, Long-wave non-hygroscopic +! Short-wave hygroscopic aerosol, Long-wave non-hygroscopic (insoluble) ! aerosol optical properties !------------------------------------------------------------------------------- module hygro_aerosol_optics_mod @@ -89,7 +89,7 @@ function constructor(aero_props, aero_state, ilist, ibin, ncols, nlevs, numrh, r sw_hygroscopic_ext=newobj%ext_sw, & sw_hygroscopic_ssa=newobj%ssa_sw, & sw_hygroscopic_asm=newobj%asm_sw, & - lw_nonhygro_ext=newobj%abs_lw ) + lw_insoluble_ext=newobj%abs_lw ) call aero_state%get_ambient_mmr(ilist, species_ndx=1, bin_ndx=ibin, mmr=newobj%mmr) diff --git a/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 index 5fd7b1c2ba..ac7475dc33 100644 --- a/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 @@ -1,5 +1,5 @@ !------------------------------------------------------------------------------- -! Insoluble (non-hygrostatic) aerosol optical properties +! Insoluble (non-hygroscopic) aerosol optical properties !------------------------------------------------------------------------------- module insoluble_aerosol_optics_mod use shr_kind_mod, only: r8 => shr_kind_r8 @@ -59,10 +59,10 @@ function constructor(aero_props, aero_state, ilist, ibin) result(newobj) ! get mode properties call aero_props%optics_params(ilist, ibin, & - sw_nonhygro_ext=newobj%sw_ext, & - sw_nonhygro_ssa=newobj%sw_ssa, & - sw_nonhygro_asm=newobj%sw_asm, & - lw_nonhygro_ext=newobj%lw_abs ) + 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) diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index e142b211d0..5a92b8df5a 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -400,7 +400,7 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as 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_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, lw_nonhygro_ext, & + sw_insoluble_ext, sw_insoluble_ssa, sw_insoluble_asm, lw_insoluble_ext, & r_sw_ext, r_sw_scat, r_sw_ascat, r_mu, r_lw_abs ) class(modal_aerosol_properties), intent(in) :: self @@ -445,16 +445,16 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as integer, optional, intent(out) :: nrelh ! relative humidity dimension size ! hygroscopic - real(r8), optional, pointer :: sw_hygroscopic_ext(:,:) - real(r8), optional, pointer :: sw_hygroscopic_ssa(:,:) - real(r8), optional, pointer :: sw_hygroscopic_asm(:,:) - real(r8), optional, pointer :: lw_hygroscopic_ext(:,:) + 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 - 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 :: lw_nonhygro_ext(:) + ! 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(:,:) @@ -550,18 +550,18 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as nullify(lw_hygroscopic_ext) end if - ! non-hygroscopic - if (present(sw_nonhygro_ext)) then - nullify(sw_nonhygro_ext) + ! non-hygroscopic (insoluble) + if (present(sw_insoluble_ext)) then + nullify(sw_insoluble_ext) end if - if (present(sw_nonhygro_ssa)) then - nullify(sw_nonhygro_ssa) + if (present(sw_insoluble_ssa)) then + nullify(sw_insoluble_ssa) end if - if (present(sw_nonhygro_asm)) then - nullify(sw_nonhygro_asm) + if (present(sw_insoluble_asm)) then + nullify(sw_insoluble_asm) end if - if (present(lw_nonhygro_ext)) then - nullify(lw_nonhygro_ext) + if (present(lw_insoluble_ext)) then + nullify(lw_insoluble_ext) end if ! volcanic radius diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 388cc5a5c6..1c5b7b201f 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -826,9 +826,12 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & 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, & - ibin, ncol, pver, numrh, relh(:ncol,:)) + 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,:)) From 1ecd44f7b03c78d980747dff2f202d47b638a7b5 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 3 Dec 2025 05:44:15 -0700 Subject: [PATCH 16/23] check history fields active before intergrating AOD, check allocate status modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 modified: src/physics/cam/aer_vis_diag_mod.F90 --- .../aerosol/bulk_aerosol_properties_mod.F90 | 5 +- src/physics/cam/aer_vis_diag_mod.F90 | 46 +++++++++++++------ 2 files changed, 35 insertions(+), 16 deletions(-) diff --git a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 index d6a7eef6e7..c5f6304b20 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -635,12 +635,13 @@ function bin_name(self, list_ndx, bin_ndx) result(name) character(len=aero_name_len) :: name character(len=64), allocatable :: names(:) - integer :: naer + integer :: naer, astat call rad_cnst_get_info(list_ndx, naero=naer) - allocate( names(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) diff --git a/src/physics/cam/aer_vis_diag_mod.F90 b/src/physics/cam/aer_vis_diag_mod.F90 index 7b84a0ea32..da96377864 100644 --- a/src/physics/cam/aer_vis_diag_mod.F90 +++ b/src/physics/cam/aer_vis_diag_mod.F90 @@ -3,11 +3,12 @@ !------------------------------------------------------------------------------- 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 + 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 ppgrid, only: pcols, pver use phys_control, only: phys_getopts + use cam_abortutils, only: endrun implicit none @@ -23,7 +24,7 @@ module aer_vis_diag_mod !============================================================================== subroutine aer_vis_diag_init() - integer :: i + integer :: i, astat character(len=64), allocatable :: aernames(:) logical :: history_aero_optics ! Output aerosol optics diagnostics @@ -33,14 +34,18 @@ subroutine aer_vis_diag_init() if (numaerosols<1) return ! get names of bulk aerosols - allocate(aernames(numaerosols)) + 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) call phys_getopts( history_aero_optics_out = history_aero_optics ) ! diagnostic output for bulk aerosols ! create outfld names for visible OD - allocate(odv_names(numaerosols)) + allocate(odv_names(numaerosols),stat=astat) + if( astat/= 0 ) call endrun('aer_vis_diag_init: odv_names allocate error') + do i = 1, numaerosols odv_names(i) = 'ODV_'//trim(aernames(i)) call addfld (odv_names(i), horiz_only, 'A', '1', & @@ -68,26 +73,39 @@ subroutine aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, tr ! Local variables integer :: i real(r8) :: tmp(pcols), tmp2(pcols) + logical :: do_calc !----------------------------------------------------------------------------- ! currently only implemented for climate calc if (diag_idx > 0) return - ! compute total column aerosol optical depth - tmp(1:ncol) = sum(tau(1:ncol,:), 2) - ! use fillvalue to indicate night columns - do i = 1, nnite - tmp(idxnite(i)) = fillvalue - end do + do_calc = .false. + if (iaer > 0) then + do_calc = hist_fld_active(odv_names(iaer)) + else + do_calc = hist_fld_active('AEROD_v') + end if + + if (do_calc) then + ! compute total column aerosol optical depth + tmp(1:ncol) = sum(tau(1:ncol,:), 2) + ! use fillvalue to indicate night columns + do i = 1, nnite + tmp(idxnite(i)) = fillvalue + end do + end if if (iaer > 0) then call outfld(odv_names(iaer), tmp, pcols, lchnk) else call outfld('AEROD_v', tmp, pcols, lchnk) - do i = 1, ncol - tmp2(i) = sum(tau(i,:troplev(i))) - end do - call outfld('AODvstrt', tmp2, pcols, lchnk) + + if (hist_fld_active('AODvstrt')) then + do i = 1, ncol + tmp2(i) = sum(tau(i,:troplev(i))) + end do + call outfld('AODvstrt', tmp2, pcols, lchnk) + end if end if end subroutine aer_vis_diag_out From 4f75309e2b3308eba6df5add20445e10cc6893f0 Mon Sep 17 00:00:00 2001 From: Steve Goldhaber Date: Wed, 3 Dec 2025 18:25:14 +0100 Subject: [PATCH 17/23] Use aerosol_is instead of is_bulk --- .../aerosol/aerosol_properties_mod.F90 | 20 ++++++++++++++----- .../aerosol/bulk_aerosol_properties_mod.F90 | 15 ++++++++++---- src/physics/cam/aerosol_optics_cam.F90 | 6 +++--- 3 files changed, 29 insertions(+), 12 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index 127a8758dc..6c6133dfc5 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -74,7 +74,7 @@ module aerosol_properties_mod procedure(aero_resuspension_resize), deferred :: resuspension_resize procedure(aero_rebin_bulk_fluxes), deferred :: rebin_bulk_fluxes procedure(aero_hydrophilic), deferred :: hydrophilic - procedure :: is_bulk + procedure(aero_id_query) :: aerosol_is procedure :: final=>aero_props_final end type aerosol_properties @@ -457,6 +457,15 @@ logical function aero_hydrophilic(self, bin_ndx) integer, intent(in) :: bin_ndx ! bin number end function aero_hydrophilic + !------------------------------------------------------------------------------ + ! Returns TRUE if the aerosol model matches the query, otherwise FALSE + !------------------------------------------------------------------------------ + logical function aero_id_query(self, query) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query + end function aero_id_query + end interface contains @@ -734,13 +743,14 @@ pure real(r8) function pom_equivso4_factor(self) end function pom_equivso4_factor !------------------------------------------------------------------------------ - ! returns TRUE if bulk aerosol representation + ! returns TRUE if aerosol model matches query !------------------------------------------------------------------------------ - pure logical function is_bulk(self) + pure logical function aerosol_is(self, query) class(aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query - is_bulk = .false. + aerosol_is = .false. - end function is_bulk + end function aerosol_is 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 c5f6304b20..2994719894 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -48,7 +48,7 @@ module bulk_aerosol_properties_mod procedure :: resuspension_resize procedure :: rebin_bulk_fluxes procedure :: hydrophilic - procedure :: is_bulk + procedure :: aerosol_is final :: destructor @@ -712,11 +712,18 @@ end function hydrophilic !------------------------------------------------------------------------------ ! returns TRUE if bulk aerosol representation !------------------------------------------------------------------------------ - pure logical function is_bulk(self) + pure logical function aerosol_is(self, query) class(bulk_aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query - is_bulk = .true. + if (trim(query) == 'BAM') then + aerosol_is = .true. + else if (trim(query) == 'bulk_model') then + aerosol_is = .true. + else + aerosol_is = .false. + end if - end function is_bulk + end function aerosol_is end module bulk_aerosol_properties_mod diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 1c5b7b201f..b701b908de 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -874,13 +874,13 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, ga(icol,ilev,iwav) = ga(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol) fa(icol,ilev,iwav) = fa(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol)*pasm(icol) - if (.not.aeroprops%is_bulk()) then + if (.not.aeroprops%model_is('BAM')) then call update_diags() end if end do column - if (aeroprops%is_bulk().and.iwav==idx_sw_diag) then + if (aeroprops%model_is('BAM').and.iwav==idx_sw_diag) then taubam(:ncol,ilev) = dopaer(:ncol) end if @@ -895,7 +895,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, deallocate(aero_optics) nullify(aero_optics) - if (aeroprops%is_bulk()) then + if (aeroprops%model_is('BAM')) then bam_cnt = bam_cnt+1 call aer_vis_diag_out(lchnk, ncol, nnite, idxnite, bam_cnt, taubam, & list_idx, troplev) From 376823ffb260bf8846b45f31d30a5118e3412d8f Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 4 Dec 2025 15:58:10 -0700 Subject: [PATCH 18/23] fix the model_is method modified: src/chemistry/aerosol/aerosol_properties_mod.F90 modified: src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/carma_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_properties_mod.F90 --- .../aerosol/aerosol_properties_mod.F90 | 13 +------------ .../aerosol/bulk_aerosol_properties_mod.F90 | 14 +++++++------- .../aerosol/carma_aerosol_properties_mod.F90 | 16 ++++++++++++++++ .../aerosol/modal_aerosol_properties_mod.F90 | 18 ++++++++++++++++++ 4 files changed, 42 insertions(+), 19 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index 6c6133dfc5..b2bc986fba 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -74,7 +74,7 @@ module aerosol_properties_mod procedure(aero_resuspension_resize), deferred :: resuspension_resize procedure(aero_rebin_bulk_fluxes), deferred :: rebin_bulk_fluxes procedure(aero_hydrophilic), deferred :: hydrophilic - procedure(aero_id_query) :: aerosol_is + procedure(aero_id_query), deferred :: model_is procedure :: final=>aero_props_final end type aerosol_properties @@ -742,15 +742,4 @@ pure real(r8) function pom_equivso4_factor(self) end function pom_equivso4_factor - !------------------------------------------------------------------------------ - ! returns TRUE if aerosol model matches query - !------------------------------------------------------------------------------ - pure logical function aerosol_is(self, query) - class(aerosol_properties), intent(in) :: self - character(len=*), intent(in) :: query - - aerosol_is = .false. - - end function aerosol_is - 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 2994719894..3033851289 100644 --- a/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -48,7 +48,7 @@ module bulk_aerosol_properties_mod procedure :: resuspension_resize procedure :: rebin_bulk_fluxes procedure :: hydrophilic - procedure :: aerosol_is + procedure :: model_is final :: destructor @@ -712,18 +712,18 @@ end function hydrophilic !------------------------------------------------------------------------------ ! returns TRUE if bulk aerosol representation !------------------------------------------------------------------------------ - pure logical function aerosol_is(self, query) + pure logical function model_is(self, query) class(bulk_aerosol_properties), intent(in) :: self character(len=*), intent(in) :: query - if (trim(query) == 'BAM') then - aerosol_is = .true. + if (trim(query) == 'BAM' .or. trim(query) == 'bam') then + model_is = .true. else if (trim(query) == 'bulk_model') then - aerosol_is = .true. + model_is = .true. else - aerosol_is = .false. + model_is = .false. end if - end function aerosol_is + end function model_is end module bulk_aerosol_properties_mod diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index 1f0c4d9287..e00c807257 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -40,6 +40,7 @@ module carma_aerosol_properties_mod procedure :: resuspension_resize procedure :: rebin_bulk_fluxes procedure :: hydrophilic + procedure :: model_is final :: destructor end type carma_aerosol_properties @@ -944,4 +945,19 @@ logical function hydrophilic(self, bin_ndx) end function hydrophilic + !------------------------------------------------------------------------------ + ! returns TRUE if CARMA aerosol representation + !------------------------------------------------------------------------------ + pure logical function model_is(self, query) + class(carma_aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query + + if (trim(query) == 'CARMA' .or. trim(query) == 'carma') then + model_is = .true. + else + model_is = .false. + end if + + end function model_is + end module carma_aerosol_properties_mod diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index 5a92b8df5a..e255be91da 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -52,6 +52,7 @@ module modal_aerosol_properties_mod procedure :: resuspension_resize procedure :: rebin_bulk_fluxes procedure :: hydrophilic + procedure :: model_is final :: destructor end type modal_aerosol_properties @@ -1108,4 +1109,21 @@ logical function hydrophilic(self, bin_ndx) end function hydrophilic + !------------------------------------------------------------------------------ + ! returns TRUE if modal aerosol representation + !------------------------------------------------------------------------------ + pure logical function model_is(self, query) + class(modal_aerosol_properties), intent(in) :: self + character(len=*), intent(in) :: query + + if (trim(query) == 'MAM' .or. trim(query) == 'mam') then + model_is = .true. + else if (trim(query) == 'modal') then + model_is = .true. + else + model_is = .false. + end if + + end function model_is + end module modal_aerosol_properties_mod From 9625deefe7658375dce00e3e5dd8798501ae1a3c Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Sat, 6 Dec 2025 09:42:25 -0700 Subject: [PATCH 19/23] ChangeLog draft --- doc/ChangeLog | 160 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 160 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index bdf8e54479..072ea59c5f 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,164 @@ +=============================================================== + +Tag name: cam6_4_134 +Originator(s): fvitt +Date: 9?? Dec 2025 +One-line Summary: Aerosol optics interfaces for bulk and volcanic aerosols +Github PR URL: https://github.com/ESCOMP/CAM/pull/1404 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + Extend aerosol optics interfaces for bulk aerosols and volcanic aerosols. + (issue #1400) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: jimmielin, gold2718 + +List all files eliminated: + +List all files added and what they do: +A src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 +A src/chemistry/aerosol/bulk_aerosol_state_mod.F90 + - minimal implementation for bulk aerosol optics + +A src/chemistry/aerosol/hygro_aerosol_optics_mod.F90 +A src/chemistry/aerosol/hygroscopic_aerosol_optics_mod.F90 +A src/chemistry/aerosol/insoluble_aerosol_optics_mod.F90 + - aerosol optics types for bulk aerosols + +A src/chemistry/aerosol/volcrad_aerosol_optics_mod.F90 + - aerosol optics type for volcanic aerosols +A src/physics/cam/aer_vis_diag_mod.F90 + - utility module for AOD diagnostics + +List all existing files that have been modified, and describe the changes: + +M src/chemistry/aerosol/aerosol_properties_mod.F90 +M src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +M src/chemistry/aerosol/modal_aerosol_properties_mod.F90 + - implement model_is interface + - add bulk and volcanic aerosol properties to the optics_params interface + +M src/physics/cam/aer_rad_props.F90 + - bulk and volcanic aerosol optics code moved to extended aerosol_optics + classes + +M src/physics/cam/aerosol_optics_cam.F90 + - use the extended aerosol optics classes for bulk and volcanic aerosols + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + DIFF ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s + DIFF SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s_amie + DIFF ERI_D_Ln18.ne16pg3_ne16pg3_mt232.FHIST_C4.derecho_intel.cam-outfrq3s_eri + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + DIFF SMS_D_Ld5.f19_f19_mt232.PC4.derecho_intel.cam-cam4_port5d + - bulk aerosol optics roundoff level differences + + DIFF ERC_D_Ln9.f09_f09_mt232.FHIST_BDRD.derecho_intel.cam-outfrq9s + DIFF ERC_D_Ln9.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERC_D_Ln9.mpasa120_mpasa120.FHISTC_LTso.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERC_D_Ln9.ne30pg3_ne30pg3_mt232.F1850C_LTso.derecho_intel.cam-outfrq9s + DIFF ERC_Ln9.C96_C96_mt232.F2000climo.derecho_intel.cam-outfrq9s + DIFF ERI_D_Ln18.f09_f09_mt232.FHIST.derecho_intel.cam-outfrq3s_eri + DIFF ERI_D_Ln18.f19_f19_mt232.FHIST_C5.derecho_intel.cam-outfrq3s_eri + DIFF ERI_D_Ln18.ne30pg3_ne30pg3_mt232.FHISTC_LTso.derecho_intel.cam-outfrq3s_eri + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mt232.F1850C_MTso.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERR_Ln9.ne16pg3_ne16pg3_mt232.FHISTC_LTso.derecho_intel.cam-outfrq9s_bwic + DIFF SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mt232.FHIST_C5.derecho_intel.cam-mam7 + DIFF SMS_D_Ln9.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mt232.FHISTC_MTso.derecho_intel.cam-outfrq9s + DIFF SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + DIFF SMS_Ln9.f19_f19_mt232.F2000climo.derecho_intel.cam-silhs + DIFF SMS_D_Ld5.f09_f09_mt232.PC6.derecho_intel.cam-cam6_port_f09 + - volcanic aerosol optics roundoff level differences + +derecho/nvhpc/aux_cam: + FAIL ERS_Ln9.ne30pg3_ne30pg3_mt232.FHISTC_LTso.derecho_nvhpc.cam-outfrq9s_gpu_default + -pre-existing failure -- exceeds wallclock time limit + NOTE: Jian has determined this is due to changes on derecho with the the last upgrade. + He has reported the issue to CISL. Note cam6_4_128 is the last CAM tag with + baselines to use for comparison but answer changes are expected starting with + cam6_4_130. + +izumi/nag/aux_cam: + DIFF SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + - bulk aerosol optics roundoff level differences + + DIFF ERC_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_nag.cam-outfrq3s_subcol + DIFF ERC_D_Ln9.f10_f10_mt232.FHIST.izumi_nag.cam-outfrq3s_cospsathist + DIFF ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHISTC_LTso.izumi_nag.cam-cosp_rad_diags + DIFF ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHISTC_LTso.izumi_nag.cam-outfrq9s_nochem + DIFF SMS_D_Ln9.f10_f10_mt232.F1850.izumi_nag.cam-outfrq9s + DIFF TMC_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_nag.cam-mc_ttrac + - volcanic aerosol optics roundoff level differences + +izumi/gnu/aux_cam: + FAIL ERC_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_gnu.cam-rad_diag COMPARE_base_rest + - new failure + ERS_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_gnu.cam-rad_diag passes restart test. + Should change to ERS ?? -- this is not a CAM only test -- active CLM and CICE + are inlcuded in this compset + + DIFF ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags + DIFF SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + DIFF SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc + DIFF ERC_D_Ln9.ne3pg3_ne3pg3_mt232.F1850_C4.izumi_gnu.cam-co2rmp + DIFF SMS_D_Ln9.f19_f19_mt232.FW4madSD.izumi_gnu.cam-outfrq9s + DIFF ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHIST.izumi_gnu.cam-nochem_clubbmf + - bulk aerosol optics roundoff level differences + + DIFF ERC_D_Ln9.f19_f19_mt232.FHIST.izumi_gnu.cam-lonlat_fv_diags + DIFF ERC_D_Ln9.mpasa480_mpasa480_mt232.FHISTC_LTso.izumi_gnu.cam-outfrq9s_mpasa480 + DIFF ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHISTC_LTso.izumi_gnu.cam-sat_lcltod + DIFF ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 + DIFF PLB_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_gnu.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_gnu.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_gnu.cam-ttrac_loadbal3 + DIFF SMS_D_Ln3.ne3pg3_ne3pg3_mt232.PC7.izumi_gnu.cam-pc7_ne3pg3 + DIFF SUB_D_Ln9.ne3pg3_ne3pg3_mt232.FHIST.izumi_gnu.cam-outfrq9s + DIFF SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 + - volcanic aerosol optics roundoff level differences + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== =============================================================== Tag name: cam6_4_134 From e3d1d184ae6786b3a2bff7f2084e1bb96a15e88c Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 8 Dec 2025 10:53:51 -0700 Subject: [PATCH 20/23] rm rad_diag/user_nl_cpl --- cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl | 2 -- 1 file changed, 2 deletions(-) delete mode 100644 cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl diff --git a/cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl deleted file mode 100644 index 398535cf65..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl +++ /dev/null @@ -1,2 +0,0 @@ -reprosum_diffmax=1.0e-14 -reprosum_recompute=.true. From 51a342d8f2034152e9829738506371f3b1b0fbc7 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 8 Dec 2025 11:13:18 -0700 Subject: [PATCH 21/23] ChangeLog update --- doc/ChangeLog | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 072ea59c5f..fa18dbba5c 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -21,6 +21,10 @@ Describe any substantial timing or memory changes: N/A Code reviewed by: jimmielin, gold2718 List all files eliminated: +D cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl + - reprosum_ namelist settings allowed roundoff level differences in + summations across MPI tasks which was caused failure of this restart + test: ERC_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_gnu.cam-rad_diag List all files added and what they do: A src/chemistry/aerosol/bulk_aerosol_properties_mod.F90 @@ -108,19 +112,14 @@ izumi/nag/aux_cam: - volcanic aerosol optics roundoff level differences izumi/gnu/aux_cam: - FAIL ERC_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_gnu.cam-rad_diag COMPARE_base_rest - - new failure - ERS_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_gnu.cam-rad_diag passes restart test. - Should change to ERS ?? -- this is not a CAM only test -- active CLM and CICE - are inlcuded in this compset - DIFF ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags DIFF SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee DIFF SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc DIFF ERC_D_Ln9.ne3pg3_ne3pg3_mt232.F1850_C4.izumi_gnu.cam-co2rmp DIFF SMS_D_Ln9.f19_f19_mt232.FW4madSD.izumi_gnu.cam-outfrq9s DIFF ERC_D_Ln9.ne3pg3_ne3pg3_mt232.FHIST.izumi_gnu.cam-nochem_clubbmf - - bulk aerosol optics roundoff level differences + DIFF ERC_D_Ln9.f10_f10_mt232.FHIST_C5.izumi_gnu.cam-rad_diag + - bulk aerosol optics roundoff level differences DIFF ERC_D_Ln9.f19_f19_mt232.FHIST.izumi_gnu.cam-lonlat_fv_diags DIFF ERC_D_Ln9.mpasa480_mpasa480_mt232.FHISTC_LTso.izumi_gnu.cam-outfrq9s_mpasa480 From ab51c20a67deed3df0fe7756c7880f07f2e6850f Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 8 Dec 2025 11:13:53 -0700 Subject: [PATCH 22/23] ChangeLog update --- doc/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index fa18dbba5c..ed9e951e2d 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -2,7 +2,7 @@ Tag name: cam6_4_134 Originator(s): fvitt -Date: 9?? Dec 2025 +Date: 8 Dec 2025 One-line Summary: Aerosol optics interfaces for bulk and volcanic aerosols Github PR URL: https://github.com/ESCOMP/CAM/pull/1404 From 405492b10ce3b5d6345d618df94bc9292fa6e83f Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 8 Dec 2025 14:04:46 -0700 Subject: [PATCH 23/23] ChangeLog update --- doc/ChangeLog | 31 +++++++------------------------ 1 file changed, 7 insertions(+), 24 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index ed9e951e2d..4c92526f04 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,6 +1,6 @@ =============================================================== -Tag name: cam6_4_134 +Tag name: cam6_4_135 Originator(s): fvitt Date: 8 Dec 2025 One-line Summary: Aerosol optics interfaces for bulk and volcanic aerosols @@ -90,6 +90,11 @@ derecho/intel/aux_cam: DIFF SMS_D_Ld5.f09_f09_mt232.PC6.derecho_intel.cam-cam6_port_f09 - volcanic aerosol optics roundoff level differences + + SMS_D_Ln9_P1536x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + - intermittent failure in CTSM code (lnd_set_decomp_and_domain.F90) + - This test failed the first time but passed on a retry. Keeping this in the ChangeLog until CTSM makes a fix + derecho/nvhpc/aux_cam: FAIL ERS_Ln9.ne30pg3_ne30pg3_mt232.FHISTC_LTso.derecho_nvhpc.cam-outfrq9s_gpu_default -pre-existing failure -- exceeds wallclock time limit @@ -133,29 +138,7 @@ izumi/gnu/aux_cam: DIFF SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 - volcanic aerosol optics roundoff level differences -CAM tag used for the baseline comparison tests if different than previous -tag: - -Summarize any changes to answers, i.e., -- what code configurations: -- what platforms/compilers: -- nature of change (roundoff; larger than roundoff but same climate; new - climate): - -If bitwise differences were observed, how did you show they were no worse -than roundoff? - -If this tag changes climate describe the run(s) done to evaluate the new -climate in enough detail that it(they) could be reproduced, i.e., -- source tag (all code used must be in the repository): -- platform/compilers: -- configure commandline: -- build-namelist command (or complete namelist): -- MSS location of output: - -MSS location of control simulations used to validate new climate: - -URL for AMWG diagnostics output used to validate new climate: +Summarize any changes to answers: roundoff =============================================================== ===============================================================