CRTM_MoleculeScatter.f90

Go to the documentation of this file.

!
! CRTM_MoleculeScatter
!
! Module to compute molecule optical properties.
!       
!
! CREATION HISTORY:
!       Written by:     Quanhua Liu, 03-Oct-2008
!                       Quanhua.Liu@noaa.gov
!

MODULE crtm_moleculescatter

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds            , ONLY: fp
  USE message_handler       , ONLY: success, failure, display_message
  USE crtm_parameters       , ONLY: zero
  USE crtm_atmosphere_define, ONLY: crtm_atmosphere_type
  USE crtm_atmoptics_define , ONLY: crtm_atmoptics_type
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  PRIVATE
  PUBLIC :: crtm_compute_moleculescatter
  PUBLIC :: crtm_compute_moleculescatter_tl
  PUBLIC :: crtm_compute_moleculescatter_ad


  ! -----------------
  ! Module parameters
  ! -----------------
  ! RCS Id for the module
  CHARACTER(*), PARAMETER :: module_rcs_id = &
  '$Id: CRTM_MoleculeScatter.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Rayleigh factor
  REAL(fp),     PARAMETER :: rfactor = 27.0363_fp  ! = 287.0/9.8*923.1907/1000.0


CONTAINS


!################################################################################
!################################################################################
!##                                                                            ##
!##                         ## PUBLIC MODULE ROUTINES ##                       ##
!##                                                                            ##
!################################################################################
!################################################################################

!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Compute_MoleculeScatter
!
! PURPOSE:
!       Function to compute molecular scattering and extinction
!
! CALLING SEQUENCE:
!       Error_Status =  CRTM_Compute_MoleculeScatter( Wavenumber             , &  ! Input
!                                                     Atmosphere             , &  ! Input
!                                                     AtmOptics              , &  ! In/Output
!                                                     Message_Log=Message_Log  )  ! Error messaging
!
! INPUT ARGUMENTS:
!       Wavenumber:      Spectral frequency
!                        UNITS:      Inverse centimetres (cm^-1)
!                        TYPE:       REAL(fp)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       Atmosphere:      Structure containing the atmospheric
!                        profile data.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_Atmosphere_type)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       AtmOptics:       Structure containing the atmospheric optics data
!                        to which the molecular scattering and extinction
!                        component is added.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_AtmOptics_type)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUT ARGUMENTS:
!       Message_Log:     Character string specifying a filename in which any
!                        messages will be logged. If not specified, or if an
!                        error occurs opening the log file, the default action
!                        is to output messages to standard output.
!                        UNITS:      N/A
!                        TYPE:       CHARACTER(*)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!       Error_Status:    The return value is an integer defining the error status.
!                        The error codes are defined in the ERROR_HANDLER module.
!                        If == SUCCESS the computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION crtm_compute_moleculescatter( Wavenumber,     &  ! Input
                                         Atmosphere,     &  ! Input
                                         AtmOptics,      &  ! In/Output
                                         Message_Log )   &  ! Error messaging
                                      result( error_status )
    ! Arguments
    REAL(fp),                   INTENT(IN)     :: wavenumber
    TYPE(crtm_atmosphere_type), INTENT(IN)     :: atmosphere
    TYPE(crtm_atmoptics_type), INTENT(IN OUT) :: atmoptics 
    CHARACTER(*), OPTIONAL,     INTENT(IN)     :: message_log
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Compute_MoleculeScatter'

    ! Local variables
    INTEGER :: k
    REAL(fp) :: wavelength , opt_unit, optical_depth

    ! Setup
    ! -----
    error_status = success
    
    ! Check input
    IF( wavenumber > zero ) THEN
      wavelength = compute_wavelength( wavenumber )
    ELSE
      error_status = failure
      CALL display_message(routine_name,'Invalid wavenumber',error_status,message_log=message_log)
      RETURN
    END IF


    ! Calculate the scattering parameters
    ! -----------------------------------
    ! Compute optical scaling unit                                                                   
    CALL raylo(wavelength, opt_unit)

    ! Loop over atmospheric layers
    DO k = 1, atmosphere%n_Layers
      optical_depth = rfactor*opt_unit*(atmosphere%Level_Pressure(k)-atmosphere%Level_Pressure(k-1))
      atmoptics%Optical_Depth(k)         = atmoptics%Optical_Depth(k)         + optical_depth 
      atmoptics%Single_Scatter_Albedo(k) = atmoptics%Single_Scatter_Albedo(k) + optical_depth 

      ! The Rayleigh spherical expansion coefficients are constant.
      atmoptics%Phase_Coefficient(2,1,k) = atmoptics%Phase_Coefficient(2,1,k) + &
                                           0.25_fp * optical_depth 

