MieInterface.F90

Go to the documentation of this file.

! $Id: MieInterface.F90,v 1.1.2.1 2015/03/09 15:40:15 drholdaw Exp $


#include "MAPL_Generic.h"

module aerooptproptablemod
  use esmf
  use mapl_mod
  use chem_miemod

  implicit none
  private

  type(chem_mie),  save :: mietable
  logical       ,  save :: mietablecreated=.false.

  public get_aerooptprop
  public get_aerooptpropallaero
  public get_aeroindex
  public get_aeroindextableprops
  public get_aerotaulist
  public create_aerooptprop

  interface get_aerooptpropallaero
     module procedure get_aerooptpropallaero3d
     module procedure get_aerooptpropallaero4d
  end interface get_aerooptpropallaero

contains

!=================================================================

  subroutine get_aerooptprop(idx,ib,qaero,rh,tau,ssa,asy,rc)

    integer,           intent(IN ) :: idx
    integer,           intent(IN ) :: ib
    real,              intent(IN ) :: qaero
    real,              intent(IN ) :: rh
    real,              intent(OUT) :: tau
    real,              intent(OUT) :: ssa
    real,              intent(OUT) :: asy
    integer, optional, intent(OUT) :: rc

    integer :: status
    character(len=ESMF_MAXSTR) :: iam='Get_AeroOptProp' 

    call chem_miequery(mietable,idx,real(ib),qaero,rh, &
         tau,ssa,asy,rc=status)
    verify_(status)

    return_(esmf_success)
  end subroutine get_aerooptprop

!=================================================================

  subroutine get_aerooptpropallaero3d(na,aerosol,nb,offset,qaero,rh,tau,ssa,asy,rc)

    integer, intent(in)            :: na         ! number of aerosols
    character(len=*),  intent(IN ) :: aerosol(:) ! list of aerosols
    integer,           intent(IN ) :: nb
    integer,           intent(IN ) :: offset
    real,              intent(IN ) :: qaero(:,:,:)
    real,              intent(IN ) :: rh(:,:)
    real,              intent(OUT) :: tau(:,:,:)
    real,              intent(OUT) :: ssa(:,:,:)
    real,              intent(OUT) :: asy(:,:,:)
    integer, optional, intent(OUT) :: rc

    integer :: status
    character(len=ESMF_MAXSTR) :: Iam='Get_AeroOptPropAllAero3D' 

    integer :: l, idx

    real*8 :: tau8(size(tau,1),size(tau,2),size(tau,3))
    real*8 :: ssa8(size(tau,1),size(tau,2),size(tau,3))
    real*8 :: asy8(size(tau,1),size(tau,2),size(tau,3))

    tau8 = 0.0
    ssa8 = 0.0
    asy8 = 0.0

    do l = 1, na
       idx = chem_miequeryidx( mietable, aerosol(l), status)
       verify_(status)

       call chem_miequeryallband3d(mietable,idx,nb,offset,qaero(:,:,l),rh, &
            tau,ssa,asy,rc=status)
       verify_(status)

       tau8 = tau8 +              tau
       ssa8 = ssa8 +       (ssa * tau)
       asy8 = asy8 + asy * (ssa * tau)
    end do

    tau = tau8
    ssa = ssa8
    asy = asy8

    return_(esmf_success)
  end subroutine get_aerooptpropallaero3d

!=================================================================

  subroutine get_aerooptpropallaero4d(na,aerosol,nb,offset,qaero,rh,tau,ssa,asy,rc)

    integer,           intent(IN ) :: na         ! number of aerosols
    character(len=*),  intent(IN ) :: aerosol(:) ! list of aerosols
    integer,           intent(IN ) :: nb
    integer,           intent(IN ) :: offset
    real,              intent(IN ) :: qaero(:,:,:,:)
    real,              intent(IN ) :: rh(:,:,:)
    real,              intent(OUT) :: tau(:,:,:,:)
    real,              intent(OUT) :: ssa(:,:,:,:)
    real,              intent(OUT) :: asy(:,:,:,:)
    integer, optional, intent(OUT) :: rc

    integer :: status
    character(len=ESMF_MAXSTR) :: Iam='Get_AeroOptPropAllAero4D' 

    integer :: l, idx

    real*8 :: tau8(size(tau,1),size(tau,2),size(tau,3),size(tau,4))
    real*8 :: ssa8(size(tau,1),size(tau,2),size(tau,3),size(tau,4))
    real*8 :: asy8(size(tau,1),size(tau,2),size(tau,3),size(tau,4))

    tau8 = 0.0
    ssa8 = 0.0
    asy8 = 0.0

    do l = 1, na
       idx = chem_miequeryidx( mietable, aerosol(l), status)
       verify_(status)

       call chem_miequeryallband4d(mietable,idx,nb,offset,qaero(:,:,:,l),rh, &
            tau,ssa,asy,rc=status)
       verify_(status)

       tau8 = tau8 +              tau
       ssa8 = ssa8 +       (ssa * tau)
       asy8 = asy8 + asy * (ssa * tau)
    end do

    tau = tau8
    ssa = ssa8
    asy = asy8

    return_(esmf_success)
  end subroutine get_aerooptpropallaero4d

