From 4b74f1b77d57cfed5d7ed027d9de12568963ef57 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 22 May 2023 13:27:00 -0600 Subject: [PATCH 01/27] aerosol optics interface for MAM modified: bld/namelist_files/namelist_definition.xml modified: src/chemistry/aerosol/aerosol_properties_mod.F90 modified: src/chemistry/aerosol/aerosol_state_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_state_mod.F90 modified: src/control/runtime_opts.F90 modified: src/physics/cam/aer_rad_props.F90 modified: src/physics/cam/rad_constituents.F90 modified: src/physics/rrtmg/radiation.F90 new file: src/chemistry/aerosol/aerosol_optics_mod.F90 new file: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 new file: src/physics/cam/aerosol_optics_cam.F90 deleted: src/physics/cam/modal_aer_opt.F90 --- bld/namelist_files/namelist_definition.xml | 2 +- src/chemistry/aerosol/aerosol_optics_mod.F90 | 58 + .../aerosol/aerosol_properties_mod.F90 | 169 +- src/chemistry/aerosol/aerosol_state_mod.F90 | 147 +- .../aerosol/modal_aerosol_properties_mod.F90 | 177 +- .../aerosol/modal_aerosol_state_mod.F90 | 197 +- .../aerosol/refractive_aerosol_optics_mod.F90 | 453 +++++ src/control/runtime_opts.F90 | 4 +- src/physics/cam/aer_rad_props.F90 | 89 +- src/physics/cam/aerosol_optics_cam.F90 | 1259 +++++++++++++ src/physics/cam/modal_aer_opt.F90 | 1621 ----------------- src/physics/cam/rad_constituents.F90 | 143 +- src/physics/rrtmg/radiation.F90 | 11 +- 13 files changed, 2558 insertions(+), 1772 deletions(-) create mode 100644 src/chemistry/aerosol/aerosol_optics_mod.F90 create mode 100644 src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 create mode 100644 src/physics/cam/aerosol_optics_cam.F90 delete mode 100644 src/physics/cam/modal_aer_opt.F90 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 5698285ef2..710a4bade9 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5412,7 +5412,7 @@ Default: false + group="aerosol_optics_nl" valid_values="" > Full pathname of dataset for water refractive indices used in modal aerosol optics Default: none diff --git a/src/chemistry/aerosol/aerosol_optics_mod.F90 b/src/chemistry/aerosol/aerosol_optics_mod.F90 new file mode 100644 index 0000000000..ae2a04bfb1 --- /dev/null +++ b/src/chemistry/aerosol/aerosol_optics_mod.F90 @@ -0,0 +1,58 @@ +module aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private + public :: aerosol_optics + + !> aerosol_optics defines interfaces to optical properties of any aerosol package + !! + !! Each aerosol optics type must extend the abstract aerosol_optics class + !! to define details of how aerosol optics properties are derived from + !! aerosol states. + type, abstract :: aerosol_optics + + contains + + procedure(aeropts_sw_props),deferred :: sw_props + procedure(aeropts_lw_props),deferred :: lw_props + + end type aerosol_optics + + abstract interface + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine aeropts_sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + import :: aerosol_optics, r8 + + class(aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized asymmetry factor + real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + + end subroutine aeropts_sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine aeropts_lw_props(self, ncol, ilev, iwav, pabs) + import :: aerosol_optics, r8 + + class(aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + end subroutine aeropts_lw_props + + end interface + +end module aerosol_optics_mod diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index 1a3a89f611..f68ae07a26 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -35,18 +35,23 @@ module aerosol_properties_mod real(r8) :: pom_equivso4_factor_ = -huge(1._r8) contains procedure :: initialize => aero_props_init - procedure :: nbins + procedure,private :: nbins_0list + procedure(aero_nbins_rlist), deferred :: nbins_rlist + generic :: nbins => nbins_0list,nbins_rlist procedure :: ncnst_tot procedure,private :: nspecies_per_bin + procedure(aero_nspecies_rlist), deferred :: nspecies_per_bin_rlist procedure,private :: nspecies_all_bins - generic :: nspecies => nspecies_all_bins,nspecies_per_bin + generic :: nspecies => nspecies_all_bins,nspecies_per_bin,nspecies_per_bin_rlist procedure,private :: n_masses_all_bins procedure,private :: n_masses_per_bin generic :: nmasses => n_masses_all_bins,n_masses_per_bin procedure :: indexer procedure :: maxsat procedure(aero_amcube), deferred :: amcube - procedure :: alogsig + procedure :: alogsig0 + procedure(aero_alogsig_rlist), deferred :: alogsig_rlist + generic :: alogsig => alogsig0,alogsig_rlist procedure(aero_number_transported), deferred :: number_transported procedure(aero_props_get), deferred :: get procedure(aero_actfracs), deferred :: actfracs @@ -63,6 +68,7 @@ module aerosol_properties_mod procedure :: pom_equivso4_factor ! POM Hygroscopicity / Sulfate Hygroscopicity procedure(aero_soluble), deferred :: soluble procedure(aero_min_mass_mean_rad), deferred :: min_mass_mean_rad + procedure(aero_optics_params), deferred :: optics_params procedure :: final=>aero_props_final end type aerosol_properties @@ -83,16 +89,81 @@ end function aero_number_transported ! returns aerosol properties: ! density ! hygroscopicity + ! species type + ! short wave species refractive indices + ! long wave species refractive indices + ! species morphology !------------------------------------------------------------------------ - subroutine aero_props_get(self, bin_ndx, species_ndx, density, hygro) + subroutine aero_props_get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & + spectype, specmorph, refindex_sw, refindex_lw) import :: aerosol_properties, r8 class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index integer, intent(in) :: species_ndx ! species index + integer, optional, intent(in) :: list_ndx ! climate or a diagnostic list number real(r8), optional, intent(out) :: density ! density (kg/m3) real(r8), optional, intent(out) :: hygro ! hygroscopicity + character(len=*), optional, intent(out) :: spectype ! species type + 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 aero_props_get + !------------------------------------------------------------------------ + ! returns optics type and table parameters + !------------------------------------------------------------------------ + subroutine aero_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 ) + + import :: aerosol_properties, r8 + + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: list_ndx ! rad climate/diags list + + character(len=*), optional, intent(out) :: opticstype + + ! refactive index table parameters + real(r8), optional, pointer :: extpsw(:,:,:,:) ! specific extinction + real(r8), optional, pointer :: abspsw(:,:,:,:) ! specific absorption + real(r8), optional, pointer :: asmpsw(:,:,:,:) ! asymmetry factor + real(r8), optional, pointer :: absplw(:,:,:,:) ! specific absorption + real(r8), optional, pointer :: refrtabsw(:,:) ! table of real refractive indices for aerosols + real(r8), optional, pointer :: refitabsw(:,:) ! table of imaginary refractive indices for aerosols + real(r8), optional, pointer :: refrtablw(:,:) ! table of real refractive indices for aerosols + real(r8), optional, pointer :: refitablw(:,:) ! table of 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 + + end subroutine aero_optics_params + !------------------------------------------------------------------------ ! returns species type !------------------------------------------------------------------------ @@ -254,7 +325,46 @@ logical function aero_soluble(self,bin_ndx) end function aero_soluble - end interface + !------------------------------------------------------------------------------ + ! returns the total number of bins for a given radiation list index + !------------------------------------------------------------------------------ + function aero_nbins_rlist(self, list_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + + integer :: res + + end function aero_nbins_rlist + + !------------------------------------------------------------------------------ + ! returns number of species in a bin for a given radiation list index + !------------------------------------------------------------------------------ + function aero_nspecies_rlist(self, list_ndx, bin_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + integer :: res + + end function aero_nspecies_rlist + + !------------------------------------------------------------------------------ + ! returns the natural log of geometric standard deviation of the number + ! distribution for radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function aero_alogsig_rlist(self, list_ndx, bin_ndx) result(res) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: res + + end function aero_alogsig_rlist + + end interface contains @@ -272,12 +382,13 @@ subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ie real(r8),intent(in) :: f2(nbin) ! eq 29 Abdul-Razzak et al 1998 integer,intent(out) :: ierr - integer :: imas,ibin,indx + integer :: imas,ibin,indx, ispc character(len=*),parameter :: prefix = 'aerosol_properties::aero_props_init: ' - real(r8), parameter :: spechygro_so4 = 0.507_r8 ! Sulfate hygroscopicity - real(r8), parameter :: spechygro_soa = 0.14_r8 ! SOA hygroscopicity - real(r8), parameter :: spechygro_pom = 0.1_r8 ! POM hygroscopicity + real(r8) :: spechygro_so4 ! Sulfate hygroscopicity + real(r8) :: spechygro_soa ! SOA hygroscopicity + real(r8) :: spechygro_pom ! POM hygroscopicity + character(len=aero_name_len) :: spectype ierr = 0 @@ -330,8 +441,31 @@ subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ie self%f1_(:) = f1(:) self%f2_(:) = f2(:) - self%soa_equivso4_factor_ = spechygro_soa/spechygro_so4 - self%pom_equivso4_factor_ = spechygro_pom/spechygro_so4 + spechygro_so4 = 0._r8 + spechygro_pom = 0._r8 + spechygro_soa = 0._r8 + + do ibin=1,nbin + do ispc = 1,nspec(ibin) + call self%species_type(ibin, ispc, spectype) + + select case ( trim(spectype) ) + case('sulfate') + call self%get(ibin, ispc, hygro=spechygro_so4) + case('p-organic') + call self%get(ibin, ispc, hygro=spechygro_pom) + case('s-organic') + call self%get(ibin, ispc, hygro=spechygro_soa) + end select + end do + end do + + if (spechygro_so4 > 0._r8 .and. spechygro_pom > 0._r8 .and. spechygro_soa > 0._r8) then + self%soa_equivso4_factor_ = spechygro_soa/spechygro_so4 + self%pom_equivso4_factor_ = spechygro_pom/spechygro_so4 + else + ierr = 99 + end if end subroutine aero_props_init @@ -422,11 +556,12 @@ end function indexer !------------------------------------------------------------------------------ ! returns the total number of bins !------------------------------------------------------------------------------ - pure integer function nbins(self) + pure function nbins_0list(self) result(nbins) class(aerosol_properties), intent(in) :: self + integer :: nbins nbins = self%nbins_ - end function nbins + end function nbins_0list !------------------------------------------------------------------------------ ! returns number of constituents (or elements) totaled across all bins @@ -440,12 +575,12 @@ end function ncnst_tot !------------------------------------------------------------------------------ ! returns the natural log of geometric standard deviation of the number distribution for aerosol bin !------------------------------------------------------------------------------ - pure real(r8) function alogsig(self, bin_ndx) + pure real(r8) function alogsig0(self, bin_ndx) class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number - alogsig = self%alogsig_(bin_ndx) - end function alogsig + alogsig0 = self%alogsig_(bin_ndx) + end function alogsig0 !------------------------------------------------------------------------------ ! returns maximum supersaturation @@ -529,4 +664,4 @@ pure real(r8) function pom_equivso4_factor(self) end function pom_equivso4_factor - end module aerosol_properties_mod +end module aerosol_properties_mod diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index 8e413f0ec1..0e036b84e9 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -28,7 +28,9 @@ module aerosol_state_mod procedure(aero_get_transported), deferred :: get_transported procedure(aero_set_transported), deferred :: set_transported procedure(aero_get_amb_total_bin_mmr), deferred :: ambient_total_bin_mmr - procedure(aero_get_state_mmr), deferred :: get_ambient_mmr + procedure(aero_get_state_mmr), deferred :: get_ambient_mmr0 + procedure(aero_get_list_mmr), deferred :: get_ambient_mmrl + generic :: get_ambient_mmr=>get_ambient_mmr0,get_ambient_mmrl procedure(aero_get_state_mmr), deferred :: get_cldbrne_mmr procedure(aero_get_state_num), deferred :: get_ambient_num procedure(aero_get_state_num), deferred :: get_cldbrne_num @@ -47,7 +49,14 @@ module aerosol_state_mod procedure :: mass_mean_radius procedure :: watact_mfactor procedure(aero_hetfrz_size_wght), deferred :: hetfrz_size_wght - end type aerosol_state + procedure(aero_hygroscopicity), deferred :: hygroscopicity + procedure(aero_water_uptake), deferred :: water_uptake + procedure :: refractive_index_sw + procedure :: refractive_index_lw + procedure(aero_volume), deferred :: dry_volume + procedure(aero_volume), deferred :: wet_volume + procedure(aero_volume), deferred :: water_volume + end type aerosol_state ! for state fields type ptr2d_t @@ -86,6 +95,19 @@ subroutine aero_get_state_mmr(self, species_ndx, bin_ndx, mmr) real(r8), pointer :: mmr(:,:) ! mass mixing ratios end subroutine aero_get_state_mmr + !------------------------------------------------------------------------ + ! returns aerosol mass mixing ratio for a given species index, bin index + ! and raditaion climate or diagnsotic list number + !------------------------------------------------------------------------ + subroutine aero_get_list_mmr(self, list_ndx, species_ndx, bin_ndx, mmr) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate/diagnostic list index + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios + end subroutine aero_get_list_mmr + !------------------------------------------------------------------------ ! returns aerosol number mixing ratio for a given species index and bin index !------------------------------------------------------------------------ @@ -193,6 +215,55 @@ function aero_hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) end function aero_hetfrz_size_wght + !------------------------------------------------------------------------------ + ! returns hygroscopicity for a given radiation diagnostic list number and + ! bin number + !------------------------------------------------------------------------------ + function aero_hygroscopicity(self, list_ndx, bin_ndx) result(kappa) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate/diagnostic list index + integer, intent(in) :: bin_ndx ! bin number + + real(r8), pointer :: kappa(:,:) + + end function aero_hygroscopicity + + !------------------------------------------------------------------------------ + ! returns aerosol wet diameter and aerosol water concentration for a given + ! radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + subroutine aero_water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + import :: aerosol_state, aerosol_properties, r8 + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) + real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) + + end subroutine aero_water_uptake + + !------------------------------------------------------------------------------ + ! aerosol volume interface + !------------------------------------------------------------------------------ + function aero_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + import :: aerosol_state, aerosol_properties, r8 + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + end function aero_volume + end interface contains @@ -712,4 +783,76 @@ subroutine watact_mfactor(self, bin_ndx, species_type, ncol, nlev, aero_props, end subroutine watact_mfactor + !------------------------------------------------------------------------------ + ! aerosol short wave refactive index + !------------------------------------------------------------------------------ + function refractive_index_sw(self, ncol, ilev, ilist, ibin, iwav, aero_props) result(crefin) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ncol ! number of columes + integer, intent(in) :: ilev ! level index + integer, intent(in) :: ilist ! radiation diagnostics list index + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: iwav ! wave length index + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + complex(r8) :: crefin(ncol) ! complex refractive index + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + complex(r8), pointer :: specrefindex(:) ! species refractive index + real(r8) :: specdens ! species density (kg/m3) + integer :: ispec, icol + real(r8) :: vol(ncol) + + crefin(:ncol) = (0._r8, 0._r8) + + do ispec = 1, aero_props%nspecies(ilist,ibin) + + call self%get_ambient_mmr(ilist,ispec,ibin,specmmr) + call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, refindex_sw=specrefindex) + + do icol = 1, ncol + vol(icol) = specmmr(icol,ilev)/specdens + crefin(icol) = crefin(icol) + vol(icol)*specrefindex(iwav) + end do + end do + + end function refractive_index_sw + + !------------------------------------------------------------------------------ + ! aerosol long wave refactive index + !------------------------------------------------------------------------------ + function refractive_index_lw(self, ncol, ilev, ilist, ibin, iwav, aero_props) result(crefin) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ncol ! number of columes + integer, intent(in) :: ilev ! level index + integer, intent(in) :: ilist ! radiation diagnostics list index + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: iwav ! wave length index + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + complex(r8) :: crefin(ncol) ! complex refractive index + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + complex(r8), pointer :: specrefindex(:) ! species refractive index + real(r8) :: specdens ! species density (kg/m3) + integer :: ispec, icol + real(r8) :: vol(ncol) + + crefin(:ncol) = (0._r8, 0._r8) + + do ispec = 1, aero_props%nspecies(ilist,ibin) + + call self%get_ambient_mmr(ilist,ispec,ibin,specmmr) + call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, refindex_lw=specrefindex) + + do icol = 1, ncol + vol(icol) = specmmr(icol,ilev)/specdens + crefin(icol) = crefin(icol) + vol(icol)*specrefindex(iwav) + end do + end do + + end function refractive_index_lw + end module aerosol_state_mod diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index 5f0ffadcbd..8de1276097 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -29,6 +29,10 @@ module modal_aerosol_properties_mod 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 final :: destructor @@ -175,19 +179,143 @@ end function number_transported ! returns aerosol properties: ! density ! hygroscopicity + ! species type + ! short wave species refractive indices + ! long wave species refractive indices + ! species morphology !------------------------------------------------------------------------ - subroutine get(self, bin_ndx, species_ndx, density,hygro) + subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & + spectype, specmorph, refindex_sw, refindex_lw) class(modal_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index integer, intent(in) :: species_ndx ! species index + integer, optional, intent(in) :: list_ndx ! climate or a diagnostic list number real(r8), optional, intent(out) :: density ! density (kg/m3) real(r8), optional, intent(out) :: hygro ! hygroscopicity + character(len=*), optional, intent(out) :: spectype ! species type + 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 - call rad_cnst_get_aer_props(0, bin_ndx, species_ndx, density_aer=density, hygro_aer=hygro) + integer :: ilist + + 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, species_ndx, density_aer=density) + end if + if (present(hygro)) then + call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, hygro_aer=hygro) + end if + if (present(spectype)) then + call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, spectype=spectype ) + end if + if (present(refindex_sw)) then + call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, refindex_aer_sw=refindex_sw ) + end if + if (present(refindex_lw)) then + call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, refindex_aer_lw=refindex_lw ) + end if + if (present(specmorph)) then + specmorph = 'UNKNOWN' + end if 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 ) + + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: list_ndx ! rad climate/diags list + + character(len=*), optional, intent(out) :: opticstype + + ! refactive index table parameters + real(r8), optional, pointer :: extpsw(:,:,:,:) ! specific extinction + real(r8), optional, pointer :: abspsw(:,:,:,:) ! specific absorption + real(r8), optional, pointer :: asmpsw(:,:,:,:) ! asymmetry factor + real(r8), optional, pointer :: absplw(:,:,:,:) ! specific absorption + real(r8), optional, pointer :: refrtabsw(:,:) ! table of real refractive indices for aerosols + real(r8), optional, pointer :: refitabsw(:,:) ! table of imaginary refractive indices for aerosols + real(r8), optional, pointer :: refrtablw(:,:) ! table of real refractive indices for aerosols + real(r8), optional, pointer :: refitablw(:,:) ! table of 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 + + if (present(opticstype)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, opticstype=opticstype) + end if + if (present(extpsw)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, extpsw=extpsw) + end if + if (present(abspsw)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, abspsw=abspsw) + end if + if (present(asmpsw)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, asmpsw=asmpsw) + end if + if (present(absplw)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, absplw=absplw) + end if + if (present(refrtabsw)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, refrtabsw=refrtabsw) + end if + if (present(refitabsw)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, refitabsw=refitabsw) + end if + if (present(refrtablw)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, refrtablw=refrtablw) + end if + if (present(refitablw)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, refitablw=refitablw) + end if + if (present(ncoef)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, ncoef=ncoef) + end if + if (present(prefr)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, prefr=prefr) + end if + if (present(prefi)) then + call rad_cnst_get_mode_props(list_ndx,bin_ndx, prefi=prefi) + end if + + end subroutine optics_params + !------------------------------------------------------------------------------ ! returns radius^3 (m3) of a given bin number !------------------------------------------------------------------------------ @@ -451,4 +579,49 @@ function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) end function min_mass_mean_rad + !------------------------------------------------------------------------------ + ! returns the total number of bins for a given radiation list index + !------------------------------------------------------------------------------ + function nbins_rlist(self, list_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + + integer :: res + + call rad_cnst_get_info(list_ndx, nmodes=res) + + end function nbins_rlist + + !------------------------------------------------------------------------------ + ! returns number of species in a bin for a given radiation list index + !------------------------------------------------------------------------------ + function nspecies_per_bin_rlist(self, list_ndx, bin_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + integer :: res + + call rad_cnst_get_info(list_ndx, bin_ndx, nspec=res) + + end function nspecies_per_bin_rlist + + !------------------------------------------------------------------------------ + ! returns the natural log of geometric standard deviation of the number + ! distribution for radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function alogsig_rlist(self, list_ndx, bin_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: res + + real(r8) :: sig + + call rad_cnst_get_mode_props(list_ndx, bin_ndx, sigmag=sig) + res = log(sig) + + end function alogsig_rlist + end module modal_aerosol_properties_mod diff --git a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 index 5ad51fdbe9..0646bfda90 100644 --- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -7,6 +7,7 @@ module modal_aerosol_state_mod use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index use physics_types, only: physics_state use aerosol_properties_mod, only: aerosol_properties, aero_name_len + use physconst, only: rhoh2o implicit none @@ -23,7 +24,8 @@ module modal_aerosol_state_mod procedure :: get_transported procedure :: set_transported procedure :: ambient_total_bin_mmr - procedure :: get_ambient_mmr + procedure :: get_ambient_mmr0 + procedure :: get_ambient_mmrl procedure :: get_cldbrne_mmr procedure :: get_ambient_num procedure :: get_cldbrne_num @@ -33,6 +35,11 @@ module modal_aerosol_state_mod 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 final :: destructor @@ -123,14 +130,28 @@ end function ambient_total_bin_mmr !------------------------------------------------------------------------------ ! returns ambient aerosol mass mixing ratio for a given species index and bin index !------------------------------------------------------------------------------ - subroutine get_ambient_mmr(self, species_ndx, bin_ndx, mmr) + subroutine get_ambient_mmr0(self, species_ndx, bin_ndx, mmr) class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: species_ndx ! species index integer, intent(in) :: bin_ndx ! bin index real(r8), pointer :: mmr(:,:) ! mass mixing ratios call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) - end subroutine get_ambient_mmr + end subroutine get_ambient_mmr0 + + !------------------------------------------------------------------------------ + ! returns ambient aerosol mass mixing ratio for a given radiation diagnostics + ! list index, species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_mmrl(self, list_ndx, species_ndx, bin_ndx, mmr) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate list index + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios + + call rad_cnst_get_aer_mmr(list_ndx, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) + end subroutine get_ambient_mmrl !------------------------------------------------------------------------------ ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index @@ -399,4 +420,174 @@ function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) end function hetfrz_size_wght + !------------------------------------------------------------------------------ + ! returns hygroscopicity for a given radiation diagnostic list number and + ! bin number + !------------------------------------------------------------------------------ + function hygroscopicity(self, list_ndx, bin_ndx) result(kappa) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate list number + integer, intent(in) :: bin_ndx ! bin number + + real(r8), pointer :: kappa(:,:) + + nullify(kappa) + + end function 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) + use modal_aero_wateruptake, only: modal_aero_wateruptake_dr + use modal_aero_calcsize, only: modal_aero_calcsize_diag + + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) + real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) + + integer :: istat, nmodes + real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes + real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes + real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes + real(r8), pointer :: wetdens_m(:,:,:) ! + real(r8), pointer :: hygro_m(:,:,:) ! + real(r8), pointer :: dryvol_m(:,:,:) ! + real(r8), pointer :: dryrad_m(:,:,:) ! + real(r8), pointer :: drymass_m(:,:,:) ! + real(r8), pointer :: so4dryvol_m(:,:,:) ! + real(r8), pointer :: naer_m(:,:,:) ! + + nmodes = aero_props%nbins() + + if (list_idx == 0) then + ! water uptake and wet radius for the climate list has already been calculated + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet_m) + call pbuf_get_field(self%pbuf, pbuf_get_index('QAERWAT'), qaerwat_m) + + dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx) + qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx) + + else + ! If doing a diagnostic calculation then need to calculate the wet radius + ! and water uptake for the diagnostic modes + allocate(dgnumdry_m(ncol,nlev,nmodes), dgnumwet_m(ncol,nlev,nmodes), & + qaerwat_m(ncol,nlev,nmodes), wetdens_m(ncol,nlev,nmodes), & + hygro_m(ncol,nlev,nmodes), dryvol_m(ncol,nlev,nmodes), & + dryrad_m(ncol,nlev,nmodes), drymass_m(ncol,nlev,nmodes), & + so4dryvol_m(ncol,nlev,nmodes), naer_m(ncol,nlev,nmodes), stat=istat) + if (istat > 0) then + dgnumwet = -huge(1._r8) + qaerwat = -huge(1._r8) + return + end if + call modal_aero_calcsize_diag(self%state, self%pbuf, list_idx, dgnumdry_m, hygro_m, & + dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) + call modal_aero_wateruptake_dr(self%state, self%pbuf, list_idx, dgnumdry_m, dgnumwet_m, & + qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & + drymass_m, so4dryvol_m, naer_m) + + dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx) + qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx) + + deallocate(dgnumdry_m) + deallocate(dgnumwet_m) + deallocate(qaerwat_m) + deallocate(wetdens_m) + deallocate(hygro_m) + deallocate(dryvol_m) + deallocate(dryrad_m) + deallocate(drymass_m) + deallocate(so4dryvol_m) + deallocate(naer_m) + endif + + + end subroutine water_uptake + + !------------------------------------------------------------------------------ + ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + real(r8), pointer :: mmr(:,:) + real(r8) :: specdens ! species density (kg/m3) + + integer :: ispec + + vol(:,:) = 0._r8 + + do ispec = 1, aero_props%nspecies(list_idx,bin_idx) + call self%get_ambient_mmr(list_idx, ispec, bin_idx, mmr) + call aero_props%get(bin_idx, ispec, list_ndx=list_idx, density=specdens) + vol(:ncol,:) = vol(:ncol,:) + mmr(:ncol,:)/specdens + end do + + end function dry_volume + + !------------------------------------------------------------------------------ + ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + real(r8) :: dryvol(ncol,nlev) + real(r8) :: watervol(ncol,nlev) + + dryvol = self%dry_volume(aero_props, list_idx, bin_idx, ncol, nlev) + watervol = self%water_volume(aero_props, list_idx, bin_idx, ncol, nlev) + + vol = watervol + dryvol + + end function wet_volume + + !------------------------------------------------------------------------------ + ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + real(r8) :: dgnumwet(ncol,nlev) + real(r8) :: qaerwat(ncol,nlev) + + call self%water_uptake(aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + + vol(:ncol,:nlev) = qaerwat(:ncol,:nlev)/rhoh2o + + end function water_volume + end module modal_aerosol_state_mod diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 new file mode 100644 index 0000000000..af662b2a5d --- /dev/null +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -0,0 +1,453 @@ +module refractive_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_optics_mod, only: aerosol_optics + use physconst, only: rhoh2o + use aerosol_state_mod, only: aerosol_state + use aerosol_properties_mod, only: aerosol_properties + + implicit none + + private + public :: refractive_aerosol_optics + + !> refractive_aerosol_optics + !! Table look up implementation of aerosol_optics to parameterize aerosol radiative properties in terms of + !! surface mode wet radius and wet refractive index using chebychev polynomials + type, extends(aerosol_optics) :: refractive_aerosol_optics + + integer :: ibin, ilist + class(aerosol_state), pointer :: aero_state ! aerosol_state object + class(aerosol_properties), pointer :: aero_props ! aerosol_properties object + + real(r8), allocatable :: watervol(:,:) ! volume concentration of water in each mode (m3/kg) + real(r8), allocatable :: wetvol(:,:) ! volume concentration of wet mode (m3/kg) + real(r8), allocatable :: cheb(:,:,:) ! chebychef polynomials + real(r8), allocatable :: radsurf(:,:) ! aerosol surface mode radius + real(r8), allocatable :: logradsurf(:,:) ! log(aerosol surface mode radius) + + ! refractive index for water read in read_water_refindex + complex(r8), allocatable :: crefwsw(:) ! complex refractive index for water visible + complex(r8), allocatable :: crefwlw(:) ! complex refractive index for water infrared + + real(r8), pointer :: extpsw(:,:,:,:) => null() ! specific extinction + real(r8), pointer :: abspsw(:,:,:,:) => null() ! specific absorption + real(r8), pointer :: asmpsw(:,:,:,:) => null() ! asymmetry factor + real(r8), pointer :: absplw(:,:,:,:) => null() ! specific absorption + + real(r8), pointer :: refrtabsw(:,:) => null() ! table of real refractive indices for aerosols + real(r8), pointer :: refitabsw(:,:) => null() ! table of imag refractive indices for aerosols + real(r8), pointer :: refrtablw(:,:) => null() ! table of real refractive indices for aerosols + real(r8), pointer :: refitablw(:,:) => null() ! table of imag refractive indices for aerosols + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type refractive_aerosol_optics + + interface refractive_aerosol_optics + procedure :: constructor + end interface refractive_aerosol_optics + + ! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties + ! in terms of refractive index and wet radius + integer, parameter :: ncoef=5, prefr=7, prefi=10 !??? get from aerosol properties ???? + + real(r8), parameter :: xrmin=log(0.01e-6_r8) + real(r8), parameter :: xrmax=log(25.e-6_r8) + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, crefwsw, crefwlw) & + result(newobj) + + class(aerosol_properties),intent(in), target :: aero_props ! aerosol_properties object + class(aerosol_state),intent(in), target :: aero_state ! aerosol_state object + integer, intent(in) :: ilist ! climate or a diagnostic list number + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + integer, intent(in) :: nsw ! number of short wave lengths + integer, intent(in) :: nlw ! number of long wave lengths + complex(r8), intent(in) :: crefwsw(nsw) ! complex refractive index for water visible + complex(r8), intent(in) :: crefwlw(nlw) ! complex refractive index for water infrared + + type(refractive_aerosol_optics), pointer :: newobj + + integer :: ierr, icol, ilev, ispec, nspec + real(r8) :: vol(ncol) ! volume concentration of aerosol specie (m3/kg) + real(r8) :: dryvol(ncol) ! volume concentration of aerosol mode (m3/kg) + real(r8) :: specdens ! species density (kg/m3) + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + real(r8) :: logsigma ! geometric standard deviation of number distribution + + real(r8) :: dgnumwet(ncol,nlev) ! aerosol wet number mode diameter (m) + real(r8) :: qaerwat(ncol,nlev) ! aerosol water (g/g) + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%watervol(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%wetvol(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%cheb(ncoef,ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%radsurf(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%logradsurf(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%crefwlw(nlw),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + newobj%crefwlw(:) = crefwlw(:) + + allocate(newobj%crefwsw(nsw),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + newobj%crefwsw(:) = crefwsw(:) + + call aero_state%water_uptake(aero_props, ilist, ibin, ncol, nlev, dgnumwet, qaerwat) + + nspec = aero_props%nspecies(ilist,ibin) + + logsigma=aero_props%alogsig(ilist,ibin) + + ! calc size parameter for all columns + call modal_size_parameters(ncol, nlev, logsigma, dgnumwet, newobj%radsurf, newobj%logradsurf, newobj%cheb) + + do ilev = 1, nlev + dryvol(:ncol) = 0._r8 + do ispec = 1, nspec + call aero_state%get_ambient_mmr(ilist,ispec,ibin,specmmr) + call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens) + + do icol = 1, ncol + vol(icol) = specmmr(icol,ilev)/specdens + dryvol(icol) = dryvol(icol) + vol(icol) + + newobj%watervol(icol,ilev) = qaerwat(icol,ilev)/rhoh2o + newobj%wetvol(icol,ilev) = newobj%watervol(icol,ilev) + dryvol(icol) + if (newobj%watervol(icol,ilev) < 0._r8) then + newobj%watervol(icol,ilev) = 0._r8 + newobj%wetvol(icol,ilev) = dryvol(icol) + end if + end do + end do + end do + + ! get mode properties + call aero_props%optics_params(ilist, ibin, & + refrtabsw=newobj%refrtabsw, refitabsw=newobj%refitabsw, & + refrtablw=newobj%refrtablw, refitablw=newobj%refitablw,& + extpsw=newobj%extpsw, abspsw=newobj%abspsw, asmpsw=newobj%asmpsw, & + absplw=newobj%absplw) + + newobj%aero_state => aero_state + newobj%aero_props => aero_props + newobj%ilist = ilist + newobj%ibin = ibin + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(refractive_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized asymmetry factor + real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + + real(r8) :: refr(ncol) ! real part of refractive index + real(r8) :: refi(ncol) ! imaginary part of refractive index + integer :: itab(ncol), jtab(ncol) + real(r8) :: ttab(ncol), utab(ncol) + real(r8) :: cext(ncol,ncoef), cabs(ncol,ncoef), casm(ncol,ncoef) + + complex(r8) :: crefin(ncol) ! complex refractive index + integer :: icol,icoef + + crefin(:ncol) = self%aero_state%refractive_index_sw(ncol, ilev, self%ilist, self%ibin, iwav, self%aero_props) + + do icol = 1, ncol + crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwsw(iwav) + crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev),1.e-60_r8) + refr(icol) = real(crefin(icol)) + refi(icol) = abs(aimag(crefin(icol))) + end do + + ! interpolate coefficients linear in refractive index + ! first call calcs itab,jtab,ttab,utab + itab(:ncol) = 0 + call binterp(self%extpsw(:,:,:,iwav), ncol, ncoef, prefr, prefi, & + refr, refi, self%refrtabsw(:,iwav), self%refitabsw(:,iwav), & + itab, jtab, ttab, utab, cext) + call binterp(self%abspsw(:,:,:,iwav), ncol, ncoef, prefr, prefi, & + refr, refi, self%refrtabsw(:,iwav), self%refitabsw(:,iwav), & + itab, jtab, ttab, utab, cabs) + call binterp(self%asmpsw(:,:,:,iwav), ncol, ncoef, prefr, prefi, & + refr, refi, self%refrtabsw(:,iwav), self%refitabsw(:,iwav), & + itab, jtab, ttab, utab, casm) + + do icol = 1,ncol + + if (self%logradsurf(icol,ilev) <= xrmax) then + pext(icol) = 0.5_r8*cext(icol,1) + do icoef = 2, ncoef + pext(icol) = pext(icol) + self%cheb(icoef,icol,ilev)*cext(icol,icoef) + enddo + pext(icol) = exp(pext(icol)) + else + pext(icol) = 1.5_r8/(self%radsurf(icol,ilev)*rhoh2o) ! geometric optics + endif + + ! convert from m2/kg water to m2/kg aerosol + pext(icol) = pext(icol)*self%wetvol(icol,ilev)*rhoh2o + pabs(icol) = 0.5_r8*cabs(icol,1) + pasm(icol) = 0.5_r8*casm(icol,1) + do icoef = 2, ncoef + pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icol,icoef) + pasm(icol) = pasm(icol) + self%cheb(icoef,icol,ilev)*casm(icol,icoef) + enddo + pabs(icol) = pabs(icol)*self%wetvol(icol,ilev)*rhoh2o + pabs(icol) = max(0._r8,pabs(icol)) + pabs(icol) = min(pext(icol),pabs(icol)) + + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(refractive_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + real(r8) :: refr(ncol) ! real part of refractive index + real(r8) :: refi(ncol) ! imaginary part of refractive index + integer :: itab(ncol), jtab(ncol) + real(r8) :: ttab(ncol), utab(ncol) + real(r8) :: cabs(ncol,ncoef) + + complex(r8) :: crefin(ncol) ! complex refractive index + integer :: icol, icoef + + crefin(:ncol) = self%aero_state%refractive_index_lw(ncol, ilev, self%ilist, self%ibin, iwav, self%aero_props) + + do icol = 1, ncol + crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwlw(iwav) + if (self%wetvol(icol,ilev) > 1.e-40_r8) then + crefin(icol) = crefin(icol)/self%wetvol(icol,ilev) + end if + refr(icol) = real(crefin(icol)) + refi(icol) = aimag(crefin(icol)) + end do + + ! interpolate coefficients linear in refractive index + ! first call calcs itab,jtab,ttab,utab + itab(:ncol) = 0 + call binterp(self%absplw(:,:,:,iwav), ncol, ncoef, prefr, prefi, & + refr, refi, self%refrtablw(:,iwav), self%refitablw(:,iwav), & + itab, jtab, ttab, utab, cabs) + + do icol = 1,ncol + pabs(icol) = 0.5_r8*cabs(icol,1) + do icoef = 2, ncoef + pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icol,icoef) + end do + pabs(icol) = pabs(icol)*self%wetvol(icol,ilev)*rhoh2o + pabs(icol) = max(0._r8,pabs(icol)) + end do + + end subroutine lw_props + + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(refractive_aerosol_optics), intent(inout) :: self + + deallocate(self%watervol) + deallocate(self%wetvol) + deallocate(self%cheb) + deallocate(self%radsurf) + deallocate(self%logradsurf) + deallocate(self%crefwsw) + deallocate(self%crefwlw) + + nullify(self%aero_state) + nullify(self%aero_props) + nullify(self%extpsw) + nullify(self%abspsw) + nullify(self%asmpsw) + nullify(self%absplw) + nullify(self%refrtabsw) + nullify(self%refitabsw) + nullify(self%refrtablw) + nullify(self%refitablw) + + end subroutine destructor + + + ! Private routines + !=============================================================================== + + !=============================================================================== + + subroutine modal_size_parameters(ncol,nlev, alnsg_amode, dgnumwet, radsurf, logradsurf, cheb) + + integer, intent(in) :: ncol,nlev + real(r8), intent(in) :: alnsg_amode ! geometric standard deviation of number distribution + real(r8), intent(in) :: dgnumwet(:,:) ! aerosol wet number mode diameter (m) + real(r8), intent(out) :: radsurf(:,:) ! aerosol surface mode radius + real(r8), intent(out) :: logradsurf(:,:) ! log(aerosol surface mode radius) + real(r8), intent(out) :: cheb(:,:,:) + + integer :: i, k, nc + real(r8) :: explnsigma + real(r8) :: xrad(ncol) ! normalized aerosol radius + + !------------------------------------------------------------------------------- + + explnsigma = exp(2.0_r8*alnsg_amode*alnsg_amode) + + ! do k = top_lev, pver + do k = 1, nlev + do i = 1, ncol + ! convert from number mode diameter to surface area + radsurf(i,k) = 0.5_r8*dgnumwet(i,k)*explnsigma + logradsurf(i,k) = log(radsurf(i,k)) + ! normalize size parameter + xrad(i) = max(logradsurf(i,k),xrmin) + xrad(i) = min(xrad(i),xrmax) + xrad(i) = (2._r8*xrad(i)-xrmax-xrmin)/(xrmax-xrmin) + ! chebyshev polynomials + cheb(1,i,k) = 1._r8 + cheb(2,i,k) = xrad(i) + do nc = 3, ncoef + cheb(nc,i,k) = 2._r8*xrad(i)*cheb(nc-1,i,k)-cheb(nc-2,i,k) + end do + end do + end do + + end subroutine modal_size_parameters + +!=============================================================================== + subroutine binterp(table,ncol,km,im,jm,x,y,xtab,ytab,ix,jy,t,u,out) + + ! bilinear interpolation of table + ! + integer, intent(in) :: ncol,km,im,jm + real(r8),intent(in) :: table(km,im,jm) + real(r8),intent(in) :: x(ncol),y(ncol), xtab(im),ytab(jm) + integer,intent(inout) :: ix(ncol), jy(ncol) + real(r8),intent(inout) :: t(ncol), u(ncol) + real(r8),intent(out) :: out(ncol,km) + + + integer :: i,j,k,ic,ip1, ixc,jyc, jp1, ip1m(ncol),jp1m(ncol) + real(r8) :: dx,dy,tu(ncol),tuc(ncol),tcu(ncol),tcuc(ncol) + + if(ix(1).gt.0) go to 30 + if(im.gt.1)then + do ic=1,ncol + do i=1,im + if(x(ic).lt.xtab(i))go to 10 + enddo +10 ix(ic)=max0(i-1,1) + ip1=min(ix(ic)+1,im) + dx=(xtab(ip1)-xtab(ix(ic))) + if(abs(dx).gt.1.e-20_r8)then + t(ic)=(x(ic)-xtab(ix(ic)))/dx + else + t(ic)=0._r8 + endif + end do + else + ix(:ncol)=1 + t(:ncol)=0._r8 + endif + if(jm.gt.1)then + do ic=1,ncol + do j=1,jm + if(y(ic).lt.ytab(j))go to 20 + enddo +20 jy(ic)=max0(j-1,1) + jp1=min(jy(ic)+1,jm) + dy=(ytab(jp1)-ytab(jy(ic))) + if(abs(dy).gt.1.e-20_r8)then + u(ic)=(y(ic)-ytab(jy(ic)))/dy + else + u(ic)=0._r8 + endif + end do + else + jy(:ncol)=1 + u(:ncol)=0._r8 + endif +30 continue + do ic=1,ncol + tu(ic)=t(ic)*u(ic) + tuc(ic)=t(ic)-tu(ic) + tcuc(ic)=1._r8-tuc(ic)-u(ic) + tcu(ic)=u(ic)-tu(ic) + jp1m(ic)=min(jy(ic)+1,jm) + ip1m(ic)=min(ix(ic)+1,im) + enddo + do ic=1,ncol + jyc=jy(ic) + ixc=ix(ic) + jp1=jp1m(ic) + ip1=ip1m(ic) + do k=1,km + out(ic,k) = tcuc(ic) * table(k,ixc,jyc) + tuc(ic) * table(k,ip1,jyc) + & + tu(ic) * table(k,ip1,jp1) + tcu(ic) * table(k,ixc,jp1) + end do + end do + return + end subroutine binterp + +end module refractive_aerosol_optics_mod diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index f09554244d..a4f75c08e6 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -64,7 +64,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use conv_water, only: conv_water_readnl use rad_constituents, only: rad_cnst_readnl use radiation_data, only: rad_data_readnl - use modal_aer_opt, only: modal_aer_opt_readnl + use aerosol_optics_cam, only: aerosol_optics_cam_readnl use clubb_intr, only: clubb_readnl use chemistry, only: chem_readnl use prescribed_volcaero, only: prescribed_volcaero_readnl @@ -165,7 +165,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call radiation_readnl(nlfilename) call rad_cnst_readnl(nlfilename) call rad_data_readnl(nlfilename) - call modal_aer_opt_readnl(nlfilename) + call aerosol_optics_cam_readnl(nlfilename) call chem_readnl(nlfilename) call lightning_readnl(nlfilename) call prescribed_volcaero_readnl(nlfilename) diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 058f53f784..5faca8beac 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -2,7 +2,7 @@ module aer_rad_props !------------------------------------------------------------------------------------------------ ! Converts aerosol masses to bulk optical properties for sw and lw radiation -! computations. +! computations. !------------------------------------------------------------------------------------------------ use shr_kind_mod, only: r8 => shr_kind_r8 @@ -15,7 +15,7 @@ module aer_rad_props use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, & rad_cnst_get_aer_props use wv_saturation, only: qsat -use modal_aer_opt, only: modal_aero_sw, modal_aero_lw +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. @@ -89,11 +89,11 @@ subroutine aer_rad_props_init() end do ! Determine default fields - if (history_amwg .or. history_dust ) then + if (history_amwg .or. history_dust ) then call add_default ('AEROD_v', 1, ' ') - endif - - if ( history_aero_optics ) then + endif + + if ( history_aero_optics ) then call add_default ('AEROD_v', 1, ' ') do i = 1, numaerosols odv_names(i) = 'ODV_'//trim(aernames(i)) @@ -101,6 +101,7 @@ subroutine aer_rad_props_init() end do endif + call aerosol_optics_cam_init() deallocate(aernames) @@ -118,7 +119,7 @@ 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 @@ -170,7 +171,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & 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 integer :: iaerosol ! index into bulk aerosol list @@ -215,15 +216,15 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & ! Contributions from modal aerosols. if (nmodes > 0) then - call modal_aero_sw(list_idx, state, pbuf, nnite, idxnite, & - tau, tau_w, tau_w_g, tau_w_f) + 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 - + call tropopause_find(state, troplev) ! Contributions from bulk aerosols. @@ -310,14 +311,14 @@ 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 + ! 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 ! 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(:) real(r8), intent(out) :: odap_aer(pcols,pver,nlwbands) ! [fraction] absorption optical depth, per layer @@ -336,7 +337,7 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) 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(:,:) @@ -369,7 +370,7 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! Contributions from modal aerosols. if (nmodes > 0) then - call modal_aero_lw(list_idx, state, pbuf, odap_aer) + call aerosol_optics_cam_lw(list_idx, state, pbuf, odap_aer) else odap_aer = 0._r8 end if @@ -422,13 +423,13 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! 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 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 @@ -440,7 +441,7 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! 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) @@ -509,7 +510,7 @@ subroutine get_hygro_rad_props(ncol, krh, wrh, mass, ext, ssa, asm, & - 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 @@ -518,10 +519,10 @@ subroutine get_hygro_rad_props(ncol, krh, wrh, mass, ext, ssa, asm, & enddo enddo -end subroutine get_hygro_rad_props +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) @@ -535,13 +536,13 @@ subroutine get_nonhygro_rad_props(ncol, mass, ext, ssa, 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) + 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) @@ -555,11 +556,11 @@ subroutine get_nonhygro_rad_props(ncol, mass, ext, ssa, asm, & 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, & tau, tau_w, tau_w_g, tau_w_f) - + use physics_buffer, only : pbuf_get_field, pbuf_get_index ! Arguments @@ -575,7 +576,7 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ 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) + real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) ! Local variables integer :: iswband @@ -586,7 +587,7 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ 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) @@ -595,10 +596,10 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ integer :: i, k ! column level iterator !----------------------------------------------------------------------------- - tau =0._r8 - tau_w =0._r8 - tau_w_g=0._r8 - tau_w_f=0._r8 + 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) @@ -634,10 +635,10 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ 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) + 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 @@ -645,7 +646,7 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ 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) @@ -659,23 +660,23 @@ subroutine get_volcanic_rad_props(ncol, mass, ext, scat, 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) + 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) + 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 @@ -695,7 +696,7 @@ subroutine aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, tr 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) @@ -718,7 +719,7 @@ subroutine aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, tr do i = 1, ncol tmp2(i) = sum(tau(i,:troplev(i))) end do - call outfld('AODvstrt', tmp2, pcols, lchnk) + call outfld('AODvstrt', tmp2, pcols, lchnk) end if end subroutine aer_vis_diag_out diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 new file mode 100644 index 0000000000..92c67f4949 --- /dev/null +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -0,0 +1,1259 @@ +module aerosol_optics_cam + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: cl => shr_kind_cl + use cam_logfile, only: iulog + use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_uv_diag, idx_nir_diag + use radconstants, only: ot_length, get_lw_spectral_boundaries + use physics_types,only: physics_state + use physics_buffer,only: physics_buffer_desc + use ppgrid, only: pcols, pver + use physconst, only: rga, rair + use cam_abortutils, only: endrun + use spmd_utils, only : masterproc + use wv_saturation, only: qsat + use rad_constituents, only: n_diag, rad_cnst_get_call_list + use cam_history, only: addfld, add_default, outfld, horiz_only, fieldname_len + use cam_history_support, only: fillvalue + + use tropopause, only : tropopause_find + + use aerosol_properties_mod, only: aerosol_properties + use modal_aerosol_properties_mod, only: modal_aerosol_properties + + use aerosol_state_mod, only: aerosol_state + use modal_aerosol_state_mod,only: modal_aerosol_state + + use aerosol_optics_mod, only: aerosol_optics + use refractive_aerosol_optics_mod, only: refractive_aerosol_optics + + implicit none + + private + + public :: aerosol_optics_cam_readnl + public :: aerosol_optics_cam_init + public :: aerosol_optics_cam_final + public :: aerosol_optics_cam_sw + public :: aerosol_optics_cam_lw + + type aero_props_t + class(aerosol_properties), pointer :: obj => null() + end type aero_props_t + type aero_state_t + class(aerosol_state), pointer :: obj => null() + end type aero_state_t + + type(aero_props_t), allocatable :: aero_props(:) + + ! refractive index for water read in read_water_refindex + complex(r8) :: crefwsw(nswbands) = -huge(1._r8) ! complex refractive index for water visible + complex(r8) :: crefwlw(nlwbands) = -huge(1._r8) ! complex refractive index for water infrared + character(len=cl) :: water_refindex_file = 'NONE' ! full pathname for water refractive index dataset + + logical :: carma_active = .false. + logical :: modal_active = .false. + integer :: num_aero_models = 0 + integer :: lw10um_indx = -1 + + character(len=4) :: diag(0:n_diag) = (/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ', '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) + + type out_name + character(len=fieldname_len), allocatable :: name(:) ! nbins + end type out_name + + type(out_name), allocatable :: burden_fields(:) ! num_aero_models + type(out_name), allocatable :: aodbin_fields(:) + type(out_name), allocatable :: aoddust_fields(:) + type(out_name), allocatable :: burdendn_fields(:) ! num_aero_models + type(out_name), allocatable :: aodbindn_fields(:) + type(out_name), allocatable :: aoddustdn_fields(:) + +contains + + !=============================================================================== + subroutine aerosol_optics_cam_readnl(nlfile) + use namelist_utils, only : find_group_name + use spmd_utils, only : mpicom, masterprocid, mpi_character, mpi_success + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aerosol_optics_cam_readnl' + + ! =================== + ! Namelist definition + ! =================== + namelist /aerosol_optics_nl/ water_refindex_file + + ! ============= + ! Read namelist + ! ============= + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aerosol_optics_nl', status=ierr) + if (ierr == 0) then + read(unitn, aerosol_optics_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! ============================ + ! Broadcast namelist variables + ! ============================ + call mpi_bcast(water_refindex_file, len(water_refindex_file), mpi_character, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname // ':: ERROR mpi_bcast '//trim(water_refindex_file)) + end if + + if (masterproc) then + write(iulog,*) subname,': water_refindex_file = ',trim(water_refindex_file) + end if + + end subroutine aerosol_optics_cam_readnl + + !=============================================================================== + subroutine aerosol_optics_cam_init + use rad_constituents, only: rad_cnst_get_info + use phys_control, only: phys_getopts + use ioFileMod, only: getfil + + character(len=*), parameter :: prefix = 'aerosol_optics_cam_sw: ' + integer :: nmodes=0, nbins=0, iaermod, istat, ilist, i + + logical :: call_list(0:n_diag) + real(r8) :: lwavlen_lo(nlwbands), lwavlen_hi(nlwbands) + integer :: m, n + + character(len=30) :: fldname + character(len=128) :: lngname + logical :: history_aero_optics ! output aerosol optics diagnostics + + character(len=256) :: locfile + + call phys_getopts(history_aero_optics_out = history_aero_optics) + + num_aero_models = 0 + nbins = 0 + + call rad_cnst_get_info(0, nmodes=nmodes) + modal_active = nmodes>0 + carma_active = nbins>0 + + if (modal_active) then + num_aero_models = num_aero_models+1 + end if + if (carma_active) then + num_aero_models = num_aero_models+1 + end if + + if (num_aero_models>0) then + allocate(aero_props(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aero_props') + end if + end if + + iaermod = 0 + + if (modal_active) then + iaermod = iaermod+1 + aero_props(iaermod)%obj => modal_aerosol_properties() +!!$ else if (carma_active) then +!!$ iaermod = iaermod+1 +!!$ aero_props(iaermod)%obj => carma_aerosol_properties() + end if + + if (water_refindex_file/='NONE') then + call getfil(water_refindex_file, locfile) + call read_water_refindex(locfile) + end if + + call get_lw_spectral_boundaries(lwavlen_lo, lwavlen_hi, units='um') + do i = 1,nlwbands + if ((lwavlen_lo(i)<=10._r8) .and. (lwavlen_hi(i)>=10._r8)) then + lw10um_indx = i + end if + end do + call rad_cnst_get_call_list(call_list) + + do ilist = 0, n_diag + if (call_list(ilist)) then + call addfld ('EXTINCT'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 550 nm, day only', flag_xyfill=.true.) + call addfld ('EXTINCTUV'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 350 nm, day only', flag_xyfill=.true.) + call addfld ('EXTINCTNIR'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 1020 nm, day only', flag_xyfill=.true.) + call addfld ('ABSORB'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol absorption, day only', flag_xyfill=.true.) + call addfld ('AODVIS'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 550 nm', flag_xyfill=.true.) + call addfld ('AODVISst'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 550 nm, day only', flag_xyfill=.true.) + call addfld ('AODNIRst'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 1020 nm, day only',flag_xyfill=.true.) + call addfld ('AODUVst'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 350 nm, day only', flag_xyfill=.true.) + call addfld ('AODUV'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 350 nm, day only', flag_xyfill=.true.) + call addfld ('AODNIR'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 1020 nm, day only',flag_xyfill=.true.) + call addfld ('AODABS'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol absorption optical depth 550 nm, day only', flag_xyfill=.true.) + call addfld ('AODxASYM'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 550 * asymmetry factor, day only', flag_xyfill=.true.) + call addfld ('EXTxASYM'//diag(ilist), (/ 'lev' /), 'A',' ', & + 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) + call addfld ('AODTOT'//diag(ilist), horiz_only, 'A','1',& + 'Aerosol optical depth summed over all sw wavelenghts', flag_xyfill=.true.) + + call addfld ('EXTINCTdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 550 nm, day only') + call addfld ('EXTINCTUVdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 350 nm, day only') + call addfld ('EXTINCTNIRdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 1020 nm, day only') + call addfld ('ABSORBdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol absorption, day only') + call addfld ('AODVISdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 550 nm') + call addfld ('AODVISstdn'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 550 nm, day only') + call addfld ('AODNIRstdn'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 1020 nm, day only') + call addfld ('AODUVstdn'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 350 nm, day only') + call addfld ('AODUVdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 350 nm, day only') + call addfld ('AODNIRdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 1020 nm, day only',flag_xyfill=.true.) + call addfld ('AODABSdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol absorption optical depth 550 nm, day only') + call addfld ('AODxASYMdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 550 * asymmetry factor, day only') + call addfld ('EXTxASYMdn'//diag(ilist), (/ 'lev' /), 'A',' ', & + 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) + call addfld ('AODTOTdn'//diag(ilist), horiz_only, 'A','1',& + 'Aerosol optical depth summed over all sw wavelenghts') + + if (lw10um_indx>0) then + call addfld('AODABSLW'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol long-wave absorption optical depth at 10 microns') + end if + call addfld ('TOTABSLW'//diag(ilist), (/ 'lev' /), 'A',' ', & + 'LW Aero total abs') + + if (history_aero_optics) then + call add_default ('EXTINCT'//diag(ilist), 1, ' ') + call add_default ('ABSORB'//diag(ilist), 1, ' ') + call add_default ('AODVIS'//diag(ilist), 1, ' ') + call add_default ('AODVISst'//diag(ilist), 1, ' ') + call add_default ('AODABS'//diag(ilist), 1, ' ') + end if + + end if + end do + + + if (num_aero_models>0) then + + allocate(burden_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: burden_fields') + end if + allocate(aodbin_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aodbin_fields') + end if + allocate(aoddust_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aoddust_fields') + end if + + allocate(burdendn_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: burdendn_fields') + end if + allocate(aodbindn_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aodbindn_fields') + end if + allocate(aoddustdn_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aoddustdn_fields') + end if + + do n = 1,num_aero_models + + allocate(burden_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: burden_fields(n)%name') + end if + allocate(aodbin_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aodbin_fields(n)%name') + end if + allocate(aoddust_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aoddust_fields(n)%name') + end if + + allocate(burdendn_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: burdendn_fields(n)%name') + end if + allocate(aodbindn_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aodbindn_fields(n)%name') + end if + allocate(aoddustdn_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aoddustdn_fields(n)%name') + end if + + do m = 1, aero_props(n)%obj%nbins() + + write(fldname,'(a,i2.2)') 'BURDEN', m + 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.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + write(fldname,'(a,i2.2)') 'AOD', m + aodbin_fields(n)%name(m) = fldname + write(lngname,'(a,i2)') 'Aerosol optical depth, day only, 550 nm bin ', m + call addfld (aodbin_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + write(fldname,'(a,i2.2)') 'AODDUST', m + 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.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + write(fldname,'(a,i2.2)') 'BURDENdn', m + 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.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + write(fldname,'(a,i2.2)') 'AODdn', m + aodbindn_fields(n)%name(m) = fldname + write(lngname,'(a,i2)') 'Aerosol optical depth 550 nm, day night, bin ', m + call addfld (aodbindn_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + write(fldname,'(a,i2.2)') 'AODdnDUST', m + 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.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + end do + + end do + + end if + + call addfld ('AODDUST', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day only', & + flag_xyfill=.true.) + call addfld ('AODSO4', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day only', & + flag_xyfill=.true.) + call addfld ('AODPOM', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day only', & + flag_xyfill=.true.) + call addfld ('AODSOA', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day only', & + flag_xyfill=.true.) + call addfld ('AODBC', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day only', & + flag_xyfill=.true.) + call addfld ('AODSS', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day only', & + flag_xyfill=.true.) + call addfld ('AODABSBC', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day only',& + flag_xyfill=.true.) + call addfld ('BURDENDUST', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENSO4', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENPOM', horiz_only, 'A','kg/m2', 'POM aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENSOA', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENBC', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day only', & + flag_xyfill=.true.) + call addfld ('BURDENSEASALT', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('SSAVIS', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day only', & + flag_xyfill=.true.) + + call addfld ('AODDUSTdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day night', & + flag_xyfill=.true.) + call addfld ('AODSO4dn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day night', & + flag_xyfill=.true.) + call addfld ('AODPOMdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day night', & + flag_xyfill=.true.) + call addfld ('AODSOAdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day night', & + flag_xyfill=.true.) + call addfld ('AODBCdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day night', & + flag_xyfill=.true.) + call addfld ('AODSSdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day night', & + flag_xyfill=.true.) + call addfld ('AODABSBCdn', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day night',& + flag_xyfill=.true.) + call addfld ('BURDENDUSTdn', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENSO4dn', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENPOMdn', horiz_only, 'A','kg/m2', 'POM aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENSOAdn', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENBCdn', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day night', & + flag_xyfill=.true.) + call addfld ('BURDENSEASALTdn', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('SSAVISdn', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day night', & + flag_xyfill=.true.) + + end subroutine aerosol_optics_cam_init + + !=============================================================================== + subroutine aerosol_optics_cam_final + + integer :: iaermod + + do iaermod = 1,num_aero_models + deallocate(aero_props(iaermod)%obj) + nullify(aero_props(iaermod)%obj) + end do + + if (allocated(aero_props)) then + deallocate(aero_props) + endif + + end subroutine aerosol_optics_cam_final + + !=============================================================================== + subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, wa, ga, fa) + + ! calculates aerosol sw radiative properties + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + type(physics_state), intent(in), target :: state ! state variables + + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(nnite) ! local column indices of night columns + + real(r8), intent(inout) :: tauxar(pcols,0:pver,nswbands) ! layer extinction optical depth + real(r8), intent(inout) :: wa(pcols,0:pver,nswbands) ! layer single-scatter albedo + real(r8), intent(inout) :: ga(pcols,0:pver,nswbands) ! asymmetry factor + real(r8), intent(inout) :: fa(pcols,0:pver,nswbands) ! forward scattered fraction + + character(len=*), parameter :: prefix = 'aerosol_optics_cam_sw: ' + + integer :: ibin, nbins + integer :: iwav, ilev + integer :: icol, istat + integer :: lchnk, ncol + + type(aero_state_t), allocatable :: aero_state(:) + + class(aerosol_optics), pointer :: aero_optics + + real(r8) :: dopaer(pcols) + real(r8) :: mass(pcols,pver) + real(r8) :: air_density(pcols,pver) + + real(r8), allocatable :: pext(:) + real(r8), allocatable :: pabs(:) + real(r8), allocatable :: palb(:) + real(r8), allocatable :: pasm(:) + + real(r8) :: relh(pcols,pver) + real(r8) :: sate(pcols,pver) ! saturation vapor pressure + real(r8) :: satq(pcols,pver) ! saturation specific humidity + + character(len=ot_length) :: opticstype + integer :: iaermod + + real(r8) :: aodvis(pcols) ! extinction optical depth in vis + real(r8) :: aoduv(pcols) ! extinction optical depth in uv + real(r8) :: aodnir(pcols) ! extinction optical depth in nir + real(r8) :: absorb(pcols,pver) + real(r8) :: aodabs(pcols) ! absorption optical depth + + real(r8) :: aodabsbc(pcols) ! absorption optical depth of BC + + real(r8) :: aodtot(pcols) + + real(r8) :: extinct(pcols,pver) + real(r8) :: extinctnir(pcols,pver) + real(r8) :: extinctuv(pcols,pver) + + real(r8) :: asymvis(pcols) ! asymmetry factor * optical depth + real(r8) :: asymext(pcols,pver) ! asymmetry factor * extinction + + real(r8) :: wetvol(pcols,pver) + real(r8) :: watervol(pcols,pver) + + real(r8) :: vol(pcols) + real(r8) :: dustvol(pcols) + + real(r8) :: scatdust(pcols) + real(r8) :: absdust(pcols) + real(r8) :: dustaodbin(pcols) + + real(r8) :: scatbc(pcols) + real(r8) :: absbc(pcols) + + real(r8) :: scatpom(pcols) + real(r8) :: abspom(pcols) + + real(r8) :: scatsslt(pcols) + real(r8) :: abssslt(pcols) + + real(r8) :: scatsoa(pcols) + real(r8) :: abssoa(pcols) + + real(r8) :: scatsulf(pcols) + real(r8) :: abssulf(pcols) + + real(r8) :: burden(pcols) + real(r8) :: burdendust(pcols), burdenso4(pcols), burdenbc(pcols), & + burdenpom(pcols), burdensoa(pcols), burdenseasalt(pcols) + + real(r8) :: hygrodust(pcols), hygrosulf(pcols), hygrobc(pcols), & + hygropom(pcols), hygrosoa(pcols), hygrosslt(pcols) + + real(r8) :: aodbin(pcols) + + complex(r8), pointer :: specrefindex(:) ! species refractive index + + class(aerosol_state), pointer :: aerostate + class(aerosol_properties), pointer :: aeroprops + integer :: ispec + real(r8) :: specdens + character(len=32) :: spectype ! species type + real(r8), pointer :: specmmr(:,:) + real(r8) :: hygro_aer ! + + real(r8) :: scath2o, absh2o, sumscat, sumabs, sumhygro + + real(r8) :: aodc ! aod of component + + ! total species AOD + real(r8) :: dustaod(pcols), sulfaod(pcols), bcaod(pcols), & + pomaod(pcols), soaaod(pcols), ssltaod(pcols) + + real(r8) :: aodvisst(pcols) ! stratospheric extinction optical depth + real(r8) :: aoduvst(pcols) ! stratospheric extinction optical depth in uv + real(r8) :: aodnirst(pcols) ! stratospheric extinction optical depth in nir + real(r8) :: ssavis(pcols) + integer :: troplev(pcols) + + nullify(aero_optics) + + call tropopause_find(state, troplev) + + lchnk = state%lchnk + ncol = state%ncol + + mass(:ncol,:) = state%pdeldry(:ncol,:)*rga + air_density(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) + + aodvis = 0._r8 + aodnir = 0._r8 + aoduv = 0._r8 + aodabs = 0._r8 + absorb = 0._r8 + aodtot = 0._r8 + tauxar = 0._r8 + extinct = 0._r8 + extinctnir = 0._r8 + extinctuv = 0._r8 + asymvis = 0.0_r8 + asymext = 0.0_r8 + ssavis = 0.0_r8 + aodvisst = 0.0_r8 + aoduvst = 0.0_r8 + aodnirst = 0.0_r8 + + burdendust = 0.0_r8 + burdenso4 = 0.0_r8 + burdenbc = 0.0_r8 + burdenpom = 0.0_r8 + burdensoa = 0.0_r8 + burdenseasalt = 0.0_r8 + + aodabsbc = 0.0_r8 + dustaod = 0.0_r8 + sulfaod = 0.0_r8 + pomaod = 0.0_r8 + soaaod = 0.0_r8 + bcaod = 0.0_r8 + ssltaod = 0.0_r8 + + if (num_aero_models<1) return + + allocate(aero_state(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aero_state') + end if + + iaermod = 0 + if (modal_active) then + iaermod = iaermod+1 + aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) +!!$ else if (carma_active) then +!!$ iaermod = iaermod+1 +!!$ aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) + end if + + allocate(pext(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: pext') + end if + allocate(pabs(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: pabs') + end if + allocate(palb(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: palb') + end if + allocate(pasm(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: pasm') + end if + + aeromodel: do iaermod = 1,num_aero_models + + aeroprops => aero_props(iaermod)%obj + aerostate => aero_state(iaermod)%obj + + nbins=aeroprops%nbins(list_idx) + + binloop: do ibin = 1, nbins + + dustaodbin(:) = 0._r8 + burden(:) = 0._r8 + 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, & + 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) + case default + call endrun(prefix//'optics method not recognized') + end select + + if (associated(aero_optics)) then + + wetvol(:ncol,:pver) = aerostate%wet_volume(aeroprops, list_idx, ibin, ncol, pver) + watervol(:ncol,:pver) = aerostate%water_volume(aeroprops, list_idx, ibin, ncol, pver) + + wavelength: do iwav = 1, nswbands + + vertical: do ilev = 1, pver + + call aero_optics%sw_props(ncol, ilev, iwav, pext, pabs, palb, pasm ) + + call init_diags + + column: do icol = 1,ncol + dopaer(icol) = pext(icol)*mass(icol,ilev) + 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 + + end do column + + end do vertical + end do wavelength + + else + call endrun(prefix//'aero_optics object pointer not associated') + end if + + deallocate(aero_optics) + nullify(aero_optics) + + call output_bin_diags + + end do binloop + end do aeromodel + + call output_tot_diags + + deallocate(pext) + deallocate(pabs) + deallocate(palb) + deallocate(pasm) + + do iaermod = 1,num_aero_models + deallocate(aero_state(iaermod)%obj) + nullify(aero_state(iaermod)%obj) + end do + + deallocate(aero_state) + + contains + + !=============================================================================== + subroutine init_diags + scatdust(:ncol) = 0._r8 + absdust(:ncol) = 0._r8 + hygrodust(:ncol) = 0._r8 + scatsulf(:ncol) = 0._r8 + abssulf(:ncol) = 0._r8 + hygrosulf(:ncol) = 0._r8 + scatbc(:ncol) = 0._r8 + absbc(:ncol) = 0._r8 + hygrobc(:ncol) = 0._r8 + scatpom(:ncol) = 0._r8 + abspom(:ncol) = 0._r8 + hygropom(:ncol) = 0._r8 + scatsoa(:ncol) = 0._r8 + abssoa(:ncol) = 0._r8 + hygrosoa(:ncol) = 0._r8 + scatsslt(:ncol) = 0._r8 + abssslt(:ncol) = 0._r8 + hygrosslt(:ncol) = 0._r8 + end subroutine init_diags + + !=============================================================================== + subroutine update_diags + + integer :: ispec + + if (iwav==idx_uv_diag) then + aoduv(icol) = aoduv(icol) + dopaer(icol) + extinctuv(icol,ilev) = extinctuv(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) + if (ilev.le.troplev(icol)) then + aoduvst(icol) = aoduvst(icol) + dopaer(icol) + end if + + else if (iwav==idx_sw_diag) then ! vis + aodvis(icol) = aodvis(icol) + dopaer(icol) + aodabs(icol) = aodabs(icol) + pabs(icol)*mass(icol,ilev) + extinct(icol,ilev) = extinct(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) + absorb(icol,ilev) = absorb(icol,ilev) + pabs(icol)*air_density(icol,ilev) + ssavis(icol) = ssavis(icol) + dopaer(icol)*palb(icol) + asymvis(icol) = asymvis(icol) + dopaer(icol)*pasm(icol) + asymext(icol,ilev) = asymext(icol,ilev) + dopaer(icol)*pasm(icol)*air_density(icol,ilev)/mass(icol,ilev) + + aodbin(icol) = aodbin(icol) + dopaer(icol) + + if (ilev.le.troplev(icol)) then + aodvisst(icol) = aodvisst(icol) + dopaer(icol) + end if + + ! loop over species ... + + do ispec = 1, aeroprops%nspecies(list_idx,ibin) + call aeroprops%get(ibin, ispec, list_ndx=list_idx, density=specdens, & + spectype=spectype, refindex_sw=specrefindex, hygro=hygro_aer) + call aerostate%get_ambient_mmr(list_idx, ispec, ibin, specmmr) + + burden(icol) = burden(icol) + specmmr(icol,ilev)*mass(icol,ilev) + + vol(icol) = specmmr(icol,ilev)/specdens + + select case ( trim(spectype) ) + case('dust') + dustvol(icol) = vol(icol) + burdendust(icol) = burdendust(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatdust(icol) = vol(icol) * specrefindex(iwav)%re + absdust(icol) =-vol(icol) * specrefindex(iwav)%im + hygrodust(icol)= vol(icol)*hygro_aer + case('black-c') + burdenbc(icol) = burdenbc(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatbc(icol) = vol(icol) * specrefindex(iwav)%re + absbc(icol) =-vol(icol) * specrefindex(iwav)%im + hygrobc(icol)= vol(icol)*hygro_aer + case('sulfate') + burdenso4(icol) = burdenso4(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatsulf(icol) = vol(icol) * specrefindex(iwav)%re + abssulf(icol) =-vol(icol) * specrefindex(iwav)%im + hygrosulf(icol)= vol(icol)*hygro_aer + case('p-organic') + burdenpom(icol) = burdenpom(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatpom(icol) = vol(icol) * specrefindex(iwav)%re + abspom(icol) =-vol(icol) * specrefindex(iwav)%im + hygropom(icol)= vol(icol)*hygro_aer + case('s-organic') + burdensoa(icol) = burdensoa(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatsoa(icol) = vol(icol) * specrefindex(iwav)%re + abssoa(icol) = -vol(icol) * specrefindex(iwav)%im + hygrosoa(icol)= vol(icol)*hygro_aer + case('seasalt') + burdenseasalt(icol) = burdenseasalt(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatsslt(icol) = vol(icol) * specrefindex(iwav)%re + abssslt(icol) = -vol(icol) * specrefindex(iwav)%im + hygrosslt(icol)= vol(icol)*hygro_aer + end select + end do + + if (wetvol(icol,ilev)>1.e-40_r8 .and. vol(icol)>0._r8) then + + dustaodbin(icol) = dustaodbin(icol) + dopaer(icol)*dustvol(icol)/wetvol(icol,ilev) + + ! partition optical depth into contributions from each constituent + ! assume contribution is proportional to refractive index X volume + + scath2o = watervol(icol,ilev)*crefwsw(iwav)%re + absh2o = -watervol(icol,ilev)*crefwsw(iwav)%im + sumscat = scatsulf(icol) + scatpom(icol) + scatsoa(icol) + scatbc(icol) + & + scatdust(icol) + scatsslt(icol) + scath2o + sumabs = abssulf(icol) + abspom(icol) + abssoa(icol) + absbc(icol) + & + absdust(icol) + abssslt(icol) + absh2o + sumhygro = hygrosulf(icol) + hygropom(icol) + hygrosoa(icol) + hygrobc(icol) + & + hygrodust(icol) + hygrosslt(icol) + + scatdust(icol) = (scatdust(icol) + scath2o*hygrodust(icol)/sumhygro)/sumscat + absdust(icol) = (absdust(icol) + absh2o*hygrodust(icol)/sumhygro)/sumabs + + scatsulf(icol) = (scatsulf(icol) + scath2o*hygrosulf(icol)/sumhygro)/sumscat + abssulf(icol) = (abssulf(icol) + absh2o*hygrosulf(icol)/sumhygro)/sumabs + + scatpom(icol) = (scatpom(icol) + scath2o*hygropom(icol)/sumhygro)/sumscat + abspom(icol) = (abspom(icol) + absh2o*hygropom(icol)/sumhygro)/sumabs + + scatsoa(icol) = (scatsoa(icol) + scath2o*hygrosoa(icol)/sumhygro)/sumscat + abssoa(icol) = (abssoa(icol) + absh2o*hygrosoa(icol)/sumhygro)/sumabs + + scatbc(icol)= (scatbc(icol) + scath2o*hygrobc(icol)/sumhygro)/sumscat + absbc(icol) = (absbc(icol) + absh2o*hygrobc(icol)/sumhygro)/sumabs + + scatsslt(icol) = (scatsslt(icol) + scath2o*hygrosslt(icol)/sumhygro)/sumscat + abssslt(icol) = (abssslt(icol) + absh2o*hygrosslt(icol)/sumhygro)/sumabs + + + aodabsbc(icol) = aodabsbc(icol) + absbc(icol)*dopaer(icol)*(1.0_r8-palb(icol)) + + + + aodc = (absdust(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatdust(icol))*dopaer(icol) + dustaod(icol) = dustaod(icol) + aodc + + aodc = (abssulf(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatsulf(icol))*dopaer(icol) + sulfaod(icol) = sulfaod(icol) + aodc + + aodc = (abspom(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatpom(icol))*dopaer(icol) + pomaod(icol) = pomaod(icol) + aodc + + aodc = (abssoa(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatsoa(icol))*dopaer(icol) + soaaod(icol) = soaaod(icol) + aodc + + aodc = (absbc(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatbc(icol))*dopaer(icol) + bcaod(icol) = bcaod(icol) + aodc + + aodc = (abssslt(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatsslt(icol))*dopaer(icol) + ssltaod(icol) = ssltaod(icol) + aodc + + end if + else if (iwav==idx_nir_diag) then + aodnir(icol) = aodnir(icol) + dopaer(icol) + extinctnir(icol,ilev) = extinctnir(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) + + if (ilev.le.troplev(icol)) then + aodnirst(icol) = aodnirst(icol) + dopaer(icol) + end if + + end if + + aodtot(icol) = aodtot(icol) + dopaer(icol) + + end subroutine update_diags + + !=============================================================================== + subroutine output_bin_diags + + integer :: icol + + if (list_idx == 0) then + + call outfld(burdendn_fields(iaermod)%name(ibin), burden, pcols, lchnk) + call outfld(aoddustdn_fields(iaermod)%name(ibin), dustaodbin, pcols, lchnk) + call outfld(aodbindn_fields(iaermod)%name(ibin), aodbin, pcols, lchnk) + + do icol = 1, nnite + burden(idxnite(icol)) = fillvalue + aodbin(idxnite(icol)) = fillvalue + dustaodbin(idxnite(icol)) = fillvalue + end do + + call outfld(burden_fields(iaermod)%name(ibin), burden, pcols, lchnk) + call outfld(aoddust_fields(iaermod)%name(ibin), dustaodbin, pcols, lchnk) + call outfld(aodbin_fields(iaermod)%name(ibin), aodbin, pcols, lchnk) + + endif + + end subroutine output_bin_diags + + !=============================================================================== + subroutine output_tot_diags + + integer :: icol + + call outfld('AODUVdn'//diag(list_idx), aoduv, pcols, lchnk) + call outfld('AODVISdn'//diag(list_idx), aodvis, pcols, lchnk) + call outfld('AODABSdn'//diag(list_idx), aodabs, pcols, lchnk) + + call outfld('AODNIRdn'//diag(list_idx), aodnir, pcols, lchnk) + call outfld('AODABSdn'//diag(list_idx), aodabs, pcols, lchnk) + call outfld('AODTOTdn'//diag(list_idx), aodtot, pcols, lchnk) + call outfld('EXTINCTUVdn'//diag(list_idx), extinctuv, pcols, lchnk) + call outfld('EXTINCTNIRdn'//diag(list_idx), extinctnir, pcols, lchnk) + call outfld('EXTINCTdn'//diag(list_idx), extinct, pcols, lchnk) + call outfld('ABSORBdn'//diag(list_idx), absorb, pcols, lchnk) + call outfld('EXTxASYMdn'//diag(list_idx), asymext, pcols, lchnk) + call outfld('AODxASYMdn'//diag(list_idx), asymvis, pcols, lchnk) + + call outfld('AODVISstdn'//diag(list_idx), aodvisst,pcols, lchnk) + call outfld('AODUVstdn'//diag(list_idx), aoduvst, pcols, lchnk) + call outfld('AODNIRstdn'//diag(list_idx), aodnirst,pcols, lchnk) + + do icol = 1, nnite + aodvis(idxnite(icol)) = fillvalue + aodnir(idxnite(icol)) = fillvalue + aoduv(idxnite(icol)) = fillvalue + aodabs(idxnite(icol)) = fillvalue + aodtot(idxnite(icol)) = fillvalue + extinct(idxnite(icol),:) = fillvalue + extinctnir(idxnite(icol),:) = fillvalue + extinctuv(idxnite(icol),:) = fillvalue + absorb(idxnite(icol),:) = fillvalue + asymext(idxnite(icol),:) = fillvalue + asymvis(idxnite(icol)) = fillvalue + aodabs(idxnite(icol)) = fillvalue + aodvisst(idxnite(icol)) = fillvalue + aoduvst(idxnite(icol)) = fillvalue + aodnirst(idxnite(icol)) = fillvalue + end do + + call outfld('AODUV'//diag(list_idx), aoduv, pcols, lchnk) + call outfld('AODVIS'//diag(list_idx), aodvis, pcols, lchnk) + call outfld('AODABS'//diag(list_idx), aodabs, pcols, lchnk) + call outfld('AODNIR'//diag(list_idx), aodnir, pcols, lchnk) + call outfld('AODABS'//diag(list_idx), aodabs, pcols, lchnk) + call outfld('AODTOT'//diag(list_idx), aodtot, pcols, lchnk) + call outfld('EXTINCTUV'//diag(list_idx), extinctuv, pcols, lchnk) + call outfld('EXTINCTNIR'//diag(list_idx), extinctnir, pcols, lchnk) + call outfld('EXTINCT'//diag(list_idx), extinct, pcols, lchnk) + call outfld('ABSORB'//diag(list_idx), absorb, pcols, lchnk) + call outfld('EXTxASYM'//diag(list_idx), asymext, pcols, lchnk) + call outfld('AODxASYM'//diag(list_idx), asymvis, pcols, lchnk) + call outfld('AODVISst'//diag(list_idx), aodvisst,pcols, lchnk) + call outfld('AODUVst'//diag(list_idx), aoduvst, pcols, lchnk) + call outfld('AODNIRst'//diag(list_idx), aodnirst,pcols, lchnk) + + ! These diagnostics are output only for climate list + if (list_idx == 0) then + do icol = 1, ncol + if (aodvis(icol) > 1.e-10_r8) then + ssavis(icol) = ssavis(icol)/aodvis(icol) + else + ssavis(icol) = 0.925_r8 + endif + end do + call outfld('SSAVISdn', ssavis, pcols, lchnk) + + call outfld('BURDENDUSTdn', burdendust, pcols, lchnk) + call outfld('BURDENSO4dn' , burdenso4, pcols, lchnk) + call outfld('BURDENPOMdn' , burdenpom, pcols, lchnk) + call outfld('BURDENSOAdn' , burdensoa, pcols, lchnk) + call outfld('BURDENBCdn' , burdenbc, pcols, lchnk) + call outfld('BURDENSEASALTdn', burdenseasalt, pcols, lchnk) + + call outfld('AODABSBCdn', aodabsbc, pcols, lchnk) + + call outfld('AODDUSTdn', dustaod, pcols, lchnk) + call outfld('AODSO4dn', sulfaod, pcols, lchnk) + call outfld('AODPOMdn', pomaod, pcols, lchnk) + call outfld('AODSOAdn', soaaod, pcols, lchnk) + call outfld('AODBCdn', bcaod, pcols, lchnk) + call outfld('AODSSdn', ssltaod, pcols, lchnk) + + + do icol = 1, nnite + + ssavis(idxnite(icol)) = fillvalue + asymvis(idxnite(icol)) = fillvalue + + burdendust(idxnite(icol)) = fillvalue + burdenso4(idxnite(icol)) = fillvalue + burdenpom(idxnite(icol)) = fillvalue + burdensoa(idxnite(icol)) = fillvalue + burdenbc(idxnite(icol)) = fillvalue + burdenseasalt(idxnite(icol)) = fillvalue + aodabsbc(idxnite(icol)) = fillvalue + + dustaod(idxnite(icol)) = fillvalue + sulfaod(idxnite(icol)) = fillvalue + pomaod(idxnite(icol)) = fillvalue + soaaod(idxnite(icol)) = fillvalue + bcaod(idxnite(icol)) = fillvalue + ssltaod(idxnite(icol)) = fillvalue + + end do + + call outfld('AODxASYM', asymvis, pcols, lchnk) + + call outfld('BURDENDUST', burdendust, pcols, lchnk) + call outfld('BURDENSO4' , burdenso4, pcols, lchnk) + call outfld('BURDENPOM' , burdenpom, pcols, lchnk) + call outfld('BURDENSOA' , burdensoa, pcols, lchnk) + call outfld('BURDENBC' , burdenbc, pcols, lchnk) + call outfld('BURDENSEASALT', burdenseasalt, pcols, lchnk) + + call outfld('AODABSBC', aodabsbc, pcols, lchnk) + + call outfld('AODDUST', dustaod, pcols, lchnk) + call outfld('AODSO4', sulfaod, pcols, lchnk) + call outfld('AODPOM', pomaod, pcols, lchnk) + call outfld('AODSOA', soaaod, pcols, lchnk) + call outfld('AODBC', bcaod, pcols, lchnk) + call outfld('AODSS', ssltaod, pcols, lchnk) + + end if + + end subroutine output_tot_diags + + end subroutine aerosol_optics_cam_sw + + !=============================================================================== + subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) + + ! calculates aerosol lw radiative properties + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + type(physics_state), intent(in), target :: state ! state variables + + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(inout) :: tauxar(pcols,pver,nlwbands) ! layer absorption optical depth + + + real(r8) :: dopaer(pcols) + real(r8) :: mass(pcols,pver) + + character(len=*), parameter :: prefix = 'aerosol_optics_cam_lw: ' + + integer :: ibin, nbins + integer :: iwav, ilev + integer :: ncol, icol, istat + + type(aero_state_t), allocatable :: aero_state(:) + + class(aerosol_optics), pointer :: aero_optics + class(aerosol_state), pointer :: aerostate + class(aerosol_properties), pointer :: aeroprops + + real(r8), allocatable :: pabs(:) + + real(r8) :: relh(pcols,pver) + real(r8) :: sate(pcols,pver) ! saturation vapor pressure + real(r8) :: satq(pcols,pver) ! saturation specific humidity + + character(len=32) :: opticstype + integer :: iaermod + + real(r8) :: lwabs(pcols,pver) + lwabs = 0._r8 + tauxar = 0._r8 + + nullify(aero_optics) + + allocate(aero_state(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aero_state') + end if + + iaermod = 0 + if (modal_active) then + iaermod = iaermod+1 + aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) +!!$ else if (carma_active) then +!!$ iaermod = iaermod+1 +!!$ aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) + end if + + ncol = state%ncol + + mass(:ncol,:) = state%pdeldry(:ncol,:)*rga + + allocate(pabs(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: pabs') + end if + + aeromodel: do iaermod = 1,num_aero_models + + aeroprops => aero_props(iaermod)%obj + aerostate => aero_state(iaermod)%obj + + nbins=aero_props(iaermod)%obj%nbins(list_idx) + + binloop: do ibin = 1, nbins + + 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, 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) + case default + call endrun(prefix//'optics method not recognized') + end select + + if (associated(aero_optics)) then + + wavelength: do iwav = 1, nlwbands + + vertical: do ilev = 1, pver + call aero_optics%lw_props(ncol, ilev, iwav, pabs ) + + column: do icol = 1, ncol + dopaer(icol) = pabs(icol)*mass(icol,ilev) + tauxar(icol,ilev,iwav) = tauxar(icol,ilev,iwav) + dopaer(icol) + lwabs(icol,ilev) = lwabs(icol,ilev) + pabs(icol) + end do column + + end do vertical + + end do wavelength + + else + call endrun(prefix//'aero_optics object pointer not associated') + end if + + deallocate(aero_optics) + nullify(aero_optics) + + end do binloop + end do aeromodel + + call outfld('TOTABSLW'//diag(list_idx), lwabs(:,:), pcols, state%lchnk) + + if (lw10um_indx>0) then + call outfld('AODABSLW'//diag(list_idx), tauxar(:,:,lw10um_indx), pcols, state%lchnk) + end if + + deallocate(pabs) + + do iaermod = 1,num_aero_models + deallocate(aero_state(iaermod)%obj) + nullify(aero_state(iaermod)%obj) + end do + + deallocate(aero_state) + + end subroutine aerosol_optics_cam_lw + + !=============================================================================== + ! Private routines + !=============================================================================== + + subroutine read_water_refindex(infilename) + use cam_pio_utils, only: cam_pio_openfile + use pio, only: file_desc_t, var_desc_t, pio_inq_dimlen, pio_inq_dimid, pio_inq_varid, & + pio_get_var, PIO_NOWRITE, pio_closefile + + + ! read water refractive index file and set module data + + character*(*), intent(in) :: infilename ! modal optics filename + + ! Local variables + + integer :: i, ierr + type(file_desc_t) :: ncid ! pio file handle + integer :: did ! dimension ids + integer :: dimlen ! dimension lengths + type(var_desc_t) :: vid ! variable ids + real(r8) :: refrwsw(nswbands), refiwsw(nswbands) ! real, imaginary ref index for water visible + real(r8) :: refrwlw(nlwbands), refiwlw(nlwbands) ! real, imaginary ref index for water infrared + !---------------------------------------------------------------------------- + + ! open file + call cam_pio_openfile(ncid, infilename, PIO_NOWRITE) + + ! inquire dimensions. Check that file values match parameter values. + + ierr = pio_inq_dimid(ncid, 'lw_band', did) + ierr = pio_inq_dimlen(ncid, did, dimlen) + if (dimlen .ne. nlwbands) then + write(iulog,*) 'lw_band len=', dimlen, ' from ', infilename, ' ne nlwbands=', nlwbands + call endrun('read_modal_optics: bad lw_band value') + endif + + ierr = pio_inq_dimid(ncid, 'sw_band', did) + ierr = pio_inq_dimlen(ncid, did, dimlen) + if (dimlen .ne. nswbands) then + write(iulog,*) 'sw_band len=', dimlen, ' from ', infilename, ' ne nswbands=', nswbands + call endrun('read_modal_optics: bad sw_band value') + endif + + ! read variables + ierr = pio_inq_varid(ncid, 'refindex_real_water_sw', vid) + ierr = pio_get_var(ncid, vid, refrwsw) + + ierr = pio_inq_varid(ncid, 'refindex_im_water_sw', vid) + ierr = pio_get_var(ncid, vid, refiwsw) + + ierr = pio_inq_varid(ncid, 'refindex_real_water_lw', vid) + ierr = pio_get_var(ncid, vid, refrwlw) + + ierr = pio_inq_varid(ncid, 'refindex_im_water_lw', vid) + ierr = pio_get_var(ncid, vid, refiwlw) + + ! set complex representation of refractive indices as module data + do i = 1, nswbands + crefwsw(i) = cmplx(refrwsw(i), abs(refiwsw(i)),kind=r8) + end do + do i = 1, nlwbands + crefwlw(i) = cmplx(refrwlw(i), abs(refiwlw(i)),kind=r8) + end do + + call pio_closefile(ncid) + + end subroutine read_water_refindex + +end module aerosol_optics_cam diff --git a/src/physics/cam/modal_aer_opt.F90 b/src/physics/cam/modal_aer_opt.F90 deleted file mode 100644 index 5c95c17840..0000000000 --- a/src/physics/cam/modal_aer_opt.F90 +++ /dev/null @@ -1,1621 +0,0 @@ -module modal_aer_opt - -! parameterizes aerosol coefficients using chebychev polynomial -! parameterize aerosol radiative properties in terms of -! surface mode wet radius and wet refractive index - -! Ghan and Zaveri, JGR 2007. - -! uses Wiscombe's (1979) mie scattering code - - -use shr_kind_mod, only: r8 => shr_kind_r8, shr_kind_cl -use ppgrid, only: pcols, pver, pverp -use constituents, only: pcnst -use spmd_utils, only: masterproc -use ref_pres, only: top_lev => clim_modal_aero_top_lev -use physconst, only: rhoh2o, rga, rair -use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_uv_diag, idx_nir_diag -use rad_constituents, only: n_diag, rad_cnst_get_call_list, rad_cnst_get_info, rad_cnst_get_aer_mmr, & - rad_cnst_get_aer_props, rad_cnst_get_mode_props -use physics_types, only: physics_state - -use physics_buffer, only : pbuf_get_index,physics_buffer_desc, pbuf_get_field -use pio, only: file_desc_t, var_desc_t, pio_inq_dimlen, pio_inq_dimid, pio_inq_varid, & - pio_get_var, pio_nowrite, pio_closefile -use cam_pio_utils, only: cam_pio_openfile -use cam_history, only: addfld, add_default, outfld, horiz_only -use cam_history_support, only: fillvalue -use cam_logfile, only: iulog -use perf_mod, only: t_startf, t_stopf -use cam_abortutils, only: endrun - -use modal_aero_wateruptake, only: modal_aero_wateruptake_dr -use modal_aero_calcsize, only: modal_aero_calcsize_diag - -implicit none -private -save - -public :: modal_aer_opt_readnl, modal_aer_opt_init, modal_aero_sw, modal_aero_lw - - -character(len=*), parameter :: unset_str = 'UNSET' - -! Namelist variables: -character(shr_kind_cl) :: modal_optics_file = unset_str ! full pathname for modal optics dataset -character(shr_kind_cl) :: water_refindex_file = unset_str ! full pathname for water refractive index dataset - -! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties -! in terms of refractive index and wet radius -integer, parameter :: ncoef=5, prefr=7, prefi=10 - -real(r8) :: xrmin, xrmax - -! refractive index for water read in read_water_refindex -complex(r8) :: crefwsw(nswbands) ! complex refractive index for water visible -complex(r8) :: crefwlw(nlwbands) ! complex refractive index for water infrared - -! physics buffer indices -integer :: dgnumwet_idx = -1 -integer :: qaerwat_idx = -1 - -character(len=4) :: diag(0:n_diag) = (/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ', & - '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) - -!=============================================================================== -CONTAINS -!=============================================================================== - -subroutine modal_aer_opt_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'modal_aer_opt_readnl' - - namelist /modal_aer_opt_nl/ water_refindex_file - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'modal_aer_opt_nl', status=ierr) - if (ierr == 0) then - read(unitn, modal_aer_opt_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - call mpibcast(water_refindex_file, len(water_refindex_file), mpichar, 0, mpicom) -#endif - - -end subroutine modal_aer_opt_readnl - -!=============================================================================== - -subroutine modal_aer_opt_init() - - use ioFileMod, only: getfil - use phys_control, only: phys_getopts - - ! Local variables - - integer :: i, m - real(r8) :: rmmin, rmmax ! min, max aerosol surface mode radius treated (m) - character(len=256) :: locfile - - 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 :: call_list(0:n_diag) - integer :: ilist, nmodes, m_ncoef, m_prefr, m_prefi - integer :: errcode - - character(len=*), parameter :: routine='modal_aer_opt_init' - character(len=10) :: fldname - character(len=128) :: lngname - - !---------------------------------------------------------------------------- - - rmmin = 0.01e-6_r8 - rmmax = 25.e-6_r8 - xrmin = log(rmmin) - xrmax = log(rmmax) - - ! Check that dimension sizes in the coefficient arrays used to - ! parameterize aerosol radiative properties are consistent between this - ! module and the mode physprop files. - call rad_cnst_get_call_list(call_list) - do ilist = 0, n_diag - if (call_list(ilist)) then - call rad_cnst_get_info(ilist, nmodes=nmodes) - do m = 1, nmodes - call rad_cnst_get_mode_props(ilist, m, ncoef=m_ncoef, prefr=m_prefr, prefi=m_prefi) - if (m_ncoef /= ncoef .or. m_prefr /= prefr .or. m_prefi /= prefi) then - write(iulog,*) routine//': ERROR - file and module values do not match:' - write(iulog,*) ' ncoef:', ncoef, m_ncoef - write(iulog,*) ' prefr:', prefr, m_prefr - write(iulog,*) ' prefi:', prefi, m_prefi - call endrun(routine//': ERROR - file and module values do not match') - end if - end do - end if - end do - - ! Initialize physics buffer indices for dgnumwet and qaerwat. Note the implicit assumption - ! that the loops over modes in the optics calculations will use the values for dgnumwet and qaerwat - ! that are set in the aerosol_wet_intr code. - dgnumwet_idx = pbuf_get_index('DGNUMWET',errcode) - if (errcode < 0) then - call endrun(routine//' ERROR: cannot find physics buffer field DGNUMWET') - end if - qaerwat_idx = pbuf_get_index('QAERWAT',errcode) - if (errcode < 0) then - call endrun(routine//' ERROR: cannot find physics buffer field QAERWAT') - end if - - call getfil(water_refindex_file, locfile) - call read_water_refindex(locfile) - if (masterproc) write(iulog,*) "modal_aer_opt_init: read water refractive index file:", trim(locfile) - - call phys_getopts(history_amwg_out = history_amwg, & - history_aero_optics_out = history_aero_optics, & - history_dust_out = history_dust ) - - ! Add diagnostic fields to history output. - - call addfld ('EXTINCT', (/ 'lev' /), 'A','/m','Aerosol extinction 550 nm, day only', & - flag_xyfill=.true.) - call addfld ('EXTINCTUV', (/ 'lev' /), 'A','/m','Aerosol extinction 350 nm, day only', & - flag_xyfill=.true.) - call addfld ('EXTINCTNIR', (/ 'lev' /), 'A','/m','Aerosol extinction 1020 nm, day only', & - flag_xyfill=.true.) - call addfld ('ABSORB', (/ 'lev' /), 'A','/m','Aerosol absorption, day only', & - flag_xyfill=.true.) - call addfld ('AODVIS', horiz_only, 'A',' ','Aerosol optical depth 550 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODVISst', horiz_only, 'A',' ','Stratospheric aerosol optical depth 550 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODUV', horiz_only, 'A',' ','Aerosol optical depth 350 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODUVst', horiz_only, 'A',' ','Stratospheric aerosol optical depth 350 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODNIR', horiz_only, 'A',' ','Aerosol optical depth 1020 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODNIRst', horiz_only, 'A',' ','Stratospheric aerosol optical depth 1020 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODABS', horiz_only, 'A',' ','Aerosol absorption optical depth 550 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODxASYM', horiz_only, 'A',' ','Aerosol optical depth 550 * asymmetry factor, day only',& - flag_xyfill=.true.) - call addfld ('EXTxASYM', (/ 'lev' /), 'A',' ','extinction 550 nm * asymmetry factor, day only', & - flag_xyfill=.true.) - - call addfld ('EXTINCTdn', (/ 'lev' /), 'A','/m','Aerosol extinction 550 nm, day night', & - flag_xyfill=.true.) - call addfld ('EXTINCTUVdn', (/ 'lev' /), 'A','/m','Aerosol extinction 350 nm, day night', & - flag_xyfill=.true.) - call addfld ('EXTINCTNIRdn', (/ 'lev' /), 'A','/m','Aerosol extinction 1020 nm, day night', & - flag_xyfill=.true.) - call addfld ('ABSORBdn', (/ 'lev' /), 'A','/m','Aerosol absorption, day night', & - flag_xyfill=.true.) - call addfld ('AODVISdn', horiz_only, 'A',' ','Aerosol optical depth 550 nm, day night', & - flag_xyfill=.true.) - call addfld ('AODVISstdn', horiz_only, 'A',' ','Stratospheric aerosol optical depth 550 nm, day night',& - flag_xyfill=.true.) - call addfld ('AODUVdn', horiz_only, 'A',' ','Aerosol optical depth 350 nm, day night', & - flag_xyfill=.true.) - call addfld ('AODUVstdn', horiz_only, 'A',' ','Stratospheric aerosol optical depth 350 nm, day night',& - flag_xyfill=.true.) - call addfld ('AODNIRdn', horiz_only, 'A',' ','Aerosol optical depth 1020 nm, day night', & - flag_xyfill=.true.) - call addfld ('AODNIRstdn', horiz_only, 'A',' ','Stratospheric aerosol optical depth 1020 nm, day night',& - flag_xyfill=.true.) - call addfld ('AODABSdn', horiz_only, 'A',' ','Aerosol absorption optical depth 550 nm, day night', & - flag_xyfill=.true.) - call addfld ('AODxASYMdn', horiz_only, 'A',' ','Aerosol optical depth 550 * asymmetry factor, day night',& - flag_xyfill=.true.) - call addfld ('EXTxASYMdn', (/ 'lev' /), 'A',' ','extinction 550 * asymmetry factor, day night', & - flag_xyfill=.true.) - - call rad_cnst_get_info(0, nmodes=nmodes) - - do m = 1, nmodes - - write(fldname,'(a,i1)') 'BURDEN', m - write(lngname,'(a,i1)') 'Aerosol burden, day only, mode ', m - call addfld (fldname, horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'AODMODE', m - write(lngname,'(a,i1)') 'Aerosol optical depth, day only, 550 nm mode ', m - call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'AODDUST', m - write(lngname,'(a,i1,a)') 'Aerosol optical depth, day only, 550 nm mode ',m,' from dust' - call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'BURDENdn', m - write(lngname,'(a,i1)') 'Aerosol burden, day night, mode ', m - call addfld (fldname, horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'AODdnMODE', m - write(lngname,'(a,i1)') 'Aerosol optical depth 550 nm, day night, mode ', m - call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'AODdnDUST', m - write(lngname,'(a,i1,a)') 'Aerosol optical depth 550 nm, day night, mode ',m,' from dust' - call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - enddo - - call addfld ('AODDUST', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day only', & - flag_xyfill=.true.) - call addfld ('AODSO4', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day only', & - flag_xyfill=.true.) - call addfld ('AODPOM', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day only', & - flag_xyfill=.true.) - call addfld ('AODSOA', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day only', & - flag_xyfill=.true.) - call addfld ('AODBC', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day only', & - flag_xyfill=.true.) - call addfld ('AODSS', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day only', & - flag_xyfill=.true.) - call addfld ('AODABSBC', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day only',& - flag_xyfill=.true.) - call addfld ('BURDENDUST', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('BURDENSO4', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('BURDENPOM', horiz_only, 'A','kg/m2', 'POM aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('BURDENSOA', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('BURDENBC', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day only', & - flag_xyfill=.true.) - call addfld ('BURDENSEASALT', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('SSAVIS', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day only', & - flag_xyfill=.true.) - - call addfld ('AODDUSTdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day night', & - flag_xyfill=.true.) - call addfld ('AODSO4dn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day night', & - flag_xyfill=.true.) - call addfld ('AODPOMdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day night', & - flag_xyfill=.true.) - call addfld ('AODSOAdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day night', & - flag_xyfill=.true.) - call addfld ('AODBCdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day night', & - flag_xyfill=.true.) - call addfld ('AODSSdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day night', & - flag_xyfill=.true.) - call addfld ('AODABSBCdn', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day night',& - flag_xyfill=.true.) - call addfld ('BURDENDUSTdn', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('BURDENSO4dn', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('BURDENPOMdn', horiz_only, 'A','kg/m2', 'POM aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('BURDENSOAdn', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('BURDENBCdn', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day night', & - flag_xyfill=.true.) - call addfld ('BURDENSEASALTdn', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('SSAVISdn', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day night', & - flag_xyfill=.true.) - - - if (history_amwg) then - call add_default ('AODDUST1' , 1, ' ') - call add_default ('AODDUST3' , 1, ' ') - call add_default ('AODDUST' , 1, ' ') - call add_default ('AODVIS' , 1, ' ') - end if - - if (history_dust) then - call add_default ('AODDUST1' , 1, ' ') - call add_default ('AODDUST2' , 1, ' ') - call add_default ('AODDUST3' , 1, ' ') - end if - - if (history_aero_optics) then - call add_default ('AODDUST1' , 1, ' ') - call add_default ('AODDUST3' , 1, ' ') - call add_default ('ABSORB' , 1, ' ') - call add_default ('AODMODE1' , 1, ' ') - call add_default ('AODMODE2' , 1, ' ') - call add_default ('AODMODE3' , 1, ' ') - call add_default ('AODVIS' , 1, ' ') - call add_default ('AODUV' , 1, ' ') - call add_default ('AODNIR' , 1, ' ') - call add_default ('AODABS' , 1, ' ') - call add_default ('AODABSBC' , 1, ' ') - call add_default ('AODDUST' , 1, ' ') - call add_default ('AODSO4' , 1, ' ') - call add_default ('AODPOM' , 1, ' ') - call add_default ('AODSOA' , 1, ' ') - call add_default ('AODBC' , 1, ' ') - call add_default ('AODSS' , 1, ' ') - call add_default ('BURDEN1' , 1, ' ') - call add_default ('BURDEN2' , 1, ' ') - call add_default ('BURDEN3' , 1, ' ') - call add_default ('BURDENDUST' , 1, ' ') - call add_default ('BURDENSO4' , 1, ' ') - call add_default ('BURDENPOM' , 1, ' ') - call add_default ('BURDENSOA' , 1, ' ') - call add_default ('BURDENBC' , 1, ' ') - call add_default ('BURDENSEASALT', 1, ' ') - call add_default ('SSAVIS' , 1, ' ') - call add_default ('EXTINCT' , 1, ' ') - call add_default ('AODxASYM' , 1, ' ') - call add_default ('EXTxASYM' , 1, ' ') - - call add_default ('AODdnDUST1' , 1, ' ') - call add_default ('AODdnDUST3' , 1, ' ') - call add_default ('ABSORBdn' , 1, ' ') - call add_default ('AODdnMODE1' , 1, ' ') - call add_default ('AODdnMODE2' , 1, ' ') - call add_default ('AODdnMODE3' , 1, ' ') - call add_default ('AODVISdn' , 1, ' ') - call add_default ('AODUVdn' , 1, ' ') - call add_default ('AODNIRdn' , 1, ' ') - call add_default ('AODABSdn' , 1, ' ') - call add_default ('AODABSBCdn' , 1, ' ') - call add_default ('AODDUSTdn' , 1, ' ') - call add_default ('AODSO4dn' , 1, ' ') - call add_default ('AODPOMdn' , 1, ' ') - call add_default ('AODSOAdn' , 1, ' ') - call add_default ('AODBCdn' , 1, ' ') - call add_default ('AODSSdn' , 1, ' ') - call add_default ('BURDENdn1' , 1, ' ') - call add_default ('BURDENdn2' , 1, ' ') - call add_default ('BURDENdn3' , 1, ' ') - call add_default ('BURDENDUSTdn' , 1, ' ') - call add_default ('BURDENSO4dn' , 1, ' ') - call add_default ('BURDENPOMdn' , 1, ' ') - call add_default ('BURDENSOAdn' , 1, ' ') - call add_default ('BURDENBCdn' , 1, ' ') - call add_default ('BURDENSEASALTdn', 1, ' ') - call add_default ('SSAVISdn' , 1, ' ') - call add_default ('EXTINCTdn' , 1, ' ') - call add_default ('AODxASYMdn' , 1, ' ') - call add_default ('EXTxASYMdn' , 1, ' ') - end if - - do ilist = 1, n_diag - if (call_list(ilist)) then - - call addfld ('EXTINCT'//diag(ilist), (/ 'lev' /), 'A','/m', & - 'Aerosol extinction', flag_xyfill=.true.) - call addfld ('ABSORB'//diag(ilist), (/ 'lev' /), 'A','/m', & - 'Aerosol absorption', flag_xyfill=.true.) - call addfld ('AODVIS'//diag(ilist), horiz_only, 'A',' ', & - 'Aerosol optical depth 550 nm', flag_xyfill=.true.) - call addfld ('AODVISst'//diag(ilist), horiz_only, 'A',' ', & - 'Stratospheric aerosol optical depth 550 nm', flag_xyfill=.true.) - call addfld ('AODABS'//diag(ilist), horiz_only, 'A',' ', & - 'Aerosol absorption optical depth 550 nm', flag_xyfill=.true.) - - call addfld ('EXTINCTdn'//diag(ilist), (/ 'lev' /), 'A','/m',& - 'Aerosol extinction 550 nm, day night', flag_xyfill=.true.) - call addfld ('ABSORBdn'//diag(ilist), (/ 'lev' /), 'A','/m',& - 'Aerosol absorption, day night', flag_xyfill=.true.) - call addfld ('AODVISdn'//diag(ilist), horiz_only, 'A',' ',& - 'Aerosol optical depth 550 nm, day night', flag_xyfill=.true.) - call addfld ('AODVISstdn'//diag(ilist), horiz_only, 'A',' ',& - 'Stratospheric aerosol optical depth 550 nm, day night', flag_xyfill=.true.) - call addfld ('AODABSdn'//diag(ilist), horiz_only, 'A',' ',& - 'Aerosol absorption optical depth 550 nm, day night', flag_xyfill=.true.) - call addfld ('EXTxASYMdn'//diag(ilist), (/ 'lev' /), 'A',' ',& - 'extinction 550 * asymmetry factor, day night', flag_xyfill=.true.) - call addfld ('EXTxASYM'//diag(ilist), (/ 'lev' /), 'A',' ',& - 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) - - if (history_aero_optics) then - call add_default ('EXTINCT'//diag(ilist), 1, ' ') - call add_default ('ABSORB'//diag(ilist), 1, ' ') - call add_default ('AODVIS'//diag(ilist), 1, ' ') - call add_default ('AODVISst'//diag(ilist), 1, ' ') - call add_default ('AODABS'//diag(ilist), 1, ' ') - end if - - end if - end do - -end subroutine modal_aer_opt_init - -!=============================================================================== - -subroutine modal_aero_sw(list_idx, state, pbuf, nnite, idxnite, & - tauxar, wa, ga, fa) - - ! calculates aerosol sw radiative properties - - use tropopause, only : tropopause_findChemTrop - - integer, intent(in) :: list_idx ! index of the climate or a diagnostic list - type(physics_state), intent(in), target :: state ! state variables - - type(physics_buffer_desc), pointer :: pbuf(:) - integer, intent(in) :: nnite ! number of night columns - integer, intent(in) :: idxnite(nnite) ! local column indices of night columns - - real(r8), intent(out) :: tauxar(pcols,0:pver,nswbands) ! layer extinction optical depth - real(r8), intent(out) :: wa(pcols,0:pver,nswbands) ! layer single-scatter albedo - real(r8), intent(out) :: ga(pcols,0:pver,nswbands) ! asymmetry factor - real(r8), intent(out) :: fa(pcols,0:pver,nswbands) ! forward scattered fraction - - ! Local variables - integer :: i, ifld, isw, k, l, m, nc, ns - integer :: lchnk ! chunk id - integer :: ncol ! number of active columns in the chunk - integer :: nmodes - integer :: nspec - integer :: troplevchem(pcols) ! Chemical tropopause level - integer :: istat - - real(r8) :: mass(pcols,pver) ! layer mass - real(r8) :: air_density(pcols,pver) ! (kg/m3) - - real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio - real(r8) :: specdens ! species density (kg/m3) - complex(r8), pointer :: specrefindex(:) ! species refractive index - character*32 :: spectype ! species type - real(r8) :: hygro_aer ! - - real(r8), pointer :: dgnumwet(:,:) ! number mode wet diameter - real(r8), pointer :: qaerwat(:,:) ! aerosol water (g/g) - - real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes - real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes - real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes - real(r8), pointer :: wetdens_m(:,:,:) ! - real(r8), pointer :: hygro_m(:,:,:) ! - real(r8), pointer :: dryvol_m(:,:,:) ! - real(r8), pointer :: dryrad_m(:,:,:) ! - real(r8), pointer :: drymass_m(:,:,:) ! - real(r8), pointer :: so4dryvol_m(:,:,:) ! - real(r8), pointer :: naer_m(:,:,:) ! - - real(r8) :: sigma_logr_aer ! geometric standard deviation of number distribution - real(r8) :: radsurf(pcols,pver) ! aerosol surface mode radius - real(r8) :: logradsurf(pcols,pver) ! log(aerosol surface mode radius) - real(r8) :: cheb(ncoef,pcols,pver) - - real(r8) :: refr(pcols) ! real part of refractive index - real(r8) :: refi(pcols) ! imaginary part of refractive index - complex(r8) :: crefin(pcols) ! complex refractive index - real(r8), pointer :: refrtabsw(:,:) ! table of real refractive indices for aerosols - real(r8), pointer :: refitabsw(:,:) ! table of imag refractive indices for aerosols - real(r8), pointer :: extpsw(:,:,:,:) ! specific extinction - real(r8), pointer :: abspsw(:,:,:,:) ! specific absorption - real(r8), pointer :: asmpsw(:,:,:,:) ! asymmetry factor - - real(r8) :: vol(pcols) ! volume concentration of aerosol specie (m3/kg) - real(r8) :: dryvol(pcols) ! volume concentration of aerosol mode (m3/kg) - real(r8) :: watervol(pcols) ! volume concentration of water in each mode (m3/kg) - real(r8) :: wetvol(pcols) ! volume concentration of wet mode (m3/kg) - - integer :: itab(pcols), jtab(pcols) - real(r8) :: ttab(pcols), utab(pcols) - real(r8) :: cext(pcols,ncoef), cabs(pcols,ncoef), casm(pcols,ncoef) - real(r8) :: pext(pcols) ! parameterized specific extinction (m2/kg) - real(r8) :: specpext(pcols) ! specific extinction (m2/kg) - real(r8) :: dopaer(pcols) ! aerosol optical depth in layer - real(r8) :: pabs(pcols) ! parameterized specific absorption (m2/kg) - real(r8) :: pasm(pcols) ! parameterized asymmetry factor - real(r8) :: palb(pcols) ! parameterized single scattering albedo - - ! Diagnostics - real(r8) :: extinct(pcols,pver) - real(r8) :: extinctnir(pcols,pver) - real(r8) :: extinctuv(pcols,pver) - real(r8) :: absorb(pcols,pver) - real(r8) :: aodvis(pcols) ! extinction optical depth - real(r8) :: aodvisst(pcols) ! stratospheric extinction optical depth - real(r8) :: aodabs(pcols) ! absorption optical depth - real(r8) :: asymvis(pcols) ! asymmetry factor * optical depth - real(r8) :: asymext(pcols,pver) ! asymmetry factor * extinction - - real(r8) :: aodabsbc(pcols) ! absorption optical depth of BC - - real(r8) :: ssavis(pcols) - real(r8) :: dustvol(pcols) ! volume concentration of dust in aerosol mode (m3/kg) - - real(r8) :: burden(pcols) - real(r8) :: burdendust(pcols), burdenso4(pcols), burdenbc(pcols), & - burdenpom(pcols), burdensoa(pcols), burdenseasalt(pcols) - - real(r8) :: aodmode(pcols) - real(r8) :: dustaodmode(pcols) ! dust aod in aerosol mode - - real(r8) :: specrefr, specrefi - real(r8) :: scatdust(pcols), scatso4(pcols), scatbc(pcols), & - scatpom(pcols), scatsoa(pcols), scatseasalt(pcols) - real(r8) :: absdust(pcols), absso4(pcols), absbc(pcols), & - abspom(pcols), abssoa(pcols), absseasalt(pcols) - real(r8) :: hygrodust(pcols), hygroso4(pcols), hygrobc(pcols), & - hygropom(pcols), hygrosoa(pcols), hygroseasalt(pcols) - - real(r8) :: scath2o, absh2o, sumscat, sumabs, sumhygro - real(r8) :: aodc ! aod of component - - ! total species AOD - real(r8) :: dustaod(pcols), so4aod(pcols), bcaod(pcols), & - pomaod(pcols), soaaod(pcols), seasaltaod(pcols) - - - - - logical :: savaervis ! true if visible wavelength (0.55 micron) - logical :: savaernir ! true if near ir wavelength (~0.88 micron) - logical :: savaeruv ! true if uv wavelength (~0.35 micron) - - real(r8) :: aoduv(pcols) ! extinction optical depth in uv - real(r8) :: aoduvst(pcols) ! stratospheric extinction optical depth in uv - real(r8) :: aodnir(pcols) ! extinction optical depth in nir - real(r8) :: aodnirst(pcols) ! stratospheric extinction optical depth in nir - - - character(len=32) :: outname - - ! debug output - integer, parameter :: nerrmax_dopaer=1000 - integer :: nerr_dopaer = 0 - real(r8) :: volf ! volume fraction of insoluble aerosol - character(len=*), parameter :: subname = 'modal_aero_sw' - !---------------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - ! initialize output variables - tauxar(:ncol,:,:) = 0._r8 - wa(:ncol,:,:) = 0._r8 - ga(:ncol,:,:) = 0._r8 - fa(:ncol,:,:) = 0._r8 - - ! zero'th layer does not contain aerosol - tauxar(1:ncol,0,:) = 0._r8 - wa(1:ncol,0,:) = 0.925_r8 - ga(1:ncol,0,:) = 0.850_r8 - fa(1:ncol,0,:) = 0.7225_r8 - - mass(:ncol,:) = state%pdeldry(:ncol,:)*rga - air_density(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) - - ! diagnostics for visible band summed over modes - extinct(1:ncol,:) = 0.0_r8 - absorb(1:ncol,:) = 0.0_r8 - aodvis(1:ncol) = 0.0_r8 - aodvisst(1:ncol) = 0.0_r8 - aodabs(1:ncol) = 0.0_r8 - burdendust(:ncol) = 0.0_r8 - burdenso4(:ncol) = 0.0_r8 - burdenpom(:ncol) = 0.0_r8 - burdensoa(:ncol) = 0.0_r8 - burdenbc(:ncol) = 0.0_r8 - burdenseasalt(:ncol) = 0.0_r8 - ssavis(1:ncol) = 0.0_r8 - asymvis(1:ncol) = 0.0_r8 - asymext(1:ncol,:) = 0.0_r8 - - aodabsbc(:ncol) = 0.0_r8 - dustaod(:ncol) = 0.0_r8 - so4aod(:ncol) = 0.0_r8 - pomaod(:ncol) = 0.0_r8 - soaaod(:ncol) = 0.0_r8 - bcaod(:ncol) = 0.0_r8 - seasaltaod(:ncol) = 0.0_r8 - - ! diags for other bands - extinctuv(1:ncol,:) = 0.0_r8 - extinctnir(1:ncol,:) = 0.0_r8 - aoduv(:ncol) = 0.0_r8 - aodnir(:ncol) = 0.0_r8 - aoduvst(:ncol) = 0.0_r8 - aodnirst(:ncol) = 0.0_r8 - call tropopause_findChemTrop(state, troplevchem) - - ! loop over all aerosol modes - call rad_cnst_get_info(list_idx, nmodes=nmodes) - - if (list_idx == 0) then - ! water uptake and wet radius for the climate list has already been calculated - call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet_m) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat_m) - else - ! If doing a diagnostic calculation then need to calculate the wet radius - ! and water uptake for the diagnostic modes - allocate(dgnumdry_m(pcols,pver,nmodes), dgnumwet_m(pcols,pver,nmodes), & - qaerwat_m(pcols,pver,nmodes), wetdens_m(pcols,pver,nmodes), & - hygro_m(pcols,pver,nmodes), dryvol_m(pcols,pver,nmodes), & - dryrad_m(pcols,pver,nmodes), drymass_m(pcols,pver,nmodes), & - so4dryvol_m(pcols,pver,nmodes), naer_m(pcols,pver,nmodes), stat=istat) - if (istat > 0) then - call endrun('modal_aero_sw: allocation FAILURE: arrays for diagnostic calcs') - end if - call modal_aero_calcsize_diag(state, pbuf, list_idx, dgnumdry_m, hygro_m, & - dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) - call modal_aero_wateruptake_dr(state, pbuf, list_idx, dgnumdry_m, dgnumwet_m, & - qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & - drymass_m, so4dryvol_m, naer_m) - endif - - do m = 1, nmodes - - ! diagnostics for visible band for each mode - burden(:ncol) = 0._r8 - aodmode(1:ncol) = 0.0_r8 - dustaodmode(1:ncol) = 0.0_r8 - - dgnumwet => dgnumwet_m(:,:,m) - qaerwat => qaerwat_m(:,:,m) - - ! get mode properties - call rad_cnst_get_mode_props(list_idx, m, sigmag=sigma_logr_aer, refrtabsw=refrtabsw , & - refitabsw=refitabsw, extpsw=extpsw, abspsw=abspsw, asmpsw=asmpsw) - - ! get mode info - call rad_cnst_get_info(list_idx, m, nspec=nspec) - - ! calc size parameter for all columns - call modal_size_parameters(ncol, sigma_logr_aer, dgnumwet, radsurf, logradsurf, cheb) - - do isw = 1, nswbands - savaervis = (isw .eq. idx_sw_diag) - savaeruv = (isw .eq. idx_uv_diag) - savaernir = (isw .eq. idx_nir_diag) - - do k = top_lev, pver - - ! form bulk refractive index - crefin(:ncol) = (0._r8, 0._r8) - dryvol(:ncol) = 0._r8 - dustvol(:ncol) = 0._r8 - - scatdust(:ncol) = 0._r8 - absdust(:ncol) = 0._r8 - hygrodust(:ncol) = 0._r8 - scatso4(:ncol) = 0._r8 - absso4(:ncol) = 0._r8 - hygroso4(:ncol) = 0._r8 - scatbc(:ncol) = 0._r8 - absbc(:ncol) = 0._r8 - hygrobc(:ncol) = 0._r8 - scatpom(:ncol) = 0._r8 - abspom(:ncol) = 0._r8 - hygropom(:ncol) = 0._r8 - scatsoa(:ncol) = 0._r8 - abssoa(:ncol) = 0._r8 - hygrosoa(:ncol) = 0._r8 - scatseasalt(:ncol) = 0._r8 - absseasalt(:ncol) = 0._r8 - hygroseasalt(:ncol) = 0._r8 - - ! aerosol species loop - do l = 1, nspec - call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & - refindex_aer_sw=specrefindex, spectype=spectype, & - hygro_aer=hygro_aer) - - do i = 1, ncol - vol(i) = specmmr(i,k)/specdens - dryvol(i) = dryvol(i) + vol(i) - crefin(i) = crefin(i) + vol(i)*specrefindex(isw) - end do - - ! compute some diagnostics for visible band only - if (savaervis) then - - specrefr = real(specrefindex(isw)) - specrefi = aimag(specrefindex(isw)) - - do i = 1, ncol - burden(i) = burden(i) + specmmr(i,k)*mass(i,k) - end do - - if (trim(spectype) == 'dust') then - do i = 1, ncol - burdendust(i) = burdendust(i) + specmmr(i,k)*mass(i,k) - dustvol(i) = vol(i) - scatdust(i) = vol(i)*specrefr - absdust(i) = -vol(i)*specrefi - hygrodust(i) = vol(i)*hygro_aer - end do - end if - - if (trim(spectype) == 'sulfate') then - do i = 1, ncol - burdenso4(i) = burdenso4(i) + specmmr(i,k)*mass(i,k) - scatso4(i) = vol(i)*specrefr - absso4(i) = -vol(i)*specrefi - hygroso4(i) = vol(i)*hygro_aer - end do - end if - if (trim(spectype) == 'black-c') then - do i = 1, ncol - burdenbc(i) = burdenbc(i) + specmmr(i,k)*mass(i,k) - scatbc(i) = vol(i)*specrefr - absbc(i) = -vol(i)*specrefi - hygrobc(i) = vol(i)*hygro_aer - end do - end if - if (trim(spectype) == 'p-organic') then - do i = 1, ncol - burdenpom(i) = burdenpom(i) + specmmr(i,k)*mass(i,k) - scatpom(i) = vol(i)*specrefr - abspom(i) = -vol(i)*specrefi - hygropom(i) = vol(i)*hygro_aer - end do - end if - if (trim(spectype) == 's-organic') then - do i = 1, ncol - burdensoa(i) = burdensoa(i) + specmmr(i,k)*mass(i,k) - scatsoa(i) = vol(i)*specrefr - abssoa(i) = -vol(i)*specrefi - hygrosoa(i) = vol(i)*hygro_aer - end do - end if - if (trim(spectype) == 'seasalt') then - do i = 1, ncol - burdenseasalt(i) = burdenseasalt(i) + specmmr(i,k)*mass(i,k) - scatseasalt(i) = vol(i)*specrefr - absseasalt(i) = -vol(i)*specrefi - hygroseasalt(i) = vol(i)*hygro_aer - end do - end if - - end if - end do ! species loop - - do i = 1, ncol - watervol(i) = qaerwat(i,k)/rhoh2o - wetvol(i) = watervol(i) + dryvol(i) - if (watervol(i) < 0._r8) then - if (abs(watervol(i)) .gt. 1.e-1_r8*wetvol(i)) then - write(iulog,'(a,2e10.2,a)') 'watervol,wetvol=', & - watervol(i), wetvol(i), ' in '//subname - end if - watervol(i) = 0._r8 - wetvol(i) = dryvol(i) - end if - - ! volume mixing - crefin(i) = crefin(i) + watervol(i)*crefwsw(isw) - crefin(i) = crefin(i)/max(wetvol(i),1.e-60_r8) - refr(i) = real(crefin(i)) - refi(i) = abs(aimag(crefin(i))) - end do - - ! call t_startf('binterp') - - ! interpolate coefficients linear in refractive index - ! first call calcs itab,jtab,ttab,utab - itab(:ncol) = 0 - call binterp(extpsw(:,:,:,isw), ncol, ncoef, prefr, prefi, & - refr, refi, refrtabsw(:,isw), refitabsw(:,isw), & - itab, jtab, ttab, utab, cext) - call binterp(abspsw(:,:,:,isw), ncol, ncoef, prefr, prefi, & - refr, refi, refrtabsw(:,isw), refitabsw(:,isw), & - itab, jtab, ttab, utab, cabs) - call binterp(asmpsw(:,:,:,isw), ncol, ncoef, prefr, prefi, & - refr, refi, refrtabsw(:,isw), refitabsw(:,isw), & - itab, jtab, ttab, utab, casm) - - ! call t_stopf('binterp') - - ! parameterized optical properties - do i=1,ncol - - if (logradsurf(i,k) .le. xrmax) then - pext(i) = 0.5_r8*cext(i,1) - do nc = 2, ncoef - pext(i) = pext(i) + cheb(nc,i,k)*cext(i,nc) - enddo - pext(i) = exp(pext(i)) - else - pext(i) = 1.5_r8/(radsurf(i,k)*rhoh2o) ! geometric optics - endif - - ! convert from m2/kg water to m2/kg aerosol - specpext(i) = pext(i) - pext(i) = pext(i)*wetvol(i)*rhoh2o - pabs(i) = 0.5_r8*cabs(i,1) - pasm(i) = 0.5_r8*casm(i,1) - do nc = 2, ncoef - pabs(i) = pabs(i) + cheb(nc,i,k)*cabs(i,nc) - pasm(i) = pasm(i) + cheb(nc,i,k)*casm(i,nc) - enddo - pabs(i) = pabs(i)*wetvol(i)*rhoh2o - pabs(i) = max(0._r8,pabs(i)) - pabs(i) = min(pext(i),pabs(i)) - - palb(i) = 1._r8-pabs(i)/max(pext(i),1.e-40_r8) - palb(i) = 1._r8-pabs(i)/max(pext(i),1.e-40_r8) - - dopaer(i) = pext(i)*mass(i,k) - end do - - if (savaeruv) then - do i = 1, ncol - extinctuv(i,k) = extinctuv(i,k) + dopaer(i)*air_density(i,k)/mass(i,k) - aoduv(i) = aoduv(i) + dopaer(i) - if (k.le.troplevchem(i)) then - aoduvst(i) = aoduvst(i) + dopaer(i) - end if - end do - end if - - if (savaernir) then - do i = 1, ncol - extinctnir(i,k) = extinctnir(i,k) + dopaer(i)*air_density(i,k)/mass(i,k) - aodnir(i) = aodnir(i) + dopaer(i) - if (k.le.troplevchem(i)) then - aodnirst(i) = aodnirst(i) + dopaer(i) - end if - end do - endif - - ! Save aerosol optical depth at longest visible wavelength - ! sum over layers - if (savaervis) then - ! aerosol extinction (/m) - do i = 1, ncol - extinct(i,k) = extinct(i,k) + dopaer(i)*air_density(i,k)/mass(i,k) - absorb(i,k) = absorb(i,k) + pabs(i)*air_density(i,k) - aodvis(i) = aodvis(i) + dopaer(i) - aodabs(i) = aodabs(i) + pabs(i)*mass(i,k) - aodmode(i) = aodmode(i) + dopaer(i) - ssavis(i) = ssavis(i) + dopaer(i)*palb(i) - asymvis(i) = asymvis(i) + dopaer(i)*pasm(i) - asymext(i,k) = asymext(i,k) + dopaer(i)*pasm(i)*air_density(i,k)/mass(i,k) - if (k.le.troplevchem(i)) then - aodvisst(i) = aodvisst(i) + dopaer(i) - end if - - if (wetvol(i) > 1.e-40_r8) then - - dustaodmode(i) = dustaodmode(i) + dopaer(i)*dustvol(i)/wetvol(i) - - ! partition optical depth into contributions from each constituent - ! assume contribution is proportional to refractive index X volume - - scath2o = watervol(i)*real(crefwsw(isw)) - absh2o = -watervol(i)*aimag(crefwsw(isw)) - sumscat = scatso4(i) + scatpom(i) + scatsoa(i) + scatbc(i) + & - scatdust(i) + scatseasalt(i) + scath2o - sumabs = absso4(i) + abspom(i) + abssoa(i) + absbc(i) + & - absdust(i) + absseasalt(i) + absh2o - sumhygro = hygroso4(i) + hygropom(i) + hygrosoa(i) + hygrobc(i) + & - hygrodust(i) + hygroseasalt(i) - - scatdust(i) = (scatdust(i) + scath2o*hygrodust(i)/sumhygro)/sumscat - absdust(i) = (absdust(i) + absh2o*hygrodust(i)/sumhygro)/sumabs - - scatso4(i) = (scatso4(i) + scath2o*hygroso4(i)/sumhygro)/sumscat - absso4(i) = (absso4(i) + absh2o*hygroso4(i)/sumhygro)/sumabs - - scatpom(i) = (scatpom(i) + scath2o*hygropom(i)/sumhygro)/sumscat - abspom(i) = (abspom(i) + absh2o*hygropom(i)/sumhygro)/sumabs - - scatsoa(i) = (scatsoa(i) + scath2o*hygrosoa(i)/sumhygro)/sumscat - abssoa(i) = (abssoa(i) + absh2o*hygrosoa(i)/sumhygro)/sumabs - - scatbc(i) = (scatbc(i) + scath2o*hygrobc(i)/sumhygro)/sumscat - absbc(i) = (absbc(i) + absh2o*hygrobc(i)/sumhygro)/sumabs - - scatseasalt(i) = (scatseasalt(i) + scath2o*hygroseasalt(i)/sumhygro)/sumscat - absseasalt(i) = (absseasalt(i) + absh2o*hygroseasalt(i)/sumhygro)/sumabs - - aodabsbc(i) = aodabsbc(i) + absbc(i)*dopaer(i)*(1.0_r8-palb(i)) - - aodc = (absdust(i)*(1.0_r8 - palb(i)) + palb(i)*scatdust(i))*dopaer(i) - dustaod(i) = dustaod(i) + aodc - - aodc = (absso4(i)*(1.0_r8 - palb(i)) + palb(i)*scatso4(i))*dopaer(i) - so4aod(i) = so4aod(i) + aodc - - aodc = (abspom(i)*(1.0_r8 - palb(i)) + palb(i)*scatpom(i))*dopaer(i) - pomaod(i) = pomaod(i) + aodc - - aodc = (abssoa(i)*(1.0_r8 - palb(i)) + palb(i)*scatsoa(i))*dopaer(i) - soaaod(i) = soaaod(i) + aodc - - aodc = (absbc(i)*(1.0_r8 - palb(i)) + palb(i)*scatbc(i))*dopaer(i) - bcaod(i) = bcaod(i) + aodc - - aodc = (absseasalt(i)*(1.0_r8 - palb(i)) + palb(i)*scatseasalt(i))*dopaer(i) - seasaltaod(i) = seasaltaod(i) + aodc - - endif - - end do - endif - - do i = 1, ncol - - if ((dopaer(i) <= -1.e-10_r8) .or. (dopaer(i) >= 30._r8)) then - - if (dopaer(i) <= -1.e-10_r8) then - write(iulog,*) "ERROR: Negative aerosol optical depth & - &in this layer." - else - write(iulog,*) "WARNING: Aerosol optical depth is & - &unreasonably high in this layer." - end if - - write(iulog,*) 'dopaer(', i, ',', k, ',', m, ',', lchnk, ')=', dopaer(i) - ! write(iulog,*) 'itab,jtab,ttab,utab=',itab(i),jtab(i),ttab(i),utab(i) - write(iulog,*) 'k=', k, ' pext=', pext(i), ' specext=', specpext(i) - write(iulog,*) 'wetvol=', wetvol(i), ' dryvol=', dryvol(i), ' watervol=', watervol(i) - ! write(iulog,*) 'cext=',(cext(i,l),l=1,ncoef) - ! write(iulog,*) 'crefin=',crefin(i) - write(iulog,*) 'nspec=', nspec - ! write(iulog,*) 'cheb=', (cheb(nc,m,i,k),nc=2,ncoef) - do l = 1, nspec - call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & - refindex_aer_sw=specrefindex) - volf = specmmr(i,k)/specdens - write(iulog,*) 'l=', l, 'vol(l)=', volf - write(iulog,*) 'isw=', isw, 'specrefindex(isw)=', specrefindex(isw) - write(iulog,*) 'specdens=', specdens - end do - - nerr_dopaer = nerr_dopaer + 1 -! if (nerr_dopaer >= nerrmax_dopaer) then - if (dopaer(i) < -1.e-10_r8) then - write(iulog,*) '*** halting in '//subname//' after nerr_dopaer =', nerr_dopaer - call endrun('exit from '//subname) - end if - - end if - end do - - do i=1,ncol - tauxar(i,k,isw) = tauxar(i,k,isw) + dopaer(i) - wa(i,k,isw) = wa(i,k,isw) + dopaer(i)*palb(i) - ga(i,k,isw) = ga(i,k,isw) + dopaer(i)*palb(i)*pasm(i) - fa(i,k,isw) = fa(i,k,isw) + dopaer(i)*palb(i)*pasm(i)*pasm(i) - end do - - end do ! pver - - end do ! sw bands - - ! mode diagnostics - ! The diagnostics are currently only output for the climate list. Code mods will - ! be necessary to provide output for the rad_diag lists. - if (list_idx == 0) then - - write(outname,'(a,i1)') 'BURDENdn', m - call outfld(trim(outname), burden, pcols, lchnk) - - write(outname,'(a,i1)') 'AODdnMODE', m - call outfld(trim(outname), aodmode, pcols, lchnk) - - write(outname,'(a,i1)') 'AODdnDUST', m - call outfld(trim(outname), dustaodmode, pcols, lchnk) - - do i = 1, nnite - burden(idxnite(i)) = fillvalue - aodmode(idxnite(i)) = fillvalue - dustaodmode(idxnite(i)) = fillvalue - end do - - write(outname,'(a,i1)') 'BURDEN', m - call outfld(trim(outname), burden, pcols, lchnk) - - write(outname,'(a,i1)') 'AODMODE', m - call outfld(trim(outname), aodmode, pcols, lchnk) - - write(outname,'(a,i1)') 'AODDUST', m - call outfld(trim(outname), dustaodmode, pcols, lchnk) - - end if - - end do ! nmodes - - if (list_idx > 0) then - deallocate(dgnumdry_m) - deallocate(dgnumwet_m) - deallocate(qaerwat_m) - deallocate(wetdens_m) - deallocate(hygro_m) - deallocate(dryvol_m) - deallocate(dryrad_m) - deallocate(drymass_m) - deallocate(so4dryvol_m) - deallocate(naer_m) - end if - - ! Output visible band diagnostics for quantities summed over the modes - ! These fields are put out for diagnostic lists as well as the climate list. - - call outfld('EXTINCTdn'//diag(list_idx), extinct, pcols, lchnk) - call outfld('ABSORBdn'//diag(list_idx), absorb, pcols, lchnk) - call outfld('AODVISdn'//diag(list_idx), aodvis, pcols, lchnk) - call outfld('AODABSdn'//diag(list_idx), aodabs, pcols, lchnk) - call outfld('AODVISstdn'//diag(list_idx), aodvisst,pcols, lchnk) - call outfld('EXTxASYMdn'//diag(list_idx), asymext, pcols, lchnk) - - do i = 1, nnite - extinct(idxnite(i),:) = fillvalue - absorb(idxnite(i),:) = fillvalue - aodvis(idxnite(i)) = fillvalue - aodabs(idxnite(i)) = fillvalue - aodvisst(idxnite(i)) = fillvalue - asymext(idxnite(i),:) = fillvalue - end do - - call outfld('EXTINCT'//diag(list_idx), extinct, pcols, lchnk) - call outfld('ABSORB'//diag(list_idx), absorb, pcols, lchnk) - call outfld('AODVIS'//diag(list_idx), aodvis, pcols, lchnk) - call outfld('AODABS'//diag(list_idx), aodabs, pcols, lchnk) - call outfld('AODVISst'//diag(list_idx), aodvisst,pcols, lchnk) - call outfld('EXTxASYM'//diag(list_idx), asymext, pcols, lchnk) - - ! These diagnostics are output only for climate list - if (list_idx == 0) then - do i = 1, ncol - if (aodvis(i) > 1.e-10_r8) then - ssavis(i) = ssavis(i)/aodvis(i) - else - ssavis(i) = 0.925_r8 - endif - end do - - call outfld('SSAVISdn', ssavis, pcols, lchnk) - call outfld('AODxASYMdn', asymvis, pcols, lchnk) - - call outfld('EXTINCTUVdn', extinctuv, pcols, lchnk) - call outfld('EXTINCTNIRdn', extinctnir, pcols, lchnk) - call outfld('AODUVdn', aoduv, pcols, lchnk) - call outfld('AODNIRdn', aodnir, pcols, lchnk) - call outfld('AODUVstdn', aoduvst, pcols, lchnk) - call outfld('AODNIRstdn', aodnirst, pcols, lchnk) - - call outfld('BURDENDUSTdn', burdendust, pcols, lchnk) - call outfld('BURDENSO4dn' , burdenso4, pcols, lchnk) - call outfld('BURDENPOMdn' , burdenpom, pcols, lchnk) - call outfld('BURDENSOAdn' , burdensoa, pcols, lchnk) - call outfld('BURDENBCdn' , burdenbc, pcols, lchnk) - call outfld('BURDENSEASALTdn', burdenseasalt, pcols, lchnk) - - call outfld('AODABSBCdn', aodabsbc, pcols, lchnk) - - call outfld('AODDUSTdn', dustaod, pcols, lchnk) - call outfld('AODSO4dn', so4aod, pcols, lchnk) - call outfld('AODPOMdn', pomaod, pcols, lchnk) - call outfld('AODSOAdn', soaaod, pcols, lchnk) - call outfld('AODBCdn', bcaod, pcols, lchnk) - call outfld('AODSSdn', seasaltaod, pcols, lchnk) - - - do i = 1, nnite - ssavis(idxnite(i)) = fillvalue - asymvis(idxnite(i)) = fillvalue - - aoduv(idxnite(i)) = fillvalue - aodnir(idxnite(i)) = fillvalue - aoduvst(idxnite(i)) = fillvalue - aodnirst(idxnite(i)) = fillvalue - extinctuv(idxnite(i),:) = fillvalue - extinctnir(idxnite(i),:) = fillvalue - - burdendust(idxnite(i)) = fillvalue - burdenso4(idxnite(i)) = fillvalue - burdenpom(idxnite(i)) = fillvalue - burdensoa(idxnite(i)) = fillvalue - burdenbc(idxnite(i)) = fillvalue - burdenseasalt(idxnite(i)) = fillvalue - - aodabsbc(idxnite(i)) = fillvalue - - dustaod(idxnite(i)) = fillvalue - so4aod(idxnite(i)) = fillvalue - pomaod(idxnite(i)) = fillvalue - soaaod(idxnite(i)) = fillvalue - bcaod(idxnite(i)) = fillvalue - seasaltaod(idxnite(i)) = fillvalue - end do - - call outfld('SSAVIS', ssavis, pcols, lchnk) - call outfld('AODxASYM', asymvis, pcols, lchnk) - - call outfld('EXTINCTUV', extinctuv, pcols, lchnk) - call outfld('EXTINCTNIR', extinctnir, pcols, lchnk) - call outfld('AODUV', aoduv, pcols, lchnk) - call outfld('AODNIR', aodnir, pcols, lchnk) - call outfld('AODUVst', aoduvst, pcols, lchnk) - call outfld('AODNIRst', aodnirst, pcols, lchnk) - - call outfld('BURDENDUST', burdendust, pcols, lchnk) - call outfld('BURDENSO4' , burdenso4, pcols, lchnk) - call outfld('BURDENPOM' , burdenpom, pcols, lchnk) - call outfld('BURDENSOA' , burdensoa, pcols, lchnk) - call outfld('BURDENBC' , burdenbc, pcols, lchnk) - call outfld('BURDENSEASALT', burdenseasalt, pcols, lchnk) - - call outfld('AODABSBC', aodabsbc, pcols, lchnk) - - call outfld('AODDUST', dustaod, pcols, lchnk) - call outfld('AODSO4', so4aod, pcols, lchnk) - call outfld('AODPOM', pomaod, pcols, lchnk) - call outfld('AODSOA', soaaod, pcols, lchnk) - call outfld('AODBC', bcaod, pcols, lchnk) - call outfld('AODSS', seasaltaod, pcols, lchnk) - end if - -end subroutine modal_aero_sw - -!=============================================================================== - -subroutine modal_aero_lw(list_idx, state, pbuf, tauxar) - - ! calculates aerosol lw radiative properties - - integer, intent(in) :: list_idx ! index of the climate or a diagnostic list - type(physics_state), intent(in), target :: state ! state variables - - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8), intent(out) :: tauxar(pcols,pver,nlwbands) ! layer absorption optical depth - - ! Local variables - integer :: i, ifld, ilw, k, l, m, nc, ns - integer :: lchnk ! chunk id - integer :: ncol ! number of active columns in the chunk - integer :: nmodes - integer :: nspec - integer :: istat - - real(r8), pointer :: dgnumwet(:,:) ! wet number mode diameter (m) - real(r8), pointer :: qaerwat(:,:) ! aerosol water (g/g) - - real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes - real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes - real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes - real(r8), pointer :: wetdens_m(:,:,:) ! - real(r8), pointer :: hygro_m(:,:,:) ! - real(r8), pointer :: dryvol_m(:,:,:) ! - real(r8), pointer :: dryrad_m(:,:,:) ! - real(r8), pointer :: drymass_m(:,:,:) ! - real(r8), pointer :: so4dryvol_m(:,:,:) ! - real(r8), pointer :: naer_m(:,:,:) ! - - real(r8) :: sigma_logr_aer ! geometric standard deviation of number distribution - real(r8) :: alnsg_amode ! log of geometric standard deviation of number distribution - real(r8) :: xrad(pcols) - real(r8) :: cheby(ncoef,pcols,pver) ! chebychef polynomials - - real(r8) :: mass(pcols,pver) ! layer mass - - real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio - real(r8) :: specdens ! species density (kg/m3) - complex(r8), pointer :: specrefindex(:) ! species refractive index - - real(r8) :: vol(pcols) ! volume concentration of aerosol specie (m3/kg) - real(r8) :: dryvol(pcols) ! volume concentration of aerosol mode (m3/kg) - real(r8) :: wetvol(pcols) ! volume concentration of wet mode (m3/kg) - real(r8) :: watervol(pcols) ! volume concentration of water in each mode (m3/kg) - real(r8) :: refr(pcols) ! real part of refractive index - real(r8) :: refi(pcols) ! imaginary part of refractive index - complex(r8) :: crefin(pcols) ! complex refractive index - real(r8), pointer :: refrtablw(:,:) ! table of real refractive indices for aerosols - real(r8), pointer :: refitablw(:,:) ! table of imag refractive indices for aerosols - real(r8), pointer :: absplw(:,:,:,:) ! specific absorption - - integer :: itab(pcols), jtab(pcols) - real(r8) :: ttab(pcols), utab(pcols) - real(r8) :: cabs(pcols,ncoef) - real(r8) :: pabs(pcols) ! parameterized specific absorption (m2/kg) - real(r8) :: dopaer(pcols) ! aerosol optical depth in layer - - integer, parameter :: nerrmax_dopaer=1000 - integer :: nerr_dopaer = 0 - real(r8) :: volf ! volume fraction of insoluble aerosol - - character(len=*), parameter :: subname = 'modal_aero_lw' - !---------------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - ! initialize output variables - tauxar(:ncol,:,:) = 0._r8 - - ! dry mass in each cell - mass(:ncol,:) = state%pdeldry(:ncol,:)*rga - - ! loop over all aerosol modes - call rad_cnst_get_info(list_idx, nmodes=nmodes) - - if (list_idx == 0) then - ! water uptake and wet radius for the climate list has already been calculated - call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet_m) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat_m) - else - ! If doing a diagnostic calculation then need to calculate the wet radius - ! and water uptake for the diagnostic modes - allocate(dgnumdry_m(pcols,pver,nmodes), dgnumwet_m(pcols,pver,nmodes), & - qaerwat_m(pcols,pver,nmodes), wetdens_m(pcols,pver,nmodes), & - hygro_m(pcols,pver,nmodes), dryvol_m(pcols,pver,nmodes), & - dryrad_m(pcols,pver,nmodes), drymass_m(pcols,pver,nmodes), & - so4dryvol_m(pcols,pver,nmodes), naer_m(pcols,pver,nmodes), stat=istat) - - if (istat > 0) then - call endrun('modal_aero_lw: allocation FAILURE: arrays for diagnostic calcs') - end if - call modal_aero_calcsize_diag(state, pbuf, list_idx, dgnumdry_m, hygro_m, & - dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) - call modal_aero_wateruptake_dr(state, pbuf, list_idx, dgnumdry_m, dgnumwet_m, & - qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & - drymass_m, so4dryvol_m, naer_m) - endif - - do m = 1, nmodes - - dgnumwet => dgnumwet_m(:,:,m) - qaerwat => qaerwat_m(:,:,m) - - ! get mode properties - call rad_cnst_get_mode_props(list_idx, m, sigmag=sigma_logr_aer, refrtablw=refrtablw , & - refitablw=refitablw, absplw=absplw) - - ! get mode info - call rad_cnst_get_info(list_idx, m, nspec=nspec) - - ! calc size parameter for all columns - ! this is the same calculation that's done in modal_size_parameters, but there - ! some intermediate results are saved and the chebyshev polynomials are stored - ! in a array with different index order. Could be unified. - do k = top_lev, pver - do i = 1, ncol - alnsg_amode = log( sigma_logr_aer ) - ! convert from number diameter to surface area - xrad(i) = log(0.5_r8*dgnumwet(i,k)) + 2.0_r8*alnsg_amode*alnsg_amode - ! normalize size parameter - xrad(i) = max(xrad(i), xrmin) - xrad(i) = min(xrad(i), xrmax) - xrad(i) = (2*xrad(i)-xrmax-xrmin)/(xrmax-xrmin) - ! chebyshev polynomials - cheby(1,i,k) = 1.0_r8 - cheby(2,i,k) = xrad(i) - do nc = 3, ncoef - cheby(nc,i,k) = 2.0_r8*xrad(i)*cheby(nc-1,i,k)-cheby(nc-2,i,k) - end do - end do - end do - - do ilw = 1, nlwbands - - do k = top_lev, pver - - ! form bulk refractive index. Use volume mixing for infrared - crefin(:ncol) = (0._r8, 0._r8) - dryvol(:ncol) = 0._r8 - - ! aerosol species loop - do l = 1, nspec - call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & - refindex_aer_lw=specrefindex) - - do i = 1, ncol - vol(i) = specmmr(i,k)/specdens - dryvol(i) = dryvol(i) + vol(i) - crefin(i) = crefin(i) + vol(i)*specrefindex(ilw) - end do - end do - - do i = 1, ncol - watervol(i) = qaerwat(i,k)/rhoh2o - wetvol(i) = watervol(i) + dryvol(i) - if (watervol(i) < 0.0_r8) then - if (abs(watervol(i)) .gt. 1.e-1_r8*wetvol(i)) then - write(iulog,*) 'watervol,wetvol,dryvol=',watervol(i),wetvol(i),dryvol(i),' in '//subname - end if - watervol(i) = 0._r8 - wetvol(i) = dryvol(i) - end if - - crefin(i) = crefin(i) + watervol(i)*crefwlw(ilw) - if (wetvol(i) > 1.e-40_r8) crefin(i) = crefin(i)/wetvol(i) - refr(i) = real(crefin(i)) - refi(i) = aimag(crefin(i)) - end do - - ! interpolate coefficients linear in refractive index - ! first call calcs itab,jtab,ttab,utab - itab(:ncol) = 0 - call binterp(absplw(:,:,:,ilw), ncol, ncoef, prefr, prefi, & - refr, refi, refrtablw(:,ilw), refitablw(:,ilw), & - itab, jtab, ttab, utab, cabs) - - ! parameterized optical properties - do i = 1, ncol - pabs(i) = 0.5_r8*cabs(i,1) - do nc = 2, ncoef - pabs(i) = pabs(i) + cheby(nc,i,k)*cabs(i,nc) - end do - pabs(i) = pabs(i)*wetvol(i)*rhoh2o - pabs(i) = max(0._r8,pabs(i)) - dopaer(i) = pabs(i)*mass(i,k) - end do - - do i = 1, ncol - - if ((dopaer(i) <= -1.e-10_r8) .or. (dopaer(i) >= 20._r8)) then - - if (dopaer(i) <= -1.e-10_r8) then - write(iulog,*) "ERROR: Negative aerosol optical depth & - &in this layer." - else - write(iulog,*) "WARNING: Aerosol optical depth is & - &unreasonably high in this layer." - end if - - write(iulog,*) 'dopaer(',i,',',k,',',m,',',lchnk,')=', dopaer(i) - write(iulog,*) 'k=',k,' pabs=', pabs(i) - write(iulog,*) 'wetvol=',wetvol(i),' dryvol=',dryvol(i), & - ' watervol=',watervol(i) - write(iulog,*) 'cabs=', (cabs(i,l),l=1,ncoef) - write(iulog,*) 'crefin=', crefin(i) - write(iulog,*) 'nspec=', nspec - do l = 1,nspec - call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & - refindex_aer_lw=specrefindex) - volf = specmmr(i,k)/specdens - write(iulog,*) 'l=',l,'vol(l)=',volf - write(iulog,*) 'ilw=',ilw,' specrefindex(ilw)=',specrefindex(ilw) - write(iulog,*) 'specdens=',specdens - end do - - nerr_dopaer = nerr_dopaer + 1 - if (nerr_dopaer >= nerrmax_dopaer .or. dopaer(i) < -1.e-10_r8) then - write(iulog,*) '*** halting in '//subname//' after nerr_dopaer =', nerr_dopaer - call endrun() - end if - - end if - end do - - do i = 1, ncol - tauxar(i,k,ilw) = tauxar(i,k,ilw) + dopaer(i) - end do - - end do ! k = top_lev, pver - - end do ! nlwbands - - end do ! m = 1, nmodes - - if (list_idx > 0) then - deallocate(dgnumdry_m) - deallocate(dgnumwet_m) - deallocate(qaerwat_m) - deallocate(wetdens_m) - deallocate(hygro_m) - deallocate(dryvol_m) - deallocate(dryrad_m) - deallocate(drymass_m) - deallocate(so4dryvol_m) - deallocate(naer_m) - end if - -end subroutine modal_aero_lw - -!=============================================================================== -! Private routines -!=============================================================================== - -subroutine read_water_refindex(infilename) - - ! read water refractive index file and set module data - - character*(*), intent(in) :: infilename ! modal optics filename - - ! Local variables - - integer :: i, ierr - type(file_desc_t) :: ncid ! pio file handle - integer :: did ! dimension ids - integer :: dimlen ! dimension lengths - type(var_desc_t) :: vid ! variable ids - real(r8) :: refrwsw(nswbands), refiwsw(nswbands) ! real, imaginary ref index for water visible - real(r8) :: refrwlw(nlwbands), refiwlw(nlwbands) ! real, imaginary ref index for water infrared - !---------------------------------------------------------------------------- - - ! open file - call cam_pio_openfile(ncid, infilename, PIO_NOWRITE) - - ! inquire dimensions. Check that file values match parameter values. - - ierr = pio_inq_dimid(ncid, 'lw_band', did) - ierr = pio_inq_dimlen(ncid, did, dimlen) - if (dimlen .ne. nlwbands) then - write(iulog,*) 'lw_band len=', dimlen, ' from ', infilename, ' ne nlwbands=', nlwbands - call endrun('read_modal_optics: bad lw_band value') - endif - - ierr = pio_inq_dimid(ncid, 'sw_band', did) - ierr = pio_inq_dimlen(ncid, did, dimlen) - if (dimlen .ne. nswbands) then - write(iulog,*) 'sw_band len=', dimlen, ' from ', infilename, ' ne nswbands=', nswbands - call endrun('read_modal_optics: bad sw_band value') - endif - - ! read variables - ierr = pio_inq_varid(ncid, 'refindex_real_water_sw', vid) - ierr = pio_get_var(ncid, vid, refrwsw) - - ierr = pio_inq_varid(ncid, 'refindex_im_water_sw', vid) - ierr = pio_get_var(ncid, vid, refiwsw) - - ierr = pio_inq_varid(ncid, 'refindex_real_water_lw', vid) - ierr = pio_get_var(ncid, vid, refrwlw) - - ierr = pio_inq_varid(ncid, 'refindex_im_water_lw', vid) - ierr = pio_get_var(ncid, vid, refiwlw) - - ! set complex representation of refractive indices as module data - do i = 1, nswbands - crefwsw(i) = cmplx(refrwsw(i), abs(refiwsw(i)),kind=r8) - end do - do i = 1, nlwbands - crefwlw(i) = cmplx(refrwlw(i), abs(refiwlw(i)),kind=r8) - end do - - call pio_closefile(ncid) - -end subroutine read_water_refindex - -!=============================================================================== - -subroutine modal_size_parameters(ncol, sigma_logr_aer, dgnumwet, radsurf, logradsurf, cheb) - - integer, intent(in) :: ncol - real(r8), intent(in) :: sigma_logr_aer ! geometric standard deviation of number distribution - real(r8), intent(in) :: dgnumwet(:,:) ! aerosol wet number mode diameter (m) - real(r8), intent(out) :: radsurf(:,:) ! aerosol surface mode radius - real(r8), intent(out) :: logradsurf(:,:) ! log(aerosol surface mode radius) - real(r8), intent(out) :: cheb(:,:,:) - - integer :: i, k, nc - real(r8) :: alnsg_amode - real(r8) :: explnsigma - real(r8) :: xrad(pcols) ! normalized aerosol radius - !------------------------------------------------------------------------------- - - alnsg_amode = log(sigma_logr_aer) - explnsigma = exp(2.0_r8*alnsg_amode*alnsg_amode) - - do k = top_lev, pver - do i = 1, ncol - ! convert from number mode diameter to surface area - radsurf(i,k) = 0.5_r8*dgnumwet(i,k)*explnsigma - logradsurf(i,k) = log(radsurf(i,k)) - ! normalize size parameter - xrad(i) = max(logradsurf(i,k),xrmin) - xrad(i) = min(xrad(i),xrmax) - xrad(i) = (2._r8*xrad(i)-xrmax-xrmin)/(xrmax-xrmin) - ! chebyshev polynomials - cheb(1,i,k) = 1._r8 - cheb(2,i,k) = xrad(i) - do nc = 3, ncoef - cheb(nc,i,k) = 2._r8*xrad(i)*cheb(nc-1,i,k)-cheb(nc-2,i,k) - end do - end do - end do - -end subroutine modal_size_parameters - -!=============================================================================== - - subroutine binterp(table,ncol,km,im,jm,x,y,xtab,ytab,ix,jy,t,u,out) - - ! bilinear interpolation of table - ! - implicit none - integer im,jm,km,ncol - real(r8) table(km,im,jm),xtab(im),ytab(jm),out(pcols,km) - integer i,ix(pcols),ip1,j,jy(pcols),jp1,k,ic,ip1m(pcols),jp1m(pcols),ixc,jyc - real(r8) x(pcols),dx,t(pcols),y(pcols),dy,u(pcols),tu(pcols),tuc(pcols),tcu(pcols),tcuc(pcols) - - if(ix(1).gt.0) go to 30 - if(im.gt.1)then - do ic=1,ncol - do i=1,im - if(x(ic).lt.xtab(i))go to 10 - enddo - 10 ix(ic)=max0(i-1,1) - ip1=min(ix(ic)+1,im) - dx=(xtab(ip1)-xtab(ix(ic))) - if(abs(dx).gt.1.e-20_r8)then - t(ic)=(x(ic)-xtab(ix(ic)))/dx - else - t(ic)=0._r8 - endif - end do - else - ix(:ncol)=1 - t(:ncol)=0._r8 - endif - if(jm.gt.1)then - do ic=1,ncol - do j=1,jm - if(y(ic).lt.ytab(j))go to 20 - enddo - 20 jy(ic)=max0(j-1,1) - jp1=min(jy(ic)+1,jm) - dy=(ytab(jp1)-ytab(jy(ic))) - if(abs(dy).gt.1.e-20_r8)then - u(ic)=(y(ic)-ytab(jy(ic)))/dy - else - u(ic)=0._r8 - endif - end do - else - jy(:ncol)=1 - u(:ncol)=0._r8 - endif - 30 continue - do ic=1,ncol - tu(ic)=t(ic)*u(ic) - tuc(ic)=t(ic)-tu(ic) - tcuc(ic)=1._r8-tuc(ic)-u(ic) - tcu(ic)=u(ic)-tu(ic) - jp1m(ic)=min(jy(ic)+1,jm) - ip1m(ic)=min(ix(ic)+1,im) - enddo - do ic=1,ncol - jyc=jy(ic) - ixc=ix(ic) - jp1=jp1m(ic) - ip1=ip1m(ic) - do k=1,km - out(ic,k) = tcuc(ic) * table(k,ixc,jyc) + tuc(ic) * table(k,ip1,jyc) + & - tu(ic) * table(k,ip1,jp1) + tcu(ic) * table(k,ixc,jp1) - end do - end do - return - end subroutine binterp - -end module modal_aer_opt diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 index ced2c35cfa..2863197669 100644 --- a/src/physics/cam/rad_constituents.F90 +++ b/src/physics/cam/rad_constituents.F90 @@ -2,9 +2,9 @@ module rad_constituents !------------------------------------------------------------------------------------------------ ! -! Provide constituent distributions and properties to the radiation and +! Provide constituent distributions and properties to the radiation and ! cloud microphysics routines. -! +! ! The logic to control which constituents are used in the climate calculations ! and which are used in diagnostic radiation calculations is contained in this module. ! @@ -115,7 +115,7 @@ module rad_constituents ! type to provide access to the data parsed from the rad_climate and rad_diag_* strings type :: rad_cnst_namelist_t integer :: ncnst - character(len= 1), pointer :: source(:) ! 'A' for state (advected), 'N' for pbuf (non-advected), + character(len= 1), pointer :: source(:) ! 'A' for state (advected), 'N' for pbuf (non-advected), ! 'M' for mode, 'Z' for zero character(len= 64), pointer :: camname(:) ! name registered in pbuf or constituents character(len=cs1), pointer :: radname(:) ! radname is the name as identfied in radiation, @@ -127,7 +127,7 @@ module rad_constituents type(rad_cnst_namelist_t) :: namelist(0:N_DIAG) ! gas, bulk aerosol, and modal components used in ! climate/diagnostic calculations -logical :: active_calls(0:N_DIAG) ! active_calls(i) is true if the i-th call to radiation is +logical :: active_calls(0:N_DIAG) ! active_calls(i) is true if the i-th call to radiation is ! specified. Note that the 0th call is for the climate ! calculation which is always made. @@ -184,7 +184,7 @@ module rad_constituents ! values for constituents with requested value of zero -real(r8), allocatable, target :: zero_cols(:,:) +real(r8), allocatable, target :: zero_cols(:,:) ! define generic interface routines interface rad_cnst_get_info @@ -299,7 +299,7 @@ subroutine rad_cnst_readnl(nlfile) ! Mode definition stings call parse_mode_defs(mode_defs, modes) - + ! Lists of externally mixed entities for climate and diagnostic calculations do i = 0,N_DIAG select case (i) @@ -331,7 +331,7 @@ subroutine rad_cnst_readnl(nlfile) ! were there any constituents specified for the nth diagnostic call? ! if so, radiation will make a call with those consituents active_calls(:) = (namelist(:)%ncnst > 0) - + ! Initialize the gas and aerosol lists with the information from the ! namelist. This is done here so that this information is available via ! the query functions at the time when the register methods are called. @@ -470,13 +470,13 @@ subroutine rad_cnst_get_gas(list_idx, gasname, state, pbuf, mmr) write(iulog,*) subname//': list_idx =', list_idx call endrun(subname//': list_idx out of bounds') endif - + lchnk = state%lchnk - ! Get index of gas in internal arrays. rad_gas_index will abort if the + ! Get index of gas in internal arrays. rad_gas_index will abort if the ! specified gasname is not recognized by the radiative transfer code. igas = rad_gas_index(trim(gasname)) - + ! Get data source source = list%gas(igas)%source idx = list%gas(igas)%idx @@ -516,10 +516,10 @@ function rad_cnst_num_name(list_idx, spc_name_in, num_name_out, mode_out, spec_o character(len= 32) :: spec_name found = .false. - + m_list => ma_list(list_idx) nmodes = m_list%nmodes - + do n = 1,nmodes mm = m_list%idx(n) nspecs = modes%comps(mm)%nspec @@ -629,7 +629,7 @@ subroutine rad_cnst_get_info(list_idx, gasnames, aernames, & ! get index of O3 in gas list igas = rad_gas_index('O3') - + ! Get data source source = g_list%gas(igas)%source @@ -1054,7 +1054,7 @@ subroutine init_mode_comps(modes) modes%comps(m)%camname_mmr_c(ispec), routine) ! get physprop ID - modes%comps(m)%idx_props(ispec) = physprop_get_id(modes%comps(m)%props(ispec)) + modes%comps(m)%idx_props(ispec) = physprop_get_id(modes%comps(m)%props(ispec)) if (modes%comps(m)%idx_props(ispec) == -1) then call endrun(routine//' : ERROR idx not found for '//trim(modes%comps(m)%props(ispec))) end if @@ -1079,7 +1079,7 @@ integer function get_cam_idx(source, name, routine) integer :: idx integer :: errcode !----------------------------------------------------------------------------- - + if (source(1:1) == 'N') then idx = pbuf_get_index(trim(name),errcode) @@ -1103,7 +1103,7 @@ integer function get_cam_idx(source, name, routine) call endrun(routine//' ERROR: invalid source for specie '//trim(name)) end if - + get_cam_idx = idx end function get_cam_idx @@ -1112,7 +1112,7 @@ end function get_cam_idx subroutine list_init1(namelist, gaslist, aerlist, ma_list) - ! Initialize the gas and bulk and modal aerosol lists with the + ! Initialize the gas and bulk and modal aerosol lists with the ! entities specified in the climate or diagnostic lists. ! This first phase initialization just sets the information that @@ -1180,7 +1180,7 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) end if ! Add component to appropriate list (gas, modal or bulk aerosol) - if (namelist%type(ii) == 'A') then + if (namelist%type(ii) == 'A') then ! Add to bulk aerosol list ba_idx = ba_idx + 1 @@ -1189,7 +1189,7 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) aerlist%aer(ba_idx)%camname = namelist%camname(ii) aerlist%aer(ba_idx)%physprop_file = namelist%radname(ii) - else if (namelist%type(ii) == 'M') then + else if (namelist%type(ii) == 'M') then ! Add to modal aerosol list ma_idx = ma_idx + 1 @@ -1209,7 +1209,7 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) ! Also save the name of the physprop file ma_list%physprop_files(ma_idx) = namelist%radname(ii) - else + else ! Add to gas list @@ -1388,7 +1388,7 @@ end subroutine rad_aer_diag_init subroutine parse_mode_defs(nl_in, modes) ! Parse the mode definition specifiers. The specifiers are of the form: - ! + ! ! 'mode_name:mode_type:=', ! 'source_num_a:camname_num_a:source_num_c:camname_num_c:num_mr:+', ! 'source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file[:+]'[,] @@ -1422,7 +1422,7 @@ subroutine parse_mode_defs(nl_in, modes) ! associated field for the prop_file. There can only be one entry ! with the num_mr type in a mode definition. ! prop_file -- For aerosol species this is a filename, which is - ! identified by a ".nc" suffix. The file contains optical and + ! identified by a ".nc" suffix. The file contains optical and ! other physical properties of the aerosol. ! ! A mode definition must contain only 1 string for the number mixing ratio components @@ -1448,7 +1448,7 @@ subroutine parse_mode_defs(nl_in, modes) character(len=32) :: tmp_name_c character(len=32) :: tmp_type !------------------------------------------------------------------------- - + ! Determine number of modes defined by counting number of strings that are ! terminated by ':=' ! (algorithm stops counting at first blank element). @@ -1458,7 +1458,7 @@ subroutine parse_mode_defs(nl_in, modes) if (len_trim(nl_in(m)) == 0) exit nstr = nstr + 1 - + ! There are no fields in the input strings in which a blank character is allowed. ! To simplify the parsing go through the input strings and remove blanks. tmpstr = adjustl(nl_in(m)) @@ -1489,7 +1489,7 @@ subroutine parse_mode_defs(nl_in, modes) write(iulog,*) routine//': ERROR: cannot allocate storage for modes. nmodes=', nmodes call endrun(routine//': ERROR allocating storage for modes') end if - + mcur = 1 ! index of current string being processed @@ -1512,7 +1512,7 @@ subroutine parse_mode_defs(nl_in, modes) nspec = nspec + 1 mcur = mcur + 1 end do - + ! a mode must have at least one specie if (nspec == 0) call parse_error('mode must have at least one specie', nl_in(mbeg)) @@ -1549,7 +1549,7 @@ subroutine parse_mode_defs(nl_in, modes) ! return to first string in mode definition mcur = mbeg tmpstr = nl_in(mcur) - + ! mode name ipos = index(tmpstr, ':') if (ipos < 2) call parse_error('mode name not found', tmpstr) @@ -1693,7 +1693,7 @@ subroutine check_specie_type(str, ib, ie) character(len=*), intent(in) :: str integer, intent(in) :: ib, ie - + integer :: i do i = 1, num_spec_types @@ -1710,7 +1710,7 @@ subroutine check_mode_type(str, ib, ie) character(len=*), intent(in) :: str integer, intent(in) :: ib, ie ! begin, end character of mode type substring - + integer :: i do i = 1, num_mode_types @@ -1739,7 +1739,7 @@ subroutine parse_rad_specifier(specifier, namelist_data) ! radname -- For gases this is a name that identifies the constituent to the ! radiative transfer codes. These names are contained in the ! radconstants module. For aerosols this is a filename, which is -! identified by a ".nc" suffix. The file contains optical and +! identified by a ".nc" suffix. The file contains optical and ! other physical properties of the aerosol. ! ! This code also identifies whether the constituent is a gas or an aerosol @@ -1759,11 +1759,11 @@ subroutine parse_rad_specifier(specifier, namelist_data) character(len=cs1) :: radname(n_rad_cnst) character(len=1) :: type(n_rad_cnst) !------------------------------------------------------------------------- - + number = 0 parse_loop: do i = 1, n_rad_cnst - if ( len_trim(specifier(i)) == 0 ) then + if ( len_trim(specifier(i)) == 0 ) then exit parse_loop endif @@ -1784,12 +1784,12 @@ subroutine parse_rad_specifier(specifier, namelist_data) ! locate the ':' separating camname from radname j = scan(tmpstr, ':') - + camname(i) = tmpstr(:j-1) radname(i) = tmpstr(j+1:) ! determine the type of constituent - if (source(i) == 'M') then + if (source(i) == 'M') then type(i) = 'M' else if(index(radname(i),".nc") .gt. 0) then type(i) = 'A' @@ -1797,7 +1797,7 @@ subroutine parse_rad_specifier(specifier, namelist_data) type(i) = 'G' end if - number = number+1 + number = number+1 end do parse_loop namelist_data%ncnst = number @@ -1876,7 +1876,7 @@ end subroutine rad_cnst_get_aer_mmr_by_idx subroutine rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, state, pbuf, mmr) ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified - ! climate or diagnostic list. + ! climate or diagnostic list. ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list @@ -1950,7 +1950,7 @@ subroutine rad_cnst_get_mam_mmr_idx(mode_idx, spec_idx, idx) ! Return constituent index of mam specie mass mixing ratio for aerosol modes in ! the climate list. - ! This is a special routine to allow direct access to information in the + ! This is a special routine to allow direct access to information in the ! constituent array inside physics parameterizations that have been passed, ! and are operating over the entire constituent array. The interstitial phase ! is assumed since that's what is contained in the constituent array. @@ -1994,7 +1994,7 @@ end subroutine rad_cnst_get_mam_mmr_idx subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num) ! Return pointer to number mixing ratio for the aerosol mode from the specified - ! climate or diagnostic list. + ! climate or diagnostic list. ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list @@ -2061,7 +2061,7 @@ subroutine rad_cnst_get_mode_num_idx(mode_idx, cnst_idx) ! Return constituent index of mode number mixing ratio for the aerosol mode in ! the climate list. - ! This is a special routine to allow direct access to information in the + ! This is a special routine to allow direct access to information in the ! constituent array inside physics parameterizations that have been passed, ! and are operating over the entire constituent array. The interstitial phase ! is assumed since that's what is contained in the constituent array. @@ -2116,7 +2116,7 @@ integer function rad_cnst_get_aer_idx(list_idx, aer_name) type(aerlist_t), pointer :: aerlist character(len=*), parameter :: subname = "rad_cnst_get_aer_idx" !------------------------------------------------------------------------- - + if (list_idx >= 0 .and. list_idx <= N_DIAG) then aerlist => aerosollist(list_idx) else @@ -2134,7 +2134,7 @@ integer function rad_cnst_get_aer_idx(list_idx, aer_name) end do if (aer_idx == -1) call endrun(subname//": ERROR - name not found") - + rad_cnst_get_aer_idx = aer_idx end function rad_cnst_get_aer_idx @@ -2160,30 +2160,30 @@ subroutine rad_cnst_get_aer_props_by_idx(list_idx, & integer, intent(in) :: list_idx ! index of the climate or a diagnostic list integer, intent(in) :: aer_idx ! index of the aerosol character(len=ot_length), optional, intent(out) :: opticstype - real(r8), optional, pointer :: sw_hygro_ext(:,:) - real(r8), optional, pointer :: sw_hygro_ssa(:,:) - real(r8), optional, pointer :: sw_hygro_asm(:,:) - real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) real(r8), optional, pointer :: sw_nonhygro_ext(:) real(r8), optional, pointer :: sw_nonhygro_ssa(:) real(r8), optional, pointer :: sw_nonhygro_asm(:) real(r8), optional, pointer :: sw_nonhygro_scat(:) real(r8), optional, pointer :: sw_nonhygro_ascat(:) - real(r8), optional, pointer :: lw_ext(:) + real(r8), optional, pointer :: lw_ext(:) complex(r8), optional, pointer :: refindex_aer_sw(:) complex(r8), optional, pointer :: refindex_aer_lw(:) - character(len=20), optional, intent(out) :: aername + character(len=20), optional, intent(out) :: aername real(r8), optional, intent(out) :: density_aer real(r8), optional, intent(out) :: hygro_aer - real(r8), optional, intent(out) :: dryrad_aer - real(r8), optional, intent(out) :: dispersion_aer - real(r8), optional, intent(out) :: num_to_mass_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer - real(r8), optional, pointer :: r_sw_ext(:,:) - real(r8), optional, pointer :: r_sw_scat(:,:) - real(r8), optional, pointer :: r_sw_ascat(:,:) - real(r8), optional, pointer :: r_lw_abs(:,:) - real(r8), optional, pointer :: mu(:) + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) ! Local variables integer :: id @@ -2259,31 +2259,31 @@ subroutine rad_cnst_get_mam_props_by_idx(list_idx, & integer, intent(in) :: mode_idx ! mode index integer, intent(in) :: spec_idx ! index of specie in the mode character(len=ot_length), optional, intent(out) :: opticstype - real(r8), optional, pointer :: sw_hygro_ext(:,:) - real(r8), optional, pointer :: sw_hygro_ssa(:,:) - real(r8), optional, pointer :: sw_hygro_asm(:,:) - real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) real(r8), optional, pointer :: sw_nonhygro_ext(:) real(r8), optional, pointer :: sw_nonhygro_ssa(:) real(r8), optional, pointer :: sw_nonhygro_asm(:) real(r8), optional, pointer :: sw_nonhygro_scat(:) real(r8), optional, pointer :: sw_nonhygro_ascat(:) - real(r8), optional, pointer :: lw_ext(:) + real(r8), optional, pointer :: lw_ext(:) complex(r8), optional, pointer :: refindex_aer_sw(:) complex(r8), optional, pointer :: refindex_aer_lw(:) - real(r8), optional, pointer :: r_sw_ext(:,:) - real(r8), optional, pointer :: r_sw_scat(:,:) - real(r8), optional, pointer :: r_sw_ascat(:,:) - real(r8), optional, pointer :: r_lw_abs(:,:) - real(r8), optional, pointer :: mu(:) + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) - character(len=20), optional, intent(out) :: aername + character(len=20), optional, intent(out) :: aername real(r8), optional, intent(out) :: density_aer real(r8), optional, intent(out) :: hygro_aer - real(r8), optional, intent(out) :: dryrad_aer - real(r8), optional, intent(out) :: dispersion_aer - real(r8), optional, intent(out) :: num_to_mass_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer character(len=32), optional, intent(out) :: spectype ! Local variables @@ -2352,7 +2352,7 @@ end subroutine rad_cnst_get_mam_props_by_idx !================================================================================================ -subroutine rad_cnst_get_mode_props(list_idx, mode_idx, & +subroutine rad_cnst_get_mode_props(list_idx, mode_idx, opticstype, & extpsw, abspsw, asmpsw, absplw, refrtabsw, & refitabsw, refrtablw, refitablw, ncoef, prefr, & prefi, sigmag, dgnum, dgnumlo, dgnumhi, & @@ -2366,7 +2366,7 @@ subroutine rad_cnst_get_mode_props(list_idx, mode_idx, & ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list integer, intent(in) :: mode_idx ! mode index - + character(len=ot_length), optional, intent(out) :: opticstype real(r8), optional, pointer :: extpsw(:,:,:,:) real(r8), optional, pointer :: abspsw(:,:,:,:) real(r8), optional, pointer :: asmpsw(:,:,:,:) @@ -2407,6 +2407,7 @@ subroutine rad_cnst_get_mode_props(list_idx, mode_idx, & ! Get the physprop index for the requested mode id = mlist%idx_props(mode_idx) + if (present(opticstype)) call physprop_get(id, opticstype=opticstype) if (present(extpsw)) call physprop_get(id, extpsw=extpsw) if (present(abspsw)) call physprop_get(id, abspsw=abspsw) if (present(asmpsw)) call physprop_get(id, asmpsw=asmpsw) diff --git a/src/physics/rrtmg/radiation.F90 b/src/physics/rrtmg/radiation.F90 index 31e33b183d..4ca347d749 100644 --- a/src/physics/rrtmg/radiation.F90 +++ b/src/physics/rrtmg/radiation.F90 @@ -17,7 +17,7 @@ module radiation use time_manager, only: get_nstep, is_first_restart_step, & get_curr_calday, get_step_size -use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, rad_cnst_get_info, & +use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, & rad_cnst_get_gas, rad_cnst_out, oldcldoptics, & liqcldoptics, icecldoptics @@ -363,7 +363,6 @@ subroutine radiation_init(pbuf2d) use rad_solar_var, only: rad_solar_var_init use radiation_data, only: rad_data_init use cloud_rad_props, only: cloud_rad_props_init - use modal_aer_opt, only: modal_aer_opt_init use rrtmg_state, only: rrtmg_state_init use time_manager, only: is_first_step @@ -372,7 +371,7 @@ subroutine radiation_init(pbuf2d) type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! local variables - integer :: icall, nmodes + integer :: icall logical :: active_calls(0:N_DIAG) integer :: nstep ! current timestep number logical :: history_amwg ! output the variables used by the AMWG diag package @@ -417,11 +416,6 @@ subroutine radiation_init(pbuf2d) history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num) - ! Determine whether modal aerosols are affecting the climate, and if so - ! then initialize the modal aerosol optics module - call rad_cnst_get_info(0, nmodes=nmodes) - if (nmodes > 0) call modal_aer_opt_init() - ! "irad_always" is number of time steps to execute radiation continuously from start of ! initial OR restart run nstep = get_nstep() @@ -1564,4 +1558,3 @@ end subroutine calc_col_mean !=============================================================================== end module radiation - From d8b0896a761e4e80dc6c4ad780d79128b5b9cef0 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 22 May 2023 16:34:26 -0600 Subject: [PATCH 02/27] code clean up modified: src/physics/cam/aerosol_optics_cam.F90 --- src/physics/cam/aerosol_optics_cam.F90 | 59 ++++++++++++++------------ 1 file changed, 31 insertions(+), 28 deletions(-) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 92c67f4949..3a60dd0a14 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -161,9 +161,9 @@ subroutine aerosol_optics_cam_init if (modal_active) then iaermod = iaermod+1 aero_props(iaermod)%obj => modal_aerosol_properties() -!!$ else if (carma_active) then -!!$ iaermod = iaermod+1 -!!$ aero_props(iaermod)%obj => carma_aerosol_properties() + else if (carma_active) then + iaermod = iaermod+1 +! aero_props(iaermod)%obj => carma_aerosol_properties() end if if (water_refindex_file/='NONE') then @@ -618,9 +618,9 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, if (modal_active) then iaermod = iaermod+1 aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) -!!$ else if (carma_active) then -!!$ iaermod = iaermod+1 -!!$ aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) + else if (carma_active) then + iaermod = iaermod+1 +! aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) end if allocate(pext(ncol), stat=istat) @@ -659,16 +659,16 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, case('modal') ! refractive method 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) + 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) case default call endrun(prefix//'optics method not recognized') end select @@ -1103,9 +1103,9 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) if (modal_active) then iaermod = iaermod+1 aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) -!!$ else if (carma_active) then -!!$ iaermod = iaermod+1 -!!$ aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) + else if (carma_active) then + iaermod = iaermod+1 +! aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) end if ncol = state%ncol @@ -1130,15 +1130,18 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) select case (trim(opticstype)) case('modal') ! refractive method - 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) + 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) case default call endrun(prefix//'optics method not recognized') end select From 8d71f9241b87f4048c28f02a1010fbb2c35fe7db Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 23 May 2023 10:43:02 -0600 Subject: [PATCH 03/27] initialize dustvol to zero; corections to add_default fields; minor clean up modified: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/refractive_aerosol_optics_mod.F90 | 1 - src/physics/cam/aerosol_optics_cam.F90 | 111 ++++++++++++++++-- 2 files changed, 98 insertions(+), 14 deletions(-) diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index af662b2a5d..a2ce2debeb 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -248,7 +248,6 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) pabs(icol) = min(pext(icol),pabs(icol)) palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) - palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) end do diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 3a60dd0a14..edcc5d478c 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -129,11 +129,15 @@ subroutine aerosol_optics_cam_init character(len=30) :: fldname character(len=128) :: lngname - logical :: history_aero_optics ! output aerosol optics diagnostics + 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 character(len=256) :: locfile - call phys_getopts(history_aero_optics_out = history_aero_optics) + call phys_getopts(history_amwg_out = history_amwg, & + history_aero_optics_out = history_aero_optics, & + history_dust_out = history_dust ) num_aero_models = 0 nbins = 0 @@ -257,7 +261,6 @@ subroutine aerosol_optics_cam_init end if end do - if (num_aero_models>0) then allocate(burden_fields(num_aero_models), stat=istat) @@ -320,7 +323,7 @@ subroutine aerosol_optics_cam_init 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.) - if (history_aero_optics) then + if (m>3 .and. history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -328,7 +331,7 @@ subroutine aerosol_optics_cam_init aodbin_fields(n)%name(m) = fldname write(lngname,'(a,i2)') 'Aerosol optical depth, day only, 550 nm bin ', m call addfld (aodbin_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (history_aero_optics) then + if (m>3 .and. history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -336,7 +339,7 @@ subroutine aerosol_optics_cam_init 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.) - if (history_aero_optics) then + if (m>3 .and. history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -344,7 +347,7 @@ subroutine aerosol_optics_cam_init 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.) - if (history_aero_optics) then + if (m>3 .and. history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -352,7 +355,7 @@ subroutine aerosol_optics_cam_init aodbindn_fields(n)%name(m) = fldname write(lngname,'(a,i2)') 'Aerosol optical depth 550 nm, day night, bin ', m call addfld (aodbindn_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (history_aero_optics) then + if (m>3 .and. history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -360,7 +363,7 @@ subroutine aerosol_optics_cam_init 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.) - if (history_aero_optics) then + if (m>3 .and. history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -428,6 +431,83 @@ subroutine aerosol_optics_cam_init call addfld ('SSAVISdn', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day night', & flag_xyfill=.true.) + if (history_amwg) then + call add_default ('AODDUST01' , 1, ' ') + call add_default ('AODDUST03' , 1, ' ') + call add_default ('AODDUST' , 1, ' ') + call add_default ('AODVIS' , 1, ' ') + end if + + if (history_dust) then + call add_default ('AODDUST01' , 1, ' ') + call add_default ('AODDUST02' , 1, ' ') + call add_default ('AODDUST03' , 1, ' ') + end if + + if (history_aero_optics) then + call add_default ('AODDUST01' , 1, ' ') + call add_default ('AODDUST03' , 1, ' ') + call add_default ('ABSORB' , 1, ' ') + call add_default ('AOD01' , 1, ' ') + call add_default ('AOD02' , 1, ' ') + call add_default ('AOD03' , 1, ' ') + call add_default ('AODVIS' , 1, ' ') + call add_default ('AODUV' , 1, ' ') + call add_default ('AODNIR' , 1, ' ') + call add_default ('AODABS' , 1, ' ') + call add_default ('AODABSBC' , 1, ' ') + call add_default ('AODDUST' , 1, ' ') + call add_default ('AODSO4' , 1, ' ') + call add_default ('AODPOM' , 1, ' ') + call add_default ('AODSOA' , 1, ' ') + call add_default ('AODBC' , 1, ' ') + call add_default ('AODSS' , 1, ' ') + call add_default ('BURDEN01' , 1, ' ') + call add_default ('BURDEN02' , 1, ' ') + call add_default ('BURDEN03' , 1, ' ') + call add_default ('BURDENDUST' , 1, ' ') + call add_default ('BURDENSO4' , 1, ' ') + call add_default ('BURDENPOM' , 1, ' ') + call add_default ('BURDENSOA' , 1, ' ') + call add_default ('BURDENBC' , 1, ' ') + call add_default ('BURDENSEASALT', 1, ' ') + call add_default ('SSAVIS' , 1, ' ') + call add_default ('EXTINCT' , 1, ' ') + call add_default ('AODxASYM' , 1, ' ') + call add_default ('EXTxASYM' , 1, ' ') + + call add_default ('AODdnDUST01' , 1, ' ') + call add_default ('AODdnDUST03' , 1, ' ') + call add_default ('ABSORBdn' , 1, ' ') + call add_default ('AODdn01' , 1, ' ') + call add_default ('AODdn02' , 1, ' ') + call add_default ('AODdn03' , 1, ' ') + call add_default ('AODVISdn' , 1, ' ') + call add_default ('AODUVdn' , 1, ' ') + call add_default ('AODNIRdn' , 1, ' ') + call add_default ('AODABSdn' , 1, ' ') + call add_default ('AODABSBCdn' , 1, ' ') + call add_default ('AODDUSTdn' , 1, ' ') + call add_default ('AODSO4dn' , 1, ' ') + call add_default ('AODPOMdn' , 1, ' ') + call add_default ('AODSOAdn' , 1, ' ') + call add_default ('AODBCdn' , 1, ' ') + call add_default ('AODSSdn' , 1, ' ') + call add_default ('BURDENdn01' , 1, ' ') + call add_default ('BURDENdn02' , 1, ' ') + call add_default ('BURDENdn03' , 1, ' ') + call add_default ('BURDENDUSTdn' , 1, ' ') + call add_default ('BURDENSO4dn' , 1, ' ') + call add_default ('BURDENPOMdn' , 1, ' ') + call add_default ('BURDENSOAdn' , 1, ' ') + call add_default ('BURDENBCdn' , 1, ' ') + call add_default ('BURDENSEASALTdn', 1, ' ') + call add_default ('SSAVISdn' , 1, ' ') + call add_default ('EXTINCTdn' , 1, ' ') + call add_default ('AODxASYMdn' , 1, ' ') + call add_default ('EXTxASYMdn' , 1, ' ') + end if + end subroutine aerosol_optics_cam_init !=============================================================================== @@ -478,10 +558,10 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, real(r8) :: mass(pcols,pver) real(r8) :: air_density(pcols,pver) - real(r8), allocatable :: pext(:) - real(r8), allocatable :: pabs(:) - real(r8), allocatable :: palb(:) - real(r8), allocatable :: pasm(:) + real(r8), allocatable :: pext(:) ! parameterized specific extinction (m2/kg) + real(r8), allocatable :: pabs(:) ! parameterized specific absorption (m2/kg) + real(r8), allocatable :: palb(:) ! parameterized single scattering albedo + real(r8), allocatable :: pasm(:) ! parameterized asymmetry factor real(r8) :: relh(pcols,pver) real(r8) :: sate(pcols,pver) ! saturation vapor pressure @@ -730,6 +810,9 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, !=============================================================================== subroutine init_diags + + dustvol(:ncol) = 0._r8 + scatdust(:ncol) = 0._r8 absdust(:ncol) = 0._r8 hygrodust(:ncol) = 0._r8 @@ -1027,6 +1110,8 @@ subroutine output_tot_diags end do + call outfld('SSAVIS', ssavis, pcols, lchnk) + call outfld('AODxASYM', asymvis, pcols, lchnk) call outfld('BURDENDUST', burdendust, pcols, lchnk) From c07a0eddf64280a6386d29b964ef7389f6936d63 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 23 May 2023 15:39:42 -0600 Subject: [PATCH 04/27] tweak to default hist fields modified: src/physics/cam/aerosol_optics_cam.F90 --- src/physics/cam/aerosol_optics_cam.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index edcc5d478c..14065f2af9 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -250,7 +250,7 @@ subroutine aerosol_optics_cam_init call addfld ('TOTABSLW'//diag(ilist), (/ 'lev' /), 'A',' ', & 'LW Aero total abs') - if (history_aero_optics) then + if (ilist>0 .and. history_aero_optics) then call add_default ('EXTINCT'//diag(ilist), 1, ' ') call add_default ('ABSORB'//diag(ilist), 1, ' ') call add_default ('AODVIS'//diag(ilist), 1, ' ') From 2dddb1d99e4592c0acf8d478f1be7e256dc3df87 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 24 May 2023 11:11:20 -0600 Subject: [PATCH 05/27] use bin names for AOD diags; some cleanup modified: src/chemistry/aerosol/aerosol_properties_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_properties_mod.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/aerosol_properties_mod.F90 | 14 +++++ .../aerosol/modal_aerosol_properties_mod.F90 | 16 ++++++ src/physics/cam/aerosol_optics_cam.F90 | 54 ++++--------------- 3 files changed, 41 insertions(+), 43 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index f68ae07a26..5514f09b17 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -69,6 +69,7 @@ module aerosol_properties_mod procedure(aero_soluble), deferred :: soluble procedure(aero_min_mass_mean_rad), deferred :: min_mass_mean_rad procedure(aero_optics_params), deferred :: optics_params + procedure(aero_bin_name), deferred :: bin_name procedure :: final=>aero_props_final end type aerosol_properties @@ -364,6 +365,19 @@ function aero_alogsig_rlist(self, list_ndx, bin_ndx) result(res) end function aero_alogsig_rlist + !------------------------------------------------------------------------------ + ! returns name for a given radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function aero_bin_name(self, list_ndx, bin_ndx) result(name) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + character(len=32) name + + end function aero_bin_name + end interface contains diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index 8de1276097..e882a28601 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -35,6 +35,8 @@ module modal_aerosol_properties_mod procedure :: alogsig_rlist procedure :: soluble procedure :: min_mass_mean_rad + procedure :: bin_name + final :: destructor end type modal_aerosol_properties @@ -624,4 +626,18 @@ function alogsig_rlist(self, list_ndx, bin_ndx) result(res) end function alogsig_rlist + !------------------------------------------------------------------------------ + ! returns name for a given radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function bin_name(self, list_ndx, bin_ndx) result(name) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + character(len=32) name + + call rad_cnst_get_info(list_ndx, bin_ndx, mode_type=name) + + end function bin_name + end module modal_aerosol_properties_mod diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 14065f2af9..81f8424461 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -127,7 +127,7 @@ subroutine aerosol_optics_cam_init real(r8) :: lwavlen_lo(nlwbands), lwavlen_hi(nlwbands) integer :: m, n - character(len=30) :: fldname + character(len=fieldname_len) :: fldname character(len=128) :: lngname logical :: history_aero_optics ! output aerosol optics diagnostics logical :: history_amwg ! output the variables used by the AMWG diag package @@ -167,7 +167,7 @@ subroutine aerosol_optics_cam_init aero_props(iaermod)%obj => modal_aerosol_properties() else if (carma_active) then iaermod = iaermod+1 -! aero_props(iaermod)%obj => carma_aerosol_properties() + !aero_props(iaermod)%obj => carma_aerosol_properties() end if if (water_refindex_file/='NONE') then @@ -327,11 +327,11 @@ subroutine aerosol_optics_cam_init call add_default (fldname, 1, ' ') end if - write(fldname,'(a,i2.2)') 'AOD', m + fldname = 'AOD_'//trim(aero_props(n)%obj%bin_name(0,m)) aodbin_fields(n)%name(m) = fldname - write(lngname,'(a,i2)') 'Aerosol optical depth, day only, 550 nm bin ', m + lngname = 'Aerosol optical depth, day only, 550 nm, '//trim(aero_props(n)%obj%bin_name(0,m)) call addfld (aodbin_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then + if (history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -351,11 +351,11 @@ subroutine aerosol_optics_cam_init call add_default (fldname, 1, ' ') end if - write(fldname,'(a,i2.2)') 'AODdn', m + fldname = 'AODdn_'//trim(aero_props(n)%obj%bin_name(0,m)) aodbindn_fields(n)%name(m) = fldname - write(lngname,'(a,i2)') 'Aerosol optical depth 550 nm, day night, bin ', m + lngname = 'Aerosol optical depth 550 nm, day night, '//trim(aero_props(n)%obj%bin_name(0,m)) call addfld (aodbindn_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then + if (history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -448,9 +448,6 @@ subroutine aerosol_optics_cam_init call add_default ('AODDUST01' , 1, ' ') call add_default ('AODDUST03' , 1, ' ') call add_default ('ABSORB' , 1, ' ') - call add_default ('AOD01' , 1, ' ') - call add_default ('AOD02' , 1, ' ') - call add_default ('AOD03' , 1, ' ') call add_default ('AODVIS' , 1, ' ') call add_default ('AODUV' , 1, ' ') call add_default ('AODNIR' , 1, ' ') @@ -479,9 +476,6 @@ subroutine aerosol_optics_cam_init call add_default ('AODdnDUST01' , 1, ' ') call add_default ('AODdnDUST03' , 1, ' ') call add_default ('ABSORBdn' , 1, ' ') - call add_default ('AODdn01' , 1, ' ') - call add_default ('AODdn02' , 1, ' ') - call add_default ('AODdn03' , 1, ' ') call add_default ('AODVISdn' , 1, ' ') call add_default ('AODUVdn' , 1, ' ') call add_default ('AODNIRdn' , 1, ' ') @@ -700,7 +694,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) else if (carma_active) then iaermod = iaermod+1 -! aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) + !aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) end if allocate(pext(ncol), stat=istat) @@ -739,16 +733,6 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, case('modal') ! refractive method 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) case default call endrun(prefix//'optics method not recognized') end select @@ -810,9 +794,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, !=============================================================================== subroutine init_diags - - dustvol(:ncol) = 0._r8 - + dustvol(:ncol) = 0._r8 scatdust(:ncol) = 0._r8 absdust(:ncol) = 0._r8 hygrodust(:ncol) = 0._r8 @@ -1111,18 +1093,14 @@ subroutine output_tot_diags end do call outfld('SSAVIS', ssavis, pcols, lchnk) - call outfld('AODxASYM', asymvis, pcols, lchnk) - call outfld('BURDENDUST', burdendust, pcols, lchnk) call outfld('BURDENSO4' , burdenso4, pcols, lchnk) call outfld('BURDENPOM' , burdenpom, pcols, lchnk) call outfld('BURDENSOA' , burdensoa, pcols, lchnk) call outfld('BURDENBC' , burdenbc, pcols, lchnk) call outfld('BURDENSEASALT', burdenseasalt, pcols, lchnk) - call outfld('AODABSBC', aodabsbc, pcols, lchnk) - call outfld('AODDUST', dustaod, pcols, lchnk) call outfld('AODSO4', sulfaod, pcols, lchnk) call outfld('AODPOM', pomaod, pcols, lchnk) @@ -1190,7 +1168,7 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) else if (carma_active) then iaermod = iaermod+1 -! aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) + !aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) end if ncol = state%ncol @@ -1217,16 +1195,6 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) case('modal') ! refractive method 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) case default call endrun(prefix//'optics method not recognized') end select From 16a723f8657efbc79fca9a10d18077f70df6a33e Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 26 May 2023 12:20:36 -0600 Subject: [PATCH 06/27] fix cam4 phys issue modified: src/physics/cam/aer_rad_props.F90 --- src/physics/cam/aer_rad_props.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 5faca8beac..3d46fe9ba8 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -53,6 +53,7 @@ subroutine aer_rad_props_init() 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 !---------------------------------------------------------------------------- @@ -77,7 +78,7 @@ subroutine aer_rad_props_init() ! get names of bulk aerosols allocate(aernames(numaerosols)) - call rad_cnst_get_info(0, aernames=aernames) + call rad_cnst_get_info(0, aernames=aernames, nmodes=nmodes) ! diagnostic output for bulk aerosols ! create outfld names for visible OD @@ -101,7 +102,9 @@ subroutine aer_rad_props_init() end do endif - call aerosol_optics_cam_init() + if (nmodes > 0) then + call aerosol_optics_cam_init() + end if deallocate(aernames) From deb1531e949a19091df43ec84c72dd704745021b Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 26 May 2023 16:14:53 -0600 Subject: [PATCH 07/27] use chem trop lev; correct hist flds in use cases modified: bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml modified: bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml modified: bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml modified: bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml modified: bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml modified: bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml modified: bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml modified: bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml modified: bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml modified: bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml modified: bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml modified: bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml modified: bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml modified: src/physics/cam/aerosol_optics_cam.F90 --- .../use_cases/2000_trop_strat_vbs_cam6.xml | 6 +++--- .../use_cases/2010_trop_strat_vbs_cam6.xml | 6 +++--- .../use_cases/hist_trop_strat_nudged_cam6.xml | 12 ++++++------ .../use_cases/hist_trop_strat_vbs_cam6.xml | 6 +++--- .../use_cases/hist_trop_strat_vbsext_cam6.xml | 6 +++--- .../use_cases/hist_trop_strat_vbsfire_cam6.xml | 6 +++--- bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml | 6 +++--- .../use_cases/sd_trop_strat_vbs_cam6.xml | 6 +++--- bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml | 4 ++-- .../use_cases/waccm_tsmlt_1850_cam6.xml | 4 ++-- .../use_cases/waccm_tsmlt_2000_cam6.xml | 4 ++-- .../use_cases/waccm_tsmlt_2010_cam6.xml | 4 ++-- .../use_cases/waccm_tsmlt_hist_cam6.xml | 4 ++-- src/physics/cam/aerosol_optics_cam.F90 | 4 ++-- 14 files changed, 39 insertions(+), 39 deletions(-) diff --git a/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml index d00387437c..d0be19e0c5 100644 --- a/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +++ b/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml @@ -148,7 +148,7 @@ - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', @@ -180,8 +180,8 @@ 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_accum', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdn_aitken', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', diff --git a/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml index ebc15d2115..a2d0f1a09b 100644 --- a/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +++ b/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml @@ -339,7 +339,7 @@ - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', @@ -371,8 +371,8 @@ 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_accum', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdn_aitken', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', diff --git a/bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml b/bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml index 2875336285..3f47604ad3 100644 --- a/bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml +++ b/bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml @@ -103,7 +103,7 @@ - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', @@ -135,8 +135,8 @@ 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_accum', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdn_aitken', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', @@ -204,7 +204,7 @@ - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', @@ -238,8 +238,8 @@ 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', - 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_accum', 'AODVISstdn', + 'AODNIRstdn', 'AODUVstdn', 'AODdn_aitken', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', diff --git a/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml index 98309c552e..6e7f5a8ff2 100644 --- a/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +++ b/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml @@ -46,7 +46,7 @@ - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', @@ -78,8 +78,8 @@ 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_accum', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdn_aitken', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', diff --git a/bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml b/bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml index 8d8ff90bf9..a0e99f8716 100644 --- a/bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml +++ b/bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml @@ -46,7 +46,7 @@ - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'O3S', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'O3S', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', @@ -81,8 +81,8 @@ 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', - 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_accum', 'AODVISstdn', + 'AODNIRstdn', 'AODUVstdn', 'AODdn_aitken', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', diff --git a/bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml b/bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml index 896609e72a..b70abab514 100644 --- a/bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml +++ b/bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml @@ -87,7 +87,7 @@ - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', @@ -119,8 +119,8 @@ 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_accum', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdn_aitken', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', diff --git a/bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml b/bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml index 8ef3f6903d..2cdbb5308f 100644 --- a/bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml +++ b/bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml @@ -51,7 +51,7 @@ - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', @@ -85,8 +85,8 @@ 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', - 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_accum', 'AODVISstdn', + 'AODNIRstdn', 'AODUVstdn', 'AODdn_aitken', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', diff --git a/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml index 10cf37265a..ff8134d80f 100644 --- a/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml +++ b/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml @@ -61,7 +61,7 @@ - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', @@ -93,8 +93,8 @@ 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_accum', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdn_aitken', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', diff --git a/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml index 4c862f997c..0f2457752e 100644 --- a/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml @@ -68,8 +68,8 @@ 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', + 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', + 'AODdnDUST03', 'AODdn_accum', 'AODdn_aitken', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml index cf01e5431a..9cc9354021 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml @@ -66,8 +66,8 @@ 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF', 'NO2_CLXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', + 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', + 'AODdnDUST03', 'AODdn_accum', 'AODdn_aitken', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml index 564cfaf660..4016a1c295 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml @@ -263,8 +263,8 @@ 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', + 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', + 'AODdnDUST03', 'AODdn_accum', 'AODdn_aitken', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml index 70a9f99e37..27fa70f286 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml @@ -163,8 +163,8 @@ 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', + 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', + 'AODdnDUST03', 'AODdn_accum', 'AODdn_aitken', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml index 12628e4412..1f53536617 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml @@ -59,8 +59,8 @@ 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', + 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', + 'AODdnDUST03', 'AODdn_accum', 'AODdn_aitken', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 81f8424461..b8fb45846e 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -15,7 +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 tropopause, only : tropopause_find + use tropopause, only : tropopause_findChemTrop use aerosol_properties_mod, only: aerosol_properties use modal_aerosol_properties_mod, only: modal_aerosol_properties @@ -641,7 +641,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, nullify(aero_optics) - call tropopause_find(state, troplev) + call tropopause_findChemTrop(state, troplev) lchnk = state%lchnk ncol = state%ncol From 9a1e1c5aa63dd75aa7a57331b37477b17a61cd5c Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 30 May 2023 10:24:48 -0600 Subject: [PATCH 08/27] hygroscopicity in pom phys prop file is suspect -- revert to hard-wired hygroscopicities modified: src/chemistry/aerosol/aerosol_properties_mod.F90 --- .../aerosol/aerosol_properties_mod.F90 | 36 ++++--------------- 1 file changed, 6 insertions(+), 30 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index 5514f09b17..7cddece92b 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -396,13 +396,12 @@ subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ie real(r8),intent(in) :: f2(nbin) ! eq 29 Abdul-Razzak et al 1998 integer,intent(out) :: ierr - integer :: imas,ibin,indx, ispc + integer :: imas,ibin,indx character(len=*),parameter :: prefix = 'aerosol_properties::aero_props_init: ' - real(r8) :: spechygro_so4 ! Sulfate hygroscopicity - real(r8) :: spechygro_soa ! SOA hygroscopicity - real(r8) :: spechygro_pom ! POM hygroscopicity - character(len=aero_name_len) :: spectype + real(r8), parameter :: spechygro_so4 = 0.507_r8 ! Sulfate hygroscopicity + real(r8), parameter :: spechygro_soa = 0.14_r8 ! SOA hygroscopicity + real(r8), parameter :: spechygro_pom = 0.1_r8 ! POM hygroscopicity ierr = 0 @@ -455,31 +454,8 @@ subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ie self%f1_(:) = f1(:) self%f2_(:) = f2(:) - spechygro_so4 = 0._r8 - spechygro_pom = 0._r8 - spechygro_soa = 0._r8 - - do ibin=1,nbin - do ispc = 1,nspec(ibin) - call self%species_type(ibin, ispc, spectype) - - select case ( trim(spectype) ) - case('sulfate') - call self%get(ibin, ispc, hygro=spechygro_so4) - case('p-organic') - call self%get(ibin, ispc, hygro=spechygro_pom) - case('s-organic') - call self%get(ibin, ispc, hygro=spechygro_soa) - end select - end do - end do - - if (spechygro_so4 > 0._r8 .and. spechygro_pom > 0._r8 .and. spechygro_soa > 0._r8) then - self%soa_equivso4_factor_ = spechygro_soa/spechygro_so4 - self%pom_equivso4_factor_ = spechygro_pom/spechygro_so4 - else - ierr = 99 - end if + self%soa_equivso4_factor_ = spechygro_soa/spechygro_so4 + self%pom_equivso4_factor_ = spechygro_pom/spechygro_so4 end subroutine aero_props_init From bd71dc4f35ddb9c95344b804775e67cc62d5eed4 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 26 Jun 2023 10:57:10 -0600 Subject: [PATCH 09/27] removed references to carma aerosol objects modified: src/physics/cam/aerosol_optics_cam.F90 --- src/physics/cam/aerosol_optics_cam.F90 | 38 ++++++++++---------------- 1 file changed, 15 insertions(+), 23 deletions(-) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index b8fb45846e..a1e6bffc59 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -43,17 +43,19 @@ module aerosol_optics_cam class(aerosol_state), pointer :: obj => null() end type aero_state_t - type(aero_props_t), allocatable :: aero_props(:) + type(aero_props_t), allocatable :: aero_props(:) ! array of aerosol properties objects to allow for + ! multiple aerosol representations in the same sim + ! such as MAM and CARMA ! refractive index for water read in read_water_refindex complex(r8) :: crefwsw(nswbands) = -huge(1._r8) ! complex refractive index for water visible complex(r8) :: crefwlw(nlwbands) = -huge(1._r8) ! complex refractive index for water infrared character(len=cl) :: water_refindex_file = 'NONE' ! full pathname for water refractive index dataset - logical :: carma_active = .false. logical :: modal_active = .false. integer :: num_aero_models = 0 - integer :: lw10um_indx = -1 + integer :: lw10um_indx = -1 ! wavelength index corresponding to 10 microns + real(r8), parameter :: lw10um = 10._r8 ! microns character(len=4) :: diag(0:n_diag) = (/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ', '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) @@ -121,7 +123,7 @@ subroutine aerosol_optics_cam_init use ioFileMod, only: getfil character(len=*), parameter :: prefix = 'aerosol_optics_cam_sw: ' - integer :: nmodes=0, nbins=0, iaermod, istat, ilist, i + integer :: nmodes=0, iaermod, istat, ilist, i logical :: call_list(0:n_diag) real(r8) :: lwavlen_lo(nlwbands), lwavlen_hi(nlwbands) @@ -140,17 +142,12 @@ subroutine aerosol_optics_cam_init history_dust_out = history_dust ) num_aero_models = 0 - nbins = 0 call rad_cnst_get_info(0, nmodes=nmodes) modal_active = nmodes>0 - carma_active = nbins>0 if (modal_active) then - num_aero_models = num_aero_models+1 - end if - if (carma_active) then - num_aero_models = num_aero_models+1 + num_aero_models = num_aero_models+1 ! count aerosol models end if if (num_aero_models>0) then @@ -165,9 +162,6 @@ subroutine aerosol_optics_cam_init if (modal_active) then iaermod = iaermod+1 aero_props(iaermod)%obj => modal_aerosol_properties() - else if (carma_active) then - iaermod = iaermod+1 - !aero_props(iaermod)%obj => carma_aerosol_properties() end if if (water_refindex_file/='NONE') then @@ -177,8 +171,8 @@ subroutine aerosol_optics_cam_init call get_lw_spectral_boundaries(lwavlen_lo, lwavlen_hi, units='um') do i = 1,nlwbands - if ((lwavlen_lo(i)<=10._r8) .and. (lwavlen_hi(i)>=10._r8)) then - lw10um_indx = i + if ((lwavlen_lo(i)<=lw10um) .and. (lwavlen_hi(i)>=lw10um)) then + lw10um_indx = i ! index corresponding to 10 microns end if end do call rad_cnst_get_call_list(call_list) @@ -544,7 +538,9 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, integer :: icol, istat integer :: lchnk, ncol - type(aero_state_t), allocatable :: aero_state(:) + type(aero_state_t), allocatable :: aero_state(:) ! array of aerosol state objects to allow for + ! multiple aerosol representations in the same sim + ! such as MAM and CARMA class(aerosol_optics), pointer :: aero_optics @@ -692,9 +688,6 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, if (modal_active) then iaermod = iaermod+1 aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) - else if (carma_active) then - iaermod = iaermod+1 - !aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) end if allocate(pext(ncol), stat=istat) @@ -1136,7 +1129,9 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) integer :: iwav, ilev integer :: ncol, icol, istat - type(aero_state_t), allocatable :: aero_state(:) + type(aero_state_t), allocatable :: aero_state(:) ! array of aerosol state objects to allow for + ! multiple aerosol representations in the same sim + ! such as MAM and CARMA class(aerosol_optics), pointer :: aero_optics class(aerosol_state), pointer :: aerostate @@ -1166,9 +1161,6 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) if (modal_active) then iaermod = iaermod+1 aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) - else if (carma_active) then - iaermod = iaermod+1 - !aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) end if ncol = state%ncol From 6d588186ea2a3b89f44b9d768d9b4a7d5bbc0da2 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 26 Jun 2023 11:36:27 -0600 Subject: [PATCH 10/27] misc clean up modified: src/physics/cam/aerosol_optics_cam.F90 --- src/physics/cam/aerosol_optics_cam.F90 | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index a1e6bffc59..9ab40155f6 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -10,7 +10,6 @@ module aerosol_optics_cam use physconst, only: rga, rair use cam_abortutils, only: endrun use spmd_utils, only : masterproc - use wv_saturation, only: qsat use rad_constituents, only: n_diag, rad_cnst_get_call_list use cam_history, only: addfld, add_default, outfld, horiz_only, fieldname_len use cam_history_support, only: fillvalue @@ -553,10 +552,6 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, real(r8), allocatable :: palb(:) ! parameterized single scattering albedo real(r8), allocatable :: pasm(:) ! parameterized asymmetry factor - real(r8) :: relh(pcols,pver) - real(r8) :: sate(pcols,pver) ! saturation vapor pressure - real(r8) :: satq(pcols,pver) ! saturation specific humidity - character(len=ot_length) :: opticstype integer :: iaermod @@ -615,7 +610,7 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, class(aerosol_state), pointer :: aerostate class(aerosol_properties), pointer :: aeroprops - integer :: ispec + real(r8) :: specdens character(len=32) :: spectype ! species type real(r8), pointer :: specmmr(:,:) @@ -1139,10 +1134,6 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) real(r8), allocatable :: pabs(:) - real(r8) :: relh(pcols,pver) - real(r8) :: sate(pcols,pver) ! saturation vapor pressure - real(r8) :: satq(pcols,pver) ! saturation specific humidity - character(len=32) :: opticstype integer :: iaermod From b2b5433dd57508a2d3b589a18f531122af19d041 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 6 Jul 2023 17:31:38 -0600 Subject: [PATCH 11/27] code review changes modified: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/refractive_aerosol_optics_mod.F90 | 9 +-- src/physics/cam/aerosol_optics_cam.F90 | 62 +++++++++++++++---- 2 files changed, 56 insertions(+), 15 deletions(-) diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index a2ce2debeb..d95349b800 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -54,10 +54,11 @@ module refractive_aerosol_optics_mod ! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties ! in terms of refractive index and wet radius - integer, parameter :: ncoef=5, prefr=7, prefi=10 !??? get from aerosol properties ???? + integer, parameter :: ncoef=5, prefr=7, prefi=10 - real(r8), parameter :: xrmin=log(0.01e-6_r8) - real(r8), parameter :: xrmax=log(25.e-6_r8) + ! radius limits (m) + real(r8), parameter :: xrmin=log(0.01e-6_r8) ! min log(aerosol surface mode radius) + real(r8), parameter :: xrmax=log(25.e-6_r8) ! max log(aerosol surface mode radius) contains @@ -339,7 +340,7 @@ end subroutine destructor subroutine modal_size_parameters(ncol,nlev, alnsg_amode, dgnumwet, radsurf, logradsurf, cheb) integer, intent(in) :: ncol,nlev - real(r8), intent(in) :: alnsg_amode ! geometric standard deviation of number distribution + real(r8), intent(in) :: alnsg_amode ! geometric standard deviation of number distribution real(r8), intent(in) :: dgnumwet(:,:) ! aerosol wet number mode diameter (m) real(r8), intent(out) :: radsurf(:,:) ! aerosol surface mode radius real(r8), intent(out) :: logradsurf(:,:) ! log(aerosol surface mode radius) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 9ab40155f6..60c95243b4 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -163,7 +163,9 @@ subroutine aerosol_optics_cam_init aero_props(iaermod)%obj => modal_aerosol_properties() end if - if (water_refindex_file/='NONE') then + if (water_refindex_file=='NONE') then + call endrun(prefix//'water_refindex_file must be specified') + else call getfil(water_refindex_file, locfile) call read_water_refindex(locfile) end if @@ -811,7 +813,7 @@ subroutine update_diags if (iwav==idx_uv_diag) then aoduv(icol) = aoduv(icol) + dopaer(icol) extinctuv(icol,ilev) = extinctuv(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) - if (ilev.le.troplev(icol)) then + if (ilev<=troplev(icol)) then aoduvst(icol) = aoduvst(icol) + dopaer(icol) end if @@ -826,7 +828,7 @@ subroutine update_diags aodbin(icol) = aodbin(icol) + dopaer(icol) - if (ilev.le.troplev(icol)) then + if (ilev<=troplev(icol)) then aodvisst(icol) = aodvisst(icol) + dopaer(icol) end if @@ -938,7 +940,7 @@ subroutine update_diags aodnir(icol) = aodnir(icol) + dopaer(icol) extinctnir(icol,ilev) = extinctnir(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) - if (ilev.le.troplev(icol)) then + if (ilev<=troplev(icol)) then aodnirst(icol) = aodnirst(icol) + dopaer(icol) end if @@ -1233,7 +1235,7 @@ end subroutine aerosol_optics_cam_lw subroutine read_water_refindex(infilename) use cam_pio_utils, only: cam_pio_openfile use pio, only: file_desc_t, var_desc_t, pio_inq_dimlen, pio_inq_dimid, pio_inq_varid, & - pio_get_var, PIO_NOWRITE, pio_closefile + pio_get_var, PIO_NOWRITE, pio_closefile, pio_noerr ! read water refractive index file and set module data @@ -1249,6 +1251,8 @@ subroutine read_water_refindex(infilename) type(var_desc_t) :: vid ! variable ids real(r8) :: refrwsw(nswbands), refiwsw(nswbands) ! real, imaginary ref index for water visible real(r8) :: refrwlw(nlwbands), refiwlw(nlwbands) ! real, imaginary ref index for water infrared + + character(len=*), parameter :: prefix = 'read_water_refindex: ' !---------------------------------------------------------------------------- ! open file @@ -1257,38 +1261,74 @@ subroutine read_water_refindex(infilename) ! inquire dimensions. Check that file values match parameter values. ierr = pio_inq_dimid(ncid, 'lw_band', did) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_dimid lw_band') + end if ierr = pio_inq_dimlen(ncid, did, dimlen) - if (dimlen .ne. nlwbands) then + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_dimlen lw_band') + end if + if (dimlen /= nlwbands) then write(iulog,*) 'lw_band len=', dimlen, ' from ', infilename, ' ne nlwbands=', nlwbands - call endrun('read_modal_optics: bad lw_band value') + call endrun(prefix//'bad lw_band value') endif ierr = pio_inq_dimid(ncid, 'sw_band', did) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_dimid sw_band') + end if ierr = pio_inq_dimlen(ncid, did, dimlen) - if (dimlen .ne. nswbands) then + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_dimlen sw_band') + end if + if (dimlen /= nswbands) then write(iulog,*) 'sw_band len=', dimlen, ' from ', infilename, ' ne nswbands=', nswbands - call endrun('read_modal_optics: bad sw_band value') + call endrun(prefix//'bad sw_band value') endif ! read variables ierr = pio_inq_varid(ncid, 'refindex_real_water_sw', vid) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_varid refindex_real_water_sw') + end if ierr = pio_get_var(ncid, vid, refrwsw) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_get_var refrwsw') + end if ierr = pio_inq_varid(ncid, 'refindex_im_water_sw', vid) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_varid refindex_im_water_sw') + end if ierr = pio_get_var(ncid, vid, refiwsw) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_get_var refiwsw') + end if ierr = pio_inq_varid(ncid, 'refindex_real_water_lw', vid) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_varid refindex_real_water_lw') + end if ierr = pio_get_var(ncid, vid, refrwlw) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_get_var refrwlw') + end if ierr = pio_inq_varid(ncid, 'refindex_im_water_lw', vid) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_varid refindex_im_water_lw') + end if ierr = pio_get_var(ncid, vid, refiwlw) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_get_var refiwlw') + end if ! set complex representation of refractive indices as module data do i = 1, nswbands - crefwsw(i) = cmplx(refrwsw(i), abs(refiwsw(i)),kind=r8) + crefwsw(i) = cmplx(refrwsw(i), abs(refiwsw(i)), kind=r8) end do do i = 1, nlwbands - crefwlw(i) = cmplx(refrwlw(i), abs(refiwlw(i)),kind=r8) + crefwlw(i) = cmplx(refrwlw(i), abs(refiwlw(i)), kind=r8) end do call pio_closefile(ncid) From 19ebc39888d81ae002623e2ca61a4389d677be5a Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 7 Jul 2023 10:36:17 -0600 Subject: [PATCH 12/27] minor misc code review changes modified: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 --- src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index d95349b800..b687862b7b 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -54,7 +54,9 @@ module refractive_aerosol_optics_mod ! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties ! in terms of refractive index and wet radius - integer, parameter :: ncoef=5, prefr=7, prefi=10 + integer, parameter :: ncoef = 5 ! number of chebychef coeficients + integer, parameter :: prefr = 7 ! number of real refractive indices + integer, parameter :: prefi = 10 ! number of imaginary refractive indices ! radius limits (m) real(r8), parameter :: xrmin=log(0.01e-6_r8) ! min log(aerosol surface mode radius) @@ -354,7 +356,6 @@ subroutine modal_size_parameters(ncol,nlev, alnsg_amode, dgnumwet, radsurf, logr explnsigma = exp(2.0_r8*alnsg_amode*alnsg_amode) - ! do k = top_lev, pver do k = 1, nlev do i = 1, ncol ! convert from number mode diameter to surface area From daddde9888e5aac4f324db15caae32135a6e2aef Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 18 Jul 2023 15:08:09 -0600 Subject: [PATCH 13/27] use table_interp utility module modified: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 new file: src/utils/table_interp_mod.F90 --- .../aerosol/refractive_aerosol_optics_mod.F90 | 149 ++++++------------ src/utils/table_interp_mod.F90 | 94 +++++++++++ 2 files changed, 138 insertions(+), 105 deletions(-) create mode 100644 src/utils/table_interp_mod.F90 diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index b687862b7b..08af52391a 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -5,6 +5,8 @@ module refractive_aerosol_optics_mod use aerosol_state_mod, only: aerosol_state use aerosol_properties_mod, only: aerosol_properties + use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_updwghts + implicit none private @@ -197,41 +199,45 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) real(r8) :: refr(ncol) ! real part of refractive index real(r8) :: refi(ncol) ! imaginary part of refractive index - integer :: itab(ncol), jtab(ncol) - real(r8) :: ttab(ncol), utab(ncol) - real(r8) :: cext(ncol,ncoef), cabs(ncol,ncoef), casm(ncol,ncoef) + real(r8) :: cext(ncoef,ncol), cabs(ncoef,ncol), casm(ncoef,ncol) complex(r8) :: crefin(ncol) ! complex refractive index integer :: icol,icoef + type(table_interp_wghts) :: wghtsr(ncol) + type(table_interp_wghts) :: wghtsi(ncol) + crefin(:ncol) = self%aero_state%refractive_index_sw(ncol, ilev, self%ilist, self%ibin, iwav, self%aero_props) do icol = 1, ncol crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwsw(iwav) crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev),1.e-60_r8) + refr(icol) = real(crefin(icol)) + refr(icol) = max(refr(icol),minval(self%refrtabsw(:,iwav))) + refr(icol) = min(refr(icol),maxval(self%refrtabsw(:,iwav))) + refi(icol) = abs(aimag(crefin(icol))) + refi(icol) = max(refi(icol),minval(self%refitabsw(:,iwav))) + refi(icol) = min(refi(icol),maxval(self%refitabsw(:,iwav))) + end do ! interpolate coefficients linear in refractive index - ! first call calcs itab,jtab,ttab,utab - itab(:ncol) = 0 - call binterp(self%extpsw(:,:,:,iwav), ncol, ncoef, prefr, prefi, & - refr, refi, self%refrtabsw(:,iwav), self%refitabsw(:,iwav), & - itab, jtab, ttab, utab, cext) - call binterp(self%abspsw(:,:,:,iwav), ncol, ncoef, prefr, prefi, & - refr, refi, self%refrtabsw(:,iwav), self%refitabsw(:,iwav), & - itab, jtab, ttab, utab, cabs) - call binterp(self%asmpsw(:,:,:,iwav), ncol, ncoef, prefr, prefi, & - refr, refi, self%refrtabsw(:,iwav), self%refitabsw(:,iwav), & - itab, jtab, ttab, utab, casm) + + call table_interp_updwghts( prefr, self%refrtabsw(:,iwav), ncol, refr(:ncol), wghtsr ) + call table_interp_updwghts( prefi, self%refitabsw(:,iwav), ncol, refi(:ncol), wghtsi ) + + cext(:,:ncol)= table_interp( ncoef,ncol, prefr,prefi, wghtsr,wghtsi, self%extpsw(:,:,:,iwav)) + cabs(:,:ncol)= table_interp( ncoef,ncol, prefr,prefi, wghtsr,wghtsi, self%abspsw(:,:,:,iwav)) + casm(:,:ncol)= table_interp( ncoef,ncol, prefr,prefi, wghtsr,wghtsi, self%asmpsw(:,:,:,iwav)) do icol = 1,ncol if (self%logradsurf(icol,ilev) <= xrmax) then - pext(icol) = 0.5_r8*cext(icol,1) + pext(icol) = 0.5_r8*cext(1,icol) do icoef = 2, ncoef - pext(icol) = pext(icol) + self%cheb(icoef,icol,ilev)*cext(icol,icoef) + pext(icol) = pext(icol) + self%cheb(icoef,icol,ilev)*cext(icoef,icol) enddo pext(icol) = exp(pext(icol)) else @@ -240,11 +246,11 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) ! convert from m2/kg water to m2/kg aerosol pext(icol) = pext(icol)*self%wetvol(icol,ilev)*rhoh2o - pabs(icol) = 0.5_r8*cabs(icol,1) - pasm(icol) = 0.5_r8*casm(icol,1) + pabs(icol) = 0.5_r8*cabs(1,icol) + pasm(icol) = 0.5_r8*casm(1,icol) do icoef = 2, ncoef - pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icol,icoef) - pasm(icol) = pasm(icol) + self%cheb(icoef,icol,ilev)*casm(icol,icoef) + pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icoef,icol) + pasm(icol) = pasm(icol) + self%cheb(icoef,icol,ilev)*casm(icoef,icol) enddo pabs(icol) = pabs(icol)*self%wetvol(icol,ilev)*rhoh2o pabs(icol) = max(0._r8,pabs(icol)) @@ -269,13 +275,14 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) real(r8) :: refr(ncol) ! real part of refractive index real(r8) :: refi(ncol) ! imaginary part of refractive index - integer :: itab(ncol), jtab(ncol) - real(r8) :: ttab(ncol), utab(ncol) - real(r8) :: cabs(ncol,ncoef) + real(r8) :: cabs(ncoef,ncol) complex(r8) :: crefin(ncol) ! complex refractive index integer :: icol, icoef + type(table_interp_wghts) :: wghtsr(ncol) + type(table_interp_wghts) :: wghtsi(ncol) + crefin(:ncol) = self%aero_state%refractive_index_lw(ncol, ilev, self%ilist, self%ibin, iwav, self%aero_props) do icol = 1, ncol @@ -283,21 +290,28 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) if (self%wetvol(icol,ilev) > 1.e-40_r8) then crefin(icol) = crefin(icol)/self%wetvol(icol,ilev) end if + refr(icol) = real(crefin(icol)) + refr(icol) = max(refr(icol),minval(self%refrtablw(:,iwav))) + refr(icol) = min(refr(icol),maxval(self%refrtablw(:,iwav))) + refi(icol) = aimag(crefin(icol)) + refi(icol) = max(refi(icol),minval(self%refitablw(:,iwav))) + refi(icol) = min(refi(icol),maxval(self%refitablw(:,iwav))) + end do ! interpolate coefficients linear in refractive index - ! first call calcs itab,jtab,ttab,utab - itab(:ncol) = 0 - call binterp(self%absplw(:,:,:,iwav), ncol, ncoef, prefr, prefi, & - refr, refi, self%refrtablw(:,iwav), self%refitablw(:,iwav), & - itab, jtab, ttab, utab, cabs) + + call table_interp_updwghts( prefr, self%refrtablw(:,iwav), ncol, refr(:ncol), wghtsr ) + call table_interp_updwghts( prefi, self%refitablw(:,iwav), ncol, refi(:ncol), wghtsi ) + + cabs(:,:ncol)= table_interp( ncoef,ncol, prefr,prefi, wghtsr,wghtsi, self%absplw(:,:,:,iwav)) do icol = 1,ncol - pabs(icol) = 0.5_r8*cabs(icol,1) + pabs(icol) = 0.5_r8*cabs(1,icol) do icoef = 2, ncoef - pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icol,icoef) + pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icoef,icol) end do pabs(icol) = pabs(icol)*self%wetvol(icol,ilev)*rhoh2o pabs(icol) = max(0._r8,pabs(icol)) @@ -376,79 +390,4 @@ subroutine modal_size_parameters(ncol,nlev, alnsg_amode, dgnumwet, radsurf, logr end subroutine modal_size_parameters -!=============================================================================== - subroutine binterp(table,ncol,km,im,jm,x,y,xtab,ytab,ix,jy,t,u,out) - - ! bilinear interpolation of table - ! - integer, intent(in) :: ncol,km,im,jm - real(r8),intent(in) :: table(km,im,jm) - real(r8),intent(in) :: x(ncol),y(ncol), xtab(im),ytab(jm) - integer,intent(inout) :: ix(ncol), jy(ncol) - real(r8),intent(inout) :: t(ncol), u(ncol) - real(r8),intent(out) :: out(ncol,km) - - - integer :: i,j,k,ic,ip1, ixc,jyc, jp1, ip1m(ncol),jp1m(ncol) - real(r8) :: dx,dy,tu(ncol),tuc(ncol),tcu(ncol),tcuc(ncol) - - if(ix(1).gt.0) go to 30 - if(im.gt.1)then - do ic=1,ncol - do i=1,im - if(x(ic).lt.xtab(i))go to 10 - enddo -10 ix(ic)=max0(i-1,1) - ip1=min(ix(ic)+1,im) - dx=(xtab(ip1)-xtab(ix(ic))) - if(abs(dx).gt.1.e-20_r8)then - t(ic)=(x(ic)-xtab(ix(ic)))/dx - else - t(ic)=0._r8 - endif - end do - else - ix(:ncol)=1 - t(:ncol)=0._r8 - endif - if(jm.gt.1)then - do ic=1,ncol - do j=1,jm - if(y(ic).lt.ytab(j))go to 20 - enddo -20 jy(ic)=max0(j-1,1) - jp1=min(jy(ic)+1,jm) - dy=(ytab(jp1)-ytab(jy(ic))) - if(abs(dy).gt.1.e-20_r8)then - u(ic)=(y(ic)-ytab(jy(ic)))/dy - else - u(ic)=0._r8 - endif - end do - else - jy(:ncol)=1 - u(:ncol)=0._r8 - endif -30 continue - do ic=1,ncol - tu(ic)=t(ic)*u(ic) - tuc(ic)=t(ic)-tu(ic) - tcuc(ic)=1._r8-tuc(ic)-u(ic) - tcu(ic)=u(ic)-tu(ic) - jp1m(ic)=min(jy(ic)+1,jm) - ip1m(ic)=min(ix(ic)+1,im) - enddo - do ic=1,ncol - jyc=jy(ic) - ixc=ix(ic) - jp1=jp1m(ic) - ip1=ip1m(ic) - do k=1,km - out(ic,k) = tcuc(ic) * table(k,ixc,jyc) + tuc(ic) * table(k,ip1,jyc) + & - tu(ic) * table(k,ip1,jp1) + tcu(ic) * table(k,ixc,jp1) - end do - end do - return - end subroutine binterp - end module refractive_aerosol_optics_mod diff --git a/src/utils/table_interp_mod.F90 b/src/utils/table_interp_mod.F90 new file mode 100644 index 0000000000..ac2adc5b16 --- /dev/null +++ b/src/utils/table_interp_mod.F90 @@ -0,0 +1,94 @@ +module table_interp_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_abortutils, only: endrun + + implicit none + + private + public :: table_interp + public :: table_interp_wghts + public :: table_interp_updwghts + + interface table_interp + module procedure interp2d + end interface table_interp + + type :: table_interp_wghts + real(r8) :: wt1 + real(r8) :: wt2 + integer :: ix1 + integer :: ix2 + end type table_interp_wghts + +contains + + !-------------------------------------------------------------------------- + !-------------------------------------------------------------------------- + + pure function interp2d( ncoef,ncol,nxs,nys, xwghts,ywghts, tbl ) result(res) + + integer, intent(in) :: ncoef,ncol,nxs,nys + real(r8), intent(in) :: tbl(ncoef,nxs,nys) + type(table_interp_wghts), intent(in) :: xwghts(ncol) + type(table_interp_wghts), intent(in) :: ywghts(ncol) + + real(r8) :: res(ncoef,ncol) + + real(r8) :: fx(ncoef,2) + + integer :: i + + do i = 1,ncol + + fx(:,1) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix1) & + + xwghts(i)%wt2*tbl(:,xwghts(i)%ix2,ywghts(i)%ix1) + fx(:,2) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix2) & + + xwghts(i)%wt2*tbl(:,xwghts(i)%ix2,ywghts(i)%ix2) + + res(:,i) = ywghts(i)%wt1*fx(:,1) + ywghts(i)%wt2*fx(:,2) + + end do + + + end function interp2d + + !-------------------------------------------------------------------------- + !-------------------------------------------------------------------------- + + subroutine table_interp_updwghts( ngrid, xgrid, ncols, xcols, wghts ) + integer, intent(in) :: ngrid + real(r8), intent(in) :: xgrid(ngrid) + integer, intent(in) :: ncols + real(r8), intent(in) :: xcols(ncols) + type(table_interp_wghts), intent(inout) :: wghts(ncols) + + integer :: i + + do i = 1,ncols + wghts(i)%ix2 = find_index(ngrid,xgrid,xcols(i)) + wghts(i)%ix1 = wghts(i)%ix2 - 1 + wghts(i)%wt1 = (xgrid(wghts(i)%ix2)-xcols(i)) & + /(xgrid(wghts(i)%ix2)-xgrid(wghts(i)%ix1)) + wghts(i)%wt2 = 1._8 - wghts(i)%wt1 + end do + + end subroutine table_interp_updwghts + + ! private methods + !-------------------------------------------------------------------------- + !-------------------------------------------------------------------------- + + pure function find_index( nvals, vals, vx ) result(ndx) + integer, intent(in) :: nvals + real(r8), intent(in) :: vals(nvals) + real(r8), intent(in) :: vx + + integer :: ndx + + find_ndx: do ndx = 1, nvals-1 + if (vals(ndx)>vx) exit find_ndx + end do find_ndx + + end function find_index + +end module table_interp_mod From 29e641391035d0e2bc83d2260ee1e5df2a280831 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 21 Jul 2023 13:57:55 -0600 Subject: [PATCH 14/27] use updated table_interp_mod modified: src/physics/cam/modal_aer_opt.F90 modified: src/utils/table_interp_mod.F90 --- .../aerosol/refractive_aerosol_optics_mod.F90 | 69 ++++----- src/utils/table_interp_mod.F90 | 134 +++++++++++++++--- 2 files changed, 151 insertions(+), 52 deletions(-) diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index 08af52391a..730c0ed81c 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -5,7 +5,7 @@ module refractive_aerosol_optics_mod use aerosol_state_mod, only: aerosol_state use aerosol_properties_mod, only: aerosol_properties - use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_updwghts + use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_calcwghts implicit none @@ -41,6 +41,12 @@ module refractive_aerosol_optics_mod real(r8), pointer :: refrtablw(:,:) => null() ! table of real refractive indices for aerosols real(r8), pointer :: refitablw(:,:) => null() ! table of imag refractive indices for aerosols + ! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties + ! in terms of refractive index and wet radius + integer :: ncoef = -1 ! number of chebychef coeficients + integer :: prefr = -1 ! number of real refractive indices + integer :: prefi = -1 ! number of imaginary refractive indices + contains procedure :: sw_props @@ -54,12 +60,6 @@ module refractive_aerosol_optics_mod procedure :: constructor end interface refractive_aerosol_optics - ! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties - ! in terms of refractive index and wet radius - integer, parameter :: ncoef = 5 ! number of chebychef coeficients - integer, parameter :: prefr = 7 ! number of real refractive indices - integer, parameter :: prefi = 10 ! number of imaginary refractive indices - ! radius limits (m) real(r8), parameter :: xrmin=log(0.01e-6_r8) ! min log(aerosol surface mode radius) real(r8), parameter :: xrmax=log(25.e-6_r8) ! max log(aerosol surface mode radius) @@ -85,11 +85,11 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, type(refractive_aerosol_optics), pointer :: newobj integer :: ierr, icol, ilev, ispec, nspec - real(r8) :: vol(ncol) ! volume concentration of aerosol specie (m3/kg) - real(r8) :: dryvol(ncol) ! volume concentration of aerosol mode (m3/kg) + real(r8) :: vol(ncol) ! volume concentration of aerosol specie (m3/kg) + real(r8) :: dryvol(ncol) ! volume concentration of aerosol mode (m3/kg) real(r8) :: specdens ! species density (kg/m3) real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio - real(r8) :: logsigma ! geometric standard deviation of number distribution + real(r8) :: logsigma ! geometric standard deviation of number distribution real(r8) :: dgnumwet(ncol,nlev) ! aerosol wet number mode diameter (m) real(r8) :: qaerwat(ncol,nlev) ! aerosol water (g/g) @@ -100,6 +100,13 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, return end if + ! get mode properties + call aero_props%optics_params(ilist, ibin, & + refrtabsw=newobj%refrtabsw, refitabsw=newobj%refitabsw, & + refrtablw=newobj%refrtablw, refitablw=newobj%refitablw,& + extpsw=newobj%extpsw, abspsw=newobj%abspsw, asmpsw=newobj%asmpsw, & + absplw=newobj%absplw, ncoef=newobj%ncoef, prefr=newobj%prefr, prefi=newobj%prefi) + allocate(newobj%watervol(ncol,nlev),stat=ierr) if (ierr/=0) then nullify(newobj) @@ -110,7 +117,7 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, nullify(newobj) return end if - allocate(newobj%cheb(ncoef,ncol,nlev),stat=ierr) + allocate(newobj%cheb(newobj%ncoef,ncol,nlev),stat=ierr) if (ierr/=0) then nullify(newobj) return @@ -147,7 +154,8 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, logsigma=aero_props%alogsig(ilist,ibin) ! calc size parameter for all columns - call modal_size_parameters(ncol, nlev, logsigma, dgnumwet, newobj%radsurf, newobj%logradsurf, newobj%cheb) + call modal_size_parameters(newobj%ncoef, ncol, nlev, logsigma, dgnumwet, & + newobj%radsurf, newobj%logradsurf, newobj%cheb) do ilev = 1, nlev dryvol(:ncol) = 0._r8 @@ -169,13 +177,6 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, end do end do - ! get mode properties - call aero_props%optics_params(ilist, ibin, & - refrtabsw=newobj%refrtabsw, refitabsw=newobj%refitabsw, & - refrtablw=newobj%refrtablw, refitablw=newobj%refitablw,& - extpsw=newobj%extpsw, abspsw=newobj%abspsw, asmpsw=newobj%asmpsw, & - absplw=newobj%absplw) - newobj%aero_state => aero_state newobj%aero_props => aero_props newobj%ilist = ilist @@ -199,7 +200,7 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) real(r8) :: refr(ncol) ! real part of refractive index real(r8) :: refi(ncol) ! imaginary part of refractive index - real(r8) :: cext(ncoef,ncol), cabs(ncoef,ncol), casm(ncoef,ncol) + real(r8) :: cext(self%ncoef,ncol), cabs(self%ncoef,ncol), casm(self%ncoef,ncol) complex(r8) :: crefin(ncol) ! complex refractive index integer :: icol,icoef @@ -225,18 +226,18 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) ! interpolate coefficients linear in refractive index - call table_interp_updwghts( prefr, self%refrtabsw(:,iwav), ncol, refr(:ncol), wghtsr ) - call table_interp_updwghts( prefi, self%refitabsw(:,iwav), ncol, refi(:ncol), wghtsi ) + wghtsr = table_interp_calcwghts( self%prefr, self%refrtabsw(:,iwav), ncol, refr(:ncol) ) + wghtsi = table_interp_calcwghts( self%prefi, self%refitabsw(:,iwav), ncol, refi(:ncol) ) - cext(:,:ncol)= table_interp( ncoef,ncol, prefr,prefi, wghtsr,wghtsi, self%extpsw(:,:,:,iwav)) - cabs(:,:ncol)= table_interp( ncoef,ncol, prefr,prefi, wghtsr,wghtsi, self%abspsw(:,:,:,iwav)) - casm(:,:ncol)= table_interp( ncoef,ncol, prefr,prefi, wghtsr,wghtsi, self%asmpsw(:,:,:,iwav)) + cext(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%extpsw(:,:,:,iwav)) + cabs(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%abspsw(:,:,:,iwav)) + casm(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%asmpsw(:,:,:,iwav)) do icol = 1,ncol if (self%logradsurf(icol,ilev) <= xrmax) then pext(icol) = 0.5_r8*cext(1,icol) - do icoef = 2, ncoef + do icoef = 2, self%ncoef pext(icol) = pext(icol) + self%cheb(icoef,icol,ilev)*cext(icoef,icol) enddo pext(icol) = exp(pext(icol)) @@ -248,7 +249,7 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) pext(icol) = pext(icol)*self%wetvol(icol,ilev)*rhoh2o pabs(icol) = 0.5_r8*cabs(1,icol) pasm(icol) = 0.5_r8*casm(1,icol) - do icoef = 2, ncoef + do icoef = 2, self%ncoef pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icoef,icol) pasm(icol) = pasm(icol) + self%cheb(icoef,icol,ilev)*casm(icoef,icol) enddo @@ -275,7 +276,7 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) real(r8) :: refr(ncol) ! real part of refractive index real(r8) :: refi(ncol) ! imaginary part of refractive index - real(r8) :: cabs(ncoef,ncol) + real(r8) :: cabs(self%ncoef,ncol) complex(r8) :: crefin(ncol) ! complex refractive index integer :: icol, icoef @@ -303,14 +304,14 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) ! interpolate coefficients linear in refractive index - call table_interp_updwghts( prefr, self%refrtablw(:,iwav), ncol, refr(:ncol), wghtsr ) - call table_interp_updwghts( prefi, self%refitablw(:,iwav), ncol, refi(:ncol), wghtsi ) + wghtsr = table_interp_calcwghts( self%prefr, self%refrtablw(:,iwav), ncol, refr(:ncol) ) + wghtsi = table_interp_calcwghts( self%prefi, self%refitablw(:,iwav), ncol, refi(:ncol) ) - cabs(:,:ncol)= table_interp( ncoef,ncol, prefr,prefi, wghtsr,wghtsi, self%absplw(:,:,:,iwav)) + cabs(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%absplw(:,:,:,iwav)) do icol = 1,ncol pabs(icol) = 0.5_r8*cabs(1,icol) - do icoef = 2, ncoef + do icoef = 2, self%ncoef pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icoef,icol) end do pabs(icol) = pabs(icol)*self%wetvol(icol,ilev)*rhoh2o @@ -353,9 +354,9 @@ end subroutine destructor !=============================================================================== - subroutine modal_size_parameters(ncol,nlev, alnsg_amode, dgnumwet, radsurf, logradsurf, cheb) + subroutine modal_size_parameters(ncoef,ncol,nlev, alnsg_amode, dgnumwet, radsurf, logradsurf, cheb) - integer, intent(in) :: ncol,nlev + integer, intent(in) :: ncoef,ncol,nlev real(r8), intent(in) :: alnsg_amode ! geometric standard deviation of number distribution real(r8), intent(in) :: dgnumwet(:,:) ! aerosol wet number mode diameter (m) real(r8), intent(out) :: radsurf(:,:) ! aerosol surface mode radius diff --git a/src/utils/table_interp_mod.F90 b/src/utils/table_interp_mod.F90 index ac2adc5b16..d5748ab88d 100644 --- a/src/utils/table_interp_mod.F90 +++ b/src/utils/table_interp_mod.F90 @@ -1,18 +1,24 @@ +!---------------------------------------------------------------------------- +! Utility module used for interpolation of aerosol optics table +!---------------------------------------------------------------------------- module table_interp_mod use shr_kind_mod, only: r8=>shr_kind_r8 - use cam_abortutils, only: endrun implicit none private public :: table_interp public :: table_interp_wghts - public :: table_interp_updwghts + public :: table_interp_calcwghts + ! overload the interpolation routines interface table_interp + module procedure interp1d module procedure interp2d + module procedure interp4d end interface table_interp + ! interpolation weights and indices type :: table_interp_wghts real(r8) :: wt1 real(r8) :: wt2 @@ -23,14 +29,40 @@ module table_interp_mod contains !-------------------------------------------------------------------------- + ! 1-D interpolation !-------------------------------------------------------------------------- + pure function interp1d( ncol, nxs, xwghts, tbl ) result(res) - pure function interp2d( ncoef,ncol,nxs,nys, xwghts,ywghts, tbl ) result(res) + integer, intent(in) :: ncol ! number of model columns + integer, intent(in) :: nxs ! table size + real(r8), intent(in) :: tbl(nxs) ! table values to be interpolated + type(table_interp_wghts), intent(in) :: xwghts(ncol) ! interpolation weights and indices - integer, intent(in) :: ncoef,ncol,nxs,nys - real(r8), intent(in) :: tbl(ncoef,nxs,nys) - type(table_interp_wghts), intent(in) :: xwghts(ncol) - type(table_interp_wghts), intent(in) :: ywghts(ncol) + real(r8) :: res(ncol) + + integer :: i + + do i = 1,ncol + + res(i) = xwghts(i)%wt1*tbl(xwghts(i)%ix1) & + + xwghts(i)%wt2*tbl(xwghts(i)%ix2) + + end do + + end function interp1d + + !-------------------------------------------------------------------------- + ! 2-D interpolation + !-------------------------------------------------------------------------- + pure function interp2d( ncoef, ncol, nxs, nys, xwghts, ywghts, tbl ) result(res) + + integer, intent(in) :: ncoef ! number chebyshev coefficients + integer, intent(in) :: ncol ! number of model columns + integer, intent(in) :: nxs ! table x-dimension size + integer, intent(in) :: nys ! table y-dimension size + real(r8), intent(in) :: tbl(ncoef,nxs,nys) ! table values to be interpolated + type(table_interp_wghts), intent(in) :: xwghts(ncol) ! x interpolation weights and indices + type(table_interp_wghts), intent(in) :: ywghts(ncol) ! y interpolation weights and indices real(r8) :: res(ncoef,ncol) @@ -40,27 +72,93 @@ pure function interp2d( ncoef,ncol,nxs,nys, xwghts,ywghts, tbl ) result(res) do i = 1,ncol - fx(:,1) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix1) & + ! interp x dir + fx(:,1) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix1) & ! @ y1 + xwghts(i)%wt2*tbl(:,xwghts(i)%ix2,ywghts(i)%ix1) - fx(:,2) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix2) & + fx(:,2) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix2) & ! @ y2 + xwghts(i)%wt2*tbl(:,xwghts(i)%ix2,ywghts(i)%ix2) + ! interp y dir res(:,i) = ywghts(i)%wt1*fx(:,1) + ywghts(i)%wt2*fx(:,2) end do - end function interp2d + !-------------------------------------------------------------------------- + ! 4-D interpolation + !-------------------------------------------------------------------------- + pure function interp4d( ncol, nxs, nys, nzs, nts, xwghts, ywghts, zwghts, twghts, tbl ) result(res) + + integer, intent(in) :: ncol ! number of model columns + integer, intent(in) :: nxs ! table x-dimension size + integer, intent(in) :: nys ! table y-dimension size + integer, intent(in) :: nzs ! table z-dimension size + integer, intent(in) :: nts ! table t-dimension size + real(r8), intent(in) :: tbl(nxs,nys,nzs,nts) ! table values to be interpolated + type(table_interp_wghts), intent(in) :: xwghts(ncol) ! x interpolation weights and indices + type(table_interp_wghts), intent(in) :: ywghts(ncol) ! y interpolation weights and indices + type(table_interp_wghts), intent(in) :: zwghts(ncol) ! z interpolation weights and indices + type(table_interp_wghts), intent(in) :: twghts(ncol) ! t interpolation weights and indices + + real(r8) :: res(ncol) + + real(r8) :: fx(8) + real(r8) :: fy(4) + real(r8) :: fz(2) + + integer :: i + + do i = 1,ncol + + ! interp x dir + fx(1) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix1) & ! @ y1, z1, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix1) + fx(2) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix1) & ! @ y2, z1, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix1) + + fx(3) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix1) & ! @ y1, z2, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix1) + fx(4) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix1) & ! @ y2, z2, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix1) + + fx(5) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix2) & ! @ y1, z1, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix2) + fx(6) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix2) & ! @ y2, z1, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix2) + + fx(7) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix2) & ! @ y1, z2, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix2) + fx(8) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix2) & ! @ y2, z2, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix2) + + ! interp y dir + fy(1) = ywghts(i)%wt1*fx(1) + ywghts(i)%wt2*fx(2) ! @ z1, t1 + fy(2) = ywghts(i)%wt1*fx(3) + ywghts(i)%wt2*fx(4) ! @ z2, t1 + fy(3) = ywghts(i)%wt1*fx(5) + ywghts(i)%wt2*fx(6) ! @ z1, t2 + fy(4) = ywghts(i)%wt1*fx(7) + ywghts(i)%wt2*fx(8) ! @ z2, t2 + + ! interp z dir + fz(1) = zwghts(i)%wt1*fy(1) + zwghts(i)%wt2*fy(2) ! @ t1 + fz(2) = zwghts(i)%wt1*fy(3) + zwghts(i)%wt2*fy(4) ! @ t2 + + ! interp t dir + res(i) = twghts(i)%wt1*fz(1) + twghts(i)%wt2*fz(2) + + end do + + end function interp4d + !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- + pure function table_interp_calcwghts( ngrid, xgrid, ncols, xcols) result(wghts ) + + integer, intent(in) :: ngrid ! number of grid point values + real(r8), intent(in) :: xgrid(ngrid) ! grid point values + integer, intent(in) :: ncols ! number of model columns + real(r8), intent(in) :: xcols(ncols) ! values at the model columns - subroutine table_interp_updwghts( ngrid, xgrid, ncols, xcols, wghts ) - integer, intent(in) :: ngrid - real(r8), intent(in) :: xgrid(ngrid) - integer, intent(in) :: ncols - real(r8), intent(in) :: xcols(ncols) - type(table_interp_wghts), intent(inout) :: wghts(ncols) + type(table_interp_wghts) :: wghts(ncols) ! interpolations weights at the model columns integer :: i @@ -68,11 +166,11 @@ subroutine table_interp_updwghts( ngrid, xgrid, ncols, xcols, wghts ) wghts(i)%ix2 = find_index(ngrid,xgrid,xcols(i)) wghts(i)%ix1 = wghts(i)%ix2 - 1 wghts(i)%wt1 = (xgrid(wghts(i)%ix2)-xcols(i)) & - /(xgrid(wghts(i)%ix2)-xgrid(wghts(i)%ix1)) + /(xgrid(wghts(i)%ix2)-xgrid(wghts(i)%ix1)) wghts(i)%wt2 = 1._8 - wghts(i)%wt1 end do - end subroutine table_interp_updwghts + end function table_interp_calcwghts ! private methods !-------------------------------------------------------------------------- From 4754394b18fdc2619f8498ca00260cc8e4240c9c Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 28 Jul 2023 11:38:55 -0600 Subject: [PATCH 15/27] some of Jesse's change requests modified: src/chemistry/aerosol/aerosol_properties_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_properties_mod.F90 modified: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 --- .../aerosol/aerosol_properties_mod.F90 | 16 +-- .../aerosol/modal_aerosol_properties_mod.F90 | 119 +++++++++++------- .../aerosol/refractive_aerosol_optics_mod.F90 | 10 +- 3 files changed, 86 insertions(+), 59 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index 7cddece92b..865ee0b799 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -129,14 +129,14 @@ subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, absps character(len=*), optional, intent(out) :: opticstype ! refactive index table parameters - real(r8), optional, pointer :: extpsw(:,:,:,:) ! specific extinction - real(r8), optional, pointer :: abspsw(:,:,:,:) ! specific absorption - real(r8), optional, pointer :: asmpsw(:,:,:,:) ! asymmetry factor - real(r8), optional, pointer :: absplw(:,:,:,:) ! specific absorption - real(r8), optional, pointer :: refrtabsw(:,:) ! table of real refractive indices for aerosols - real(r8), optional, pointer :: refitabsw(:,:) ! table of imaginary refractive indices for aerosols - real(r8), optional, pointer :: refrtablw(:,:) ! table of real refractive indices for aerosols - real(r8), optional, pointer :: refitablw(:,:) ! table of imaginary refractive indices for aerosols + 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 diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index e882a28601..66cee40480 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -208,21 +208,10 @@ subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & ilist = 0 end if - if (present(density)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, density_aer=density) - end if - if (present(hygro)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, hygro_aer=hygro) - end if - if (present(spectype)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, spectype=spectype ) - end if - if (present(refindex_sw)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, refindex_aer_sw=refindex_sw ) - end if - if (present(refindex_lw)) then - call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, refindex_aer_lw=refindex_lw ) - end if + call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, & + density_aer=density, hygro_aer=hygro, spectype=spectype, & + refindex_aer_sw=refindex_sw, refindex_aer_lw=refindex_lw) + if (present(specmorph)) then specmorph = 'UNKNOWN' end if @@ -245,14 +234,14 @@ subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, as character(len=*), optional, intent(out) :: opticstype ! refactive index table parameters - real(r8), optional, pointer :: extpsw(:,:,:,:) ! specific extinction - real(r8), optional, pointer :: abspsw(:,:,:,:) ! specific absorption - real(r8), optional, pointer :: asmpsw(:,:,:,:) ! asymmetry factor - real(r8), optional, pointer :: absplw(:,:,:,:) ! specific absorption - real(r8), optional, pointer :: refrtabsw(:,:) ! table of real refractive indices for aerosols - real(r8), optional, pointer :: refitabsw(:,:) ! table of imaginary refractive indices for aerosols - real(r8), optional, pointer :: refrtablw(:,:) ! table of real refractive indices for aerosols - real(r8), optional, pointer :: refitablw(:,:) ! table of imaginary refractive indices for aerosols + 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 @@ -279,41 +268,77 @@ 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 - if (present(opticstype)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, opticstype=opticstype) + ! refactive index table parameters + call rad_cnst_get_mode_props(list_ndx, bin_ndx, & + opticstype=opticstype, & + extpsw=extpsw, & + abspsw=abspsw, & + asmpsw=asmpsw, & + absplw=absplw, & + refrtabsw=refrtabsw, & + refitabsw=refitabsw, & + refrtablw=refrtablw, & + refitablw=refitablw, & + ncoef=ncoef, & + prefr=prefr, & + prefi=prefi) + + ! hygrowghtpct table parameters + if (present(sw_hygro_ext_wtp)) then + nullify(sw_hygro_ext_wtp) + end if + if (present(sw_hygro_ssa_wtp)) then + nullify(sw_hygro_ssa_wtp) + end if + if (present(sw_hygro_asm_wtp)) then + nullify(sw_hygro_asm_wtp) + end if + if (present(lw_hygro_ext_wtp)) then + nullify(lw_hygro_ext_wtp) + end if + if (present(wgtpct)) then + nullify(wgtpct) + end if + if (present(nwtp)) then + nwtp = -1 + end if + + ! hygrocoreshell table parameters + if (present(sw_hygro_coreshell_ext)) then + nullify(sw_hygro_coreshell_ext) end if - if (present(extpsw)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, extpsw=extpsw) + if (present(sw_hygro_coreshell_ssa)) then + nullify(sw_hygro_coreshell_ssa) end if - if (present(abspsw)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, abspsw=abspsw) + if (present(sw_hygro_coreshell_asm)) then + nullify(sw_hygro_coreshell_asm) end if - if (present(asmpsw)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, asmpsw=asmpsw) + if (present(lw_hygro_coreshell_ext)) then + nullify(lw_hygro_coreshell_ext) end if - if (present(absplw)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, absplw=absplw) + if (present(corefrac)) then + nullify(corefrac) end if - if (present(refrtabsw)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, refrtabsw=refrtabsw) + if (present(bcdust)) then + nullify(bcdust) end if - if (present(refitabsw)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, refitabsw=refitabsw) + if (present(kap)) then + nullify(kap) end if - if (present(refrtablw)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, refrtablw=refrtablw) + if (present(relh)) then + nullify(relh) end if - if (present(refitablw)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, refitablw=refitablw) + if (present(nfrac)) then + nfrac = -1 end if - if (present(ncoef)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, ncoef=ncoef) + if (present(nbcdust)) then + nbcdust = -1 end if - if (present(prefr)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, prefr=prefr) + if (present(nkap)) then + nkap = -1 end if - if (present(prefi)) then - call rad_cnst_get_mode_props(list_ndx,bin_ndx, prefi=prefi) + if (present(nrelh)) then + nrelh = -1 end if end subroutine optics_params diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index 730c0ed81c..17f6e93e2d 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -23,7 +23,7 @@ module refractive_aerosol_optics_mod real(r8), allocatable :: watervol(:,:) ! volume concentration of water in each mode (m3/kg) real(r8), allocatable :: wetvol(:,:) ! volume concentration of wet mode (m3/kg) - real(r8), allocatable :: cheb(:,:,:) ! chebychef polynomials + real(r8), allocatable :: cheb(:,:,:) ! chebychev polynomials real(r8), allocatable :: radsurf(:,:) ! aerosol surface mode radius real(r8), allocatable :: logradsurf(:,:) ! log(aerosol surface mode radius) @@ -43,7 +43,7 @@ module refractive_aerosol_optics_mod ! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties ! in terms of refractive index and wet radius - integer :: ncoef = -1 ! number of chebychef coeficients + integer :: ncoef = -1 ! number of chebychev coeficients integer :: prefr = -1 ! number of real refractive indices integer :: prefi = -1 ! number of imaginary refractive indices @@ -85,7 +85,7 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, type(refractive_aerosol_optics), pointer :: newobj integer :: ierr, icol, ilev, ispec, nspec - real(r8) :: vol(ncol) ! volume concentration of aerosol specie (m3/kg) + real(r8) :: vol(ncol) ! volume concentration of aerosol species (m3/kg) real(r8) :: dryvol(ncol) ! volume concentration of aerosol mode (m3/kg) real(r8) :: specdens ! species density (kg/m3) real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio @@ -94,6 +94,8 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, real(r8) :: dgnumwet(ncol,nlev) ! aerosol wet number mode diameter (m) real(r8) :: qaerwat(ncol,nlev) ! aerosol water (g/g) + real(r8), parameter :: rh2odens = 1._r8/rhoh2o + allocate(newobj, stat=ierr) if (ierr/=0) then nullify(newobj) @@ -167,7 +169,7 @@ function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, vol(icol) = specmmr(icol,ilev)/specdens dryvol(icol) = dryvol(icol) + vol(icol) - newobj%watervol(icol,ilev) = qaerwat(icol,ilev)/rhoh2o + newobj%watervol(icol,ilev) = qaerwat(icol,ilev)*rh2odens newobj%wetvol(icol,ilev) = newobj%watervol(icol,ilev) + dryvol(icol) if (newobj%watervol(icol,ilev) < 0._r8) then newobj%watervol(icol,ilev) = 0._r8 From 54ebce566c0bb7b8f6a24e9c285fdd67c93db378 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 31 Jul 2023 11:29:20 -0600 Subject: [PATCH 16/27] r8 correction modified: src/utils/table_interp_mod.F90 --- src/utils/table_interp_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utils/table_interp_mod.F90 b/src/utils/table_interp_mod.F90 index d5748ab88d..3571013455 100644 --- a/src/utils/table_interp_mod.F90 +++ b/src/utils/table_interp_mod.F90 @@ -167,7 +167,7 @@ pure function table_interp_calcwghts( ngrid, xgrid, ncols, xcols) result(wghts ) wghts(i)%ix1 = wghts(i)%ix2 - 1 wghts(i)%wt1 = (xgrid(wghts(i)%ix2)-xcols(i)) & /(xgrid(wghts(i)%ix2)-xgrid(wghts(i)%ix1)) - wghts(i)%wt2 = 1._8 - wghts(i)%wt1 + wghts(i)%wt2 = 1._r8 - wghts(i)%wt1 end do end function table_interp_calcwghts From cd63ce68752e667dfbc41e2f487414f81ccf7b4b Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 2 Aug 2023 10:09:51 -0600 Subject: [PATCH 17/27] do not extrapolate beyond the edges of the table modified: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 modified: src/utils/table_interp_mod.F90 --- .../aerosol/refractive_aerosol_optics_mod.F90 | 12 ------------ src/utils/table_interp_mod.F90 | 19 ++++++++++++++++--- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index 17f6e93e2d..d4827d3db7 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -215,15 +215,8 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) do icol = 1, ncol crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwsw(iwav) crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev),1.e-60_r8) - refr(icol) = real(crefin(icol)) - refr(icol) = max(refr(icol),minval(self%refrtabsw(:,iwav))) - refr(icol) = min(refr(icol),maxval(self%refrtabsw(:,iwav))) - refi(icol) = abs(aimag(crefin(icol))) - refi(icol) = max(refi(icol),minval(self%refitabsw(:,iwav))) - refi(icol) = min(refi(icol),maxval(self%refitabsw(:,iwav))) - end do ! interpolate coefficients linear in refractive index @@ -295,12 +288,7 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) end if refr(icol) = real(crefin(icol)) - refr(icol) = max(refr(icol),minval(self%refrtablw(:,iwav))) - refr(icol) = min(refr(icol),maxval(self%refrtablw(:,iwav))) - refi(icol) = aimag(crefin(icol)) - refi(icol) = max(refi(icol),minval(self%refitablw(:,iwav))) - refi(icol) = min(refi(icol),maxval(self%refitablw(:,iwav))) end do diff --git a/src/utils/table_interp_mod.F90 b/src/utils/table_interp_mod.F90 index 3571013455..776ef2c15c 100644 --- a/src/utils/table_interp_mod.F90 +++ b/src/utils/table_interp_mod.F90 @@ -1,5 +1,7 @@ !---------------------------------------------------------------------------- ! Utility module used for interpolation of aerosol optics table +! NOTE: Results will be set to table edges for interpolations beyond +! the edges -- no extropolations !---------------------------------------------------------------------------- module table_interp_mod use shr_kind_mod, only: r8=>shr_kind_r8 @@ -161,11 +163,22 @@ pure function table_interp_calcwghts( ngrid, xgrid, ncols, xcols) result(wghts ) type(table_interp_wghts) :: wghts(ncols) ! interpolations weights at the model columns integer :: i + real(r8) :: xs(ncols) + + xs(:) = xcols(:) + + ! do not extrapolate beyond the edges of the table + where(xs < xgrid(1)) + xs = xgrid(1) + end where + where(xs > xgrid(ngrid)) + xs = xgrid(ngrid) + end where do i = 1,ncols - wghts(i)%ix2 = find_index(ngrid,xgrid,xcols(i)) + wghts(i)%ix2 = find_index(ngrid,xgrid,xs(i)) wghts(i)%ix1 = wghts(i)%ix2 - 1 - wghts(i)%wt1 = (xgrid(wghts(i)%ix2)-xcols(i)) & + wghts(i)%wt1 = (xgrid(wghts(i)%ix2)-xs(i)) & /(xgrid(wghts(i)%ix2)-xgrid(wghts(i)%ix1)) wghts(i)%wt2 = 1._r8 - wghts(i)%wt1 end do @@ -183,7 +196,7 @@ pure function find_index( nvals, vals, vx ) result(ndx) integer :: ndx - find_ndx: do ndx = 1, nvals-1 + find_ndx: do ndx = 2, nvals-1 if (vals(ndx)>vx) exit find_ndx end do find_ndx From 741d5360eba956f048823fefaddec654646c58e4 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 3 Aug 2023 10:18:56 -0600 Subject: [PATCH 18/27] improve docs and index finder modified: src/utils/table_interp_mod.F90 --- src/utils/table_interp_mod.F90 | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/src/utils/table_interp_mod.F90 b/src/utils/table_interp_mod.F90 index 776ef2c15c..9daac52b51 100644 --- a/src/utils/table_interp_mod.F90 +++ b/src/utils/table_interp_mod.F90 @@ -152,8 +152,9 @@ pure function interp4d( ncol, nxs, nys, nzs, nts, xwghts, ywghts, zwghts, twghts end function interp4d !-------------------------------------------------------------------------- + ! determines interpolation weights and indices for given values at the model columns !-------------------------------------------------------------------------- - pure function table_interp_calcwghts( ngrid, xgrid, ncols, xcols) result(wghts ) + pure function table_interp_calcwghts( ngrid, xgrid, ncols, xcols ) result(wghts) integer, intent(in) :: ngrid ! number of grid point values real(r8), intent(in) :: xgrid(ngrid) ! grid point values @@ -188,16 +189,24 @@ end function table_interp_calcwghts ! private methods !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- - - pure function find_index( nvals, vals, vx ) result(ndx) + ! determines last index of grid vals of which is greater then or equal to + ! value vx + !-------------------------------------------------------------------------- + pure function find_index( nvals, vals, vx ) result(res) integer, intent(in) :: nvals real(r8), intent(in) :: vals(nvals) real(r8), intent(in) :: vx + integer :: res integer :: ndx - find_ndx: do ndx = 2, nvals-1 - if (vals(ndx)>vx) exit find_ndx + res = -1 + + find_ndx: do ndx = 2, nvals + if (vals(ndx)>=vx) then + res = ndx + exit find_ndx + end if end do find_ndx end function find_index From 7d054bf616db2ba78c8c16688aa4809b3048e595 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 3 Aug 2023 15:36:38 -0600 Subject: [PATCH 19/27] rh2odens parameter modified: src/chemistry/aerosol/modal_aerosol_state_mod.F90 --- src/chemistry/aerosol/modal_aerosol_state_mod.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 index 0646bfda90..c58cac0c8a 100644 --- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -49,6 +49,8 @@ module modal_aerosol_state_mod procedure :: constructor end interface modal_aerosol_state + real(r8), parameter :: rh2odens = 1._r8/rhoh2o + contains !------------------------------------------------------------------------------ @@ -586,7 +588,10 @@ function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vo call self%water_uptake(aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) - vol(:ncol,:nlev) = qaerwat(:ncol,:nlev)/rhoh2o + vol(:ncol,:nlev) = qaerwat(:ncol,:nlev)*rh2odens + where (vol<0._r8) + vol = 0._r8 + end where end function water_volume From acf694ea78d956edc5497cdf2cecb8cb85119a48 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 11 Aug 2023 11:29:18 -0600 Subject: [PATCH 20/27] minor corrections modified: src/physics/cam/aerosol_optics_cam.F90 --- src/physics/cam/aerosol_optics_cam.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 60c95243b4..5e0aa88f84 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -207,7 +207,7 @@ subroutine aerosol_optics_cam_init call addfld ('EXTxASYM'//diag(ilist), (/ 'lev' /), 'A',' ', & 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) call addfld ('AODTOT'//diag(ilist), horiz_only, 'A','1',& - 'Aerosol optical depth summed over all sw wavelenghts', flag_xyfill=.true.) + 'Aerosol optical depth summed over all sw wavelengths', flag_xyfill=.true.) call addfld ('EXTINCTdn'//diag(ilist), (/ 'lev' /), 'A','/m',& 'Aerosol extinction 550 nm, day only') @@ -236,7 +236,7 @@ subroutine aerosol_optics_cam_init call addfld ('EXTxASYMdn'//diag(ilist), (/ 'lev' /), 'A',' ', & 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) call addfld ('AODTOTdn'//diag(ilist), horiz_only, 'A','1',& - 'Aerosol optical depth summed over all sw wavelenghts') + 'Aerosol optical depth summed over all sw wavelengths, day only') if (lw10um_indx>0) then call addfld('AODABSLW'//diag(ilist), (/ 'lev' /), 'A','/m',& From 8b4138f0ed4665460cb191546cd5e7a4100529a2 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 24 Aug 2023 15:43:37 -0600 Subject: [PATCH 21/27] Some of Matt's change requests modified: src/chemistry/aerosol/aerosol_state_mod.F90 modified: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- src/chemistry/aerosol/aerosol_state_mod.F90 | 8 ++++---- .../aerosol/refractive_aerosol_optics_mod.F90 | 4 +--- src/physics/cam/aerosol_optics_cam.F90 | 14 ++++++++------ 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index 0e036b84e9..04dc30e893 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -92,7 +92,7 @@ subroutine aero_get_state_mmr(self, species_ndx, bin_ndx, mmr) class(aerosol_state), intent(in) :: self integer, intent(in) :: species_ndx ! species index integer, intent(in) :: bin_ndx ! bin index - real(r8), pointer :: mmr(:,:) ! mass mixing ratios + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) end subroutine aero_get_state_mmr !------------------------------------------------------------------------ @@ -105,7 +105,7 @@ subroutine aero_get_list_mmr(self, list_ndx, species_ndx, bin_ndx, mmr) integer, intent(in) :: list_ndx ! rad climate/diagnostic list index integer, intent(in) :: species_ndx ! species index integer, intent(in) :: bin_ndx ! bin index - real(r8), pointer :: mmr(:,:) ! mass mixing ratios + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) end subroutine aero_get_list_mmr !------------------------------------------------------------------------ @@ -115,7 +115,7 @@ subroutine aero_get_state_num(self, bin_ndx, num) import :: aerosol_state, r8 class(aerosol_state), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index - real(r8), pointer :: num(:,:) ! number densities + real(r8), pointer :: num(:,:) ! number densities (ncol,nlev) end subroutine aero_get_state_num !------------------------------------------------------------------------ @@ -225,7 +225,7 @@ function aero_hygroscopicity(self, list_ndx, bin_ndx) result(kappa) integer, intent(in) :: list_ndx ! rad climate/diagnostic list index integer, intent(in) :: bin_ndx ! bin number - real(r8), pointer :: kappa(:,:) + real(r8), pointer :: kappa(:,:) ! hygroscopicity (ncol,nlev) end function aero_hygroscopicity diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index d4827d3db7..a7e3c3a183 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -283,9 +283,7 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) do icol = 1, ncol crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwlw(iwav) - if (self%wetvol(icol,ilev) > 1.e-40_r8) then - crefin(icol) = crefin(icol)/self%wetvol(icol,ilev) - end if + crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev), 1.e-40) refr(icol) = real(crefin(icol)) refi(icol) = aimag(crefin(icol)) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 5e0aa88f84..630dae42a5 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -318,7 +318,7 @@ subroutine aerosol_optics_cam_init 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.) - if (m>3 .and. history_aero_optics) then + if (history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -334,7 +334,7 @@ subroutine aerosol_optics_cam_init 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.) - if (m>3 .and. history_aero_optics) then + if (history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -342,7 +342,7 @@ subroutine aerosol_optics_cam_init 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.) - if (m>3 .and. history_aero_optics) then + if (history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -358,7 +358,7 @@ subroutine aerosol_optics_cam_init 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.) - if (m>3 .and. history_aero_optics) then + if (history_aero_optics) then call add_default (fldname, 1, ' ') end if @@ -505,8 +505,10 @@ subroutine aerosol_optics_cam_final integer :: iaermod do iaermod = 1,num_aero_models - deallocate(aero_props(iaermod)%obj) - nullify(aero_props(iaermod)%obj) + if (associated(aero_props(iaermod)%obj)) then + deallocate(aero_props(iaermod)%obj) + nullify(aero_props(iaermod)%obj) + end if end do if (allocated(aero_props)) then From 15e832ce38de64b525aa9ee04eab8a38d6fcf8e5 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 28 Aug 2023 08:07:07 -0600 Subject: [PATCH 22/27] more code reviewers requests modified: src/chemistry/aerosol/aerosol_properties_mod.F90 modified: src/chemistry/aerosol/aerosol_state_mod.F90 modified: src/chemistry/aerosol/modal_aerosol_state_mod.F90 modified: src/physics/cam/aerosol_optics_cam.F90 --- .../aerosol/aerosol_properties_mod.F90 | 10 ++++----- src/chemistry/aerosol/aerosol_state_mod.F90 | 6 ++--- .../aerosol/modal_aerosol_state_mod.F90 | 22 +++++++++---------- src/physics/cam/aerosol_optics_cam.F90 | 13 +++++------ 4 files changed, 25 insertions(+), 26 deletions(-) diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index 865ee0b799..aadd56f87d 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -49,9 +49,9 @@ module aerosol_properties_mod procedure :: indexer procedure :: maxsat procedure(aero_amcube), deferred :: amcube - procedure :: alogsig0 + procedure :: alogsig_0list procedure(aero_alogsig_rlist), deferred :: alogsig_rlist - generic :: alogsig => alogsig0,alogsig_rlist + generic :: alogsig => alogsig_0list,alogsig_rlist procedure(aero_number_transported), deferred :: number_transported procedure(aero_props_get), deferred :: get procedure(aero_actfracs), deferred :: actfracs @@ -565,12 +565,12 @@ end function ncnst_tot !------------------------------------------------------------------------------ ! returns the natural log of geometric standard deviation of the number distribution for aerosol bin !------------------------------------------------------------------------------ - pure real(r8) function alogsig0(self, bin_ndx) + pure real(r8) function alogsig_0list(self, bin_ndx) class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin number - alogsig0 = self%alogsig_(bin_ndx) - end function alogsig0 + alogsig_0list = self%alogsig_(bin_ndx) + end function alogsig_0list !------------------------------------------------------------------------------ ! returns maximum supersaturation diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index 04dc30e893..b0e8d24a1e 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -28,9 +28,9 @@ module aerosol_state_mod procedure(aero_get_transported), deferred :: get_transported procedure(aero_set_transported), deferred :: set_transported procedure(aero_get_amb_total_bin_mmr), deferred :: ambient_total_bin_mmr - procedure(aero_get_state_mmr), deferred :: get_ambient_mmr0 - procedure(aero_get_list_mmr), deferred :: get_ambient_mmrl - generic :: get_ambient_mmr=>get_ambient_mmr0,get_ambient_mmrl + procedure(aero_get_state_mmr), deferred :: get_ambient_mmr_0list + procedure(aero_get_list_mmr), deferred :: get_ambient_mmr_rlist + generic :: get_ambient_mmr=>get_ambient_mmr_0list,get_ambient_mmr_rlist procedure(aero_get_state_mmr), deferred :: get_cldbrne_mmr procedure(aero_get_state_num), deferred :: get_ambient_num procedure(aero_get_state_num), deferred :: get_cldbrne_num diff --git a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 index c58cac0c8a..398b272a27 100644 --- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -24,8 +24,8 @@ module modal_aerosol_state_mod procedure :: get_transported procedure :: set_transported procedure :: ambient_total_bin_mmr - procedure :: get_ambient_mmr0 - procedure :: get_ambient_mmrl + procedure :: get_ambient_mmr_0list + procedure :: get_ambient_mmr_rlist procedure :: get_cldbrne_mmr procedure :: get_ambient_num procedure :: get_cldbrne_num @@ -132,28 +132,28 @@ end function ambient_total_bin_mmr !------------------------------------------------------------------------------ ! returns ambient aerosol mass mixing ratio for a given species index and bin index !------------------------------------------------------------------------------ - subroutine get_ambient_mmr0(self, species_ndx, bin_ndx, mmr) + subroutine get_ambient_mmr_0list(self, species_ndx, bin_ndx, mmr) class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: species_ndx ! species index integer, intent(in) :: bin_ndx ! bin index - real(r8), pointer :: mmr(:,:) ! mass mixing ratios + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) - end subroutine get_ambient_mmr0 + 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_mmrl(self, list_ndx, species_ndx, bin_ndx, mmr) + subroutine get_ambient_mmr_rlist(self, list_ndx, species_ndx, bin_ndx, mmr) class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: list_ndx ! rad climate list index integer, intent(in) :: species_ndx ! species index integer, intent(in) :: bin_ndx ! bin index - real(r8), pointer :: mmr(:,:) ! mass mixing ratios + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) call rad_cnst_get_aer_mmr(list_ndx, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) - end subroutine get_ambient_mmrl + end subroutine get_ambient_mmr_rlist !------------------------------------------------------------------------------ ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index @@ -428,10 +428,10 @@ end function hetfrz_size_wght !------------------------------------------------------------------------------ function hygroscopicity(self, list_ndx, bin_ndx) result(kappa) class(modal_aerosol_state), intent(in) :: self - integer, intent(in) :: list_ndx ! rad climate list number - integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: list_ndx ! rad climate list number + integer, intent(in) :: bin_ndx ! bin number - real(r8), pointer :: kappa(:,:) + real(r8), pointer :: kappa(:,:) ! hygroscopicity (ncol,nlev) nullify(kappa) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 630dae42a5..31118ea10b 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -9,7 +9,7 @@ module aerosol_optics_cam use ppgrid, only: pcols, pver use physconst, only: rga, rair use cam_abortutils, only: endrun - use spmd_utils, only : masterproc + use spmd_utils, only: masterproc use rad_constituents, only: n_diag, rad_cnst_get_call_list use cam_history, only: addfld, add_default, outfld, horiz_only, fieldname_len use cam_history_support, only: fillvalue @@ -79,6 +79,7 @@ subroutine aerosol_optics_cam_readnl(nlfile) character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input integer :: unitn, ierr + character(len=cl) :: errmsg character(len=*), parameter :: subname = 'aerosol_optics_cam_readnl' ! =================== @@ -95,7 +96,8 @@ subroutine aerosol_optics_cam_readnl(nlfile) if (ierr == 0) then read(unitn, aerosol_optics_nl, iostat=ierr) if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') + write(errmsg,'(2a,i10)') subname,':: ERROR reading namelist, error code: ',ierr + call endrun(errmsg) end if end if close(unitn) @@ -121,7 +123,7 @@ subroutine aerosol_optics_cam_init use phys_control, only: phys_getopts use ioFileMod, only: getfil - character(len=*), parameter :: prefix = 'aerosol_optics_cam_sw: ' + character(len=*), parameter :: prefix = 'aerosol_optics_cam_init: ' integer :: nmodes=0, iaermod, istat, ilist, i logical :: call_list(0:n_diag) @@ -134,7 +136,7 @@ subroutine aerosol_optics_cam_init logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_dust ! output dust diagnostics - character(len=256) :: locfile + character(len=cl) :: locfile call phys_getopts(history_amwg_out = history_amwg, & history_aero_optics_out = history_aero_optics, & @@ -985,9 +987,7 @@ subroutine output_tot_diags call outfld('AODUVdn'//diag(list_idx), aoduv, pcols, lchnk) call outfld('AODVISdn'//diag(list_idx), aodvis, pcols, lchnk) call outfld('AODABSdn'//diag(list_idx), aodabs, pcols, lchnk) - call outfld('AODNIRdn'//diag(list_idx), aodnir, pcols, lchnk) - call outfld('AODABSdn'//diag(list_idx), aodabs, pcols, lchnk) call outfld('AODTOTdn'//diag(list_idx), aodtot, pcols, lchnk) call outfld('EXTINCTUVdn'//diag(list_idx), extinctuv, pcols, lchnk) call outfld('EXTINCTNIRdn'//diag(list_idx), extinctnir, pcols, lchnk) @@ -1022,7 +1022,6 @@ subroutine output_tot_diags call outfld('AODVIS'//diag(list_idx), aodvis, pcols, lchnk) call outfld('AODABS'//diag(list_idx), aodabs, pcols, lchnk) call outfld('AODNIR'//diag(list_idx), aodnir, pcols, lchnk) - call outfld('AODABS'//diag(list_idx), aodabs, pcols, lchnk) call outfld('AODTOT'//diag(list_idx), aodtot, pcols, lchnk) call outfld('EXTINCTUV'//diag(list_idx), extinctuv, pcols, lchnk) call outfld('EXTINCTNIR'//diag(list_idx), extinctnir, pcols, lchnk) From b085542e8a1b129c9cd9fb6e1f6f29f39fdcb202 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 28 Aug 2023 11:04:01 -0600 Subject: [PATCH 23/27] specify cloud-borne mmr dimensions in comment modified: src/chemistry/aerosol/modal_aerosol_state_mod.F90 --- src/chemistry/aerosol/modal_aerosol_state_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 index 398b272a27..8f50e5b7e9 100644 --- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -162,7 +162,7 @@ subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: species_ndx ! species index integer, intent(in) :: bin_ndx ! bin index - real(r8), pointer :: mmr(:,:) ! mass mixing ratios + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'c', self%state, self%pbuf, mmr) end subroutine get_cldbrne_mmr From cbe401a6a8714ca368e83de685476ec11eca9abf Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 29 Aug 2023 08:09:51 -0600 Subject: [PATCH 24/27] impose floor for radsurf modified: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 --- src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index a7e3c3a183..a789db0383 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -61,8 +61,10 @@ module refractive_aerosol_optics_mod end interface refractive_aerosol_optics ! radius limits (m) - real(r8), parameter :: xrmin=log(0.01e-6_r8) ! min log(aerosol surface mode radius) - real(r8), parameter :: xrmax=log(25.e-6_r8) ! max log(aerosol surface mode radius) + real(r8), parameter :: radmin = 0.01e-6_r8 ! min aerosol surface mode radius (m) + real(r8), parameter :: radmax = 25.e-6_r8 ! max aerosol surface mode radius (m) + real(r8), parameter :: xrmin=log(radmin) ! min log(aerosol surface mode radius) + real(r8), parameter :: xrmax=log(radmax) ! max log(aerosol surface mode radius) contains @@ -362,7 +364,7 @@ subroutine modal_size_parameters(ncoef,ncol,nlev, alnsg_amode, dgnumwet, radsurf do k = 1, nlev do i = 1, ncol ! convert from number mode diameter to surface area - radsurf(i,k) = 0.5_r8*dgnumwet(i,k)*explnsigma + radsurf(i,k) = max(0.5_r8*dgnumwet(i,k)*explnsigma,radmin) logradsurf(i,k) = log(radsurf(i,k)) ! normalize size parameter xrad(i) = max(logradsurf(i,k),xrmin) From f3b788e2752c61147d56d35d9d80d007796b62af Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 29 Aug 2023 09:19:11 -0600 Subject: [PATCH 25/27] restore flag_xyfill for some optics diagnostics modified: src/physics/cam/aerosol_optics_cam.F90 --- src/physics/cam/aerosol_optics_cam.F90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 31118ea10b..eb094446c8 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -212,29 +212,29 @@ subroutine aerosol_optics_cam_init 'Aerosol optical depth summed over all sw wavelengths', flag_xyfill=.true.) call addfld ('EXTINCTdn'//diag(ilist), (/ 'lev' /), 'A','/m',& - 'Aerosol extinction 550 nm, day only') + 'Aerosol extinction 550 nm, day only', flag_xyfill=.true.) call addfld ('EXTINCTUVdn'//diag(ilist), (/ 'lev' /), 'A','/m',& - 'Aerosol extinction 350 nm, day only') + 'Aerosol extinction 350 nm, day only', flag_xyfill=.true.) call addfld ('EXTINCTNIRdn'//diag(ilist), (/ 'lev' /), 'A','/m',& - 'Aerosol extinction 1020 nm, day only') + 'Aerosol extinction 1020 nm, day only', flag_xyfill=.true.) call addfld ('ABSORBdn'//diag(ilist), (/ 'lev' /), 'A','/m',& - 'Aerosol absorption, day only') + 'Aerosol absorption, day only', flag_xyfill=.true.) call addfld ('AODVISdn'//diag(ilist), horiz_only, 'A',' ', & - 'Aerosol optical depth 550 nm') + 'Aerosol optical depth 550 nm', flag_xyfill=.true.) call addfld ('AODVISstdn'//diag(ilist), horiz_only, 'A',' ', & - 'Stratospheric aerosol optical depth 550 nm, day only') + 'Stratospheric aerosol optical depth 550 nm, day only', flag_xyfill=.true.) call addfld ('AODNIRstdn'//diag(ilist), horiz_only, 'A',' ', & - 'Stratospheric aerosol optical depth 1020 nm, day only') + 'Stratospheric aerosol optical depth 1020 nm, day only', flag_xyfill=.true.) call addfld ('AODUVstdn'//diag(ilist), horiz_only, 'A',' ', & - 'Stratospheric aerosol optical depth 350 nm, day only') + 'Stratospheric aerosol optical depth 350 nm, day only', flag_xyfill=.true.) call addfld ('AODUVdn'//diag(ilist), horiz_only, 'A',' ', & - 'Aerosol optical depth 350 nm, day only') + 'Aerosol optical depth 350 nm, day only', flag_xyfill=.true.) call addfld ('AODNIRdn'//diag(ilist), horiz_only, 'A',' ', & - 'Aerosol optical depth 1020 nm, day only',flag_xyfill=.true.) + 'Aerosol optical depth 1020 nm, day only', flag_xyfill=.true.) call addfld ('AODABSdn'//diag(ilist), horiz_only, 'A',' ', & - 'Aerosol absorption optical depth 550 nm, day only') + 'Aerosol absorption optical depth 550 nm, day only', flag_xyfill=.true.) call addfld ('AODxASYMdn'//diag(ilist), horiz_only, 'A',' ', & - 'Aerosol optical depth 550 * asymmetry factor, day only') + 'Aerosol optical depth 550 * asymmetry factor, day only', flag_xyfill=.true.) call addfld ('EXTxASYMdn'//diag(ilist), (/ 'lev' /), 'A',' ', & 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) call addfld ('AODTOTdn'//diag(ilist), horiz_only, 'A','1',& From fe7aeaa1cb7d93b5f7cb163fd097e98edbf9fc84 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 29 Aug 2023 12:44:10 -0600 Subject: [PATCH 26/27] update ChangeLog --- doc/ChangeLog | 171 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 171 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 90c1a34aff..1a8c03424a 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,176 @@ =============================================================== +Tag name: cam6_3_125 +Originator(s): fvitt +Date: 29 Aug 2023 +One-line Summary: Generalize aerosol optics +Github PR URL: https://github.com/ESCOMP/CAM/pull/824 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Issue #816 -- Refactor aerosol optics to use abstract aerosol optics class + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all files eliminated: + +D src/physics/cam/modal_aer_opt.F90 + - replaced by generalized aer_rad_props module + +List all files added and what they do: + +A src/chemistry/aerosol/aerosol_optics_mod.F90 + - abstract interface to aerosol optics + +A src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 + - index of refaction based aerosol optics + +A src/physics/cam/aerosol_optics_cam.F90 + - generalized aerosol optics module + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/namelist_definition.xml + - modal_aer_opt_nl group renamed as aerosol_optics_nl + +M src/chemistry/aerosol/aerosol_properties_mod.F90 +M src/chemistry/aerosol/modal_aerosol_properties_mod.F90 + - add methods for optical parameters + +M src/chemistry/aerosol/aerosol_state_mod.F90 +M src/chemistry/aerosol/modal_aerosol_state_mod.F90 + - add methods for optics + +M src/control/runtime_opts.F90 + - modal_aer_opt --> aerosol_optics_cam + +M src/physics/cam/aer_rad_props.F90 + - modal_aer_opt --> aerosol_optics_cam + +M src/physics/cam/rad_constituents.F90 + - add opticstype arg to rad_cnst_get_mode_props + +M src/physics/rrtmg/radiation.F90 + - remove modal_aer_opt_init call + +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. + +cheyenne/intel/aux_cam: + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: NLFAIL) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: NLFAIL) details: + - modal_aer_opt_nl namelist group renamed as aerosol_optics_nl + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - modal_aer_opt_nl namelist group renamed as aerosol_optics_nl + +izumi/gnu/aux_cam: + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + - modal_aer_opt_nl namelist group renamed as aerosol_optics_nl + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + Tag name: cam6_3_124 Originator(s): fvitt Date: 23 Aug 2023 From aeece27795d2ae71a48f84cd2b07cf1643e4ee7d Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 29 Aug 2023 13:35:12 -0600 Subject: [PATCH 27/27] ChangeLog update --- doc/ChangeLog | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 1a8c03424a..bfc4e3f9ef 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -3,22 +3,25 @@ Tag name: cam6_3_125 Originator(s): fvitt Date: 29 Aug 2023 -One-line Summary: Generalize aerosol optics +One-line Summary: Introduce abstract interface to aerosol optics Github PR URL: https://github.com/ESCOMP/CAM/pull/824 Purpose of changes (include the issue number and title text for each relevant GitHub issue): - Issue #816 -- Refactor aerosol optics to use abstract aerosol optics class + Issue #816 -- Refactor aerosol optics to use abstract aerosol optics class which can be + extended for different aerosol representations such as MAM and CARMA -Describe any changes made to build system: +Describe any changes made to build system: n/a Describe any changes made to the namelist: -List any changes to the defaults for the boundary datasets: + Namelist group "modal_aer_opt_nl" is renamed as "aerosol_optics_nl" -Describe any substantial timing or memory changes: +List any changes to the defaults for the boundary datasets: n/a -Code reviewed by: +Describe any substantial timing or memory changes: n/a + +Code reviewed by: cacraigucar mattldawson nusbaume List all files eliminated: