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