! FOR FUTURE IMPLEMENTATION
!      ! Compute atmospheric polarisatin component
!      AtmOptics%Phase_Coefficient(2,2,k) = AtmOptics%Phase_Coefficient(2,2,k) + &
!                                           1.5_fp * Optical_Depth
!      AtmOptics%Phase_Coefficient(1,4,k) = AtmOptics%Phase_Coefficient(1,4,k) + &
!                                           0.75_fp * Optical_Depth 
!      AtmOptics%Phase_Coefficient(2,5,k) = AtmOptics%Phase_Coefficient(2,5,k) + &
!                                           0.612372_fp * Optical_Depth   
    END DO
  END FUNCTION crtm_compute_moleculescatter


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Compute_MoleculeScatter_TL
!
! PURPOSE:
!       Function to compute the tangent-linear molecular scattering and
!       extinction
!
! CALLING SEQUENCE:
!       Error_Status =  CRTM_Compute_MoleculeScatter_TL( Wavenumber             , &  ! Input
!                                                        Atmosphere_TL          , &  ! Input
!                                                        AtmOptics_TL           , &  ! In/Output
!                                                        Message_Log=Message_Log  )  ! Error messaging
!
! INPUT ARGUMENTS:
!       Wavenumber:      Spectral frequency
!                        UNITS:      Inverse centimetres (cm^-1)
!                        TYPE:       REAL(fp)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       Atmosphere_TL:   Structure containing the tangent-linear atmospheric
!                        profile data.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_Atmosphere_type)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       AtmOptics_TL:    Structure containing the tangent-linear atmospheric
!                        optics data to which the molecular scattering and
!                        extinction component is added.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_AtmOptics_type)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUT ARGUMENTS:
!       Message_Log:     Character string specifying a filename in which any
!                        messages will be logged. If not specified, or if an
!                        error occurs opening the log file, the default action
!                        is to output messages to standard output.
!                        UNITS:      N/A
!                        TYPE:       CHARACTER(*)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!       Error_Status:    The return value is an integer defining the error status.
!                        The error codes are defined in the ERROR_HANDLER module.
!                        If == SUCCESS the computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION crtm_compute_moleculescatter_tl( Wavenumber,     &  ! Input
                                            Atmosphere_TL,  &  ! TL Input
                                            AtmOptics_TL,   &  ! TL Output
                                            Message_Log )   &  ! Error messaging
                                         result( error_status )
    ! Arguments
    REAL(fp),                   INTENT(IN)     :: wavenumber
    TYPE(crtm_atmosphere_type), INTENT(IN)     :: atmosphere_tl
    TYPE(crtm_atmoptics_type), INTENT(IN OUT) :: atmoptics_tl
    CHARACTER(*), OPTIONAL,     INTENT(IN)     :: message_log
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Compute_MoleculeScatter_TL'
    ! Local variables
    INTEGER :: k
    REAL(fp) :: wavelength , opt_unit, optical_depth_tl

    ! Setup
    ! -----
    error_status = success
    
    ! Check input
    IF( wavenumber > zero ) THEN
      wavelength = compute_wavelength( wavenumber )
    ELSE
      error_status = failure
      CALL display_message(routine_name,'Invalid wavenumber',error_status,message_log=message_log)
      RETURN
    END IF

    ! Calculate the TL scattering parameters
    ! --------------------------------------
    CALL raylo(wavelength, opt_unit)
    DO k = 1, atmosphere_tl%n_Layers
      optical_depth_tl = rfactor*opt_unit*(atmosphere_tl%Level_Pressure(k)-atmosphere_tl%Level_Pressure(k-1))
      atmoptics_tl%Optical_Depth(k)         = atmoptics_tl%Optical_Depth(k)         + optical_depth_tl
      atmoptics_tl%Single_Scatter_Albedo(k) = atmoptics_tl%Single_Scatter_Albedo(k) + optical_depth_tl
      ! The Rayleigh spherical expansion coefficients are constant.
      atmoptics_tl%Phase_Coefficient(2,1,k) = atmoptics_tl%Phase_Coefficient(2,1,k) + &
                                              0.25_fp * optical_depth_tl
    END DO

  END FUNCTION crtm_compute_moleculescatter_tl


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Compute_MoleculeScatter_AD
!
! PURPOSE:
!       Function to compute the molecular scattering and extinction adjoint.
!
! CALLING SEQUENCE:
!       Error_Status =  CRTM_Compute_MoleculeScatter_AD( Wavenumber             , &  ! Input
!                                                        AtmOptics_AD           , &  ! In/Output
!                                                        Atmosphere_AD          , &  ! Input
!                                                        Message_Log=Message_Log  )  ! Error messaging
!
! INPUT ARGUMENTS:
!       Wavenumber:      Spectral frequency
!                        UNITS:      Inverse centimetres (cm^-1)
!                        TYPE:       REAL(fp)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       AtmOptics_AD:    Structure containing the adjoint atmospheric
!                        optics data from which the molecular scattering and
!                        extinction component is taken.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_AtmOptics_type)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN OUT)
!
! OUTPUT ARGUMENTS:
!       Atmosphere_AD:   Structure containing the adjoint atmospheric
!                        profile data.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_Atmosphere_type)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUT ARGUMENTS:
!       Message_Log:     Character string specifying a filename in which any
!                        messages will be logged. If not specified, or if an
!                        error occurs opening the log file, the default action
!                        is to output messages to standard output.
!                        UNITS:      N/A
!                        TYPE:       CHARACTER(*)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!       Error_Status:    The return value is an integer defining the error status.
!                        The error codes are defined in the ERROR_HANDLER module.
!                        If == SUCCESS the computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION crtm_compute_moleculescatter_ad( Wavenumber,     &  ! Input
                                            AtmOptics_AD,   &  ! AD Input
                                            Atmosphere_AD,  &  ! AD Output
                                            Message_Log )   &  ! Error messaging
                                         result( error_status )
    ! Arguments
    REAL(fp),                   INTENT(IN)     :: wavenumber
    TYPE(crtm_atmoptics_type), INTENT(IN OUT) :: atmoptics_ad
    TYPE(crtm_atmosphere_type), INTENT(IN OUT) :: atmosphere_ad
    CHARACTER(*), OPTIONAL,     INTENT(IN)     :: message_log
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Compute_MoleculeScatter_AD'
    INTEGER :: k
    REAL(fp) :: wavelength , opt_unit, optical_depth_ad

    ! Setup
    ! -----
    error_status = success
    
    ! Check input
    IF( wavenumber > zero ) THEN
      wavelength = compute_wavelength( wavenumber )
    ELSE
      error_status = failure
      CALL display_message(routine_name,'Invalid wavenumber',error_status,message_log=message_log)
      RETURN
    END IF

    ! Calculate the AD scattering parameters
    ! --------------------------------------
    CALL raylo(wavelength, opt_unit)
    DO k = 1, atmosphere_ad%n_Layers
      optical_depth_ad = atmoptics_ad%Single_Scatter_Albedo(k)
      optical_depth_ad = optical_depth_ad + 0.25_fp * atmoptics_ad%Phase_Coefficient(2,1,k)
      atmosphere_ad%Level_Pressure(k)   = atmosphere_ad%Level_Pressure(k)   + &
                                            rfactor*opt_unit*optical_depth_ad
      atmosphere_ad%Level_Pressure(k-1) = atmosphere_ad%Level_Pressure(k-1) - &
                                            rfactor*opt_unit*optical_depth_ad
    END DO
    
  END FUNCTION crtm_compute_moleculescatter_ad


