33                                       spccoeff_ismicrowavesensor , & 
    34                                       spccoeff_isinfraredsensor  , & 
    35                                       spccoeff_isvisiblesensor   , &
    36                                       spccoeff_isultravioletsensor
    40                                       seasalt_ssam_aerosol      , &
    41                                       seasalt_sscm1_aerosol     , &
    42                                       seasalt_sscm2_aerosol     , &
    43                                       seasalt_sscm3_aerosol     , &
    44                                       organic_carbon_aerosol    , &
    45                                       black_carbon_aerosol      , &
    92   '$Id: CRTM_AerosolScatter.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'      94   INTEGER, 
PARAMETER :: 
ml = 256
   177     SensorIndex , &  ! Input
   178     ChannelIndex, &  ! Input
   181   result( error_status )
   184     INTEGER                   , 
INTENT(IN)     :: channelindex
   185     INTEGER                   , 
INTENT(IN)     :: sensorindex
   189     INTEGER :: error_status    
   191     CHARACTER(*), 
PARAMETER :: routine_name = 
'CRTM_Compute_AerosolScatter'   193     CHARACTER(ML) :: message
   194     INTEGER :: k, ka, l, m, n
   195     REAL(fp) :: frequency
   196     LOGICAL  :: layer_mask(atm%n_layers)
   197     INTEGER  :: layer_index(atm%n_layers)
   198     INTEGER  :: naerosol_layers
   205     IF ( spccoeff_ismicrowavesensor(
sc(sensorindex)) ) 
RETURN    206     IF ( atm%n_Aerosols == 0 ) 
RETURN   209     frequency = 
sc(sensorindex)%Wavenumber(channelindex)
   213     SELECT CASE(ascat%n_Legendre_Terms)
   223           ascat%n_Legendre_Terms = 0
   226           WRITE(message,
'("The n_Legendre_Terms in AerosolScatter, ",i0,", do not fit model")') &
   227                         ascat%n_Legendre_Terms
   237     aerosol_loop: 
DO n = 1, atm%n_Aerosols
   242       naerosol_layers = count(layer_mask)
   243       IF ( naerosol_layers == 0 ) cycle aerosol_loop
   249       layer_index(1:naerosol_layers) = pack((/(k,k=1,atm%Aerosol(n)%n_Layers)/), layer_mask)
   250       aerosol_layer_loop: 
DO k = 1, naerosol_layers
   256                               atm%Aerosol(n)%Type                , & 
   257                               atm%Aerosol(n)%Effective_Radius(ka), & 
   260                               asv%pcoeff(:,:,ka,n)               , & 
   264         IF( asv%ke(ka,n) <= 
zero ) 
THEN   268         IF( asv%w(ka,n) <= 
zero ) 
THEN   270           asv%pcoeff(:,:,ka,n) = 
zero   272         IF( asv%w(ka,n) >= 
one ) 
THEN   290         ascat%Optical_Depth(ka) = ascat%Optical_Depth(ka) + &
   291                                   (asv%ke(ka,n)*atm%Aerosol(n)%Concentration(ka))
   297         IF( ascat%n_Phase_Elements > 0 .and. ascat%Include_Scattering ) 
THEN   308         bs = atm%Aerosol(n)%Concentration(ka) * asv%ke(ka,n) * asv%w(ka,n) 
   309         asv%Total_bs(ka) = asv%Total_bs(ka) + bs  
   310         ascat%Single_Scatter_Albedo(ka) = ascat%Single_Scatter_Albedo(ka) + bs
   312           DO m = 1, ascat%n_Phase_Elements
   313             DO l = 0, ascat%n_Legendre_Terms
   314               ascat%Phase_Coefficient(l,m,ka) = ascat%Phase_Coefficient(l,m,ka) + &
   315                                                 (asv%pcoeff(l,m,ka,n) * bs) 
   319       END DO aerosol_layer_loop
   415     AScat       , & ! FWD Input
   416     Atm_TL      , & ! TL  Input
   417     SensorIndex , & ! Input
   418     ChannelIndex, & ! Input
   419     AScat_TL    , & ! TL  Input
   421   result( error_status )
   426     INTEGER                    , 
