CRTM_AtmAbsorption.f90

Go to the documentation of this file.

!
! CRTM_AtmAbsorption
!
! Module containing routines to compute the optical depth profile
! due to gaseous absorption.
!
!
! CREATION HISTORY:
!       Modifed by:     Yong Han, NESDIS/STAR 25-June-2008
!                       yong.han@noaa.gov


MODULE crtm_atmabsorption

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds,                 ONLY: fp
  USE message_handler,            ONLY: success, failure, display_message
  USE crtm_parameters,            ONLY: zero, &
                                        odas_algorithm,  odps_algorithm, odssu_algorithm
  USE crtm_atmosphere_define,     ONLY: crtm_atmosphere_type
  USE crtm_taucoeff,              ONLY: tc
  USE crtm_ancillaryinput_define, ONLY: crtm_ancillaryinput_type
  USE crtm_geometryinfo_define,   ONLY: crtm_geometryinfo_type, &
                                        crtm_geometryinfo_getvalue
  USE crtm_atmoptics_define,      ONLY: crtm_atmoptics_type
  USE crtm_predictor_define,      ONLY: crtm_predictor_type
  ! ODAS modules
  USE odas_atmabsorption,         ONLY: odas_aavar_type => ivar_type , &
                                        odas_compute_atmabsorption   , &
                                        odas_compute_atmabsorption_tl, &
                                        odas_compute_atmabsorption_ad
  ! ODPS modules
  USE odps_atmabsorption,         ONLY: odps_aavar_type => ivar_type , &
                                        odps_compute_atmabsorption   , &
                                        odps_compute_atmabsorption_tl, &
                                        odps_compute_atmabsorption_ad
  ! ODSSU modules
  USE odssu_atmabsorption,        ONLY: odssu_aavar_type => ivar_type , &
                                        odssu_compute_weights         , &
                                        odssu_compute_atmabsorption   , &
                                        odssu_compute_atmabsorption_tl, &
                                        odssu_compute_atmabsorption_ad
  ! ODZeeman modules
  USE odzeeman_atmabsorption,     ONLY: zeeman_compute_atmabsorption,    &
                                        zeeman_compute_atmabsorption_tl, &
                                        zeeman_compute_atmabsorption_ad, &
                                        is_zeeman_channel

  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Datatypes
  PUBLIC :: ivar_type
  ! Procedures
  PUBLIC :: crtm_compute_atmabsorption
  PUBLIC :: crtm_compute_atmabsorption_tl
  PUBLIC :: crtm_compute_atmabsorption_ad


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: CRTM_AtmAbsorption.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Message string length
  INTEGER, PARAMETER :: ml = 256


  ! ---------------------------------------------
  ! Structure to hold AtmAbsorption forward model
  ! variables across FWD, TL, and AD calls
  ! ---------------------------------------------
  !:tdoc+:
  TYPE :: ivar_type
    PRIVATE
    TYPE(odas_aavar_type)   :: odas
    TYPE(odps_aavar_type)   :: odps
    TYPE(odssu_aavar_type)  :: odssu
  END TYPE ivar_type
  !:tdoc-:


CONTAINS


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

