!
! ODZeeman_AtmAbsorption
!
! Module containing routines to compute the optical depth profile
! due to gaseous absorption affected by Zeeman spilitting in
! the Optical Depth Pressure Space (ODPS).
!
!
! CREATION HISTORY:
! Written by: Yong Han, JCSDA, NOAA/NESDIS 10-NOV-2009
!
MODULE ODZeeman_AtmAbsorption
! -----------------
! Environment setup
! -----------------
! Module use
USE Type_Kinds, ONLY: fp
USE Message_Handler, ONLY: SUCCESS, FAILURE, Display_Message
USE CRTM_Parameters, ONLY: ZERO, ONE
USE CRTM_Atmosphere_Define, ONLY: CRTM_Atmosphere_type, H2O_ID
USE CRTM_AtmScatter_Define, ONLY: CRTM_AtmAbsorption_type => CRTM_AtmScatter_type
USE CRTM_GeometryInfo_Define, ONLY: CRTM_GeometryInfo_type, &
CRTM_GeometryInfo_GetValue
USE ODPS_Predictor_Define, ONLY: Predictor_type
USE ODPS_Define, ONLY: ODPS_type
USE ODZeeman_Predictor, ONLY: Compute_Predictors_zssmis, &
Compute_Predictors_zssmis_TL, &
Compute_Predictors_zssmis_AD, &
Compute_Predictors_zamsua, &
Compute_Predictors_zamsua_TL, &
Compute_Predictors_zamsua_AD, &
ZSSMIS_ChannelMap, &
ZAMSUA_ChannelMap, &
ODPS_gINDEX_ZSSMIS, &
ODPS_gINDEX_ZAMSUA, &
N_ZCOMPONENTS, &
N_ZABSORBERS, &
MAX_N_PREDICTORS_ZSSMIS, &
MAX_N_PREDICTORS_ZAMSUA
USE Zeeman_Input_Define, ONLY: Zeeman_Input_type, &
Zeeman_Input_GetValue
USE ODPS_CoordinateMapping, ONLY: Map_Input, Map_Input_TL, Map_Input_AD, &
Interpolate_Profile, &
Interpolate_Profile_F1_TL, &
Interpolate_Profile_F1_AD, &
Compute_Interp_Index
! Disable implicit typing
IMPLICIT NONE
! ------------
! Visibilities
! ------------
! Everything private by default
PRIVATE
! Public routines
PUBLIC :: Zeeman_Compute_Predictors
PUBLIC :: Zeeman_Compute_Predictors_TL
PUBLIC :: Zeeman_Compute_Predictors_AD
PUBLIC :: Zeeman_Compute_AtmAbsorption
PUBLIC :: Zeeman_Compute_AtmAbsorption_TL
PUBLIC :: Zeeman_Compute_AtmAbsorption_AD
PUBLIC :: Is_Zeeman_Channel
PUBLIC :: Is_ODZeeman
PUBLIC :: Get_NumOfZPredictors
PUBLIC :: Get_NumOfZComponents
PUBLIC :: Get_NumOfZAbsorbers
! ----------
! Parameters
! ----------
CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
'$Id: ODZeeman_AtmAbsorption.f90 22707 2012-11-21 21:09:10Z paul.vandelst@noaa.gov $'
CONTAINS
!------------------------------------------------------------------------------
!
! NAME:
! Zeeman_Compute_AtmAbsorption
!
! PURPOSE:
! Subroutine to compute slant path optical path for channels affected by
! affected by Zeeman splitting
!
! CALLING SEQUENCE:
!
! SUBROUTINE Zeeman_Compute_AtmAbsorption(TC, &
! ChannelIndex, &
! Predictor, &
! AtmAbsorption )
!
! INPUT ARGUMENTS:
!
! TC: ODPS structure holding coefficient data
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the predictors for estimating of optical depth
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
! AtmAbsorption: Structure containing computed optical depth
! profile data.
! UNITS: N/A
! TYPE: TYPE(CRTM_AtmAbsorption_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!------------------------------------------------------------------------------
SUBROUTINE Zeeman_Compute_AtmAbsorption(TC , & ! Input
ChannelIndex , & ! Input
Predictor , & ! Input
AtmAbsorption) ! Output
! Arguments
TYPE(ODPS_type) , INTENT(IN) :: TC
INTEGER , INTENT(IN) :: ChannelIndex
TYPE(Predictor_type) , INTENT(IN OUT) :: Predictor
TYPE(CRTM_AtmAbsorption_type), INTENT(IN OUT) :: AtmAbsorption
! Local variables
INTEGER :: n_User_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)
INTEGER :: idx
n_User_Layers = Predictor%n_User_Layers
IF(TC%Group_Index == ODPS_gINDEX_ZSSMIS)THEN
idx = ZSSMIS_ChannelMap(ChannelIndex)
CALL Compute_ODPath_zssmis(idx, &
TC, &
Predictor, &
OD_Path)
ELSE
CALL Compute_ODPath_zamsua(TC, &
Predictor, &
OD_Path)
END IF
! Interpolate the path profile back on the user pressure grids,
! Compute layer optical depths (vertical direction)
IF(Predictor%PAFV%Active)THEN
! save forwad variables
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 Zeeman_Compute_AtmAbsorption
!------------------------------------------------------------------------------
!
! NAME:
! Zeeman_Compute_AtmAbsorption_TL
!
! PURPOSE:
! Subroutine to compute TL slant path optical path for channels affected by
! affected by Zeeman splitting
!
! CALLING SEQUENCE:
!
! CALL Zeeman_Compute_AtmAbsorption_TL(TC, &
! ChannelIndex, &
! Predictor, &
! Predictor_TL, &
! AtmAbsorption_TL )
!
! INPUT ARGUMENTS:
!
! TC: ODPS structure holding coefficient data
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the predictors for estimating of optical depth
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_TL: Predictor structure containing the TL predictors
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(INOUT)
!
! OUTPUT ARGUMENTS:
! AtmAbsorption_TL: Structure containing computed TL optical depth
! profile data.
! UNITS: N/A
! TYPE: TYPE(CRTM_AtmAbsorption_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!------------------------------------------------------------------------------
SUBROUTINE Zeeman_Compute_AtmAbsorption_TL(TC , & ! Input
ChannelIndex , & ! Input
Predictor , & ! Input
Predictor_TL, & ! Input
AtmAbsorption_TL) ! Output
! Arguments
TYPE(ODPS_type) , INTENT(IN) :: TC
INTEGER , INTENT(IN) :: ChannelIndex
TYPE(Predictor_type) , INTENT(IN) :: Predictor
TYPE(Predictor_type) , INTENT(INOUT) :: Predictor_TL
TYPE(CRTM_AtmAbsorption_type), INTENT(INOUT) :: AtmAbsorption_TL
! Local variables
INTEGER :: n_User_Layers
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)
INTEGER :: ODPS2User_Idx(2, 0:Predictor%n_User_Layers)
INTEGER :: idx
n_User_Layers = Predictor%n_User_Layers
IF(TC%Group_Index == ODPS_gINDEX_ZSSMIS)THEN
idx = ZSSMIS_ChannelMap(ChannelIndex)
CALL Compute_ODPath_zssmis_TL(idx, &
TC, &
Predictor, &
Predictor_TL, &
OD_Path_TL )
ELSE
CALL Compute_ODPath_zamsua_TL(TC, &
Predictor, &
Predictor_TL, &
OD_Path_TL )
END IF
! 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%PAFV%OD_Path, &
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 Zeeman_Compute_AtmAbsorption_TL
!------------------------------------------------------------------------------
!
! NAME:
! Zeeman_Compute_AtmAbsorption_AD
!
! PURPOSE:
! Subroutine to compute AD slant path optical path for channels affected by
! affected by Zeeman splitting
!
! CALLING SEQUENCE:
!
! CALL Zeeman_Compute_AtmAbsorption_AD(TC, &
! ChannelIndex, &
! Predictor, &
! AtmAbsorption_AD, &
! Predictor_AD)
!
! INPUT ARGUMENTS:
!
! TC: ODPS structure holding coefficient data
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the predictors for estimating of optical depth
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OD_Path_AD: AD Slant path optical path profile (from space down)
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 (0:n_Layers)
! ATTRIBUTES: INTENT(INOUT)
!
! OUTPUT ARGUMENTS:
! AtmAbsorption_AD: Structure containing computed AD optical depth
! profile data.
! UNITS: N/A
! TYPE: TYPE(CRTM_AtmAbsorption_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!------------------------------------------------------------------------------
SUBROUTINE Zeeman_Compute_AtmAbsorption_AD( TC , & ! Input
ChannelIndex , & ! Input
Predictor , & ! Input
AtmAbsorption_AD, & ! Input
Predictor_AD) ! Output
! Arguments
TYPE(ODPS_type) , INTENT(IN) :: TC
INTEGER , INTENT(IN) :: ChannelIndex
TYPE(Predictor_type) , INTENT(IN) :: Predictor
TYPE(CRTM_AtmAbsorption_type), INTENT(IN OUT) :: AtmAbsorption_AD
TYPE(Predictor_type) , INTENT(IN OUT) :: Predictor_AD
! Local variables
INTEGER :: n_User_Layers, k
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)
INTEGER :: ODPS2User_Idx(2, 0:Predictor%n_User_Layers)
INTEGER :: idx
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%PAFV%OD_Path, &
Predictor%Ref_Level_LnPressure, &
Predictor%User_Level_LnPressure, &
User_OD_Path_AD, &
OD_Path_AD )
User_OD_Path_AD(0) = ZERO
IF(TC%Group_Index == ODPS_gINDEX_ZSSMIS)THEN
idx = ZSSMIS_ChannelMap(ChannelIndex)
CALL Compute_ODPath_zssmis_AD(idx, &
TC, &
Predictor, &
OD_Path_AD, &
Predictor_AD )
ELSE
CALL Compute_ODPath_zamsua_AD(TC, &
Predictor, &
OD_Path_AD, &
Predictor_AD )
END IF
END SUBROUTINE Zeeman_Compute_AtmAbsorption_AD
!------------------------------------------------------------------------------
!
! NAME:
! Compute_ODPath_zssmis
!
! PURPOSE:
! Subroutine to compute slant path optical path for ZSSMIS
! (a virtual sensor created for the SSMIS 4 Zeeman channels:
! ch 19, 20, 21, 22)
!
! CALLING SEQUENCE:
!
! SUBROUTINE Compute_ODPath_zssmis(ChannelIndex, &
! TC, &
! Predictor, &
! OD_Path )
!
! INPUT ARGUMENTS:
!
! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! TC: ODPS structure holding coefficient data
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the predictors for estimating of optical depth
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
! OD_Path: Slant path optical path profile (from space down)
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 (0:n_Layers)
! ATTRIBUTES: INTENT(OUT)
!
!------------------------------------------------------------------------------
SUBROUTINE Compute_ODPath_zssmis(ChannelIndex, &
TC, &
Predictor, &
OD_Path )
INTEGER, INTENT( IN ) :: ChannelIndex
TYPE(ODPS_type), INTENT( IN ) :: TC
TYPE(Predictor_type), INTENT( INOUT ) :: Predictor
REAL(fp), INTENT( OUT) :: OD_Path(0:)
! Local
REAL(fp), DIMENSION(Predictor%n_Layers) :: OD1, OD2, OD
REAL(fp) :: OD_tmp
REAL(fp) :: w1, w2, Doppler_shift
INTEGER :: i, j, j1, j2, js1, js2, k, inode, n_nodes, n_Layers, nc, np
OD_Path = ZERO
np = TC%n_Predictors(1, ChannelIndex)
! Check if there is any absorption for the component&channel combination.
IF( np > 0 ) THEN
!----------------------------------------------------------------------------------
! (1) Find the nodes of the Doppler shift frequencies, which bracket the user
! Doppler frequency; (2) compute weights for interpolation.
!----------------------------------------------------------------------------------
Doppler_Shift = Predictor%u
j = TC%Pos_Index(1, ChannelIndex)
n_nodes = INT(TC%C(j))
n_Layers = Predictor%n_Layers
j = j + 1
IF(Doppler_Shift < TC%C(j))THEN
j1 = j
w1 = ONE
w2 = ZERO
inode = 1
ELSE IF(Doppler_Shift > TC%C(j+n_nodes-1))THEN
j1 = j+n_nodes-2
w1 = ZERO
w2 = ONE
inode = n_nodes-2
ELSE
DO i = 1, n_nodes-1
j1 = j + i - 1
j2 = j1 + 1
IF(Doppler_Shift >= TC%C(j1) .AND. Doppler_Shift <= TC%C(j2))THEN
w1 = (TC%C(j2) - Doppler_Shift)/(TC%C(j2) - TC%C(j1))
w2 = ONE - w1
inode = i
EXIT
END IF
END DO
END IF
!--------------------------------------------
! Compute optical depths at the two nodes
!--------------------------------------------
OD1 = ZERO
OD2 = ZERO
nc = np * n_Layers
j1 = j + n_nodes + (inode-1)*nc
j2 = j1 + nc
DO i = 1, np
js1 = j1+(i-1)*n_Layers-1
js2 = j2+(i-1)*n_Layers-1
DO k = 1, n_Layers
OD1(k) = OD1(k) + TC%C(js1+k)*Predictor%X(k, i, 1)
OD2(k) = OD2(k) + TC%C(js2+k)*Predictor%X(k, i, 1)
END DO
END DO
!-------------------------------------------------------
! (1) Interpolate on the user requested Doppler frequency
! (2) Compute the Slant path optical depth profile.
!-------------------------------------------------------
DO k = 1, n_Layers
IF(ChannelIndex == 2)THEN
OD(k) = w1*EXP(OD1(k)) + w2*EXP(OD2(k))
OD_tmp = OD(k)
ELSE
OD(k) = w1*OD1(k) + w2*OD2(k)
OD_tmp = OD(k)
IF(OD(k) < ZERO)OD_tmp = ZERO
END IF
OD_Path(k) = OD_Path(k-1) + OD_tmp*Predictor%Secant_Zenith(k)
END DO
! Save FW variables
IF(Predictor%PAFV%Active)THEN
Predictor%PAFV%OD = OD
Predictor%PAFV%w1 = w1
Predictor%PAFV%w2 = w2
Predictor%PAFV%inode = inode
END IF
END IF
END SUBROUTINE Compute_ODPath_zssmis
!------------------------------------------------------------------------------
!
! NAME:
! Compute_ODPath_zssmis_TL
!
! PURPOSE:
! Subroutine to compute TL slant path optical path for ZSSMIS
! (a virtual sensor created for the SSMIS 4 Zeeman channels:
! ch 19, 20, 21, 22)
!
! CALLING SEQUENCE:
!
! CALL Compute_ODPath_zssmis_TL(ChannelIndex, &
! TC, &
! Predictor, &
! Predictor_TL, &
! OD_Path_TL )
!
! INPUT ARGUMENTS:
!
! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! TC: ODPS structure holding coefficient data
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the predictors for estimating of optical depth
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_TL: Predictor structure containing the TL predictors
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(INOUT)
!
! OUTPUT ARGUMENTS:
! OD_Path_TL: TL Slant path optical path profile (from space down)
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 (0:n_Layers)
! ATTRIBUTES: INTENT(OUT)
!
!------------------------------------------------------------------------------
SUBROUTINE Compute_ODPath_zssmis_TL(ChannelIndex, &
TC, &
Predictor, &
Predictor_TL, &
OD_Path_TL )
INTEGER, INTENT( IN ) :: ChannelIndex
TYPE(ODPS_type), INTENT( IN ) :: TC
TYPE(Predictor_type), INTENT( IN ) :: Predictor
TYPE(Predictor_type), INTENT( INOUT ) :: Predictor_TL
REAL(fp), INTENT(OUT) :: OD_Path_TL(0:)
! Local
REAL(fp), DIMENSION(Predictor%n_Layers) :: OD1, OD2, OD1_TL, OD2_TL
REAL(fp) :: O1, O2
REAL(fp) :: OD_TL
INTEGER :: i, j, j1, j2, js1, js2, k, n_nodes, n_Layers, nc, np
OD_Path_TL = ZERO
np = TC%n_Predictors(1, ChannelIndex)
! Check if there is any absorption for the component&channel combination.
IF( np > 0 ) THEN
!----------------------------------------------------------------------------------
! (1) Find the nodes of the Doppler shift frequencies, which bracket the user
! Doppler frequency; (2) compute weights for interpolation.
!----------------------------------------------------------------------------------
j = TC%Pos_Index(1, ChannelIndex)
n_nodes = INT(TC%C(j))
n_Layers = Predictor%n_Layers
j = j + 1
!--------------------------------------------
! Compute optical depths at the two nodes
!--------------------------------------------
OD1 = ZERO
OD2 = ZERO
OD1_TL = ZERO
OD2_TL = ZERO
nc = np * n_Layers
j1 = j + n_nodes + (Predictor%PAFV%inode-1)*nc
j2 = j1 + nc
DO i = 1, np
js1 = j1+(i-1)*n_Layers-1
js2 = j2+(i-1)*n_Layers-1
DO k = 1, n_Layers
OD1(k) = OD1(k) + TC%C(js1+k)*Predictor%X(k, i, 1)
OD2(k) = OD2(k) + TC%C(js2+k)*Predictor%X(k, i, 1)
OD1_TL(k) = OD1_TL(k) + TC%C(js1+k)*Predictor_TL%X(k, i, 1)
OD2_TL(k) = OD2_TL(k) + TC%C(js2+k)*Predictor_TL%X(k, i, 1)
END DO
END DO
!-------------------------------------------------------
! (1) Interpolate on the user requested Doppler frequency
! (2) Compute the Slant path optical depth profile.
!-------------------------------------------------------
DO k = 1, n_Layers
IF(ChannelIndex == 2)THEN
O1 = EXP(OD1(k))
O2 = EXP(OD2(k))
OD_TL = Predictor%PAFV%w1*O1*OD1_TL(k) + Predictor%PAFV%w2*O2*OD2_TL(k)
ELSE
OD_TL = Predictor%PAFV%w1*OD1_TL(k) + Predictor%PAFV%w2*OD2_TL(k)
IF(Predictor%PAFV%OD(k) < ZERO)OD_TL = ZERO
END IF
OD_Path_TL(k) = OD_Path_TL(k-1) + OD_TL*Predictor%Secant_Zenith(k)
END DO
END IF
END SUBROUTINE Compute_ODPath_zssmis_TL
!------------------------------------------------------------------------------
!
! NAME:
! Compute_ODPath_zssmis_AD
!
! PURPOSE:
! Subroutine to compute AD slant path optical path for ZSSMIS
! (a virtual sensor created for the SSMIS 4 Zeeman channels:
! ch 19, 20, 21, 22)
!
! CALLING SEQUENCE:
!
! CALL Compute_ODPath_zssmis_AD(ChannelIndex, &
! TC, &
! Predictor, &
! OD_Path_AD, &
! Predictor_AD)
!
! INPUT ARGUMENTS:
!
! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! TC: ODPS structure holding coefficient data
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the predictors for estimating of optical depth
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OD_Path_AD: AD Slant path optical path profile (from space down)
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 (0:n_Layers)
! ATTRIBUTES: INTENT(INOUT)
!
! OUTPUT ARGUMENTS:
! Predictor_AD: Predictor structure containing the AD predictors
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(INOUT)
!
!------------------------------------------------------------------------------
SUBROUTINE Compute_ODPath_zssmis_AD(ChannelIndex, &
TC, &
Predictor, &
OD_Path_AD, &
Predictor_AD)
INTEGER, INTENT( IN ) :: ChannelIndex
TYPE(ODPS_type), INTENT( IN ) :: TC
TYPE(Predictor_type), INTENT( IN ) :: Predictor
REAL(fp), INTENT( INOUT ) :: OD_Path_AD(0:)
TYPE(Predictor_type), INTENT( INOUT ) :: Predictor_AD
! Local
REAL(fp), DIMENSION(Predictor%n_Layers) :: OD1, OD2, OD1_AD, OD2_AD
REAL(fp) :: O1, O2
REAL(fp) :: OD_AD
INTEGER :: i, j, j1, j2, js1, js2, k, n_nodes, n_Layers, nc, np
np = TC%n_Predictors(1, ChannelIndex)
!------------------------
! Forward calculation
!------------------------
! Check if there is any absorption for the component&channel combination.
IF( np > 0 ) THEN
j = TC%Pos_Index(1, ChannelIndex)
n_nodes = INT(TC%C(j))
n_Layers = Predictor%n_Layers
j = j + 1
OD1 = ZERO
OD2 = ZERO
nc = np * n_Layers
j1 = j + n_nodes + (Predictor%PAFV%inode-1)*nc
j2 = j1 + nc
DO i = 1, np
js1 = j1+(i-1)*n_Layers-1
js2 = j2+(i-1)*n_Layers-1
DO k = 1, n_Layers
OD1(k) = OD1(k) + TC%C(js1+k)*Predictor%X(k, i, 1)
OD2(k) = OD2(k) + TC%C(js2+k)*Predictor%X(k, i, 1)
END DO
END DO
!-------------------------------
! AD calculation
!-------------------------------
DO k = n_Layers, 1, -1
OD_AD = Predictor%Secant_Zenith(k)*OD_Path_AD(k) ! OD_AD does not cumulate
OD_Path_AD(k-1) = OD_Path_AD(k-1) + OD_Path_AD(k)
IF(ChannelIndex == 2)THEN
O1 = EXP(OD1(k))
O2 = EXP(OD2(k))
OD1_AD(k) = Predictor%PAFV%w1*O1*OD_AD ! OD1_AD(k) and OD2_AD(k) do not cumulate
OD2_AD(k) = Predictor%PAFV%w2*O2*OD_AD
ELSE
IF(Predictor%PAFV%OD(k) < ZERO)OD_AD = ZERO
OD1_AD(k) = Predictor%PAFV%w1*OD_AD
OD2_AD(k) = Predictor%PAFV%w2*OD_AD
END IF
END DO
DO i = 1, np
js1 = j1+(i-1)*n_Layers-1
js2 = j2+(i-1)*n_Layers-1
DO k = n_Layers, 1, -1
Predictor_AD%X(k, i, 1) = Predictor_AD%X(k, i, 1) + &
OD1_AD(k)*TC%C(js1+k)
Predictor_AD%X(k, i, 1) = Predictor_AD%X(k, i, 1) + &
OD2_AD(k)*TC%C(js2+k)
END DO
END DO
OD_Path_AD = ZERO
END IF
END SUBROUTINE Compute_ODPath_zssmis_AD
!------------------------------------------------------------------------------
!
! NAME:
! Compute_ODPath_zamsua
!
! PURPOSE:
! Subroutine to compute slant path optical path for AMSUA channel 14
! affected by Zeeman splitting.
!
! CALLING SEQUENCE:
!
! SUBROUTINE Compute_ODPath_zamsua(TC, &
! Predictor, &
! OD_Path )
!
! INPUT ARGUMENTS:
!
! TC: ODPS structure holding coefficient data
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the predictors for estimating of optical depth
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
! OD_Path: Slant path optical path profile (from space down)
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 (0:n_Layers)
! ATTRIBUTES: INTENT(OUT)
!
!------------------------------------------------------------------------------
SUBROUTINE Compute_ODPath_zamsua(TC, &
Predictor, &
OD_Path )
TYPE(ODPS_type), INTENT( IN ) :: TC
TYPE(Predictor_type), INTENT( INOUT ) :: Predictor
REAL(fp), INTENT( OUT) :: OD_Path(0:)
! Local
REAL(fp), DIMENSION(Predictor%n_Layers) :: ODv, ODh
REAL(fp), DIMENSION(0:Predictor%n_Layers) :: ODv_Path, ODh_Path
REAL(fp) :: tauv, tauh, tau
REAL(fp) :: Wv, Wh
INTEGER :: i, j1, j2, k1, k2, k, m1, m2, n_Layers, np
OD_Path = ZERO
np = TC%n_Predictors(1, 1)
! Check if there is any absorption for the component&channel combination.
IF( np > 0 ) THEN
!----------------------------------------------------------------------------------
! Compute optical depths at specified polarizations
!----------------------------------------------------------------------------------
n_Layers = Predictor%n_Layers
j1 = TC%Pos_Index(1, 1) ! starting index for vertical polarization
j2 = j1 + (np+1)*n_Layers ! starting index for horizontal polarization
! offset coefficients
ODv = TC%C(j1:(j1+n_Layers-1))
ODh = TC%C(j2:(j2+n_Layers-1))
! Predictor contributions
DO i = 1, np
m1 = j1+i*n_Layers
m2 = j2+i*n_Layers
DO k = 1, n_Layers
k1 = m1+(k-1)
k2 = m2+(k-1)
ODv(k) = ODv(k) + TC%C(k1)*Predictor%X(k, i, 1)
ODh(k) = ODh(k) + TC%C(k2)*Predictor%X(k, i, 1)
END DO
END DO
!------------------------------------------------------
! Compute transmittances and then combine them
!------------------------------------------------------
Wv = Predictor%w
Wh = ONE - Wv
ODv_Path(0) = ZERO
ODh_Path(0) = ZERO
DO k = 1, n_Layers
IF(ODv(k) < ZERO)ODv(k) = ZERO
ODv_Path(k) = ODv_Path(k-1) + ODv(k)
tauv = EXP(-ODv_Path(k))
IF(ODh(k) < ZERO)ODh(k) = ZERO
ODh_Path(k) = ODh_Path(k-1) + ODh(k)
tauh = EXP(-ODh_Path(k))
tau = Wv*tauv + Wh*tauh
OD_Path(k) = -LOG(tau)
END DO
END IF
END SUBROUTINE Compute_ODPath_zamsua
!------------------------------------------------------------------------------
!
! NAME:
! Compute_ODPath_zamsua_TL
!
! PURPOSE:
! Subroutine to compute TL slant path optical path for AMSUA channel 14
! affected by Zeeman splitting.
!
! CALLING SEQUENCE:
!
! CALL Compute_ODPath_zamsua_TL(TC, &
! Predictor, &
! Predictor_TL, &
! OD_Path_TL )
!
! INPUT ARGUMENTS:
!
! TC: ODPS structure holding coefficient data
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the predictors for estimating of optical depth
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_TL: Predictor structure containing the TL predictors
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(INOUT)
!
! OUTPUT ARGUMENTS:
! OD_Path_TL: TL Slant path optical path profile (from space down)
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 (0:n_Layers)
! ATTRIBUTES: INTENT(OUT)
!
!------------------------------------------------------------------------------
SUBROUTINE Compute_ODPath_zamsua_TL(TC, &
Predictor, &
Predictor_TL, &
OD_Path_TL )
TYPE(ODPS_type), INTENT( IN ) :: TC
TYPE(Predictor_type), INTENT( IN ) :: Predictor
TYPE(Predictor_type), INTENT( IN ) :: Predictor_TL
REAL(fp), INTENT( OUT) :: OD_Path_TL(0:)
! Local
REAL(fp), DIMENSION(Predictor%n_Layers) :: ODv, ODh, ODv_TL, ODh_TL
REAL(fp), DIMENSION(0:Predictor%n_Layers) :: ODv_Path, ODh_Path, ODv_Path_Tl, ODh_Path_TL
REAL(fp) :: tauv, tauh, tau, tauv_TL, tauh_TL, tau_TL
REAL(fp) :: Wv, Wh
INTEGER :: i, j1, j2, k1, k2, k, m1, m2, n_Layers, np
OD_Path_TL = ZERO
np = TC%n_Predictors(1, 1)
! Check if there is any absorption for the component&channel combination.
IF( np > 0 ) THEN
!----------------------------------------------------------------------------------
! Compute optical depths at specified polarizations
!----------------------------------------------------------------------------------
n_Layers = Predictor%n_Layers
j1 = TC%Pos_Index(1, 1) ! starting index for vertical polarization
j2 = j1 + (np+1)*n_Layers ! starting index for horizontal polarization
ODv = TC%C(j1:(j1+n_Layers-1))
ODh = TC%C(j2:(j2+n_Layers-1))
ODv_TL = ZERO
ODh_TL = ZERO
DO i = 1, np
m1 = j1+i*n_Layers
m2 = j2+i*n_Layers
DO k = 1, n_Layers
k1 = m1+(k-1)
k2 = m2+(k-1)
ODv(k) = ODv(k) + TC%C(k1)*Predictor%X(k, i, 1)
ODh(k) = ODh(k) + TC%C(k2)*Predictor%X(k, i, 1)
ODv_TL(k) = ODv_TL(k) + TC%C(k1)*Predictor_TL%X(k, i, 1)
ODh_TL(k) = ODh_TL(k) + TC%C(k2)*Predictor_TL%X(k, i, 1)
END DO
END DO
!------------------------------------------------------
! Compute transmittances and then combine them
!------------------------------------------------------
Wv = Predictor%w
Wh = ONE - Wv
ODv_Path(0) = ZERO
ODh_Path(0) = ZERO
ODv_Path_TL(0) = ZERO
ODh_Path_TL(0) = ZERO
DO k = 1, n_Layers
IF(ODv(k) < ZERO)THEN
ODv(k) = ZERO
ODv_TL(k) = ZERO
END IF
ODv_Path(k) = ODv_Path(k-1) + ODv(k)
tauv = EXP(-ODv_Path(k))
ODv_Path_TL(k) = ODv_Path_TL(k-1) + ODv_TL(k)
tauv_TL = -tauv*ODv_Path_TL(k)
IF(ODh(k) < ZERO)THEN
ODh(k) = ZERO
ODh_TL(k) = ZERO
END IF
ODh_Path(k) = ODh_Path(k-1) + ODh(k)
tauh = EXP(-ODh_Path(k))
ODh_Path_TL(k) = ODh_Path_TL(k-1) + ODh_TL(k)
tauh_TL = -tauh*ODh_Path_TL(k)
tau = Wv*tauv + Wh*tauh
tau_TL = Wv*tauv_TL + Wh*tauh_TL
OD_Path_TL(k) = -(ONE/tau)*tau_TL
END DO
END IF
END SUBROUTINE Compute_ODPath_zamsua_TL
!------------------------------------------------------------------------------
!
! NAME:
! Compute_ODPath_zamsua_AD
!
! PURPOSE:
! Subroutine to compute AD slant path optical path for AMSUA channel 14
! affected by Zeeman splitting.
!
! CALLING SEQUENCE:
!
! CALL Compute_ODPath_zamsua_AD(TC, &
! Predictor, &
! OD_Path_AD, &
! Predictor_AD)
!
! INPUT ARGUMENTS:
!
! TC: ODPS structure holding coefficient data
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the predictors for estimating of optical depth
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OD_Path_AD: AD Slant path optical path profile (from space down)
! UNITS: N/A
! TYPE: REAL(fp)
! DIMENSION: Rank-1 (0:n_Layers)
! ATTRIBUTES: INTENT(INOUT)
!
! OUTPUT ARGUMENTS:
! Predictor_AD: Predictor structure containing the AD predictors
! UNITS: N/A
! TYPE: TYPE(Predictor_type)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(INOUT)
!
!------------------------------------------------------------------------------
SUBROUTINE Compute_ODPath_zamsua_AD(TC, &
Predictor, &
OD_Path_AD, &
Predictor_AD)
TYPE(ODPS_type), INTENT( IN ) :: TC
TYPE(Predictor_type), INTENT( IN ) :: Predictor
REAL(fp), INTENT( INOUT) :: OD_Path_AD(0:)
TYPE(Predictor_type), INTENT( INOUT ) :: Predictor_AD
! Local
REAL(fp), DIMENSION(Predictor%n_Layers) :: ODv, ODh, ODv_AD, ODh_AD
REAL(fp), DIMENSION(0:Predictor%n_Layers) :: ODv_Path, ODh_Path, ODv_Path_AD, ODh_Path_AD
REAL(fp) :: tauv, tauh, tau, tauv_AD, tauh_AD, tau_AD
REAL(fp) :: Wv, Wh, OD_tmp
INTEGER :: i, j1, j2, k1, k2, m1, m2, k, n_Layers, np
np = TC%n_Predictors(1, 1)
! Check if there is any absorption for the component&channel combination.
IF( np > 0 ) THEN
ODv_AD = ZERO
ODh_AD = ZERO
ODv_Path_AD = ZERO
ODh_Path_AD = ZERO
tauv_AD = ZERO
tauh_AD = ZERO
tau_AD = ZERO
! ***************
! Forward part
! ***************
!----------------------------------------------------------------------------------
! Compute optical depths at specified polarizations
!----------------------------------------------------------------------------------
n_Layers = Predictor%n_Layers
j1 = TC%Pos_Index(1, 1) ! starting index for vertical polarization
j2 = j1 + (np+1)*n_Layers ! starting index for horizontal polarization
ODv = TC%C(j1:(j1+n_Layers-1))
ODh = TC%C(j2:(j2+n_Layers-1))
DO i = 1, np
m1 = j1+i*n_Layers
m2 = j2+i*n_Layers
DO k = 1, n_Layers
k1 = m1+(k-1)
k2 = m2+(k-1)
ODv(k) = ODv(k) + TC%C(k1)*Predictor%X(k, i, 1)
ODh(k) = ODh(k) + TC%C(k2)*Predictor%X(k, i, 1)
END DO
END DO
!------------------------------------------------------
! Compute transmittances and then combine them
!------------------------------------------------------
Wv = Predictor%w
Wh = ONE - Wv
ODv_Path(0) = ZERO
ODh_Path(0) = ZERO
DO k = 1, n_Layers
OD_tmp = ODv(k)
IF(ODv(k) < ZERO)OD_tmp = ZERO
ODv_Path(k) = ODv_Path(k-1) + OD_tmp
OD_tmp = ODh(k)
IF(ODh(k) < ZERO)OD_tmp = ZERO
ODh_Path(k) = ODh_Path(k-1) + OD_tmp
END DO
! ***************
! Adjoint part
! ***************
DO k = n_Layers, 1, -1
tauv = EXP(-ODv_Path(k))
tauh = EXP(-ODh_Path(k))
tau = Wv*tauv + Wh*tauh
tau_AD = tau_AD - (ONE/tau)*OD_Path_AD(k)
OD_Path_AD(k) = ZERO
tauv_AD = tauv_AD + Wv*tau_AD
tauh_AD = tauh_AD + Wh*tau_AD
tau_AD = ZERO
ODh_PATH_AD(k) = ODh_PATH_AD(k) - tauh*tauh_AD
tauh_AD = ZERO
ODh_Path_AD(k-1) = ODh_Path_AD(k-1) + ODh_Path_AD(k)
ODh_AD(k) = ODh_AD(k) + ODh_Path_AD(k)
ODh_Path_AD(k) = ZERO
IF(ODh(k) < ZERO)ODh_AD(k) = ZERO
ODv_PATH_AD(k) = ODv_PATH_AD(k) - tauv*tauv_AD
tauv_AD = ZERO
ODv_Path_AD(k-1) = ODv_Path_AD(k-1) + ODv_Path_AD(k)
ODv_AD(k) = ODv_AD(k) + ODv_Path_AD(k)
ODv_Path_AD(k) = ZERO
IF(ODv(k) < ZERO)ODv_AD(k) = ZERO
END DO
! ODv_Path_AD(0) = ZERO
! ODh_Path_AD(0) = ZERO
DO i = np, 1, -1
m1 = j1+i*n_Layers
m2 = j2+i*n_Layers
DO k = n_Layers, 1, -1
k1 = m1+(k-1)
k2 = m2+(k-1)
Predictor_AD%X(k, i, 1) = Predictor_AD%X(k, i, 1) + TC%C(k1)*ODv_AD(k)
Predictor_AD%X(k, i, 1) = Predictor_AD%X(k, i, 1) + TC%C(k2)*ODh_AD(k)
END DO
END DO
! OD1_AD(:) = ZERO
! OD2_AD(:) = ZERO
END IF
OD_Path_AD = ZERO
END SUBROUTINE Compute_ODPath_zamsua_AD
!--------------------------------------------------------------------------------
!
! NAME:
! Zeeman_Compute_Predictors
!
! PURPOSE:
! Subroutine to calculate the gas absorption model predictors. It first
! Interpolates the user temperature and absorber profiles on the
! internal pressure grids and then call the predictor computation
! routine to compute the predictors
!
! CALLING SEQUENCE:
! CALL Zeeman_Compute_Predictors( Zeeman , & ! Input
! TC , & ! Input
! Atm , & ! Input
! GeoInfo , & ! Input
! Predictor ) ! Output
!
! INPUT ARGUMENTS:
! Zeeman: Structure holding Zeeman-specific user inputs
! UNITS: N/A
! TYPE: Zeeman_Input_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! TC: ODPS structure holding tau coefficients
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Atm: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! GeoInfo: CRTM_GeometryInfo structure containing the
! view geometry information.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
! Predictor: Predictor structure containing the integrated absorber
! and predictor profiles.
! UNITS: N/A
! TYPE: Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!--------------------------------------------------------------------------------
SUBROUTINE Zeeman_Compute_Predictors( &
Zeeman , &
TC , &
Atm , &
GeoInfo , &
Predictor )
! Arguments
TYPE(Zeeman_Input_type) , INTENT(IN) :: Zeeman
TYPE(ODPS_type) , INTENT(IN) :: TC
TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: Atm
TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: GeoInfo
TYPE(Predictor_type) , INTENT(IN OUT) :: Predictor
! Local variables
REAL(fp) :: Temperature(Predictor%n_Layers)
REAL(fp) :: Absorber(Predictor%n_Layers, TC%n_Absorbers)
INTEGER :: H2O_idx
REAL(fp) :: Sensor_Scan_Radian, Secant_Sensor_Zenith
REAL(fp) :: Be, COS_ThetaB, COS_PhiB, Doppler_Shift
REAL(fp) :: COS2_ScanA, COS2_PhiB
! Retrieve required geometry values
CALL CRTM_GeometryInfo_GetValue( &
GeoInfo , & ! Input
Sensor_Scan_Radian = Sensor_Scan_Radian , & ! Output
Secant_Sensor_Zenith = Secant_Sensor_Zenith ) ! Output
! ...Store the surface secant zenith angle
Predictor%Secant_Zenith_Surface = Secant_Sensor_Zenith
! Mapping data from user to internal fixed pressure layers/levels.
CALL Map_Input( &
Atm , & ! Input
TC , & ! Input
GeoInfo , & ! Input
Temperature , & ! Output
Absorber , & ! output
Predictor%User_Level_LnPressure, & ! Output, non variable
Predictor%Ref_Level_LnPressure , & ! Output, non variable
Predictor%Secant_Zenith , & ! Output, non variable
H2O_idx , &
Predictor%PAFV ) ! structure holding FW parameters
! Compute predictor for specific instruments
SELECT CASE ( TC%Group_Index )
CASE ( ODPS_gINDEX_ZSSMIS )
CALL Zeeman_Input_GetValue( &
Zeeman , & ! Input
Field_Strength = Be , & ! Output
COS_ThetaB = COS_ThetaB , & ! Output
Doppler_Shift = Doppler_Shift ) ! Output
CALL Compute_Predictors_zssmis( &
Temperature , &
Be , &
COS_ThetaB , &
Doppler_Shift , &
Predictor%Secant_Zenith, &
Predictor )
CASE ( ODPS_gINDEX_ZAMSUA )
CALL Zeeman_Input_GetValue( &
Zeeman , & ! Input
Field_Strength = Be , & ! Output
COS_ThetaB = COS_ThetaB, & ! Output
COS_PhiB = COS_PhiB ) ! Output
CALL Compute_Predictors_zamsua( &
Temperature , &
TC%Ref_Temperature , &
Be , &
COS_ThetaB , &
Predictor%Secant_Zenith, &
Predictor )
! Weights for combining transmittances at the two special polarizations
COS2_ScanA = COS(Sensor_Scan_Radian)**2
COS2_PhiB = COS_PhiB**2
Predictor%w = (ONE-COS2_ScanA)*COS2_PhiB + COS2_ScanA*(ONE-COS2_PhiB)
CASE DEFAULT
! This is a NOOP - does checking need to
! be done upon entry to this routine?
END SELECT
IF ( Predictor%PAFV%Active ) THEN
! Set and save the interpolation index array for absorption
! calculations. Since the indexes do not depend on channel but
! the absorption calculations do, put the index calculation here
! can improve efficency.
CALL Compute_Interp_Index( &
Predictor%Ref_Level_LnPressure , &
Predictor%User_Level_LnPressure, &
Predictor%PAFV%ODPS2User_Idx )
END IF
END SUBROUTINE Zeeman_Compute_Predictors
!--------------------------------------------------------------------------------
!
! NAME:
! Zeeman_Compute_Predictors_TL
!
! PURPOSE:
! Subroutine to calculate the TL gas absorption model predictors. It first
! Interpolates the user temperature and absorber profiles on the
! internal pressure grids and then call the predictor computation
! routine to compute the predictors
!
! CALLING SEQUENCE:
! CALL Zeeman_Compute_Predictors_TL( Zeeman , & ! Input
! TC , & ! Input
! Atm , & ! FWD Input
! GeoInfo , & ! Input
! Predictor , & ! FWD Input
! Atm_TL , & ! TL Input
! Predictor_TL ) ! TL Output
!
! INPUT ARGUMENTS:
! Zeeman: Structure holding Zeeman-specific user inputs
! UNITS: N/A
! TYPE: Zeeman_Input_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! TC: ODPS structure holding tau coefficients
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Atm: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! GeoInfo: CRTM_GeometryInfo structure containing the
! view geometry information.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the integrated absorber
! and predictor profiles.
! UNITS: N/A
! TYPE: Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Atm_TL: CRTM Atmosphere structure containing the tangent-linear
! atmospheric state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
! Predictor_TL: Predictor structure containing the tangent-linear
! integrated absorber and predictor profiles.
! UNITS: N/A
! TYPE: Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!--------------------------------------------------------------------------------
SUBROUTINE Zeeman_Compute_Predictors_TL( &
Zeeman , &
TC , &
Atm , &
GeoInfo , &
Predictor , &
Atm_TL , &
Predictor_TL)
! Arguments
TYPE(Zeeman_Input_type) , INTENT(IN) :: Zeeman
TYPE(ODPS_type) , INTENT(IN) :: TC
TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: Atm
TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: GeoInfo
TYPE(Predictor_type) , INTENT(IN) :: Predictor
TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: Atm_TL
TYPE(Predictor_type) , INTENT(IN OUT) :: Predictor_TL
! Local variables
REAL(fp) :: Absorber_TL(Predictor%n_Layers, TC%n_Absorbers)
REAL(fp) :: Temperature_TL(Predictor%n_Layers)
REAL(fp) :: Be, COS_ThetaB, Doppler_Shift
! Mapping data from user to internal fixed pressure layers/levels.
CALL Map_Input_TL( &
Atm , & ! Input
TC , & ! Input
Atm_TL , & ! Input
Temperature_TL, & ! Output
Absorber_TL , & ! Output
Predictor%PAFV ) ! Input
! Compute predictor for specific instruments
SELECT CASE ( TC%Group_Index )
CASE ( ODPS_gINDEX_ZSSMIS )
CALL Zeeman_Input_GetValue( &
Zeeman , & ! Input
Field_Strength = Be , & ! Output
COS_ThetaB = COS_ThetaB , & ! Output
Doppler_Shift = Doppler_Shift ) ! Output
CALL Compute_Predictors_zssmis_TL( &
Predictor%PAFV%Temperature, &
Be , &
COS_ThetaB , &
Doppler_Shift , &
Predictor%Secant_Zenith , &
Temperature_TL , &
Predictor_TL )
CASE ( ODPS_gINDEX_ZAMSUA )
CALL Zeeman_Input_GetValue( &
Zeeman , & ! Input
Field_Strength = Be , & ! Output
COS_ThetaB = COS_ThetaB ) ! Output
CALL Compute_Predictors_zamsua_TL( &
Predictor%PAFV%Temperature, &
TC%Ref_Temperature , &
Be , &
COS_ThetaB , &
Predictor%Secant_Zenith , &
Temperature_TL , &
Predictor_TL )
CASE DEFAULT
! This is a NOOP - does checking need to
! be done upon entry to this routine?
END SELECT
END SUBROUTINE Zeeman_Compute_Predictors_TL
!--------------------------------------------------------------------------------
!
! NAME:
! Zeeman_Compute_Predictors_AD
!
! PURPOSE:
! Subroutine to calculate the AD gas absorption model predictors. It first
! Interpolates the user temperature and absorber profiles on the
! internal pressure grids and then call the predictor computation
! routine to compute the predictors
!
! CALLING SEQUENCE:
! CALL Zeeman_Compute_Predictors_AD( Zeeman , & ! Input
! TC, , & ! Input
! Atm, , & ! FWD Input
! GeoInfo, , & ! Input
! Predictor, , & ! FWD Input
! Predictor_AD, & ! AD Input
! Atm_AD ) ! AD Output
!
! INPUT ARGUMENTS:
! Zeeman: Structure holding Zeeman-specific user inputs
! UNITS: N/A
! TYPE: Zeeman_Input_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! TC: ODPS structure holding tau coefficients
! UNITS: N/A
! TYPE: ODPS_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Atm: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! GeoInfo: CRTM_GeometryInfo structure containing the
! view geometry information.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the integrated absorber
! and predictor profiles.
! UNITS: N/A
! TYPE: Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_AD: Predictor structure containing the adjoint integrated
! absorber and predictor profiles.
! UNITS: N/A
! TYPE: Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!
! Atm_AD: CRTM Atmosphere structure containing the adjoint
! atmospheric state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!--------------------------------------------------------------------------------
SUBROUTINE Zeeman_Compute_Predictors_AD( &
Zeeman , &
TC , &
Atm , &
GeoInfo , &
Predictor , &
Predictor_AD, &
Atm_AD )
! Arguments
TYPE(Zeeman_Input_type) , INTENT(IN) :: Zeeman
TYPE(ODPS_type) , INTENT(IN) :: TC
TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: Atm
TYPE(CRTM_GeometryInfo_type) , INTENT(IN) :: GeoInfo
TYPE(Predictor_type) , INTENT(IN) :: Predictor
TYPE(Predictor_type) , INTENT(IN OUT) :: predictor_AD
TYPE(CRTM_Atmosphere_type) , INTENT(IN OUT) :: Atm_AD
! Local variables
REAL(fp) :: Absorber_AD(Predictor%n_Layers, TC%n_Absorbers)
REAL(fp) :: Temperature_AD(Predictor%n_Layers)
REAL(fp) :: Be, COS_ThetaB, Doppler_Shift
! Local adjoint variable initialization
Temperature_AD = ZERO
Absorber_AD = ZERO
! Compute predictor for specific instruments
SELECT CASE ( TC%Group_Index )
CASE ( ODPS_gINDEX_ZSSMIS )
CALL Zeeman_Input_GetValue( &
Zeeman , & ! Input
Field_Strength = Be , & ! Output
COS_ThetaB = COS_ThetaB , & ! Output
Doppler_Shift = Doppler_Shift ) ! Output
CALL Compute_Predictors_zssmis_AD( &
Predictor%PAFV%Temperature, &
Be , &
COS_ThetaB , &
Doppler_Shift , &
Predictor%Secant_Zenith , &
Predictor_AD , &
Temperature_AD )
CASE ( ODPS_gINDEX_ZAMSUA )
CALL Zeeman_Input_GetValue( &
Zeeman , & ! Input
Field_Strength = Be , & ! Output
COS_ThetaB = COS_ThetaB ) ! Output
CALL Compute_Predictors_zamsua_AD( &
Predictor%PAFV%Temperature, &
TC%Ref_Temperature , &
Be , &
COS_ThetaB , &
Predictor%Secant_Zenith , &
Predictor_AD , &
Temperature_AD )
CASE DEFAULT
! This is a NOOP - does checking need to
! be done upon entry to this routine?
END SELECT
! Mapping data from user to internal fixed pressure layers/levels.
CALL Map_Input_AD( &
Atm , & ! Input
TC , & ! Input
Temperature_AD, & ! Input
Absorber_AD , & ! Input
Atm_AD , & ! output
Predictor%PAFV ) ! Input
END SUBROUTINE Zeeman_Compute_Predictors_AD
!-------------------------------------------------
! Check if the given channel is a Zeeman channel
! Inputs:
! TC - Taucoeff structure
! ChannelIndex - the sensor's channel index
! Return
! .TRUE. - this is a Zeeman channel
! .FALSE. - not a Zeeman channel
!-------------------------------------------------
FUNCTION Is_Zeeman_Channel(TC, ChannelIndex) RESULT( ZChannel )
TYPE(ODPS_type), INTENT(IN) :: TC
INTEGER, INTENT(IN) :: ChannelIndex
LOGICAL :: ZChannel
SELECT CASE ( TC%Group_Index )
CASE ( ODPS_gINDEX_ZSSMIS )
ZChannel = ZSSMIS_ChannelMap(ChannelIndex) > 0
CASE ( ODPS_gINDEX_ZAMSUA )
ZChannel = ZAMSUA_ChannelMap(ChannelIndex) > 0
CASE DEFAULT
ZChannel = .FALSE.
END SELECT
END FUNCTION Is_Zeeman_Channel
!---------------------------------------------------------
! Check if the given TC is associated with Zeeman algorithm
! Inputs:
! TC - Taucoeff structure
! Return
! .TRUE. - associated with the Zeeman algorithm
! .FALSE. - not associated with the Zeeman algorithm
!-------------------------------------------------
FUNCTION Is_ODZeeman( TC ) RESULT( ODZeeman )
TYPE(ODPS_type), INTENT(IN) :: TC
LOGICAL :: ODZeeman
ODZeeman = ( TC%Group_Index == ODPS_gINDEX_ZSSMIS .OR. &
TC%Group_Index == ODPS_gINDEX_ZAMSUA )
END FUNCTION Is_ODZeeman
!----------------------------------------------------------
! Obtain number of predictors, given an ODPS group index
!----------------------------------------------------------
FUNCTION Get_NumOfZPredictors( gIndex ) RESULT( n_Predictors )
INTEGER, INTENT(IN) :: gIndex
INTEGER :: n_Predictors
SELECT CASE ( gIndex )
CASE ( ODPS_gINDEX_ZSSMIS )
n_Predictors = MAX_N_PREDICTORS_ZSSMIS
CASE ( ODPS_gINDEX_ZAMSUA )
n_Predictors = MAX_N_PREDICTORS_ZAMSUA
CASE DEFAULT
n_Predictors = 0
END SELECT
END FUNCTION Get_NumOfZPredictors
!----------------------------------------------------------
! Obtain number of compoents, given an ODPS group index
!----------------------------------------------------------
FUNCTION Get_NumOfZComponents( gIndex ) RESULT( n_Components )
INTEGER, INTENT(IN) :: gIndex
INTEGER :: n_Components
n_Components = N_ZCOMPONENTS
END FUNCTION Get_NumOfZComponents
! Obtain number of compoents, given an ODPS group index
!----------------------------------------------------------
FUNCTION Get_NumOfZAbsorbers( gIndex ) RESULT( n_Absorbers )
INTEGER, INTENT(IN) :: gIndex
INTEGER :: n_Absorbers
n_Absorbers = N_ZABSORBERS
END FUNCTION Get_NumOfZAbsorbers
END MODULE ODZeeman_AtmAbsorption