| blob | 1d3cca07fea6297e6027588ca0f30df9c596d874 |
1 MODULE module_aer_opt_out
2 ! SAM lower and upper wavelength limits (microns) for AFWA band averaging - 2 averaging bins considered here
3 REAL, PARAMETER, PRIVATE :: afwalowv1 = 3. ! lower wavelength for first AFWA band average extinction coefficent
4 REAL, PARAMETER, PRIVATE :: afwahiwv1 = 5. ! upper wavelength for first AFWA band average extinction coefficent
5 REAL, PARAMETER, PRIVATE :: afwalowv2 = 8. ! lower wavelength for second AFWA band average extinction coefficent
6 REAL, PARAMETER, PRIVATE :: afwahiwv2 = 12. ! upper wavelength for second AFWA band average extinction coefficent
7 CONTAINS
8 SUBROUTINE aer_opt_out(dz8w &
9 ,ext_coeff,bscat_coeff,asym_par &
10 ,tauaer300,tauaer400,tauaer600,tauaer999 & ! jcb
11 ,gaer300,gaer400,gaer600,gaer999 & ! jcb
12 ,waer300,waer400,waer600,waer999 & ! jcb
13 ,num_ext_coef,num_bscat_coef,num_asym_par &
14 ,ids,ide, jds,jde, kds,kde &
15 ,ims,ime, jms,jme, kms,kme &
16 ,its,ite, jts,jte, kts,kte )
17 USE module_configure, only:p_extcof3,p_extcof55,p_extcof106,p_extcof3_5,p_extcof8_12,p_bscof3,p_bscof55, &
18 p_bscof106,p_asympar3,p_asympar55,p_asympar106
20 IMPLICIT NONE
21 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
22 ims,ime, jms,jme, kms,kme, &
23 its,ite, jts,jte, kts,kte, &
24 num_ext_coef,num_bscat_coef,num_asym_par
25 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_ext_coef ), INTENT (OUT) :: ext_coeff
26 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_bscat_coef ), INTENT (OUT) :: bscat_coeff
27 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_asym_par ), INTENT (OUT) :: asym_par
28 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
29 INTENT(IN ) :: tauaer300,tauaer400,tauaer600,tauaer999, &
30 gaer300,gaer400,gaer600,gaer999, &
31 waer300,waer400,waer600,waer999,dz8w
32 real :: ang,slope,slopeg,slopessa,onemang
33 integer :: i,j,k
36 !SAM 10/22/09 AFWA ouput. Fill following arrays:
37 ! 0.3 micron extinction coefficient (1/km), scattering coefficient (1/km), assymetry coefficient (unitless)
38 ! 0.55 micron extinction coefficient (1/km), scattering coefficient (1/km), assymetry coefficient (unitless)
39 ! 1.06 micron extinction coefficient (1/km), scattering coefficient (1/km), assymetry coefficient (unitless)
40 ! 3. - 5. micron band averaged extinction coefficient (1/km)
41 ! 8. - 12. micron band averaged extinction coefficient (1/km)
42 ! As in PNNL MOSAIC, extrapolate or interpolate based on 300-999 nm Angstrom coefficient,
43 ! or linear interpolation/extrapolation between 300 and 999 nm for assymetry coefficient
44 do j = jts,jte
45 do k = kts,kte
46 do i = its,ite
47 ! convert optical properties at 300,400,600, and 999 to conform to the band wavelengths
48 ! these are: 300, 550 and 1060
49 ! 300 nm already calculated in aerosol_optical_averaging and miecalc
50 ext_coeff(i,k,j,p_extcof3)=tauaer300(i,k,j)*1.E3/dz8w(i,k,j) ! 300nm ext. coeff. (1/km)
51 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)
52 asym_par(i,k,j,p_asympar3)=gaer300(i,k,j) ! 300nm assym. parameter (no units)
53 ! 550 nm done like PNNL
54 ang=log(tauaer300(i,k,j)/tauaer999(i,k,j))/log(999./300.)
55 slopessa=(waer600(i,k,j)-waer400(i,k,j))/.2
56 slopeg=(gaer600(i,k,j)-gaer400(i,k,j))/.2
57 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)
58 slope= slopessa*(0.55-.6)+waer600(i,k,j) ! slope is scratch variable, = single scat albedo at .55 micron
59 slope=AMIN1(1.0,AMAX1(0.4,slope)) ! SSA has same limits as in PNNL
60 bscat_coeff(i,k,j,p_bscof55)=ext_coeff(i,k,j,p_extcof55)*slope ! 550nm scat. coeff. (1/km)
61 asym_par(i,k,j,p_asympar55)=AMIN1(1.,AMAX1(0.5,slopeg*(.55-.6)+gaer600(i,k,j))) ! 550nm assym. parameter (no units)
62 ! 1060 nm done like PNNL
63 slopessa=(waer999(i,k,j)-waer600(i,k,j))/.399
64 slopeg=(gaer999(i,k,j)-gaer600(i,k,j))/.399
65 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)
66 slope= slopessa*(1.06-.999)+waer999(i,k,j) ! slope is scratch variable, = single scat albedo at 1.06 micron
67 slope=AMIN1(1.0,AMAX1(0.4,slope)) ! SSA has same limits as in PNNL
68 bscat_coeff(i,k,j,p_bscof106)=ext_coeff(i,k,j,p_extcof106)*slope ! 1060nm scat. coeff. (1/km)
69 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)
70 ! 3.-5. and 8. - 12. micron band averages done by extrapolating .3-.999 calculations, like PNNL
71 onemang=1.-ang
72 if(abs(onemang).gt.1.E-3)then ! if ang sufficiently different than one, no need to worry about singularity
73 slope = tauaer400(i,k,j)*(0.4/afwalowv1)**ang ! Dummy incrumental tau at afwa lower wavelength for band average
74 slopeg = tauaer400(i,k,j)*(0.4/afwahiwv1)**ang ! Dummy incrumental tau at afwa high wavelength for band average
75 ext_coeff(i,k,j,p_extcof3_5) = (slopeg*afwahiwv1-slope*afwalowv1)/(afwahiwv1-afwalowv1)/onemang
76 slope = tauaer400(i,k,j)*(0.4/afwalowv2)**ang ! Dummy incrumental tau at afwa lower wavelength for band average
77 slopeg = tauaer400(i,k,j)*(0.4/afwahiwv2)**ang ! Dummy incrumental tau at afwa high wavelength for band average
78 ext_coeff(i,k,j,p_extcof8_12) = (slopeg*afwahiwv2-slope*afwalowv2)/(afwahiwv2-afwalowv2)/onemang
79 else ! ang is close to 1., avoid singularity
80 ext_coeff(i,k,j,p_extcof3_5) = tauaer400(i,k,j)*0.4*log(afwahiwv1/afwalowv1)/(afwahiwv1-afwalowv1)
81 ext_coeff(i,k,j,p_extcof8_12) = tauaer400(i,k,j)*0.4*log(afwahiwv2/afwalowv2)/(afwahiwv2-afwalowv2)
82 endif
83 ! Convert band average incrumental taus to extinction coefficients (1/km)
84 ext_coeff(i,k,j,p_extcof3_5) = ext_coeff(i,k,j,p_extcof3_5)*1.E3/dz8w(i,k,j)
85 ext_coeff(i,k,j,p_extcof8_12) = ext_coeff(i,k,j,p_extcof8_12)*1.E3/dz8w(i,k,j)
86 end do
87 end do
88 end do
89 END SUBROUTINE AER_OPT_OUT
90 END MODULE module_aer_opt_out