INTENT(IN)     :: sensorindex
   427     INTEGER                    , 
INTENT(IN)     :: channelindex
   431     INTEGER :: error_status
   433     CHARACTER(*), 
PARAMETER :: routine_name = 
'CRTM_Compute_AerosolScatter_TL'   435     INTEGER  :: k, ka, l, m, n
   436     INTEGER  :: n_legendre_terms, n_phase_elements
   437     REAL(fp) :: frequency
   438     LOGICAL  :: layer_mask(atm%n_layers)
   439     INTEGER  :: layer_index(atm%n_layers)
   440     INTEGER  :: naerosol_layers
   441     REAL(fp) :: ke_tl, w_tl
   442     REAL(fp) :: pcoeff_tl(0:ascat%n_legendre_terms, ascat%n_phase_elements)
   443     REAL(fp) :: bs, bs_tl
   449     IF ( spccoeff_ismicrowavesensor(
sc(sensorindex)) ) 
RETURN    450     IF ( atm%n_Aerosols == 0 ) 
RETURN   452     frequency = 
sc(sensorindex)%Wavenumber(channelindex)
   454     n_legendre_terms = ascat_tl%n_Legendre_Terms
   455     n_phase_elements = ascat_tl%n_Phase_Elements
   456     ascat_tl%lOffset = ascat%lOffset
   462     aerosol_loop: 
DO n = 1, atm%n_Aerosols
   467       naerosol_layers = count(layer_mask)
   468       IF (naerosol_layers == 0) cycle aerosol_loop
   474       layer_index(1:naerosol_layers) = pack((/(k,k=1,atm%Aerosol(n)%n_Layers)/), layer_mask)
   475       aerosol_layer_loop: 
DO k = 1, naerosol_layers
   480                                 atm%Aerosol(n)%Type                   , & 
   483                                 atm_tl%Aerosol(n)%Effective_Radius(ka), & 
   490         IF( asv%ke(ka,n) <= 
zero ) 
THEN   494         IF( asv%w(ka,n) <= 
zero ) 
THEN   498         IF( asv%w(ka,n) >= 
one ) 
THEN   503         ascat_tl%Optical_Depth(ka) = ascat_tl%Optical_Depth(ka) + &
   504                                      (ke_tl        * atm%Aerosol(n)%Concentration(ka)) + &
   505                                      (asv%ke(ka,n) * atm_tl%Aerosol(n)%Concentration(ka))
   508         IF( n_phase_elements > 0 .and. ascat%Include_Scattering ) 
THEN   510         bs = atm%Aerosol(n)%Concentration(ka) * asv%ke(ka,n) * asv%w(ka,n)  
   511         bs_tl = (atm_tl%Aerosol(n)%Concentration(ka) * asv%ke(ka,n) * asv%w(ka,n) ) + &
   512                 (atm%Aerosol(n)%Concentration(ka) * ke_tl * asv%w(ka,n) ) + &
   513                 (atm%Aerosol(n)%Concentration(ka) * asv%ke(ka,n) * w_tl ) 
   514         ascat_tl%Single_Scatter_Albedo(ka) = ascat_tl%Single_Scatter_Albedo(ka) + bs_tl
   516           DO m = 1, n_phase_elements
   517             DO l = 0, n_legendre_terms
   518               ascat_tl%Phase_Coefficient(l,m,ka) = ascat_tl%Phase_Coefficient(l,m,ka) + &
   519                                                    (pcoeff_tl(l,m)       * bs   ) + &
   520                                                    (asv%pcoeff(l,m,ka,n) * bs_tl)
   524       END DO aerosol_layer_loop
   621     AScat       , &  ! FWD Input
   622     AScat_AD    , &  ! AD  Input
   623     SensorIndex , &  ! Input
   624     ChannelIndex, &  ! Input
   625     Atm_AD      , &  ! AD  Output
   627   result( error_status )               
   632     INTEGER                   , 
