MODULE module_aer_opt_out
! SAM lower and upper wavelength limits (microns) for AFWA band averaging - 2 averaging bins considered here
   REAL,    PARAMETER, PRIVATE ::   afwalowv1   = 3.  ! lower wavelength for first AFWA band average extinction coefficent
   REAL,    PARAMETER, PRIVATE ::   afwahiwv1   = 5.  ! upper wavelength for first AFWA band average extinction coefficent
   REAL,    PARAMETER, PRIVATE ::   afwalowv2   = 8.  ! lower wavelength for second AFWA band average extinction coefficent
   REAL,    PARAMETER, PRIVATE ::   afwahiwv2   = 12. ! upper wavelength for second AFWA band average extinction coefficent
CONTAINS
   SUBROUTINE aer_opt_out(dz8w  &
                   ,ext_coeff,bscat_coeff,asym_par                &
                   ,tauaer300,tauaer400,tauaer600,tauaer999       & ! jcb
                   ,gaer300,gaer400,gaer600,gaer999               & ! jcb
                   ,waer300,waer400,waer600,waer999               & ! jcb
                   ,num_ext_coef,num_bscat_coef,num_asym_par    &
                   ,ids,ide, jds,jde, kds,kde                     &
                   ,ims,ime, jms,jme, kms,kme                     &
                   ,its,ite, jts,jte, kts,kte )
USE module_configure, only:p_extcof3,p_extcof55,p_extcof106,p_extcof3_5,p_extcof8_12,p_bscof3,p_bscof55, &
           p_bscof106,p_asympar3,p_asympar55,p_asympar106

   IMPLICIT NONE
   INTEGER,    INTENT(IN   ) ::        ids,ide, jds,jde, kds,kde, &
                                       ims,ime, jms,jme, kms,kme, &
                                       its,ite, jts,jte, kts,kte, &
                                       num_ext_coef,num_bscat_coef,num_asym_par
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_ext_coef ), INTENT (OUT) :: ext_coeff
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_bscat_coef ), INTENT (OUT) :: bscat_coeff
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_asym_par ), INTENT (OUT) :: asym_par
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),        &
         INTENT(IN    ) :: tauaer300,tauaer400,tauaer600,tauaer999, &
                                 gaer300,gaer400,gaer600,gaer999, &
                              waer300,waer400,waer600,waer999,dz8w
   real :: ang,slope,slopeg,slopessa,onemang
   integer :: i,j,k

!SAM 10/22/09 AFWA ouput.  Fill following arrays:
! 0.3 micron extinction coefficient (1/km), scattering coefficient (1/km), assymetry coefficient (unitless)
! 0.55 micron extinction coefficient (1/km), scattering coefficient (1/km), assymetry coefficient (unitless)
! 1.06 micron extinction coefficient (1/km), scattering coefficient (1/km), assymetry coefficient (unitless)
! 3. - 5. micron band averaged extinction coefficient (1/km)
! 8. - 12. micron band averaged extinction coefficient (1/km)
! As in PNNL MOSAIC, extrapolate or interpolate based on 300-999 nm Angstrom coefficient,
! or linear interpolation/extrapolation between 300 and 999 nm for assymetry coefficient
      do j = jts,jte
      do k = kts,kte
      do i = its,ite
! convert optical properties at 300,400,600, and 999 to conform to the band wavelengths
! these are: 300, 550 and 1060
! 300 nm already calculated in aerosol_optical_averaging and miecalc
      ext_coeff(i,k,j,p_extcof3)=tauaer300(i,k,j)*1.E3/dz8w(i,k,j)  ! 300nm ext. coeff. (1/km)
      bscat_coeff(i,k,j,p_bscof3)=tauaer300(i,k,j)*waer300(i,k,j)*1.E3/dz8w(i,k,j)  ! 300nm scat. coeff. (1/km)
      asym_par(i,k,j,p_asympar3)=gaer300(i,k,j)  ! 300nm assym. parameter (no units)