!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Compute_AtmAbsorption
!
! PURPOSE:
!       Subroutine to calculate the layer optical depths due to gaseous
!       absorption for a given sensor and channel and atmospheric profile.
!       It is a wrapper which calls the algorithm-specific routine.
!
! CALLING SEQUENCE:
!       CALL CRTM_Compute_AtmAbsorption( &
!              SensorIndex   , &  ! Input
!              ChannelIndex  , &  ! Input
!              AncillaryInput, &  ! Input
!              Predictor     , &  ! Input
!              AtmOptics     , &  ! Output
!              iVar            )  ! Internal variable output
!
! INPUTS:
!       SensorIndex:
!         Sensor index id. This is a unique index associated
!         with a (supported) sensor used to access the
!         shared coefficient data for a particular sensor.
!         See the ChannelIndex argument.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       ChannelIndex:
!         Channel index id. This is a unique index associated
!         with a (supported) sensor channel used to access the
!         shared coefficient data for a particular sensor's
!         channel.
!         See the SensorIndex argument.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       AncillaryInput:
!         Structure holding ancillary inputs
!         UNITS:      N/A
!         TYPE:       AncillaryInput_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       Predictor:
!         Structure containing the integrated absorber and
!         predictor profile data.
!         UNITS:      N/A
!         TYPE:       CRTM_Predictor_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       AtmOptics:
!         Structure containing computed optical depth profile data.
!         UNITS:      N/A
!         TYPE:       CRTM_AtmOptics_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN OUT)
!
!       iVar:
!         Structure containing internal variables required for
!         subsequent tangent-linear or adjoint model calls.
!         The contents of this structure are NOT accessible
!         outside of this module.
!         UNITS:      N/A
!         TYPE:       iVar_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!------------------------------------------------------------------------------

  SUBROUTINE crtm_compute_atmabsorption( &
    SensorIndex   , &  ! Input
    ChannelIndex  , &  ! Input
    AncillaryInput, &  ! Input
    Predictor     , &  ! Input
    AtmOptics     , &  ! Output
    iVar            )  ! Internal variable output
    ! Arguments
    INTEGER                       , INTENT(IN)     :: sensorindex
    INTEGER                       , INTENT(IN)     :: channelindex
    TYPE(crtm_ancillaryinput_type), INTENT(IN)     :: ancillaryinput
    TYPE(crtm_predictor_type)     , INTENT(IN OUT) :: predictor
    TYPE(crtm_atmoptics_type)     , INTENT(IN OUT) :: atmoptics
    TYPE(ivar_type)               , INTENT(IN OUT) :: ivar
    ! Local variables
    INTEGER :: idx

    ! Is this a Zeeman channel?
    idx = tc%ZSensor_LoIndex(sensorindex)
    IF( idx > 0 )THEN
      IF( is_zeeman_channel(tc%ODZeeman(idx), channelindex) )THEN
        CALL zeeman_compute_atmabsorption( &
               tc%ODZeeman(idx)  , &  ! Input
               channelindex      , &  ! Input
               predictor%ODZeeman, &  ! Input
               atmoptics           )  ! Output
        RETURN
      END IF
    END IF


    ! Call required model
    idx = tc%Sensor_LoIndex(sensorindex)
    SELECT CASE( tc%Algorithm_ID(sensorindex) )

      ! ODAS transmittance model
      CASE( odas_algorithm )
        CALL odas_compute_atmabsorption( &
               tc%ODAS(idx)  , &  ! Input
               channelindex  , &  ! Input
               predictor%ODAS, &  ! Input
               atmoptics     , &  ! Output
               ivar%ODAS       )  ! Internal variable output

      ! ODPS transmittance model
      CASE( odps_algorithm )
        CALL odps_compute_atmabsorption( &
               tc%ODPS(idx)  , &  ! Input
               channelindex  , &  ! Input
               predictor%ODPS, &  ! Input
               atmoptics       )  ! Output

      ! SSU instrument specific
      CASE( odssu_algorithm )
        CALL odssu_compute_weights( &
               ancillaryinput%SSU, &  ! Input
               sensorindex       , &  ! Input
               channelindex      , &  ! Input
               ivar%ODSSU          )  ! Internal variable output

        ! ...Select particular transmittance algorithm for this instrument
        SELECT CASE( tc%ODSSU(idx)%subAlgorithm )
          CASE( odas_algorithm )
            CALL odssu_compute_atmabsorption( &
                   tc%Sensor_LoIndex(sensorindex), &  ! Input
                   channelindex                  , &  ! Input
                   predictor%ODAS                , &  ! Input
                   atmoptics                     , &  ! Output
                   ivar%ODSSU                      )  ! Internal variable output
          CASE( odps_algorithm )
            CALL odssu_compute_atmabsorption( &
                   tc%Sensor_LoIndex(sensorindex), &  ! Input
                   channelindex                  , &  ! Input
                   predictor%ODPS                , &  ! Input
                   atmoptics                     , &  ! Output
                   ivar%ODSSU                      )  ! Internal variable output
        END SELECT
    END SELECT

  END SUBROUTINE crtm_compute_atmabsorption


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Compute_AtmAbsorption_TL
!
! PURPOSE:
!       Subroutine to calculate the tangent-linear layer optical depths due
!       to gaseous absorption for a given sensor and channel and atmospheric
!       profile. It is a wrapper which calls the algorithm specific routine.
!
! CALLING SEQUENCE:
!       CALL CRTM_Compute_AtmAbsorption_TL( &
!              SensorIndex   , &  ! Input
!              ChannelIndex  , &  ! Input
!              Predictor     , &  ! FWD Input
!              Predictor_TL  , &  ! TL Input
!              AtmOptics_TL  , &  ! TL Output
!              iVar            )  ! Internal variable input
!
! INPUTS:
!       SensorIndex:
!         Sensor index id. This is a unique index associated
!         with a (supported) sensor used to access the
!         shared coefficient data for a particular sensor.
!         See the ChannelIndex argument.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       ChannelIndex:
!         Channel index id. This is a unique index associated
!         with a (supported) sensor channel used to access the
!         shared coefficient data for a particular sensor's
!         channel.
!         See the SensorIndex argument.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       Predictor:
!         Structure containing the integrated absorber and
!         predictor profile data.
!         UNITS:      N/A
!         TYPE:       CRTM_Predictor_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       Predictor_TL:
!         Structure containing the tangent-linearintegrated absorber and
!         predictor profile data.
!         UNITS:      N/A
!         TYPE:       CRTM_Predictor_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       iVar:
!         Structure containing internal variables required for
!         subsequent tangent-linear or adjoint model calls.
!         The contents of this structure are NOT accessible
!         outside of this module.
!         UNITS:      N/A
!         TYPE:       iVar_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       AtmOptics_TL:
!         Structure containing the computed tangent-linear
!         optical depth profile data.
!         UNITS:      N/A
!         TYPE:       CRTM_AtmOptics_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN OUT)
!
! :sdoc-:
!------------------------------------------------------------------------------

  SUBROUTINE crtm_compute_atmabsorption_tl( &
    SensorIndex   , &  ! Input
    ChannelIndex  , &  ! Input
    Predictor     , &  ! Input
    Predictor_TL  , &  ! Input
    AtmOptics_TL  , &  ! Output
    iVar            )  ! Internal variable input
    ! Arguments
    INTEGER                  , INTENT(IN)     :: sensorindex
    INTEGER                  , INTENT(IN)     :: channelindex
    TYPE(crtm_predictor_type), INTENT(IN)     :: predictor
    TYPE(crtm_predictor_type), INTENT(IN OUT) :: predictor_tl
    TYPE(crtm_atmoptics_type), INTENT(IN OUT) :: atmoptics_tl
    TYPE(ivar_type)          , INTENT(IN)     :: ivar
    ! Local variables
    INTEGER :: idx

    ! Is this a Zeeman channel?
    idx = tc%ZSensor_LoIndex(sensorindex)
    IF( idx > 0 )THEN
      IF( is_zeeman_channel(tc%ODZeeman(idx), channelindex) )THEN
        CALL zeeman_compute_atmabsorption_tl( &
               tc%ODZeeman(idx)     , &  ! Input
               channelindex         , &  ! Input
               predictor%ODZeeman   , &  ! Input
               predictor_tl%ODZeeman, &  ! Input
               atmoptics_tl           )  ! Output
        RETURN
      END IF
    END IF


    ! Call required model
    idx = tc%Sensor_LoIndex(sensorindex)
    SELECT CASE( tc%Algorithm_ID(sensorindex) )

      ! ODAS transmittance model
      CASE( odas_algorithm )
        CALL odas_compute_atmabsorption_tl( &
               tc%ODAS(idx)     , &  ! Input
               channelindex     , &  ! Input
               predictor%ODAS   , &  ! Input
               predictor_tl%ODAS, &  ! Input
               atmoptics_tl     , &  ! Output
               ivar%ODAS          )  ! Internal variable input

      ! ODPS transmittance model
      CASE( odps_algorithm )
        CALL odps_compute_atmabsorption_tl( &
               tc%ODPS(idx)     , &  ! Input
               channelindex     , &  ! Input
               predictor%ODPS   , &  ! Input
               predictor_tl%ODPS, &  ! Input
               atmoptics_tl       )  ! Output

      ! SSU instrument specific
      CASE( odssu_algorithm )

        ! ...Select particular transmittance algorithm for this instrument
        SELECT CASE( tc%ODSSU(idx)%subAlgorithm )
          CASE( odas_algorithm )
            CALL odssu_compute_atmabsorption_tl( &
                   tc%Sensor_LoIndex(sensorindex), &  ! Input
                   channelindex                  , &  ! Input
                   predictor%ODAS                , &  ! Input
                   predictor_tl%ODAS             , &  ! Input
                   atmoptics_tl                  , &  ! Output
                   ivar%ODSSU                      )  ! Internal variable input
          CASE( odps_algorithm )
            CALL odssu_compute_atmabsorption_tl( &
                   tc%Sensor_LoIndex(sensorindex), &  ! Input
                   channelindex                  , &  ! Input
                   predictor%ODPS                , &  ! Input
                   predictor_tl%ODPS             , &  ! Input
                   atmoptics_tl                  , &  ! Output
                   ivar%ODSSU                      )  ! Internal variable input
        END SELECT
    END SELECT

  END SUBROUTINE crtm_compute_atmabsorption_tl