!##################################################################################
!##################################################################################
!##                                                                              ##
!##                          ## PRIVATE MODULE ROUTINES ##                       ##
!##                                                                              ##
!##################################################################################
!##################################################################################

  ! ---------------------------------------------------------------------
  ! Simple function to convert wavenumber (cm^-1) to wavelength (microns)
  ! ---------------------------------------------------------------------
  FUNCTION compute_wavelength( Wavenumber ) RESULT( Wavelength )
    REAL(fp), INTENT(IN) :: wavenumber
    REAL(fp) :: wavelength
    REAL(fp), PARAMETER :: wfactor = 10000.0_fp
    wavelength = wfactor/wavenumber
  END FUNCTION compute_wavelength

  
  !--------------------------------------------------------------------
  !   OPTICAL DEPTH FOR Molecule SCATTERING
  ! ARGUMENTS -
  !     WE      R*8    IN      WAVELENGTH ( MICRO METER)
  !     RAYLO   R*8    OUT     OPTICAL DEPTH PER KM
  !--------------------------------------------------------------------
  SUBROUTINE raylo(WE, OPT)
     REAL(fp), INTENT(IN)  :: WE
     REAL(fp), INTENT(OUT) :: OPT
     REAL(fp), PARAMETER :: DELT = 0.0279_fp
     REAL(fp) :: X1, DY, X2, AS
     x1=1.0_fp/(we*we)
     as=(6432.8_fp+2949810.0_fp/(146.0_fp-x1)+25540.0_fp/(41.0_fp-x1))*1.0e-08_fp + 1.0_fp
     x2=(as*as - 1.0_fp)**2
     dy = (6.0_fp+3.0_fp*delt)/(6.0_fp-7.0_fp*delt)
     opt = x2*dy/(we**4)
  END SUBROUTINE raylo

END MODULE crtm_moleculescatter