! 550 nm done like PNNL
           ang=log(tauaer300(i,k,j)/tauaer999(i,k,j))/log(999./300.)
           slopessa=(waer600(i,k,j)-waer400(i,k,j))/.2
           slopeg=(gaer600(i,k,j)-gaer400(i,k,j))/.2
      ext_coeff(i,k,j,p_extcof55)=tauaer400(i,k,j)*1.E3*((0.4/0.55)**ang)/dz8w(i,k,j)  ! 550nm ext. coeff. (1/km)
      slope= slopessa*(0.55-.6)+waer600(i,k,j) ! slope is scratch variable, = single scat albedo at .55 micron
      slope=AMIN1(1.0,AMAX1(0.4,slope))   ! SSA has same limits as in PNNL
      bscat_coeff(i,k,j,p_bscof55)=ext_coeff(i,k,j,p_extcof55)*slope  ! 550nm scat. coeff. (1/km)
      asym_par(i,k,j,p_asympar55)=AMIN1(1.,AMAX1(0.5,slopeg*(.55-.6)+gaer600(i,k,j)))  ! 550nm assym. parameter (no units)
! 1060 nm done like PNNL
           slopessa=(waer999(i,k,j)-waer600(i,k,j))/.399
           slopeg=(gaer999(i,k,j)-gaer600(i,k,j))/.399
      ext_coeff(i,k,j,p_extcof106)=tauaer400(i,k,j)*1.E3*((0.4/1.06)**ang)/dz8w(i,k,j)  ! 1060nm ext. coeff. (1/km)
      slope= slopessa*(1.06-.999)+waer999(i,k,j) ! slope is scratch variable, = single scat albedo at 1.06 micron
      slope=AMIN1(1.0,AMAX1(0.4,slope))   ! SSA has same limits as in PNNL
      bscat_coeff(i,k,j,p_bscof106)=ext_coeff(i,k,j,p_extcof106)*slope  ! 1060nm scat. coeff. (1/km)
      asym_par(i,k,j,p_asympar106)=AMIN1(1.,AMAX1(0.5,slopeg*(1.06-.999)+gaer600(i,k,j)))  ! 1060nm assym. parameter (no units)
! 3.-5.  and 8. - 12. micron band averages done by extrapolating .3-.999 calculations, like PNNL
      onemang=1.-ang
      if(abs(onemang).gt.1.E-3)then   ! if ang sufficiently different than one, no need to worry about singularity
      slope = tauaer400(i,k,j)*(0.4/afwalowv1)**ang  ! Dummy incrumental tau at afwa lower wavelength for band average
      slopeg = tauaer400(i,k,j)*(0.4/afwahiwv1)**ang  ! Dummy incrumental tau at afwa high wavelength for band average
      ext_coeff(i,k,j,p_extcof3_5) = (slopeg*afwahiwv1-slope*afwalowv1)/(afwahiwv1-afwalowv1)/onemang
      slope = tauaer400(i,k,j)*(0.4/afwalowv2)**ang  ! Dummy incrumental tau at afwa lower wavelength for band average
      slopeg = tauaer400(i,k,j)*(0.4/afwahiwv2)**ang  ! Dummy incrumental tau at afwa high wavelength for band average
      ext_coeff(i,k,j,p_extcof8_12) = (slopeg*afwahiwv2-slope*afwalowv2)/(afwahiwv2-afwalowv2)/onemang
      else                           ! ang is close to 1., avoid singularity
      ext_coeff(i,k,j,p_extcof3_5) = tauaer400(i,k,j)*0.4*log(afwahiwv1/afwalowv1)/(afwahiwv1-afwalowv1)
      ext_coeff(i,k,j,p_extcof8_12) = tauaer400(i,k,j)*0.4*log(afwahiwv2/afwalowv2)/(afwahiwv2-afwalowv2)
      endif
! Convert band average incrumental taus to extinction coefficients (1/km)
      ext_coeff(i,k,j,p_extcof3_5) = ext_coeff(i,k,j,p_extcof3_5)*1.E3/dz8w(i,k,j)
      ext_coeff(i,k,j,p_extcof8_12) = ext_coeff(i,k,j,p_extcof8_12)*1.E3/dz8w(i,k,j)
      end do
      end do
      end do
  END SUBROUTINE AER_OPT_OUT
END MODULE module_aer_opt_out