From 4b74f1b77d57cfed5d7ed027d9de12568963ef57 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 22 May 2023 13:27:00 -0600 Subject: [PATCH 01/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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/39] 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 6532cf6530bde32b893641002c553271e3d89622 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 10 Aug 2023 16:17:16 -0600 Subject: [PATCH 20/39] Fix memory issue, default PE layout for FMTHIST modified: Externals.cfg modified: bld/namelist_files/namelist_defaults_cam.xml modified: cime_config/config_compsets.xml modified: cime_config/config_pes.xml modified: cime_config/testdefs/testlist_cam.xml modified: src/chemistry/utils/tracer_data.F90 --- Externals.cfg | 2 +- bld/namelist_files/namelist_defaults_cam.xml | 2 +- cime_config/config_compsets.xml | 4 +-- cime_config/config_pes.xml | 27 ++++++++++++++++++++ cime_config/testdefs/testlist_cam.xml | 18 +++++++++++++ src/chemistry/utils/tracer_data.F90 | 20 +++------------ 6 files changed, 53 insertions(+), 20 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index fcc9322e56..9badad437d 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -1,5 +1,5 @@ [ccs_config] -tag = ccs_config_cesm0.0.72 +tag = ccs_config_cesm0.0.73 protocol = git repo_url = https://github.com/ESMCI/ccs_config_cesm local_path = ccs_config diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 6b583ff69d..656a1b1ab6 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -123,7 +123,7 @@ atm/cam/inic/se/f.e22.FCnudged.ne0CONUSne30x8_ne0CONUSne30x8_mt12.cam6_2_032.002.cam.i.2013-01-01-00000_c200623.nc atm/cam/inic/se/f.e22.FCnudged.ne0CONUSne30x8_ne0CONUSne30x8_mt12.cam6_2_032.002.cam.i.2013-01-01-00000_c200623.nc atm/cam/inic/se/f.e22.FCnudged.ne30_ne30_mg17.release-cesm2.2.0_spinup.2010_2020.001.cam.i.2011-01-01-00000_L58_c220310.nc -atm/cam/inic/se/FCMTHIST_ne30pg3_1980-01-01_c221214.nc +atm/cam/inic/se/f.cam6_3_112.FCMTHIST_v0c.ne30.non-ogw-ubcT-effgw0.7.001.cam.i.1998-01-01-00000_c230810.nc atm/cam/inic/se/FLT_L58_ne30pg3_IC_c220623.nc atm/cam/inic/se/cam7_FMT_ne30pg3_mg17_L93_c221118.nc diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 23aada6520..eedcf65e38 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -62,12 +62,12 @@ - FLTHIST_v0d + FLTHIST HIST_CAM%DEV%LT%GHGMAM4_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FMTHIST_v0d + FMTHIST HIST_CAM%DEV%MT%GHGMAM4_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index 316bd8435d..dae8cc032e 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -333,6 +333,33 @@ + + none + + -8 + -8 + -8 + -8 + -8 + -8 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + + none diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 73219c0c07..b9d844ebf5 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1589,6 +1589,24 @@ + + + + + + + + + + + + + + + + + + diff --git a/src/chemistry/utils/tracer_data.F90 b/src/chemistry/utils/tracer_data.F90 index 861a4cd7eb..f1eeb00e17 100644 --- a/src/chemistry/utils/tracer_data.F90 +++ b/src/chemistry/utils/tracer_data.F90 @@ -92,10 +92,10 @@ module tracer_data real(r8) :: one_yr = 0 real(r8) :: curr_mod_time ! model time - calendar day real(r8) :: next_mod_time ! model time - calendar day - next time step - integer :: nlon - integer :: nlat - integer :: nlev - integer :: nilev + integer :: nlon = 0 + integer :: nlat = 0 + integer :: nlev = 0 + integer :: nilev = 0 integer :: ps_coords(3) ! LATDIM | LONDIM | TIMDIM integer :: ps_order(3) ! LATDIM | LONDIM | TIMDIM real(r8), pointer, dimension(:) :: lons => null() @@ -104,7 +104,6 @@ module tracer_data real(r8), pointer, dimension(:) :: ilevs => null() real(r8), pointer, dimension(:) :: hyam => null() real(r8), pointer, dimension(:) :: hybm => null() - real(r8), pointer, dimension(:,:) :: ps => null() real(r8), pointer, dimension(:) :: hyai => null() real(r8), pointer, dimension(:) :: hybi => null() real(r8), pointer, dimension(:,:) :: weight_x => null(), weight_y => null() @@ -340,12 +339,6 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & lat_dimid = old_dimid endif - allocate( file%ps(file%nlon,file%nlat), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%ps allocation error = ',astat - call endrun('trcdata_init: failed to allocate x array') - end if - call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR, oldmethod=err_handling) ierr = pio_inq_varid( file%curr_fileid, 'PS', file%ps_id ) file%has_ps = (ierr==PIO_NOERR) @@ -435,11 +428,6 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & ierr = pio_get_var( file%curr_fileid, varid, file%hybi ) endif - allocate( file %ps (pcols,begchunk:endchunk), stat=astat ) - if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate file%ps array; error = ',astat - call endrun - end if allocate( file%ps_in(1)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(1)%data array; error = ',astat From acf694ea78d956edc5497cdf2cecb8cb85119a48 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 11 Aug 2023 11:29:18 -0600 Subject: [PATCH 21/39] 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 6b4b303207d896960125cb946ae2362996ca8079 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 16 Aug 2023 10:51:09 -0600 Subject: [PATCH 22/39] Zero bergso above trop_lev; better PE layouts for ERP tests modified: cime_config/config_pes.xml modified: src/physics/cam_dev/micro_pumas_cam.F90 --- cime_config/config_pes.xml | 29 ++++++++++++++++++++++++- src/physics/cam_dev/micro_pumas_cam.F90 | 2 ++ 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index dae8cc032e..42fe06d64a 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -333,7 +333,7 @@ - + none -8 @@ -360,6 +360,33 @@ 0 + + none + + -12 + -12 + -12 + -12 + -12 + -12 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + + none diff --git a/src/physics/cam_dev/micro_pumas_cam.F90 b/src/physics/cam_dev/micro_pumas_cam.F90 index ebe8b43976..32923101a6 100644 --- a/src/physics/cam_dev/micro_pumas_cam.F90 +++ b/src/physics/cam_dev/micro_pumas_cam.F90 @@ -2498,6 +2498,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) !Copy pbuf field from proc_rates back to pbuf pointer bergstot(:ncol,top_lev:) = proc_rates%bergstot(:ncol,1:nlev) + bergstot(:ncol,1:top_lev-1) = 0._r8 ! ------------------------------------------------------ ! ! ------------------------------------------------------ ! @@ -2628,6 +2629,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) nmultgo_grid(:ncol,:top_lev-1) = 0._r8 nmultrgo_grid(:ncol,:top_lev-1) = 0._r8 npsacwgo_grid(:ncol,:top_lev-1) = 0._r8 + bergso_grid(:ncol,:top_lev-1) = 0._r8 ! These pbuf fields need to be assigned. There is no corresponding subcol_field_avg ! as they are reset before being used, so it would be a needless calculation From cfdb2ae6114cf667b177c33364f545662bfe4456 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 16 Aug 2023 11:13:20 -0600 Subject: [PATCH 23/39] Adjustments to regression tests modified: cime_config/testdefs/testlist_cam.xml --- cime_config/testdefs/testlist_cam.xml | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index b9d844ebf5..5ee5f95aa7 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1591,14 +1591,23 @@ - + - + + + + + + + + + + @@ -1607,6 +1616,15 @@ + + + + + + + + + From eb970c539f251cb35b9fe6c4da34653d093c1b51 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 16 Aug 2023 15:35:30 -0600 Subject: [PATCH 24/39] restrict log message to masterproc modified: src/dynamics/se/dyn_comp.F90 --- src/dynamics/se/dyn_comp.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 6504eb75cd..38603c637b 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -763,8 +763,10 @@ subroutine dyn_init(dyn_in, dyn_out) (hvcoord%hyam(:)+hvcoord%hybm(:))*hvcoord%ps0,km_sponge_factor,& kmvis_ref,kmcnd_ref,rho_ref) - write(iulog,*) "Molecular viscoity and thermal conductivity reference profile" - write(iulog,*) "k, p, z, km_sponge_factor, kmvis_ref/rho_ref, kmcnd_ref/(cp*rho_ref):" + if (masterproc) then + write(iulog,*) "Molecular viscoity and thermal conductivity reference profile" + write(iulog,*) "k, p, z, km_sponge_factor, kmvis_ref/rho_ref, kmcnd_ref/(cp*rho_ref):" + end if do k=1,nlev ! only apply molecular viscosity where viscosity is > 1000 m/s^2 if (MIN(kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)))>1000.0_r8) then From 21c4f6f12ee2c27a26e651a7d7d0c737edc3e968 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 22 Aug 2023 08:39:34 -0600 Subject: [PATCH 25/39] minor fixes modified: cime_config/testdefs/testlist_cam.xml modified: src/dynamics/se/dyn_comp.F90 --- cime_config/testdefs/testlist_cam.xml | 8 ++++---- src/dynamics/se/dyn_comp.F90 | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 5ee5f95aa7..e339bd4afc 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1595,7 +1595,7 @@ - + @@ -1604,7 +1604,7 @@ - + @@ -1613,7 +1613,7 @@ - + @@ -1622,7 +1622,7 @@ - + diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 38603c637b..683565267c 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -764,7 +764,7 @@ subroutine dyn_init(dyn_in, dyn_out) kmvis_ref,kmcnd_ref,rho_ref) if (masterproc) then - write(iulog,*) "Molecular viscoity and thermal conductivity reference profile" + write(iulog,*) "Molecular viscosity and thermal conductivity reference profile" write(iulog,*) "k, p, z, km_sponge_factor, kmvis_ref/rho_ref, kmcnd_ref/(cp*rho_ref):" end if do k=1,nlev From bde9720fab59b8f1bf939be208418b785b7241a4 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 23 Aug 2023 09:13:36 -0600 Subject: [PATCH 26/39] ChangeLog draft --- doc/ChangeLog | 110 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 110 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index bf2db678b4..1d979ffe70 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,115 @@ =============================================================== +Tag name: cam6_3_124 +Originator(s): fvitt +Date: 23 Aug 2023 +One-line Summary: Fix issues exposed by FMTHIST; add regression tests for FLTHIST and FMTHIST +Github PR URL: https://github.com/ESCOMP/CAM/pull/872 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fix memory issue in code that reads input data on the native unstructured grid. + Fix floating point exception issue in aerosol wet deposition caused by undefined values in + BERGSO (conversion of cloud water to snow) above above pumus active region + + Address github issues: + Increase PE layout for MT runs #812 + Introduce regression tests for FLTHIST and FMTHIST #841 + +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: cacraigucar nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg +M bld/namelist_files/namelist_defaults_cam.xml + - default spun-up IC file for L93 ne30 CAM-Chem-SE + +M cime_config/config_compsets.xml + - remove "_v0d" from FLTHIST and FMTHIST compset short names + +M cime_config/config_pes.xml + - set default PE layouts for FLTHIST and FMTHIST compsets + +M cime_config/testdefs/testlist_cam.xml + - add cheyenne regression tests for FLTHIST and FMTHIST compsets + +M src/chemistry/utils/tracer_data.F90 + - remove unused ps field that was allocated using undefined sizes when + the input file was on the native unsctructured model grid + +M src/dynamics/se/dyn_comp.F90 + - write "Molecular viscosity" message only if masterproc + +M src/physics/cam_dev/micro_pumas_cam.F90 + - zero bergo field above top_lev + +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: +aux_cam_20230822154526: 61 tests + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_123: DIFF + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 RUN time=287 + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 COMPARE_base_rest + - pre-extisting failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_123: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_123/ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s' does not exist + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_123: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_123/SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s' does not exist + - new tests + + +izumi/nag/aux_cam: + +izumi/gnu/aux_cam: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + Tag name: cam6_3_123 Originator(s): cacraig, jedwards, fvitt Date: August 16, 2023 From f39a204a6d36f619359db091645f520e4eaa7d4a Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 23 Aug 2023 13:40:47 -0600 Subject: [PATCH 27/39] ChangeLog update --- doc/ChangeLog | 30 +++++------------------------- 1 file changed, 5 insertions(+), 25 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 1d979ffe70..9d6fd22886 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -78,34 +78,14 @@ aux_cam_20230822154526: 61 tests FAIL SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_123: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_123/SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s' does not exist - new tests - izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - pre-extisting failure -izumi/gnu/aux_cam: - -CAM tag used for the baseline comparison tests if different than previous -tag: - -Summarize any changes to answers, i.e., -- what code configurations: -- what platforms/compilers: -- nature of change (roundoff; larger than roundoff but same climate; new - climate): - -If bitwise differences were observed, how did you show they were no worse -than roundoff? - -If this tag changes climate describe the run(s) done to evaluate the new -climate in enough detail that it(they) could be reproduced, i.e., -- source tag (all code used must be in the repository): -- platform/compilers: -- configure commandline: -- build-namelist command (or complete namelist): -- MSS location of output: - -MSS location of control simulations used to validate new climate: +izumi/gnu/aux_cam: All PASS -URL for AMWG diagnostics output used to validate new climate: +Summarize any changes to answers: bit-for-bit unchanged =============================================================== =============================================================== From 7289b7a75a15b89f69df142826cf232668cfb8ef Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 23 Aug 2023 13:57:51 -0600 Subject: [PATCH 28/39] ChangeLog update --- doc/ChangeLog | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 9d6fd22886..672f32bfc4 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -8,7 +8,7 @@ Github PR URL: https://github.com/ESCOMP/CAM/pull/872 Purpose of changes (include the issue number and title text for each relevant GitHub issue): - Fix memory issue in code that reads input data on the native unstructured grid. + Fix memory issue in code that reads input data on the native unstructured model grid. Fix floating point exception issue in aerosol wet deposition caused by undefined values in BERGSO (conversion of cloud water to snow) above above pumus active region @@ -16,19 +16,19 @@ Purpose of changes (include the issue number and title text for each relevant Gi Increase PE layout for MT runs #812 Introduce regression tests for FLTHIST and FMTHIST #841 -Describe any changes made to build system: +Describe any changes made to build system: n/a -Describe any changes made to the namelist: +Describe any changes made to the namelist: n/a -List any changes to the defaults for the boundary datasets: +List any changes to the defaults for the boundary datasets: n/a -Describe any substantial timing or memory changes: +Describe any substantial timing or memory changes: n/a Code reviewed by: cacraigucar nusbaume -List all files eliminated: +List all files eliminated: n/a -List all files added and what they do: +List all files added and what they do: n/a List all existing files that have been modified, and describe the changes: M Externals.cfg From 781349a84deda86fcca92b409b37833bd43daf58 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 23 Aug 2023 14:00:23 -0600 Subject: [PATCH 29/39] ChangeLog update --- doc/ChangeLog | 1 - 1 file changed, 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 672f32bfc4..90c1a34aff 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -60,7 +60,6 @@ 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: -aux_cam_20230822154526: 61 tests ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: From 8b4138f0ed4665460cb191546cd5e7a4100529a2 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 24 Aug 2023 15:43:37 -0600 Subject: [PATCH 30/39] 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 31/39] 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 32/39] 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 33/39] 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 34/39] 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 35/39] 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 36/39] 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: From ea1d0da8c8abb49ea10f9b61b41c776ae1f84ee1 Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Fri, 23 Jun 2023 11:35:06 -0600 Subject: [PATCH 37/39] Add 60 and 30km ncdata files for analytic ICs w/o topography These files have been generated using MPAS-A init-atmosphere core for CAM-MPAS grids (case 13) based on standard 60 and 30km MPAS meshes. Also add default values for mpasa60 and mpasa30 hgrids. Needed default values for mpas_dt and mpas_len_disp since they are affected by hgrids. --- bld/namelist_files/namelist_defaults_cam.xml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 656a1b1ab6..75cc4f4677 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -48,6 +48,8 @@ atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c201216.nc atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc +atm/cam/inic/mpas/mpasa60_L32_notopo_coords_c230707.nc +atm/cam/inic/mpas/mpasa30_L32_notopo_coords_c230707.nc atm/cam/inic/fv/cami_0000-01-01_0.23x0.31_L26_c100513.nc @@ -3115,6 +3117,8 @@ 2 1800.0D0 900.0D0 + 450.0D0 + 225.0D0 .true. 2 @@ -3129,6 +3133,8 @@ 480000.0D0 120000.0D0 + 60000.0D0 + 30000.0D0 0.05D0 10.0D0 From 3f7cfa489e103769355519646b401ba7a17aa136 Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Mon, 28 Aug 2023 16:15:51 -0600 Subject: [PATCH 38/39] Update ChangeLog Aug28 - missing aux_cam test results, date, and CAM tag (not assigned yet). --- doc/ChangeLog | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index bfc4e3f9ef..fcbce38668 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,52 @@ =============================================================== +Tag name: +Originator(s): gdicker +Date: +One-line Summary: Add MPAS-A 60 and 30km analytic-ic ncdata +Github PR URL: https://github.com/ESCOMP/CAM/pull/848 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Add 60 and 30km MPAS-A meshes w/ 32L for analytic ICs: https://github.com/ESCOMP/CAM/issues/847 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - See specific details below in file section. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig, jtruesdal, nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/namelist_defaults_cam.xml + - Adds two new MPAS-A notopo files to ncdata section for runs with analytic_ic + - Adds mpas_dt for mpasa60 and mpasa30 hgrids + - Adds mpas_len_disp for mpasa60 and mpasa30 hgrids + +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: + +izumi/nag/aux_cam: + +izumi/gnu/aux_cam: + +CAM tag used for the baseline comparison tests if different than previous +tag: cam6_3_111 + +=============================================================== +=============================================================== + Tag name: cam6_3_125 Originator(s): fvitt Date: 29 Aug 2023 From c95209b5dfd690db4d32041616131d8bc676537a Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Wed, 6 Sep 2023 11:25:35 -0600 Subject: [PATCH 39/39] Update ChangeLog Add tag, date, and regression test results. Imply cam6_3_125 as test baseline by removing reference to cam6_3_111. --- doc/ChangeLog | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index fcbce38668..6ee1ed2f62 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,8 +1,8 @@ =============================================================== -Tag name: +Tag name: cam6_3_126 Originator(s): gdicker -Date: +Date: 6 Sep 2023 One-line Summary: Add MPAS-A 60 and 30km analytic-ic ncdata Github PR URL: https://github.com/ESCOMP/CAM/pull/848 @@ -36,13 +36,20 @@ 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.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures izumi/nag/aux_cam: + TR8 test FAIL: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90:288 crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev), 1.e-40) + - missing r8 qualifier, see Issue #882 + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure -izumi/gnu/aux_cam: +izumi/gnu/aux_cam: All PASS -CAM tag used for the baseline comparison tests if different than previous -tag: cam6_3_111 +Summarize any changes to answers: bit-for-bit unchanged =============================================================== ===============================================================