INTENT(IN)     :: sensorindex
   633     INTEGER                   , 
INTENT(IN)     :: channelindex
   637     INTEGER :: error_status
   639     CHARACTER(*), 
PARAMETER :: routine_name = 
'CRTM_Compute_AerosolScatter_AD'   641     INTEGER   :: k, ka, l, m, n
   642     INTEGER   :: n_legendre_terms, n_phase_elements
   643     REAL(fp)  :: frequency
   644     LOGICAL   :: layer_mask(atm%n_layers)
   645     INTEGER   :: layer_index(atm%n_layers)
   646     INTEGER   :: naerosol_layers
   647     REAL(fp)  :: ke_ad, w_ad
   648     REAL(fp)  :: pcoeff_ad(0:ascat%n_legendre_terms, ascat%n_phase_elements)
   649     REAL(fp)  :: bs, bs_ad
   655     IF ( spccoeff_ismicrowavesensor(
sc(sensorindex)) ) 
RETURN    656     IF ( atm%n_Aerosols == 0 ) 
RETURN   658     frequency = 
sc(sensorindex)%Wavenumber(channelindex)
   660     n_legendre_terms = ascat_ad%n_Legendre_Terms
   661     n_phase_elements = ascat_ad%n_Phase_Elements
   662     ascat_ad%lOffset = ascat%lOffset
   674     aerosol_loop: 
DO n = 1, atm%n_Aerosols
   679       naerosol_layers = count(layer_mask)
   680       IF ( naerosol_layers == 0 ) cycle aerosol_loop
   685       layer_index(1:naerosol_layers) = pack((/(k,k=1,atm%Aerosol(n)%n_Layers)/), layer_mask)
   686       aerosol_layer_loop: 
DO k = 1, naerosol_layers
   698         IF( n_phase_elements > 0 .and. ascat%Include_Scattering ) 
THEN   701         bs = atm%Aerosol(n)%Concentration(ka) * asv%ke(ka,n) * asv%w(ka,n)  
   702           DO m = 1, n_phase_elements
   703             DO l = 0, n_legendre_terms
   704               bs_ad = bs_ad + (asv%pcoeff(l,m,ka,n) * ascat_ad%Phase_Coefficient(l,m,ka))
   705               pcoeff_ad(l,m) = pcoeff_ad(l,m) + (bs * ascat_ad%Phase_Coefficient(l,m,ka))
   711         bs_ad = bs_ad + ascat_ad%Single_Scatter_Albedo(ka)
   712         w_ad  = w_ad  + (atm%Aerosol(n)%Concentration(ka) * asv%ke(ka,n)* bs_ad )
   717         atm_ad%Aerosol(n)%Concentration(ka) = atm_ad%Aerosol(n)%Concentration(ka) + &
   718                                               (asv%ke(ka,n) * ascat_ad%Optical_Depth(ka))
   719         ke_ad = ke_ad + (atm%Aerosol(n)%Concentration(ka) * ascat_ad%Optical_Depth(ka))
   724         ke_ad = ke_ad + (atm%Aerosol(n)%Concentration(ka) * bs_ad * asv%w(ka,n) )
   725         atm_ad%Aerosol(n)%Concentration(ka) = atm_ad%Aerosol(n)%Concentration(ka) + &
   726                                               ( bs_ad * asv%ke(ka,n) * asv%w(ka,n) )
   729         IF( asv%w(ka,n) >= 
one ) 
THEN   732         IF( asv%ke(ka,n) <= 
zero ) 
THEN   736         IF( asv%w(ka,n) <= 
zero ) 
THEN   741         IF( asv%w(ka,n) >= 
one ) 
THEN   744         IF( asv%ke(ka,n) <= 
zero ) 
THEN   748         IF( asv%w(ka,n) <= 
zero ) 
THEN   755                                 atm%Aerosol(n)%Type                   , & 
   761                                 atm_ad%Aerosol(n)%Effective_Radius(ka), & 
   764       END DO aerosol_layer_loop
   784     INTEGER, 
