<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
!
! ODPS_AtmAbsorption
!
! Module containing routines to compute the optical depth profile
! due to gaseous absorption using the Optical Depth Pressure Space
! (ODPS) algorithm
!
!
! CREATION HISTORY:
! Written by: Yong Han & Yong Chen, JCSDA, NOAA/NESDIS 20-Jun-2008
! TL,AD: Tong Zhu, CIRA/CSU@NOAA/NESDIS 06-Jan-2009
!
<A NAME='ODPS_ATMABSORPTION'><A href='../../html_code/crtm/ODPS_AtmAbsorption.f90.html#ODPS_ATMABSORPTION' TARGET='top_target'><IMG SRC="../../gif/bar_purple.gif" border=0></A>
MODULE ODPS_AtmAbsorption 2,8
! -----------------
! Environment setup
! -----------------
! Module use
USE Type_Kinds
, ONLY: fp
USE CRTM_Parameters, ONLY: ZERO, LIMIT_EXP, LIMIT_LOG
USE CRTM_Atmosphere_Define, ONLY: CRTM_Atmosphere_type
USE CRTM_GeometryInfo_Define, ONLY: CRTM_GeometryInfo_type, &
CRTM_GeometryInfo_GetValue
USE CRTM_AtmOptics_Define, ONLY: CRTM_AtmOptics_type
USE ODPS_Define, ONLY: ODPS_type , &
SIGNIFICANCE_OPTRAN
USE ODPS_Predictor_Define, ONLY: ODPS_Predictor_type, &
PAFV_Associated , &
MAX_OPTRAN_ORDER , &
MAX_OPTRAN_USED_PREDICTORS
USE ODPS_CoordinateMapping, ONLY: Interpolate_Profile , &
Interpolate_Profile_F1_TL, &
Interpolate_Profile_F1_AD, &
Compute_Interp_Index
! Disable implicit typing
IMPLICIT NONE
! ------------
! Visibilities
! ------------
! Everything private by default
PRIVATE
! Datatypes
PUBLIC :: iVar_type
! Procedures
PUBLIC :: ODPS_Compute_AtmAbsorption
PUBLIC :: ODPS_Compute_AtmAbsorption_TL
PUBLIC :: ODPS_Compute_AtmAbsorption_AD
! -----------------
! Module parameters
! -----------------
CHARACTER(*), PRIVATE, PARAMETER :: MODULE_VERSION_ID = &
'$Id: $'
! Maximum allowed layer optical depth
REAL(fp), PARAMETER :: MAX_OD = 20.0_fp
! ------------------------------------------
! Structure definition to hold forward model
! variables across FWD, TL, and AD calls
! ------------------------------------------
TYPE :: iVar_type
PRIVATE
INTEGER :: dummy
END TYPE iVar_type
CONTAINS
!################################################################################
!################################################################################
!## ##
!## ## PUBLIC MODULE ROUTINES ## ##
!## ##
!################################################################################
!################################################################################
!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ODPS_Compute_AtmAbsorption
!
! PURPOSE:
! Subroutine to calculate the layer optical depths due to gaseous
! absorption for a given sensor and channel and atmospheric profile.
!
! CALLING SEQUENCE:
! CALL ODPS_Compute_AtmAbsorption( &
! TC , &
! ChannelIndex , &
! Predictor , &
! AtmAbsorption )
!
! INPUTS:
! TC:
! ODPS structure holding tau coefficients
! UNITS: N/A
! TYPE: ODPS_type
! 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.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor:
! Structure containing the predictor profile data.
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
! AtmAbsorption:
! Structure containing computed optical depth profile data.
! UNITS: N/A
! TYPE: CRTM_AtmOptics_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!------------------------------------------------------------------------------
<A NAME='ODPS_COMPUTE_ATMABSORPTION'><A href='../../html_code/crtm/ODPS_AtmAbsorption.f90.html#ODPS_COMPUTE_ATMABSORPTION' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ODPS_Compute_AtmAbsorption( & 3,4
TC , & ! Input
ChannelIndex , & ! Input
Predictor , & ! Input
AtmAbsorption ) ! Output
! Arguments
TYPE(ODPS_type) , INTENT(IN) :: TC
INTEGER , INTENT(IN) :: ChannelIndex
TYPE(ODPS_Predictor_type), INTENT(IN OUT) :: Predictor
TYPE(CRTM_AtmOptics_type), INTENT(IN OUT) :: AtmAbsorption
! Local variables
INTEGER :: n_Layers, n_User_Layers
INTEGER :: i ! coefficent index
INTEGER :: k ! Layer index
INTEGER :: j ! Component index
INTEGER :: np ! number of predictors
REAL(fp) :: OD(Predictor%n_Layers)
REAL(fp) :: OD_Path(0:Predictor%n_Layers)
REAL(fp) :: User_OD_Path(0:Predictor%n_User_Layers)
INTEGER :: ODPS2User_Idx(2, 0:Predictor%n_User_Layers)
REAL(fp) :: OD_tmp
LOGICAL :: OPTRAN
INTEGER :: j0, js
! ------
! Set up
! ------
! Assign the indices to a short name
n_Layers = Predictor%n_Layers
n_User_Layers = Predictor%n_User_Layers
!--------------------------------------------------------
! Compute optical path profile
!--------------------------------------------------------
! Loop over each tau component for optical depth calculation
OD = ZERO
Component_Loop: DO j = 1, Predictor%n_Components
! number of predictors for the current component and channel
! Note, TC%n_Predictors(j, ChannelIndex) <= Predictor%n_CP(j).
! For example, if the upper m predictors have zero coefficients,
! then, only coefficients with indexed 1 to (Predictor%n_CP(j) - m)
! are stored and used used in the OD calculations.
np = TC%n_Predictors(j, ChannelIndex)
! Check if there is any absorption for the component&channel combination.
IF( np <= 0 ) CYCLE Component_Loop
! set flag for possible OPTRAN algorithm
! If this flag is set, this component is computed using OPTRAN algorithm.
! Otherwise, it is computed using ODPS algorithm.
IF( Predictor%OPTRAN .AND. j == TC%OComponent_Index)THEN
OPTRAN = TC%OSignificance(ChannelIndex) == SIGNIFICANCE_OPTRAN
ELSE
OPTRAN = .FALSE.
END IF
IF(OPTRAN)THEN
CALL Add_OPTRAN_wloOD(TC, &
ChannelIndex, &
Predictor, &
OD )
ELSE
! ODPS algorithm
j0 = TC%Pos_Index(j, ChannelIndex)
DO i = 1, np
js = j0+(i-1)*n_Layers-1
DO k = 1, n_Layers
OD(k) = OD(k) + TC%C(js+k)*Predictor%X(k, i, j)
END DO
END DO
END IF
END DO Component_Loop
!------------------------------------------------------
! Compute optical path (level to space) profile
!------------------------------------------------------
OD_Path(0) = ZERO
DO k = 1, n_layers
OD_tmp = OD(k)
IF(OD(k) < ZERO)THEN
OD_tmp = ZERO
ELSE IF(OD(k) > MAX_OD)THEN
OD_tmp = MAX_OD
END IF
OD_Path(k) = OD_Path(k-1) + OD_tmp
END DO
! Save forward variables
! Interpolate the path profile back on the user pressure grids,
! Compute layer optical depths (vertical direction)
IF ( PAFV_Associated(Predictor%PAFV) ) THEN
! save forwad variables
Predictor%PAFV%OD = OD
Predictor%PAFV%OD_Path = OD_Path
! If interpolation indexes are known
User_OD_Path(0) = ZERO
CALL Interpolate_Profile(Predictor%PAFV%ODPS2User_Idx, &
OD_Path, &
Predictor%Ref_Level_LnPressure, &
Predictor%User_Level_LnPressure, &
User_OD_Path)
ELSE
! interpolation indexes are not known
CALL Compute_Interp_Index(Predictor%Ref_Level_LnPressure, &
Predictor%User_Level_LnPressure,&
ODPS2User_Idx)
CALL Interpolate_Profile(ODPS2User_Idx, &
OD_Path, &
Predictor%Ref_Level_LnPressure, &
Predictor%User_Level_LnPressure, &
User_OD_Path)
END IF
! Optical depth profile scaled to zenith. Note that the scaling
! factor is the surface secant zenith angle.
AtmAbsorption%Optical_Depth = (User_OD_Path(1:n_User_Layers) - &
User_OD_Path(0:n_User_Layers-1)) / &
Predictor%Secant_Zenith_Surface
END SUBROUTINE ODPS_Compute_AtmAbsorption
!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ODPS_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.
!
! CALLING SEQUENCE:
! CALL ODPS_Compute_AtmAbsorption_TL( &
! TC , &
! ChannelIndex , &
! Predictor , &
! Predictor_TL, &
! AtmAbsorption_TL )
!
! INPUTS:
! TC:
! ODPS structure holding tau coefficients
! UNITS: N/A
! TYPE: ODPS_type
! 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.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor:
! Structure containing the predictor profile data.
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_TL:
! Structure containing the tangent-linear predictor profile data.
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
! AtmAbsorption_TL:
! Structure containing computed tangent-linear optical depth profile
! data.
! UNITS: N/A
! TYPE: CRTM_AtmOptics_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!------------------------------------------------------------------------------
<A NAME='ODPS_COMPUTE_ATMABSORPTION_TL'><A href='../../html_code/crtm/ODPS_AtmAbsorption.f90.html#ODPS_COMPUTE_ATMABSORPTION_TL' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ODPS_Compute_AtmAbsorption_TL( & 3,2
TC , & ! Input
ChannelIndex , & ! Input
Predictor , & ! Input
Predictor_TL , & ! Input
AtmAbsorption_TL ) ! Output
! Arguments
TYPE(ODPS_type) , INTENT(IN) :: TC
INTEGER , INTENT(IN) :: ChannelIndex
TYPE(ODPS_Predictor_type), INTENT(IN) :: Predictor
TYPE(ODPS_Predictor_type), INTENT(IN OUT) :: Predictor_TL
TYPE(CRTM_AtmOptics_type), INTENT(IN OUT) :: AtmAbsorption_TL
! Local variables
INTEGER :: n_Layers, n_User_Layers
INTEGER :: i ! coefficent index
INTEGER :: k ! Layer index
INTEGER :: j ! Component index
INTEGER :: np ! number of predictors
REAL(fp) :: OD_TL(Predictor%n_Layers)
REAL(fp) :: OD_Path_TL(0:Predictor%n_Layers)
REAL(fp) :: User_OD_Path_TL(0:Predictor%n_User_Layers)
LOGICAL :: OPTRAN
INTEGER :: j0, js
! ------
! Set up
! ------
! Assign the indices to a short name
n_Layers = Predictor%n_Layers
n_User_Layers = Predictor%n_User_Layers
!-----------------------------
! Compute optical path profile
!-----------------------------
! Loop over each tau component for optical depth calculation
OD_TL = ZERO
Component_Loop: DO j = 1, Predictor%n_Components
! number of predictors for the current component and channel
! Note, TC%n_Predictors(j, ChannelIndex) <= Predictor%n_CP(j).
! For example, if the upper m predictors have zero coefficients,
! then, only coefficients with indexed 1 to (Predictor%n_CP(j) - m)
! are stored and used used in the OD calculations.
np = TC%n_Predictors(j, ChannelIndex)
! Check if there is any absorption for the component&channel combination.
IF( np <= 0 ) CYCLE Component_Loop
! set flag for possible OPTRAN algorithm
! If this flag is set, this component is computed using OPTRAN algorithm.
! Otherwise, it is computed using ODPS algorithm.
IF( Predictor%OPTRAN .AND. j == TC%OComponent_Index)THEN
OPTRAN = TC%OSignificance(ChannelIndex) == SIGNIFICANCE_OPTRAN
ELSE
OPTRAN = .FALSE.
END IF
IF(OPTRAN)THEN
CALL Add_OPTRAN_wloOD_TL(TC, &
ChannelIndex, &
Predictor, &
Predictor_TL, &
OD_TL)
ELSE
! ODPS algorithm
j0 = TC%Pos_Index(j, ChannelIndex)
DO i = 1, np
js = j0+(i-1)*n_Layers-1
DO k = 1, n_Layers
OD_TL(k) = OD_TL(k) + TC%C(js+k)*Predictor_TL%X(k, i, j)
END DO
END DO
END IF
END DO Component_Loop
!------------------------------------------------------
! Compute optical path (level to space) profile
!------------------------------------------------------
OD_Path_TL(0) = ZERO
DO k = 1, n_layers
IF(Predictor%PAFV%OD(k) < ZERO)THEN
OD_TL(k) = ZERO
ELSE IF(Predictor%PAFV%OD(k) > MAX_OD)THEN
OD_TL(k) = ZERO
END IF
OD_Path_TL(k) = OD_Path_TL(k-1) + OD_TL(k)
END DO
! Interpolate the path profile back on the user pressure grids,
! Compute layer optical depths (vertical direction)
CALL Interpolate_Profile_F1_TL(Predictor%PAFV%ODPS2User_Idx, &
Predictor%Ref_Level_LnPressure, &
Predictor%User_Level_LnPressure, &
OD_Path_TL, &
User_OD_Path_TL)
AtmAbsorption_TL%Optical_Depth = (User_OD_Path_TL(1:n_User_Layers) - &
User_OD_Path_TL(0:n_User_Layers-1)) / &
Predictor%Secant_Zenith_Surface
END SUBROUTINE ODPS_Compute_AtmAbsorption_TL
!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ODPS_Compute_AtmAbsorption_AD
!
! PURPOSE:
! Subroutine to calculate the layer optical depth adjoint due to gaseous
! absorption for a given sensor and channel and atmospheric profile.
!
! CALLING SEQUENCE:
! CALL ODPS_Compute_AtmAbsorption_AD( &
! TC , &
! ChannelIndex , &
! Predictor , &
! AtmAbsorption_AD, &
! Predictor_AD )
!
! INPUTS:
! TC:
! ODPS structure holding tau coefficients
! UNITS: N/A
! TYPE: ODPS_type
! 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.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor:
! Structure containing the predictor profile data.
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! AtmAbsorption_AD:
! Structure containing optical depth adjoint profile data.
! **NOTE: Optical depth component Set to zero upon exit **
! UNITS: N/A
! TYPE: CRTM_AtmOptics_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! OUTPUTS:
! Predictor_AD:
! Structure containing the adjoint predictor profile data.
! **NOTE: Must contain data upon entry **
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!------------------------------------------------------------------------------
<A NAME='ODPS_COMPUTE_ATMABSORPTION_AD'><A href='../../html_code/crtm/ODPS_AtmAbsorption.f90.html#ODPS_COMPUTE_ATMABSORPTION_AD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ODPS_Compute_AtmAbsorption_AD( & 3,2
TC , & ! Input
ChannelIndex , & ! Input
Predictor , & ! Input
AtmAbsorption_AD, & ! Input
Predictor_AD ) ! Output
! Arguments
TYPE(ODPS_type) , INTENT(IN) :: TC
INTEGER , INTENT(IN) :: ChannelIndex
TYPE(ODPS_Predictor_type), INTENT(IN) :: Predictor
TYPE(CRTM_AtmOptics_type), INTENT(IN OUT) :: AtmAbsorption_AD
TYPE(ODPS_Predictor_type), INTENT(IN OUT) :: Predictor_AD
! Local variables
INTEGER :: n_Layers, n_User_Layers
INTEGER :: i ! coefficent index
INTEGER :: k ! Layer index
INTEGER :: j ! Component index
INTEGER :: np ! number of predictors
REAL(fp) :: OD_AD(Predictor%n_Layers)
REAL(fp) :: OD_Path_AD(0:Predictor%n_Layers)
REAL(fp) :: User_OD_Path_AD(0:Predictor%n_User_Layers)
LOGICAL :: OPTRAN
INTEGER :: j0, js
! ------
! Set up
! ------
! Assign the indices to a short name
n_Layers = Predictor%n_Layers
n_User_Layers = Predictor%n_User_Layers
!------- Adjoint part ---------
! Interpolate the path profile back on the user pressure grids,
! Compute layer optical depths (vertical direction)
User_OD_Path_AD(n_User_Layers) = ZERO
DO k = n_User_Layers, 1, -1
User_OD_Path_AD(k) = User_OD_Path_AD(k) &
+ AtmAbsorption_AD%Optical_Depth(k)/Predictor%Secant_Zenith_Surface
! combined with initilization
User_OD_Path_AD(k-1) = -AtmAbsorption_AD%Optical_Depth(k)/Predictor%Secant_Zenith_Surface
END DO
AtmAbsorption_AD%Optical_Depth = ZERO
OD_Path_AD = ZERO
CALL Interpolate_Profile_F1_AD(Predictor%PAFV%ODPS2User_Idx, &
Predictor%Ref_Level_LnPressure, &
Predictor%User_Level_LnPressure, &
User_OD_Path_AD, &
OD_Path_AD )
User_OD_Path_AD(0) = ZERO
!-----------------------------
! Compute optical path profile
!-----------------------------
DO k = n_layers, 1, -1
OD_Path_AD(k-1) = OD_Path_AD(k-1) + OD_Path_AD(k)
! combined with initialization
OD_AD(k) = OD_Path_AD(k)
OD_Path_AD(k) = ZERO
IF(Predictor%PAFV%OD(k) < ZERO)THEN
OD_AD(k) = ZERO
ELSE IF(Predictor%PAFV%OD(k) > MAX_OD)THEN
OD_AD(k) = ZERO
END IF
END DO
OD_Path_AD(0) = ZERO
! Loop over each tau component for optical depth calculation
Component_Loop_AD: DO j = 1, Predictor%n_Components
! number of predictors for the current component and channel
! Note, TC%n_Predictors(j, ChannelIndex) <= Predictor%n_CP(j).
! For example, if the upper m predictors have zero coefficients,
! then, only coefficients with indexed 1 to (Predictor%n_CP(j) - m)
! are stored and used used in the OD calculations.
np = TC%n_Predictors(j, ChannelIndex)
! Check if there is any absorption for the component&channel combination.
IF( np <= 0 ) CYCLE Component_Loop_AD
IF( Predictor%OPTRAN .AND. j == TC%OComponent_Index)THEN
OPTRAN = TC%OSignificance(ChannelIndex) == SIGNIFICANCE_OPTRAN
ELSE
OPTRAN = .FALSE.
END IF
IF(OPTRAN)THEN
CALL Add_OPTRAN_wloOD_AD(TC, &
ChannelIndex, &
Predictor, &
OD_AD, &
Predictor_AD )
ELSE
! ODPS algorithm
j0 = TC%Pos_Index(j, ChannelIndex)
DO i = 1, np
js = j0+(i-1)*n_Layers-1
DO k = n_Layers, 1, -1
Predictor_AD%X(k, i, j) = Predictor_AD%X(k, i, j) + TC%C(js+k)*OD_AD(k)
END DO
END DO
END IF
END DO Component_Loop_AD
END SUBROUTINE ODPS_Compute_AtmAbsorption_AD
!################################################################################
!################################################################################
!## ##
!## ## PRIVATE MODULE ROUTINES ## ##
!## ##
!################################################################################
!################################################################################
!------------------------------------------------------------------------------
!
! NAME:
! Add_OPTRAN_wloOD
!
! PURPOSE:
! Subroutine to calculate and add the layer optical depths due to water
! vapor line absorption via the ODAS algorithm.
! Note the OD argument is an in/out argument, which may hold accumulated
! optical depths from other absorbers.
!
! CALLING SEQUENCE:
! CALL Add_OPTRAN_wloOD( &
! TC , &
! ChannelIndex, &
! Predictor , &
! OD )
!
! INPUTS:
! TC:
! ODPS structure holding tau coefficients
! UNITS: N/A
! TYPE: ODPS_type
! 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.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor:
! Structure containing the predictor profile data.
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! IN/OUTPUTS:
! OD:
! Slant path optical depth profile.
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 array (n_Layers)
! ATTRIBUTES: INTENT(IN OUT)
!
!
!------------------------------------------------------------------------------
<A NAME='ADD_OPTRAN_WLOOD'><A href='../../html_code/crtm/ODPS_AtmAbsorption.f90.html#ADD_OPTRAN_WLOOD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Add_OPTRAN_wloOD( & 1
TC , & ! Input
ChannelIndex, & ! Input
Predictor , & ! Input
OD ) ! In/Output
! Arguments
TYPE(ODPS_type), INTENT(IN) :: TC
INTEGER, INTENT(IN) :: ChannelIndex
TYPE(ODPS_Predictor_type), INTENT(IN OUT) :: Predictor
REAL(fp), INTENT(IN OUT) :: OD(:)
! Local variables
REAL(fp) :: LN_Chi(TC%n_Layers), coeff(0:MAX_OPTRAN_ORDER)
REAL(fp) :: b(TC%n_Layers, 0:MAX_OPTRAN_USED_PREDICTORS)
REAL(fp) :: Chi(TC%n_Layers)
INTEGER :: np, n_Layers, n_orders, js, i, j, k, ii, jj
! -----------------------------------------
! Check if there is any absorption for this
! absorber/channel combination.
! -----------------------------------------
np = TC%OP_Index(0,ChannelIndex) ! number of predictors
IF ( np <= 0 ) RETURN
n_Layers = TC%n_Layers
js = TC%OPos_Index(ChannelIndex)
n_orders = TC%Order(ChannelIndex)
DO i = 0, np
jj = js + i*(n_orders+1)
coeff(0:n_orders) = TC%OC(jj:jj+n_orders)
DO k = 1, n_Layers
b(k,i) = coeff(0)
DO j = 1, n_orders
b(k,i) = b(k,i) + coeff(j)*Predictor%Ap(k, j)
END DO
END DO
END DO
LN_Chi = b(:,0)
DO i = 1, np
ii = TC%OP_Index(i,ChannelIndex)
DO k = 1, n_Layers
LN_Chi(k) = LN_Chi(k) + b(k, i)* Predictor%OX(k, ii)
END DO
END DO
DO k = 1, n_Layers
IF( LN_Chi(k) > LIMIT_EXP ) THEN
Chi(k) = LIMIT_LOG
ELSE IF( LN_Chi(k) < -LIMIT_EXP ) THEN
Chi(k) = ZERO
ELSE
Chi(k) = EXP(LN_Chi(k))
ENDIF
OD(k) = OD(k) + Chi(k)*Predictor%dA(k)
END DO
IF(Predictor%PAFV%OPTRAN)THEN
Predictor%PAFV%b = b
Predictor%PAFV%LN_Chi = LN_Chi
Predictor%PAFV%Chi = Chi
END IF
END SUBROUTINE Add_OPTRAN_wloOD
!------------------------------------------------------------------------------
!
! NAME:
! Add_OPTRAN_wloOD_TL
!
! PURPOSE:
! Subroutine to calculate and add the tangent-linear layer optical depths
! due to water vapor line absorption via the ODAS algorithm.
! Note the OD_TL argument is an in/out argument, which may hold accumulated
! tangent-linear optical depths from other absorbers.
!
! CALLING SEQUENCE:
! CALL Add_OPTRAN_wloOD_TL( &
! TC , &
! ChannelIndex, &
! Predictor , &
! Predictor_TL, &
! OD_TL )
!
! INPUTS:
! TC:
! ODPS structure holding tau coefficients
! UNITS: N/A
! TYPE: ODPS_type
! 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.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor:
! Structure containing the predictor profile data.
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_TL:
! Structure containing the tangent-linear predictor profile data.
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! IN/OUTPUT ARGUMENTS:
! OD_TL:
! Slant path tangent-linear optical depth profile
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 array (n_Layers)
! ATTRIBUTES: INTENT(IN OUT)
!
!------------------------------------------------------------------------------
<A NAME='ADD_OPTRAN_WLOOD_TL'><A href='../../html_code/crtm/ODPS_AtmAbsorption.f90.html#ADD_OPTRAN_WLOOD_TL' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Add_OPTRAN_wloOD_TL( & 1
TC , &
ChannelIndex, &
Predictor , &
Predictor_TL, &
OD_TL )
! Arguments
TYPE(ODPS_type), INTENT(IN) :: TC
INTEGER, INTENT(IN) :: ChannelIndex
TYPE(ODPS_Predictor_type), INTENT(IN) :: Predictor
TYPE(ODPS_Predictor_type), INTENT(IN) :: Predictor_TL
REAL(fp), INTENT(IN OUT) :: OD_TL(:)
! Local variables
REAL(fp) :: coeff(0:MAX_OPTRAN_ORDER)
REAL(fp) :: LN_Chi_TL(TC%n_Layers), b_TL(TC%n_Layers, 0:MAX_OPTRAN_USED_PREDICTORS)
REAL(fp) :: chi_TL(TC%n_Layers)
INTEGER :: np, n_Layers, n_orders, js, i, j, k, ii, jj
! -----------------------------------------
! Check if there is any absorption for this
! absorber/channel combination.
! -----------------------------------------
np = TC%OP_Index(0,ChannelIndex) ! number of predictors
IF ( np <= 0 ) RETURN
n_Layers = TC%n_Layers
js = TC%OPos_Index(ChannelIndex)
n_orders = TC%Order(ChannelIndex)
DO i = 0, np
jj = js + i*(n_orders+1)
coeff(0:n_orders) = TC%OC(jj:jj+n_orders)
DO k = 1, n_Layers
b_TL(k,i) = ZERO
DO j = 1, n_orders
b_TL(k,i) = b_TL(k,i) + coeff(j)*Predictor_TL%Ap(k, j)
END DO
END DO
END DO
LN_Chi_TL = b_TL(:,0)
DO i = 1, np
ii = TC%OP_Index(i,ChannelIndex)
DO k = 1, n_Layers
LN_Chi_TL(k) = LN_Chi_TL(k) + b_TL(k, i)* Predictor%OX(k, ii) + Predictor%PAFV%b(k, i)* Predictor_TL%OX(k, ii)
END DO
END DO
DO k = 1, n_Layers
IF( Predictor%PAFV%LN_Chi(k) > LIMIT_EXP ) THEN
Chi_TL(k) = ZERO
ELSE IF( Predictor%PAFV%LN_Chi(k) < -LIMIT_EXP ) THEN
Chi_TL(k) = ZERO
ELSE
Chi_TL(k) = Predictor%PAFV%Chi(k) * LN_Chi_TL(k)
ENDIF
OD_TL(k) = OD_TL(k) + Chi_TL(k)*Predictor%dA(k) + Predictor%PAFV%Chi(k)*Predictor_TL%dA(k)
END DO
END SUBROUTINE Add_OPTRAN_wloOD_TL
!------------------------------------------------------------------------------
!
! NAME:
! Add_OPTRAN_wloOD_AD
!
! PURPOSE:
! Subroutine to calculate and add the layer optical depth adjoints due
! to water vapor line absorption via the ODAS algorithm.
!
! CALLING SEQUENCE:
! CALL Add_OPTRAN_wloOD_AD( &
! TC , &
! ChannelIndex, &
! Predictor , &
! OD_AD , &
! Predictor_AD )
!
! INPUTS:
! TC:
! ODPS structure holding tau coefficients
! UNITS: N/A
! TYPE: ODPS_type
! 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.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor:
! Structure containing the predictor profile data.
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OD_AD:
! Slant path adjoint optical depth profile
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 array (n_Layers)
! ATTRIBUTES: INTENT(IN)
!
! IN/OUTPUTS:
! Predictor_AD:
! Structure containing the adjoint predictor profile data.
! **NOTE: Must contain data upon entry **
! UNITS: N/A
! TYPE: ODPS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!------------------------------------------------------------------------------
<A NAME='ADD_OPTRAN_WLOOD_AD'><A href='../../html_code/crtm/ODPS_AtmAbsorption.f90.html#ADD_OPTRAN_WLOOD_AD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Add_OPTRAN_wloOD_AD( & 1
TC , &
ChannelIndex, &
Predictor , &
OD_AD , &
Predictor_AD )
! Arguments
TYPE(ODPS_type), INTENT(IN) :: TC
INTEGER, INTENT(IN) :: ChannelIndex
TYPE(ODPS_Predictor_type), INTENT(IN) :: Predictor
REAL(fp), INTENT(IN OUT) :: OD_AD(:)
TYPE(ODPS_Predictor_type), INTENT(IN OUT) :: Predictor_AD
! Local variables
REAL(fp) :: coeff(0:MAX_OPTRAN_ORDER)
REAL(fp) :: LN_Chi_AD(TC%n_Layers), b_AD(TC%n_Layers, 0:MAX_OPTRAN_USED_PREDICTORS)
REAL(fp) :: Chi_AD(TC%n_Layers)
INTEGER :: np, n_Layers, n_orders, js, i, j, k, ii, jj
!------ Forward part for LN_Chi, b -----------
! -----------------------------------------
! Check if there is any absorption for this
! absorber/channel combination.
! -----------------------------------------
np = TC%OP_Index(0,ChannelIndex) ! number of predictors
IF ( np <= 0 ) RETURN
n_Layers = TC%n_Layers
js = TC%OPos_Index(ChannelIndex)
n_orders = TC%Order(ChannelIndex)
!------ Adjoint part ----------------------
! -----------------------------------------
! Check if there is any absorption for this
! absorber/channel combination.
! -----------------------------------------
Chi_AD = ZERO
LN_Chi_AD = ZERO
DO k = n_Layers, 1, -1
Chi_AD(k) = Chi_AD(k) + OD_AD(k) * Predictor%dA(k)
Predictor_AD%dA(k) = Predictor_AD%dA(k) + OD_AD(k) * Predictor%PAFV%Chi(k)
IF( Predictor%PAFV%LN_Chi(k) > LIMIT_EXP ) THEN
Chi_AD(k) = ZERO
ELSE IF( Predictor%PAFV%LN_Chi(k) < -LIMIT_EXP ) THEN
Chi_AD(k) = ZERO
ELSE
LN_Chi_AD(k) = Predictor%PAFV%Chi(k) * Chi_AD(k) ! combinded with initialization for LN_Chi_AD(k)
ENDIF
END DO
DO i = 1, np
ii = TC%OP_Index(i,ChannelIndex)
DO k = n_Layers, 1, -1
b_AD(k, i) = LN_Chi_AD(k) * Predictor%OX(k, ii) ! Combinded with initialization for b_AD
Predictor_AD%OX(k, ii) = Predictor_AD%OX(k, ii) + LN_Chi_AD(k)*Predictor%PAFV%b(k, i)
END DO
END DO
b_AD(:,0) = LN_Chi_AD
DO i = 0, np
jj = js + i*(n_orders+1)
coeff(0:n_orders) = TC%OC(jj:jj+n_orders)
DO k = n_Layers, 1, -1
DO j = 1, n_orders
Predictor_AD%Ap(k, j) = Predictor_AD%Ap(k, j) + coeff(j)*b_AD(k,i)
END DO
b_AD(k,i) = ZERO
END DO
END DO
END SUBROUTINE Add_OPTRAN_wloOD_AD
END MODULE ODPS_AtmAbsorption