!--------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Compute_AtmAbsorption_AD
!
! PURPOSE:
!       Subroutine to calculate the layer optical depth adjoints due to
!       gaseous absorption for a given sensor and channel and atmospheric
!       profile. It is a wrapper which calls the algorithm specific routine.
!
! CALLING SEQUENCE:
!       CALL CRTM_Compute_AtmAbsorption_AD( &
!              SensorIndex , &  ! Input
!              ChannelIndex, &  ! Input
!              Predictor   , &  ! FWD Input
!              AtmOptics_AD, &  ! AD  Input
!              Predictor_AD, &  ! AD  Output
!              iVar          )  ! Internal variable input
!
! INPUT ARGUMENTS:
!       SensorIndex:
!         Sensor index id. This is a unique index associated
!         with a (supported) sensor used to access the
!         shared coefficient data for a particular sensor.
!         See the ChannelIndex argument.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       ChannelIndex:
!         Channel index id. This is a unique index associated
!         with a (supported) sensor channel used to access the
!         shared coefficient data for a particular sensor's
!         channel.
!         See the SensorIndex argument.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       Predictor:
!         Structure containing the integrated absorber and
!         predictor profile data.
!         UNITS:      N/A
!         TYPE:       CRTM_Predictor_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!       AtmOptics_AD:
!         Structure containing the computed adjoint optical depth profile data.
!         UNITS:      N/A
!         TYPE:       CRTM_AtmOptics_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN OUT)
!
!       iVar:
!         Structure containing internal variables required for
!         subsequent tangent-linear or adjoint model calls.
!         The contents of this structure are NOT accessible
!         outside of this module.
!         UNITS:      N/A
!         TYPE:       iVar_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       Predictor_AD:
!         Structure containing the adjoint integrated absorber and
!         predictor profile data.
!         UNITS:      N/A
!         TYPE:       CRTM_Predictor_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN OUT)
!
! SIDE EFFECTS:
!       Components of the AtmOptics_AD structure argument are modified
!       in this function.
!
!:sdoc-:
!------------------------------------------------------------------------------

  SUBROUTINE crtm_compute_atmabsorption_ad( &
    SensorIndex , &  ! Input
    ChannelIndex, &  ! Input
    Predictor   , &  ! FWD Input
    AtmOptics_AD, &  ! AD  Input
    Predictor_AD, &  ! AD  Output
    iVar          )  ! Internal variable input
    ! Arguments
    INTEGER                  , INTENT(IN)     :: sensorindex
    INTEGER                  , INTENT(IN)     :: channelindex
    TYPE(crtm_predictor_type), INTENT(IN)     :: predictor
    TYPE(crtm_atmoptics_type), INTENT(IN OUT) :: atmoptics_ad
    TYPE(crtm_predictor_type), INTENT(IN OUT) :: predictor_ad
    TYPE(ivar_type)          , INTENT(IN)     :: ivar
    ! Local variables
    INTEGER :: idx

    ! Is this a Zeeman channel?
    idx = tc%ZSensor_LoIndex(sensorindex)
    IF( idx > 0 )THEN
      IF( is_zeeman_channel(tc%ODZeeman(idx), channelindex) )THEN
        CALL zeeman_compute_atmabsorption_ad( &
               tc%ODZeeman(idx)     , &  ! Input
               channelindex         , &  ! Input
               predictor%ODZeeman   , &  ! Input
               atmoptics_ad         , &  ! AD Input
               predictor_ad%ODZeeman  )  ! AD Output
        RETURN
      END IF
    END IF

    ! Call required model
    idx = tc%Sensor_LoIndex(sensorindex)
    SELECT CASE( tc%Algorithm_ID(sensorindex) )

      ! ODAS transmittance model
      CASE( odas_algorithm )
        CALL odas_compute_atmabsorption_ad( &
               tc%ODAS(idx)     , &  ! Input
               channelindex     , &  ! Input
               predictor%ODAS   , &  ! FWD Input
               atmoptics_ad     , &  ! AD Input
               predictor_ad%ODAS, &  ! AD Output
               ivar%ODAS          )  ! Internal variable input

      ! ODPS transmittance model
      CASE( odps_algorithm )
        CALL odps_compute_atmabsorption_ad( &
               tc%ODPS(idx)     , &  ! Input
               channelindex     , &  ! Input
               predictor%ODPS   , &  ! FWD Input
               atmoptics_ad     , &  ! AD Input
               predictor_ad%ODPS  )  ! AD Output

      ! SSU instrument specific
      CASE( odssu_algorithm )

        ! Select particular transmittance algorithm for this instrument
        SELECT CASE( tc%ODSSU(idx)%subAlgorithm )
          CASE( odas_algorithm )
            CALL odssu_compute_atmabsorption_ad( &
                   tc%Sensor_LoIndex(sensorindex), &  ! Input
                   channelindex                  , &  ! Input
                   predictor%ODAS                , &  ! FWD Input
                   atmoptics_ad                  , &  ! AD Input
                   predictor_ad%ODAS             , &  ! AD Output
                   ivar%ODSSU                      )  ! Internal variable input
          CASE( odps_algorithm )
            CALL odssu_compute_atmabsorption_ad( &
                   tc%Sensor_LoIndex(sensorindex), &  ! Input
                   channelindex                  , &  ! Input
                   predictor%ODPS                , &  ! FWD Input
                   atmoptics_ad                  , &  ! AD Input
                   predictor_ad%ODPS             , &  ! AD Output
                   ivar%ODSSU                      )  ! Internal variable input
        END SELECT
    END SELECT

  END SUBROUTINE crtm_compute_atmabsorption_ad

END MODULE crtm_atmabsorption