LCOV - code coverage report
Current view: top level - chemistry/aerosol - hygrocoreshell_aerosol_optics_mod.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 100 114 87.7 %
Date: 2025-03-14 01:30:37 Functions: 5 6 83.3 %

          Line data    Source code
       1             : module hygrocoreshell_aerosol_optics_mod
       2             :   use shr_kind_mod, only: r8 => shr_kind_r8
       3             :   use aerosol_optics_mod, only: aerosol_optics
       4             :   use aerosol_state_mod, only: aerosol_state
       5             :   use aerosol_properties_mod, only: aerosol_properties
       6             :   use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_calcwghts
       7             : 
       8             :   implicit none
       9             : 
      10             :   private
      11             :   public :: hygrocoreshell_aerosol_optics
      12             : 
      13             :   !> hygrocoreshell_aerosol_optics
      14             :   !! Table look up implementation of aerosol_optics to parameterize aerosol
      15             :   !! radiative properties in terms of core mass fraction, black carbon/dust fraction,
      16             :   !! kappa and relative humidity
      17             :   type, extends(aerosol_optics) :: hygrocoreshell_aerosol_optics
      18             : 
      19             :      real(r8), allocatable :: totalmmr(:,:) ! total mmr of the aerosol
      20             :      real(r8), allocatable :: corefrac(:,:) ! mass fraction that is core
      21             :      real(r8), allocatable :: bcdust(:,:)   ! mass fraction of bc vs (bc + dust)
      22             :      real(r8), allocatable :: kappa(:,:)    ! hygroscopicity
      23             :      real(r8), allocatable :: relh(:,:)     ! relative humidity
      24             : 
      25             :      real(r8), pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) => null() ! short wave extinction table
      26             :      real(r8), pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) => null() ! short wave single-scatter albedo table
      27             :      real(r8), pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) => null() ! short wave asymmetry table
      28             :      real(r8), pointer :: lw_hygro_coreshell_abs(:,:,:,:,:) => null() ! long wave absorption table
      29             : 
      30             :      real(r8), pointer :: tbl_corefrac(:) => null() ! core fraction dimension values
      31             :      real(r8), pointer :: tbl_bcdust(:) => null()   ! bc/(bc + dust) fraction dimension values
      32             :      real(r8), pointer :: tbl_kap(:) => null()      ! hygroscopicity dimension values
      33             :      real(r8), pointer :: tbl_relh(:) => null()     ! relative humidity dimension values
      34             : 
      35             :      integer :: nfrac = -1    ! core fraction dimension size
      36             :      integer :: nbcdust = -1  ! bc/(bc + dust) fraction dimension size
      37             :      integer :: nkap = -1     ! hygroscopicity dimension size
      38             :      integer :: nrelh = -1    ! relative humidity dimension size
      39             : 
      40             :    contains
      41             : 
      42             :      procedure :: sw_props
      43             :      procedure :: lw_props
      44             : 
      45             :      final :: destructor
      46             : 
      47             :   end type hygrocoreshell_aerosol_optics
      48             : 
      49             :   interface hygrocoreshell_aerosol_optics
      50             :      procedure :: constructor
      51             :   end interface hygrocoreshell_aerosol_optics
      52             : 
      53             : contains
      54             : 
      55             :   !------------------------------------------------------------------------------
      56             :   !------------------------------------------------------------------------------
      57     1536000 :  function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, relhum) result(newobj)
      58             : 
      59             :     class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object
      60             :     class(aerosol_state),intent(in) :: aero_state      ! aerosol_state object
      61             :     integer, intent(in) :: ilist  ! climate or a diagnostic list number
      62             :     integer, intent(in) :: ibin   ! bin number
      63             :     integer, intent(in) :: ncol   ! number of columns
      64             :     integer, intent(in) :: nlev   ! number of levels
      65             :     real(r8),intent(in) :: relhum(ncol,nlev) ! relative humidity
      66             : 
      67             :     type(hygrocoreshell_aerosol_optics), pointer :: newobj
      68             : 
      69             :     integer :: ierr, nspec
      70             :     integer :: ilev, ispec, icol
      71             : 
      72     1536000 :     real(r8), pointer :: specmmr(:,:)   ! species mass mixing ratio
      73             : 
      74     3072000 :     real(r8) :: coremmr(ncol,nlev)
      75     3072000 :     real(r8) :: coredustmmr(ncol,nlev)
      76     3072000 :     real(r8) :: corebcmmr(ncol,nlev)
      77     3072000 :     real(r8) :: shellmmr(ncol,nlev)
      78     3072000 :     real(r8) :: bcdustmmr(ncol,nlev)
      79             : 
      80             :     character(len=32) :: spectype  ! species type
      81             :     character(len=32) :: specmorph
      82             :     real(r8)          :: specdens  ! species density (kg/m3)
      83             : 
      84     1536000 :     allocate(newobj, stat=ierr)
      85     1536000 :     if (ierr/=0) then
      86     1536000 :        nullify(newobj)
      87             :        return
      88             :     end if
      89             : 
      90     6144000 :     allocate(newobj%totalmmr(ncol,nlev),stat=ierr)
      91     1536000 :     if (ierr/=0) then
      92           0 :        nullify(newobj)
      93           0 :        return
      94             :     end if
      95             : 
      96     4608000 :     allocate(newobj%corefrac(ncol,nlev),stat=ierr)
      97     1536000 :     if (ierr/=0) then
      98           0 :        nullify(newobj)
      99           0 :        return
     100             :     end if
     101             : 
     102     4608000 :     allocate(newobj%bcdust(ncol,nlev),stat=ierr)
     103     1536000 :     if (ierr/=0) then
     104           0 :        nullify(newobj)
     105           0 :        return
     106             :     end if
     107             : 
     108     4608000 :     allocate(newobj%kappa(ncol,nlev),stat=ierr)
     109     1536000 :     if (ierr/=0) then
     110           0 :        nullify(newobj)
     111           0 :        return
     112             :     end if
     113             : 
     114     4608000 :     allocate(newobj%relh(ncol,nlev),stat=ierr)
     115     1536000 :     if (ierr/=0) then
     116           0 :        nullify(newobj)
     117           0 :        return
     118             :     end if
     119             : 
     120     1536000 :     nspec = aero_props%nspecies(ilist,ibin)
     121             : 
     122   758476800 :     coremmr(:,:) = 0._r8
     123   758476800 :     coredustmmr(:,:) = 0._r8
     124   758476800 :     corebcmmr(:,:) = 0._r8
     125   758476800 :     shellmmr(:,:) = 0._r8
     126             : 
     127    16896000 :     do ispec = 1,nspec
     128             : 
     129    15360000 :        call aero_state%get_ambient_mmr(ilist,ispec,ibin,specmmr)
     130             : 
     131             :        call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, &
     132    15360000 :                            spectype=spectype, specmorph=specmorph)
     133             : 
     134    16896000 :        if (trim(specmorph) == 'core') then
     135     3072000 :           if (trim(spectype) == 'dust') then
     136   758476800 :              coredustmmr(:ncol,:nlev) = coredustmmr(:ncol,:nlev) + specmmr(:ncol,:nlev)
     137             :           end if
     138     3072000 :           if (trim(spectype) == 'black-c') then
     139   758476800 :              corebcmmr(:ncol,:nlev) = corebcmmr(:ncol,:nlev) + specmmr(:ncol,:nlev)
     140             :           end if
     141  1516953600 :           coremmr(:ncol,:nlev) = coremmr(:ncol,:nlev) + specmmr(:ncol,:nlev)
     142    12288000 :        else if (trim(specmorph) == 'shell') then
     143  6067814400 :           shellmmr(:ncol,:nlev) = shellmmr(:ncol,:nlev) + specmmr(:ncol,:nlev)
     144             :        else
     145           0 :           nullify(newobj)
     146           0 :           return
     147             :        end if
     148             : 
     149             :     end do
     150             : 
     151   758476800 :     newobj%totalmmr(:,:) = coremmr(:,:) + shellmmr(:,:)
     152   758476800 :     bcdustmmr(:,:) = corebcmmr(:,:) + coredustmmr(:,:)
     153             : 
     154    50688000 :     do ilev = 1, nlev
     155   758476800 :        do icol = 1, ncol
     156             : 
     157   707788800 :           if (newobj%totalmmr(icol,ilev) > 0._r8) then
     158   707788800 :              newobj%corefrac(icol,ilev) = coremmr(icol,ilev) / newobj%totalmmr(icol,ilev)
     159             :           else
     160           0 :              newobj%corefrac(icol,ilev) = 0._r8
     161             :           end if
     162   707788800 :           newobj%corefrac(icol,ilev) = max(0._r8, min(1.0_r8, newobj%corefrac(icol,ilev)))
     163             : 
     164   707788800 :           if (bcdustmmr(icol,ilev) > 0._r8) then
     165   707788800 :              newobj%bcdust(icol,ilev) = corebcmmr(icol,ilev) / bcdustmmr(icol,ilev)
     166             :           else
     167           0 :              newobj%bcdust(icol,ilev) = 0._r8
     168             :           end if
     169   756940800 :           newobj%bcdust(icol,ilev) = max(0._r8, min(1.0_r8, newobj%bcdust(icol,ilev)))
     170             : 
     171             :        end do
     172             :     end do
     173             : 
     174     1536000 :     call aero_state%hygroscopicity(ilist, ibin, newobj%kappa)
     175             : 
     176             :     call aero_props%optics_params(ilist, ibin, &
     177             :          corefrac=newobj%tbl_corefrac, kap=newobj%tbl_kap, &
     178             :          bcdust=newobj%tbl_bcdust, relh=newobj%tbl_relh, &
     179             :          nfrac=newobj%nfrac, nbcdust=newobj%nbcdust, &
     180     1536000 :          nkap=newobj%nkap, nrelh=newobj%nrelh)
     181             : 
     182   758476800 :     newobj%relh(:ncol,:) = relhum(:ncol,:)
     183             : 
     184             :     ! long wave optical properties table
     185             :     call aero_props%optics_params(ilist, ibin,  &
     186             :          sw_hygro_coreshell_ext=newobj%sw_hygro_coreshell_ext, &
     187             :          sw_hygro_coreshell_ssa=newobj%sw_hygro_coreshell_ssa, &
     188             :          sw_hygro_coreshell_asm=newobj%sw_hygro_coreshell_asm, &
     189     1536000 :          lw_hygro_coreshell_ext=newobj%lw_hygro_coreshell_abs)
     190             : 
     191     1536000 :   end function constructor
     192             : 
     193             :   !------------------------------------------------------------------------------
     194             :   ! returns short wave aerosol optics properties
     195             :   !------------------------------------------------------------------------------
     196   344064000 :   subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm)
     197             : 
     198             :     class(hygrocoreshell_aerosol_optics), intent(in) :: self
     199             :     integer, intent(in) :: ncol        ! number of columns
     200             :     integer, intent(in) :: ilev        ! vertical level index
     201             :     integer, intent(in) :: iwav        ! wave length index
     202             :     real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg)
     203             :     real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg)
     204             :     real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo
     205             :     real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor
     206             : 
     207             :     integer :: icol
     208             : 
     209   688128000 :     type(table_interp_wghts) :: rhwghts(ncol)
     210   688128000 :     type(table_interp_wghts) :: cfwghts(ncol)
     211   688128000 :     type(table_interp_wghts) :: bcwghts(ncol)
     212   688128000 :     type(table_interp_wghts) :: kpwghts(ncol)
     213             : 
     214   344064000 :     rhwghts = table_interp_calcwghts( self%nrelh, self%tbl_relh, ncol, self%relh(:ncol,ilev) )
     215   344064000 :     cfwghts = table_interp_calcwghts( self%nfrac, self%tbl_corefrac, ncol, self%corefrac(:ncol,ilev) )
     216   344064000 :     bcwghts = table_interp_calcwghts( self%nbcdust, self%tbl_bcdust, ncol, self%bcdust(:ncol,ilev) )
     217   344064000 :     kpwghts = table_interp_calcwghts( self%nkap, self%tbl_kap, ncol, self%kappa(:ncol,ilev) )
     218             : 
     219 >24807*10^8 :     pext = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap,  rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_ext(:,iwav,:,:,:))
     220 >24860*10^8 :     pabs = (1._r8-table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap,  rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_ssa(:,iwav,:,:,:)))*pext
     221 >24807*10^8 :     pasm = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap,  rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_asm(:,iwav,:,:,:))
     222             : 
     223  5298585600 :     do icol = 1, ncol
     224             : 
     225  4954521600 :        pext(icol) = pext(icol)*self%totalmmr(icol,ilev)
     226  4954521600 :        pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev)
     227  4954521600 :        pabs(icol) = max(0._r8,pabs(icol))
     228  4954521600 :        pabs(icol) = min(pext(icol),pabs(icol))
     229             : 
     230  5298585600 :        palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8)
     231             : 
     232             :     end do
     233             : 
     234   344064000 :   end subroutine sw_props
     235             : 
     236             :   !------------------------------------------------------------------------------
     237             :   ! returns long wave aerosol optics properties
     238             :   !------------------------------------------------------------------------------
     239   393216000 :   subroutine lw_props(self, ncol, ilev, iwav, pabs)
     240             : 
     241             :     class(hygrocoreshell_aerosol_optics), intent(in) :: self
     242             :     integer, intent(in) :: ncol        ! number of columns
     243             :     integer, intent(in) :: ilev        ! vertical level index
     244             :     integer, intent(in) :: iwav        ! wave length index
     245             :     real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg)
     246             : 
     247             :     integer :: icol
     248             : 
     249   786432000 :     type(table_interp_wghts) :: rhwghts(ncol)
     250   786432000 :     type(table_interp_wghts) :: cfwghts(ncol)
     251   786432000 :     type(table_interp_wghts) :: bcwghts(ncol)
     252   786432000 :     type(table_interp_wghts) :: kpwghts(ncol)
     253             : 
     254   393216000 :     rhwghts = table_interp_calcwghts( self%nrelh, self%tbl_relh, ncol, self%relh(:ncol,ilev) )
     255   393216000 :     cfwghts = table_interp_calcwghts( self%nfrac, self%tbl_corefrac, ncol, self%corefrac(:ncol,ilev) )
     256   393216000 :     bcwghts = table_interp_calcwghts( self%nbcdust, self%tbl_bcdust, ncol, self%bcdust(:ncol,ilev) )
     257   393216000 :     kpwghts = table_interp_calcwghts( self%nkap, self%tbl_kap, ncol, self%kappa(:ncol,ilev) )
     258             : 
     259 >28350*10^8 :     pabs = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap,  rhwghts,cfwghts,bcwghts,kpwghts, self%lw_hygro_coreshell_abs(:,iwav,:,:,:))
     260             : 
     261  6055526400 :     do icol = 1, ncol
     262  5662310400 :        pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev)
     263  6055526400 :        pabs(icol) = max(0._r8,pabs(icol))
     264             :     end do
     265             : 
     266   393216000 :   end subroutine lw_props
     267             : 
     268             :   !------------------------------------------------------------------------------
     269             :   !------------------------------------------------------------------------------
     270     1536000 :   subroutine destructor(self)
     271             : 
     272             :     type(hygrocoreshell_aerosol_optics), intent(inout) :: self
     273             : 
     274     1536000 :     deallocate(self%totalmmr)
     275     1536000 :     deallocate(self%corefrac)
     276     1536000 :     deallocate(self%bcdust)
     277     1536000 :     deallocate(self%kappa)
     278     1536000 :     deallocate(self%relh)
     279             : 
     280     1536000 :     nullify(self%tbl_corefrac)
     281     1536000 :     nullify(self%tbl_bcdust)
     282     1536000 :     nullify(self%tbl_kap)
     283     1536000 :     nullify(self%tbl_relh)
     284     1536000 :     nullify(self%sw_hygro_coreshell_ext)
     285     1536000 :     nullify(self%sw_hygro_coreshell_ssa)
     286     1536000 :     nullify(self%sw_hygro_coreshell_asm)
     287     1536000 :     nullify(self%lw_hygro_coreshell_abs)
     288             : 
     289     1536000 :   end subroutine destructor
     290             : 
     291     6144000 : end module hygrocoreshell_aerosol_optics_mod

Generated by: LCOV version 1.14