!=================================================================

  subroutine get_aerotaulist(idx,ib,nn,qaero,rh,tau,rc)

    integer,           intent(IN ) :: idx
    integer,           intent(IN ) :: ib,nn
    real,              intent(IN ) :: qaero(nn)
    real,              intent(IN ) :: rh(nn)
    real,              intent(OUT) :: tau(nn)
    integer, optional, intent(OUT) :: rc

    integer :: status
    character(len=ESMF_MAXSTR) :: iam='Get_AeroTauList' 


    call chem_miequerytaulist(mietable,idx,real(ib),qaero,rh, &
         tau,rc=status)
    verify_(status)

    return_(esmf_success)
  end subroutine get_aerotaulist

!=================================================================

  integer function get_aeroindex(aerosol, rc ) result (idx)
    character (len=*), intent(IN ) :: aerosol
    integer, optional, intent(OUT) :: rc

    integer :: status
    character(len=ESMF_MAXSTR) :: iam='Get_AeroIndex' 


    idx = chem_miequeryidx( mietable, aerosol, status ) 
    verify_(status)

    return_(esmf_success)
  end function get_aeroindex

  subroutine get_aeroindextableprops(na,aerosol,rh,routine,&
                                     idx,nrh,bext,bsca,gasy,arh,irh,rc)
    
    integer, intent(in) :: na                  ! number of aerosols
    character(len=*), intent(in) :: aerosol(:) ! list of aerosols
    real, intent(in) :: rh(:,:)                ! relative humidity
    character(len=5), intent(in) :: routine    ! name of routine

    integer, intent(out) :: idx(:)     ! subindex of aerosol table
    integer, intent(out) :: nrh(:)     ! number of RH levels in table
    real, intent(out) :: bext(:,:,:,:) ! mass extinction efficiency
    real, intent(out) :: bsca(:,:,:,:) ! mass scattering efficiency
    real, intent(out) :: gasy(:,:,:,:) ! asymmetry parameter
    real, intent(out) :: arh(:,:,:)    ! mapped slope from hi-res RH map
    integer, intent(out) :: irh(:,:,:) ! mapped pointer from hi-res RH map
    integer, optional, intent(out) :: rc

    integer :: status, i,j,k, ii, jj, isnap
    integer :: num_radii, num_rh
    character(len=ESMF_MAXSTR) :: iam='Get_AeroIndexTableProps' 

    ii = size(rh,1)
    jj = size(rh,2)

    ! Initialize outgoing matrices
    idx = 0
    nrh = 0
    bext = 0.0
    bsca = 0.0
    gasy = 0.0
    arh = 0.0
    irh = 0

    do k = 1, na

      idx(k) = chem_miequeryidx( mietable, aerosol(k), status)
      verify_(status)

      nrh(k) = mietable%vtableUse%nrh

      num_rh = size(mietable%vtableUse%bext,2)
      num_radii = size(mietable%vtableUse%bext,3)

      select case(routine)
      case('SOLAR') ! Use only the first 8 tables for SOLAR
         bext(1:8,1:num_rh,1:num_radii,k) = mietable%vtableUse%bext(1:8,:,:)
         bsca(1:8,1:num_rh,1:num_radii,k) = mietable%vtableUse%bsca(1:8,:,:)
         gasy(1:8,1:num_rh,1:num_radii,k) = mietable%vtableUse%g(   1:8,:,:)
      case('IRRAD') ! Use only the last 10 tables for IRRAD
         bext(1:10,1:num_rh,1:num_radii,k) = mietable%vtableUse%bext(9:18,:,:)
         bsca(1:10,1:num_rh,1:num_radii,k) = mietable%vtableUse%bsca(9:18,:,:)
         gasy(1:10,1:num_rh,1:num_radii,k) = mietable%vtableUse%g(   9:18,:,:)
      case default
         assert_(.false.) ! We MUST have a case
      end select

      do j = 1, jj
         do i = 1, ii
            isnap = int(((min(max(rh(i,j),0.0),0.99))+0.001)*1000)

            arh(i,j,k) = mietable%vtableUse%rha(isnap)
            irh(i,j,k) = mietable%vtableUse%rhi(isnap)
         end do
      end do

    end do

    return_(esmf_success)
  end subroutine get_aeroindextableprops

  subroutine create_aerooptprop(cf,rc)

    type(esmf_config), intent(IN ) :: cf
    integer, optional, intent(OUT) :: rc

    integer :: status
    character(len=ESMF_MAXSTR) :: iam='Create_AeroOptProp' 

    mietable = chem_miecreate(cf,status)
    verify_(status)

    return_(esmf_success)
  end subroutine create_aerooptprop


end module aerooptproptablemod