INTENT(IN) :: aerosol_type
   786     SELECT CASE (aerosol_type)
   787       CASE(dust_aerosol)              ; k=1
   788       CASE(seasalt_ssam_aerosol)      ; k=2
   789       CASE(seasalt_sscm1_aerosol)     ; k=3
   790       CASE(seasalt_sscm2_aerosol)     ; k=4
   791       CASE(seasalt_sscm3_aerosol)     ; k=5
   792       CASE(organic_carbon_aerosol)    ; k=6
   793       CASE(black_carbon_aerosol)      ; k=7
   794       CASE(sulfate_aerosol)           ; k=8
   807   SUBROUTINE get_aerosol_opt( AerosolScatter, &  ! Input AerosolScatter structure
   808                               Frequency     , &  ! Input in cm^-1
   809                               Aerosol_Type  , &  ! Input see CRTM_Aerosol_Define.f90
   810                               Reff          , &  ! Input effective radius (mm)
   816     TYPE(CRTM_AtmOptics_type), 
INTENT(IN)     :: AerosolScatter
   817     REAL(fp)                 , 
INTENT(IN)     :: Frequency
   818     INTEGER                  , 
INTENT(IN)     :: Aerosol_Type
   819     REAL(fp)                 , 
INTENT(IN)     :: Reff
   820     REAL(fp)                 , 
INTENT(OUT)    :: ke
   821     REAL(fp)                 , 
INTENT(OUT)    :: w
   822     REAL(fp)                 , 
INTENT(IN OUT) :: pcoeff(0:,:)
   823     TYPE(ASinterp_type)      , 
INTENT(IN OUT) :: asi
   837     CALL find_index(
aeroc%Frequency(:),asi%f_int,asi%i1,asi%i2, asi%f_outbound)
   838     asi%f = 
aeroc%Frequency(asi%i1:asi%i2)
   841     CALL find_index(
aeroc%Reff(:,k), asi%r_int, asi%j1,asi%j2, asi%r_outbound)
   842     asi%r = 
aeroc%Reff(asi%j1:asi%j2,k) 
   848     CALL lpoly( asi%f, asi%f_int, &  
   851     CALL lpoly( asi%r, asi%r_int, &  
   857     CALL interp_2d( 
aeroc%ke(asi%i1:asi%i2,asi%j1:asi%j2,k), asi%wlp, asi%xlp, ke )
   858     CALL interp_2d( 
aeroc%w(asi%i1:asi%i2,asi%j1:asi%j2,k) , asi%wlp, asi%xlp, w  )
   859     IF (aerosolscatter%n_Phase_Elements > 0 .and. aerosolscatter%Include_Scattering ) 
THEN   861       DO m = 1, aerosolscatter%n_Phase_Elements
   862         DO l = 1, aerosolscatter%n_Legendre_Terms
   863           CALL interp_2d( 
aeroc%pcoeff(asi%i1:asi%i2,asi%j1:asi%j2,k,l+aerosolscatter%lOffset,m), &
   864                           asi%wlp, asi%xlp, pcoeff(l,m) )
   884                                 Aerosol_Type     , &  ! Input  see CRTM_Aerosol_Define.f90
   887                                 Reff_TL          , &  ! Input  TL effective radius (mm)
   894     TYPE(CRTM_AtmOptics_type), 
INTENT(IN)     :: AerosolScatter_TL
   895     INTEGER ,                  
INTENT(IN)     :: Aerosol_Type
   896     REAL(fp),                  
INTENT(IN)     :: w, ke, Reff_TL
   897     REAL(fp),                  
INTENT(OUT)    :: ke_TL
   898     REAL(fp),                  
INTENT(OUT)    :: w_TL
   899     REAL(fp),                  
INTENT(IN OUT) :: pcoeff_TL(0:,:)
   900     TYPE(ASinterp_type),       
INTENT(IN)     :: asi
   903     REAL(fp) :: f_int_TL, r_int_TL
   904     REAL(fp) :: f_TL(NPTS), r_TL(NPTS)
   905     REAL(fp) :: z_TL(NPTS,NPTS)
   906     TYPE(LPoly_type) :: wlp_TL, xlp_TL
   907     REAL(fp), 
POINTER :: z(:,:) => null()
   913     IF ( asi%f_outbound .AND. asi%r_outbound ) 
THEN   949     z => 
aeroc%ke(asi%i1:asi%i2,asi%j1:asi%j2,k)
   951                        z_tl, wlp_tl , xlp_tl , &  
   954     z => 
aeroc%w(asi%i1:asi%i2,asi%j1:asi%j2,k)
   956                        z_tl, wlp_tl , xlp_tl , &  
   959     IF (aerosolscatter_tl%n_Phase_Elements > 0 .and. aerosolscatter_tl%Include_Scattering ) 
THEN   960       pcoeff_tl(0,1) = 
zero   961       DO m = 1, aerosolscatter_tl%n_Phase_Elements
   962         DO l = 1, aerosolscatter_tl%n_Legendre_Terms
   963           z => 
aeroc%pcoeff(asi%i1:asi%i2,asi%j1:asi%j2,k,l+aerosolscatter_tl%lOffset,m)
   965                              z_tl, wlp_tl , xlp_tl , &  
   972         ke_tl = ke_tl * (
one - w) - ke/(
one -w) * w_tl
   990   SUBROUTINE get_aerosol_opt_ad( AerosolScatter_AD, & ! Input AerosolScatter AD structure
   991                                  Aerosol_Type     , & ! Input see CRTM_Aerosol_Define.f90
   994                                  ke_AD            , & ! AD Input extinction cross section
   995                                  w_AD             , & ! AD Input single scatter albedo
   996                                  pcoeff_AD        , & ! AD Input spherical Legendre coefficients
   997                                  Reff_AD          , & ! AD Output effective radius
  1000     TYPE(CRTM_AtmOptics_type), 
INTENT(IN)     :: AerosolScatter_AD
  1001     INTEGER ,                  
INTENT(IN)     :: Aerosol_Type
  1002     REAL(fp),                  
INTENT(IN)     :: ke, w
  1003     REAL(fp),                  
INTENT(IN OUT) :: ke_AD            
  1004     REAL(fp),                  
INTENT(IN OUT) :: w_AD             
  1005     REAL(fp),                  
INTENT(IN OUT) :: pcoeff_AD(0:,:)  
  1006     REAL(fp),                  
INTENT(IN OUT) :: Reff_AD          
  1007     TYPE(ASinterp_type),       
INTENT(IN)     :: asi
  1010     REAL(fp) :: f_int_AD, r_int_AD
  1011     REAL(fp) :: f_AD(NPTS), r_AD(NPTS)
  1012     REAL(fp) :: z_AD(NPTS,NPTS)
  1013     TYPE(LPoly_type) :: wlp_AD, xlp_AD
  1014     REAL(fp), 
POINTER :: z(:,:) => null()
  1021     IF ( asi%f_outbound .AND. asi%r_outbound ) 
THEN  1046     IF (aerosolscatter_ad%n_Phase_Elements > 0 .and. aerosolscatter_ad%Include_Scattering ) 
THEN  1047       DO m = 1, aerosolscatter_ad%n_Phase_Elements
  1048         DO l = 1, aerosolscatter_ad%n_Legendre_Terms
  1049           z => 
aeroc%pcoeff(asi%i1:asi%i2,asi%j1:asi%j2,k,l+aerosolscatter_ad%lOffset,m)
  1052                              z_ad, wlp_ad, xlp_ad    )  
  1055       pcoeff_ad(0,1) = 
zero  1059         w_ad  = w_ad - ke/(
one -w) * ke_ad
  1060         ke_ad = ke_ad * (
one - w)
  1068     z => 
aeroc%w(asi%i1:asi%i2,asi%j1:asi%j2,k)
  1071                        z_ad, wlp_ad , xlp_ad   )  
  1073     z => 
aeroc%ke(asi%i1:asi%i2,asi%j1:asi%j2,k)
  1076                        z_ad, wlp_ad , xlp_ad   )  
  1094     reff_ad = reff_ad + r_int_ad
 integer function, public crtm_compute_aerosolscatter_ad(Atm, AScat, AScat_AD, SensorIndex, ChannelIndex, Atm_AD, ASV)
 
subroutine get_aerosol_opt_tl(AerosolScatter_TL, Aerosol_Type, ke, w, Reff_TL, ke_TL, w_TL, pcoeff_TL, asi)
 
subroutine, public interp_3d_ad(z, ulp, vlp, wlp, z_int_AD, z_AD, ulp_AD, vlp_AD, wlp_AD)
 
subroutine, public interp_3d_tl(z, ulp, vlp, wlp, z_TL, ulp_TL, vlp_TL, wlp_TL, z_int_TL)
 
integer, parameter, public failure
 
real(fp), parameter, public onepointfive
 
real(fp), parameter, public zero
 
integer, parameter, public max_n_phase_elements
 
integer function, public crtm_compute_aerosolscatter_tl(Atm, AScat, Atm_TL, SensorIndex, ChannelIndex, AScat_TL, ASV)
 
integer, parameter, public fp
 
character(*), parameter module_version_id
 
integer, parameter thirtytwo_streams
 
integer, parameter sixteen_streams
 
integer, parameter, public max_n_legendre_terms
 
logical, parameter, public hgphase
 
integer, parameter two_streams
 
subroutine, public clear_lpoly(p)
 
subroutine, public lpoly_ad(x, x_int, p, p_AD, x_AD, x_int_AD)
 
real(fp), parameter, public bs_threshold
 
subroutine get_aerosol_opt_ad(AerosolScatter_AD, Aerosol_Type, ke, w, ke_AD, w_AD, pcoeff_AD, Reff_AD, asi)
 
integer function, public crtm_compute_aerosolscatter(Atm, SensorIndex, ChannelIndex, AScat, ASV)
 
integer, parameter, public max_n_aerosols
 
type(aerosolcoeff_type), target, save, public aeroc
 
real(fp), parameter, public aerosol_content_threshold
 
real(fp), parameter, public one
 
integer function aerosol_type_index(Aerosol_Type)
 
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
 
elemental subroutine, public asvar_destroy(self)
 
subroutine get_aerosol_opt(AerosolScatter, Frequency, Aerosol_Type, Reff, ke, w, pcoeff, asi)
 
subroutine, public interp_2d_ad(z, ulp, vlp, z_int_AD, z_AD, ulp_AD, vlp_AD)
 
subroutine, public lpoly(x, x_int, p)
 
integer, parameter, public npts
 
type(spccoeff_type), dimension(:), allocatable, save, public sc
 
elemental logical function, public asvar_associated(self)
 
integer, parameter, public max_n_layers
 
real(fp), parameter, public point_5
 
subroutine, public interp_3d(z, ulp, vlp, wlp, z_int)
 
integer, parameter four_streams
 
elemental subroutine, public asvar_create(self, n_Legendre_Terms, n_Phase_Elements, n_Layers, n_Aerosols)
 
integer, parameter six_streams
 
integer, parameter eight_streams
 
subroutine, public lpoly_tl(x, x_int, p, x_TL, x_int_TL, p_TL)
 
subroutine, public interp_1d(z, ulp, z_int)
 
integer, parameter, public success
 
subroutine, public interp_2d_tl(z, ulp, vlp, z_TL, ulp_TL, vlp_TL, z_int_TL)
 
subroutine, public interp_2d(z, ulp, vlp, z_int)