<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
!
! 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
<A NAME='CRTM_ATMABSORPTION'><A href='../../html_code/crtm/CRTM_AtmAbsorption.f90.html#CRTM_ATMABSORPTION' TARGET='top_target'><IMG SRC="../../gif/bar_purple.gif" border=0></A>
MODULE CRTM_AtmAbsorption 4,13
! -----------------
! 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 29405 2013-06-20 20:19:52Z 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-:
!------------------------------------------------------------------------------
<A NAME='CRTM_COMPUTE_ATMABSORPTION'><A href='../../html_code/crtm/CRTM_AtmAbsorption.f90.html#CRTM_COMPUTE_ATMABSORPTION' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE CRTM_Compute_AtmAbsorption( & 4,6
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-:
!------------------------------------------------------------------------------
<A NAME='CRTM_COMPUTE_ATMABSORPTION_TL'><A href='../../html_code/crtm/CRTM_AtmAbsorption.f90.html#CRTM_COMPUTE_ATMABSORPTION_TL' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE CRTM_Compute_AtmAbsorption_TL( & 1,5
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-:
!------------------------------------------------------------------------------
<A NAME='CRTM_COMPUTE_ATMABSORPTION_AD'><A href='../../html_code/crtm/CRTM_AtmAbsorption.f90.html#CRTM_COMPUTE_ATMABSORPTION_AD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE CRTM_Compute_AtmAbsorption_AD( & 2,5
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