!
! ODAS_Predictor
!
! Module continaing routines to compute the predictors for the
! Optical Depth in Absorber Space (ODAS) .
!
!
! CREATION HISTORY:
! Written by: Paul van Delst, 29-Aug-2006
! paul.vandelst@noaa.gov
!
! Modified by: Yong Han, 25-June-2008
! yong.han@noaa.gov
!
MODULE ODAS_Predictor
! -----------------
! Environment setup
! -----------------
! Module use
USE Type_Kinds , ONLY: fp
USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message
USE CRTM_Parameters , ONLY: ZERO , &
POINT_25, POINT_5, POINT_75, &
ONE, TWO, THREE, TEN , &
MINIMUM_ABSORBER_AMOUNT , &
TOA_PRESSURE , &
RECIPROCAL_GRAVITY , &
MAX_N_LAYERS
USE CRTM_Atmosphere_Define , ONLY: CRTM_Atmosphere_type, &
CRTM_Get_AbsorberIdx, &
H2O_ID, O3_ID
USE CRTM_GeometryInfo_Define, ONLY: CRTM_GeometryInfo_type, &
CRTM_GeometryInfo_GetValue
USE ODAS_Predictor_Define , ONLY: ODAS_Predictor_type , &
ODAS_Predictor_Associated, &
ODAS_Predictor_Destroy , &
ODAS_Predictor_Create , &
ODAS_Predictor_Zero
! Disable implicit typing
IMPLICIT NONE
! ------------
! Visibilities
! ------------
! Everything private by default
PRIVATE
! Datatypes
PUBLIC :: iVar_type
! Procedures
PUBLIC :: ODAS_Assemble_Predictors
PUBLIC :: ODAS_Assemble_Predictors_TL
PUBLIC :: ODAS_Assemble_Predictors_AD
! Parameters
PUBLIC :: MAX_N_ABSORBERS
PUBLIC :: WET_ABSORBER_INDEX
PUBLIC :: DRY_ABSORBER_INDEX
PUBLIC :: OZO_ABSORBER_INDEX
PUBLIC :: ABSORBER_INDEX
PUBLIC :: ABSORBER_NAME
PUBLIC :: MAX_N_STANDARD_PREDICTORS
PUBLIC :: MAX_N_INTEGRATED_PREDICTORS
PUBLIC :: MAX_N_PREDICTORS
PUBLIC :: MAX_N_PREDICTORS_USED
PUBLIC :: MAX_N_ORDERS
! -----------------
! Module parameters
! -----------------
CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
'$Id: ODAS_Predictor.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $'
! Absorbers in the gas absorption model
! -------------------------------------
! The total number
INTEGER, PARAMETER :: MAX_N_ABSORBERS = 3
! The indexing order of the absorbers
INTEGER, PARAMETER :: WET_ABSORBER_INDEX = 1
INTEGER, PARAMETER :: DRY_ABSORBER_INDEX = 2
INTEGER, PARAMETER :: OZO_ABSORBER_INDEX = 3
! The absorber index and name arrays
INTEGER, PARAMETER :: ABSORBER_INDEX(MAX_N_ABSORBERS) = &
(/ WET_ABSORBER_INDEX, &
DRY_ABSORBER_INDEX, &
OZO_ABSORBER_INDEX /)
CHARACTER(*), PARAMETER :: ABSORBER_NAME(MAX_N_ABSORBERS) = &
(/ 'wet', &
'dry', &
'ozo' /)
! Predictors in the gas absorption model
! --------------------------------------
! Standard predictors are absorber independent
INTEGER, PARAMETER :: MAX_N_STANDARD_PREDICTORS = 11
! Integrated predictors are defined for EACH absoreber
INTEGER, PARAMETER :: MAX_N_INTEGRATED_PREDICTORS = 6
! The total number of predictors
INTEGER, PARAMETER :: MAX_N_PREDICTORS = MAX_N_STANDARD_PREDICTORS + &
( MAX_N_ABSORBERS * MAX_N_INTEGRATED_PREDICTORS )
! The number selected from the total to be
! used in the gas absorption algorithm
INTEGER, PARAMETER :: MAX_N_PREDICTORS_USED = 6
! Maximum number of polynomial orders for
! reconstructing the gas absorption coefficients
INTEGER, PARAMETER :: MAX_N_ORDERS = 10
! ------------------------------------------
! Structure definition to hold forward model
! variables across FWD, TL, and AD calls
! ------------------------------------------
TYPE :: iVar_type
PRIVATE
REAL(fp), DIMENSION(0:MAX_N_LAYERS,MAX_N_ABSORBERS) :: A_2 = ZERO
REAL(fp), DIMENSION(MAX_N_LAYERS,MAX_N_ABSORBERS) :: Factor_1 = ZERO
REAL(fp), DIMENSION(MAX_N_LAYERS,MAX_N_ABSORBERS) :: Factor_2 = ZERO
REAL(fp), DIMENSION(MAX_N_INTEGRATED_PREDICTORS,0:MAX_N_LAYERS,MAX_N_ABSORBERS) :: s ! no need to initialized it to zero
REAL(fp), DIMENSION(MAX_N_LAYERS,MAX_N_ABSORBERS) :: A_Level ! no need to initialized it to zero
END TYPE iVar_type
CONTAINS
!################################################################################
!################################################################################
!## ##
!## ## PUBLIC MODULE ROUTINES ## ##
!## ##
!################################################################################
!################################################################################
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ODAS_Assemble_Predictors
!
! PURPOSE:
! Subroutine to assemble all the gas absorption model predictors
! for the ODAS algorithm.
!
! CALLING SEQUENCE:
! CALL ODAS_Assemble_Predictors( &
! Atmosphere , &
! GeometryInfo, &
! Max_Order , &
! Alpha , &
! Predictor , &
! iVar )
!
! INPUTS:
! Atmosphere:
! Structure containing the atmospheric state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! GeometryInfo:
! Structure containing the view geometry information.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Max_Order:
! The maximum order of the polynomial function for each absorber
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: 1D array (n_Absorbers)
! ATTRIBUTES: INTENT(IN)
!
! Alpha:
! The alpha coefficients for absorber level calculations
! UNITS: depends on the units of the absorber
! TYPE: INTEGER
! DIMENSION: 2D array (n_Alphas x n_Absorbers)
! ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
! Predictor:
! Structure containing the integrated absorber and predictor profiles.
! UNITS: N/A
! TYPE: ODAS_Predictor_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)
!
! COMMENTS:
! The predictors used in the gas absorption model are organised in
! the following manner:
!
! ------------------------------------------------------------------------------
! | 1 | 2 | 3 | ... | 9 | 10 | 11 | 12 |....| 17 | 18 |....| 23 | 24 |....| 29 |
! ------------------------------------------------------------------------------
!
! \ /\ /\ /\ /
! \ / \ / \ / \ /
! ---------------------------- ----------- ----------- -----------
! | | | |
! v v v v
!
! Standard Integrated Integrated Integrated
! Predictors predictors predictors predictors
! for for for
! Absorber 1 Absorber 2 Absorber 3
! (water vapor) (dry gases) (ozone)
!
!:sdoc-:
!--------------------------------------------------------------------------------
SUBROUTINE ODAS_Assemble_Predictors( &
Atmosphere , & ! Input
GeometryInfo, & ! Input
Max_Order , & ! Input
Alpha , & ! Input
Predictor , & ! Output
iVar ) ! Internal variable output
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atmosphere
TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: GeometryInfo
INTEGER, INTENT(IN) :: Max_Order(:)
REAL(fp), INTENT(IN) :: Alpha(:,:)
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Predictor
TYPE(iVar_type), INTENT(OUT) :: iVar
! Local variables
INTEGER :: i,j,k,n_Layers
REAL(fp) :: Secant_Sensor_Zenith
! Save the angle information
CALL CRTM_GeometryInfo_GetValue( GeometryInfo, &
Secant_Trans_Zenith = Secant_Sensor_Zenith )
Predictor%Secant_Sensor_Zenith = Secant_Sensor_Zenith
! Compute the nadir integrated absorber profiles
CALL Compute_IntAbsorber( Atmosphere, Predictor )
! Compute the predictors
! ...Standard predictors
CALL Standard_Predictors( Atmosphere, Predictor )
! ...Integrated predictors
CALL Integrated_Predictors( Atmosphere, Predictor, iVar )
! Calculate absorber space level associated with the average
! absorber amount
!
! Absorber level, k, to amount
!
! A(k) = C1.exp(Alpha * k) + C2
!
! Absorber amount to level
!
! 1 A - C2
! k = ----- LN ------
! Alpha C1
!
! AP(k, i) = A(k)**(i), i = 1, Max_Order(j)
!
! Alpha : absorber amount-level coordinate constant
! C1,C2 : scaling factors for level in the range of 0 to 1
n_Layers = Atmosphere%n_Layers
DO j = 1, Predictor%n_Absorbers
IF( Max_Order(j) < 0 )CYCLE
DO k = 1, n_Layers
iVar%A_Level(k,j) = LOG((Predictor%aveA(k,j) - Alpha(3,j)) / Alpha(2,j)) / &
! ----------------------------------------------------
Alpha(1,j)
END DO
Predictor%Ap(1:n_Layers, 1, j) = iVar%A_Level(1:n_Layers,j)
DO i = 2, Max_Order(j)
DO k = 1, n_Layers
Predictor%Ap(k, i, j) = Predictor%Ap(k, i-1, j) * iVar%A_Level(k,j)
END DO
END DO
END DO
END SUBROUTINE ODAS_Assemble_Predictors
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ODAS_Assemble_Predictors_TL
!
! PURPOSE:
! Subroutine to assemble all the gas absorption model predictors
! for the tangent-linear ODAS algorithm.
!
! CALLING SEQUENCE:
! CALL ODAS_Assemble_Predictors_TL ( &
! Atmosphere , & ! FWD Input
! Predictor , & ! FWD Input
! Atmosphere_TL, & ! TL Input
! Max_Order , & ! Input
! Alpha , & ! Input
! Predictor_TL , & ! TL Output
! iVar ) ! Internal variable input
!
! INPUTS:
! Atmosphere:
! Structure containing the atmospheric state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor:
! Structure containing the integrated absorber and predictor profiles.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Atmosphere_TL:
! Structure containing the tanggent-linear atmospheric state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! GeometryInfo:
! Structure containing the view geometry information.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Max_Order:
! The maximum order of the polynomial function for each absorber
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: 1D array (n_Absorbers)
! ATTRIBUTES: INTENT(IN)
!
! Alpha:
! The alpha coefficients for absorber level calculations
! UNITS: depends on the units of the absorber
! TYPE: INTEGER
! DIMENSION: 2D array (n_Alphas x n_Absorbers)
! 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(OUT)
!
! OUTPUTS:
! Predictor_TL:
! Structure containing the tangent-linear integrated absorber
! and predictor profiles.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! COMMENTS:
! The predictors used in the gas absorption model are organised in
! the following manner:
!
! ------------------------------------------------------------------------------
! | 1 | 2 | 3 | ... | 9 | 10 | 11 | 12 |....| 17 | 18 |....| 23 | 24 |....| 29 |
! ------------------------------------------------------------------------------
!
! \ /\ /\ /\ /
! \ / \ / \ / \ /
! ---------------------------- ----------- ----------- -----------
! | | | |
! v v v v
!
! Standard Integrated Integrated Integrated
! Predictors predictors predictors predictors
! for for for
! Absorber 1 Absorber 2 Absorber 3
! (water vapor) (dry gases) (ozone)
!
!:sdoc-:
!--------------------------------------------------------------------------------
SUBROUTINE ODAS_Assemble_Predictors_TL( &
Atmosphere , & ! FWD Input
Predictor , & ! FWD Input
Atmosphere_TL, & ! TL Input
Max_Order , & ! Input
Alpha , & ! Input
Predictor_TL , & ! TL Output
iVar ) ! Internal variable input
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atmosphere
TYPE(ODAS_Predictor_type), INTENT(IN) :: Predictor
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atmosphere_TL
INTEGER, INTENT(IN) :: Max_Order(:)
REAL(fp), INTENT(IN) :: Alpha(:,:)
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Predictor_TL
TYPE(iVar_type), INTENT(IN) :: iVar
! Local variables
REAL(fp) :: A_Level_TL(Atmosphere%n_Layers)
INTEGER :: i, j, k, n_Layers
! Save the angle information
Predictor_TL%Secant_Sensor_Zenith = Predictor%Secant_Sensor_Zenith
! Compute the tangent-linear nadir integrated absorber profiles
CALL Compute_IntAbsorber_TL( &
Atmosphere , & ! Input
Atmosphere_TL, & ! Input
Predictor_TL ) ! Output
! Compute the tangent-linear predictors
! ...Standard predictors
CALL Standard_Predictors_TL( &
Atmosphere , & ! Input
Atmosphere_TL, & ! Input
Predictor_TL ) ! Output
! ...Integrated predictors
CALL Integrated_Predictors_TL( &
Atmosphere , & ! Input
Predictor , & ! Input
Atmosphere_TL, & ! Input
Predictor_TL , & ! Output
iVar ) ! Internal variable input
! Calculate tangent-linear absorber space level associated
! with the average absorber amount
n_Layers = Atmosphere%n_Layers
DO j = 1, Predictor%n_Absorbers
IF( Max_Order(j) < 0 )CYCLE
DO k = 1, n_Layers
A_Level_TL(k) = Predictor_TL%aveA(k,j) / &
! -------------------------------------------------
(Alpha(1,j) * (Predictor%aveA(k,j) - Alpha(3,j)))
END DO
Predictor_TL%Ap(1:n_layers, 1, j) = A_Level_TL(1:n_layers)
DO i = 2, Max_Order(j)
DO k = 1, n_Layers
Predictor_TL%Ap(k, i, j) = (Predictor_TL%Ap(k,i-1,j)*iVar%A_Level(k,j)) + &
(Predictor%Ap(k,i-1,j) *A_Level_TL(k))
END DO
END DO
END DO
END SUBROUTINE ODAS_Assemble_Predictors_TL
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ODAS_Assemble_Predictors_AD
!
! PURPOSE:
! Subroutine to assemble all the gas absorption model predictors
! for the adjoint ODAS algorithm.
!
! CALLING SEQUENCE:
! CALL ODAS_Assemble_Predictors_AD ( &
! Atmosphere , & ! FWD Input
! Predictor , & ! FWD Input
! Predictor_AD , & ! AD Input
! Max_Order , & ! Input
! Alpha , & ! Input
! Atmosphere_AD, & ! AD Output
! iVar ) ! Internal variable input
!
! INPUTS:
! Atmosphere:
! Structure containing the atmospheric state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor:
! Structure containing the integrated absorber and predictor profiles.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_AD:
! Structure containing the adjoint integrated absorber and
! predictor profiles.
! **NOTE: This structure is zeroed upon output
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! Max_Order:
! The maximum order of the polynomial function for each absorber
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: 1D array (n_Absorbers)
! ATTRIBUTES: INTENT(IN)
!
! Alpha:
! The alpha coefficients for absorber level calculations
! UNITS: depends on the units of the absorber
! TYPE: INTEGER
! DIMENSION: 2D array (n_Alphas x n_Absorbers)
! 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(OUT)
!
! OUTPUTS:
! Atmosphere_AD:
! Structure containing the adjoint atmospheric state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! COMMENTS:
! The predictors used in the gas absorption model are organised in
! the following manner:
!
! ------------------------------------------------------------------------------
! | 1 | 2 | 3 | ... | 9 | 10 | 11 | 12 |....| 17 | 18 |....| 23 | 24 |....| 29 |
! ------------------------------------------------------------------------------
!
! \ /\ /\ /\ /
! \ / \ / \ / \ /
! ---------------------------- ----------- ----------- -----------
! | | | |
! v v v v
!
! Standard Integrated Integrated Integrated
! Predictors predictors predictors predictors
! for for for
! water vapor dry gases ozone
!:sdoc-:
!--------------------------------------------------------------------------------
SUBROUTINE ODAS_Assemble_Predictors_AD( &
Atmosphere , & ! FWD Input
Predictor , & ! FWD Input
Predictor_AD , & ! AD Input
Max_Order , & ! Input
Alpha , & ! Input
Atmosphere_AD, & ! AD Output
iVar ) ! Internal variable input
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atmosphere
TYPE(ODAS_Predictor_type), INTENT(IN) :: Predictor
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Predictor_AD
INTEGER, INTENT(IN) :: Max_Order(:)
REAL(fp), INTENT(IN) :: Alpha(:,:)
TYPE(CRTM_Atmosphere_type), INTENT(IN OUT) :: Atmosphere_AD
TYPE(iVar_type), INTENT(IN) :: iVar
! Local variables
REAL(fp):: A_Level_AD(Atmosphere%n_Layers)
INTEGER :: i, j, k, n_Layers
! Save the angle information
Predictor_AD%Secant_Sensor_Zenith = Predictor%Secant_Sensor_Zenith
! Calculate adjoint absorber space level associated
! with the average absorber amount
A_Level_AD = ZERO
n_Layers = Atmosphere%n_Layers
DO j = 1, Predictor%n_Absorbers
IF( Max_Order(j) < 0 )CYCLE
DO i = Max_Order(j), 2, -1
DO k = n_Layers, 1, -1
Predictor_AD%Ap(k, i-1, j) = Predictor_AD%Ap(k,i-1,j) + &
(Predictor_AD%Ap(k,i,j)*iVar%A_Level(k,j))
A_Level_AD(k) = A_Level_AD(k) + (Predictor%Ap(k,i-1,j)*Predictor_AD%Ap(k,i,j))
Predictor_AD%Ap(k,i,j) = ZERO
END DO
END DO
A_Level_AD(1:n_Layers) = A_Level_AD(1:n_Layers) + Predictor_AD%Ap(1:n_layers,1,j)
Predictor_AD%Ap(1:n_Layers, 1, j) = ZERO
DO k = n_Layers, 1, -1
Predictor_AD%aveA(k,j) = Predictor_AD%aveA(k,j) + &
(A_Level_AD(k) / (Alpha(1,j) * (Predictor%aveA(k,j) - Alpha(3,j))))
A_Level_AD(k) = ZERO
END DO
END DO
! Calculate the predictor adjoints
! ...Integrated predictors
CALL Integrated_Predictors_AD( &
Atmosphere , & ! Input
Predictor , & ! Input
Predictor_AD , & ! In/Output
Atmosphere_AD, & ! Output
iVar ) ! Internal variable input
! ...Standard predictors
CALL Standard_Predictors_AD( &
Atmosphere , & ! Input
Predictor_AD , & ! Input
Atmosphere_AD ) ! Output
! Compute the nadir integrated absorber profile adjoint
CALL Compute_IntAbsorber_AD( &
Atmosphere , & ! Input
Predictor_AD , & ! Output
Atmosphere_AD ) ! Input
! Zero the adjoint predictor structure
CALL ODAS_Predictor_Zero( Predictor_AD )
END SUBROUTINE ODAS_Assemble_Predictors_AD
!################################################################################
!################################################################################
!## ##
!## ## PRIVATE MODULE ROUTINES ## ##
!## ##
!################################################################################
!################################################################################
!================================================================================
! -- INTEGRATED ABSORBER COMPUTATION ROUTINES --
!================================================================================
!--------------------------------------------------------------------------------
!
! NAME:
! Compute_IntAbsorber
!
! PURPOSE:
! Subroutine to compute the integrated absorber profiles.
!
! LANGUAGE:
! Fortran-95
!
! CALLING SEQUENCE:
! CALL Compute_IntAbsorber( Atmosphere, & ! Input
! Predictor ) ! Output
!
! INPUT ARGUMENTS:
! Atmosphere: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
! Predictor: Predictor structure containing the calculated
! integrated absorber profiles
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!--------------------------------------------------------------------------------
SUBROUTINE Compute_IntAbsorber( Atm, & ! Input
Pred ) ! Output
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Pred
! Local variables
INTEGER :: k, j
REAL(fp) :: dPonG
INTEGER :: H2O_Idx
INTEGER :: O3_Idx
! Initialise 0'th level amounts
Pred%A(0,WET_ABSORBER_INDEX) = ZERO
Pred%A(0,DRY_ABSORBER_INDEX) = MIN(TOA_PRESSURE,Atm%Level_Pressure(0))
Pred%A(0,OZO_ABSORBER_INDEX) = ZERO
! Get the atmosphere gaseous absorber indices
H2O_Idx = CRTM_Get_AbsorberIdx(Atm,H2O_ID)
O3_Idx = CRTM_Get_AbsorberIdx(Atm, O3_ID)
! Loop over layers, TOA -> SFC
DO k = 1, Atm%n_Layers
! Compute dP/g for the current layer
dPonG = RECIPROCAL_GRAVITY * (Atm%Level_Pressure(k) - Atm%Level_Pressure(k-1))
! Compute and accumulate the sum for the
! layer absorber amounts for each absorber
Pred%A( k, WET_ABSORBER_INDEX ) = Pred%A(k-1,WET_ABSORBER_INDEX) + &
(dPonG * Atm%Absorber(k,H2O_Idx))
Pred%A( k, DRY_ABSORBER_INDEX ) = Atm%Level_Pressure(k)
Pred%A( k, OZO_ABSORBER_INDEX ) = Pred%A(k-1,OZO_ABSORBER_INDEX) + &
(dPonG * Atm%Absorber(k,O3_Idx))
END DO
! Modify absorber quantities by the angle secant
Pred%A = Pred%Secant_Sensor_Zenith * Pred%A
! Compute the integrated absorber level
! differences and average layer amount
DO j = 1, Pred%n_Absorbers
DO k = 1, Pred%n_Layers
Pred%dA(k,j) = Pred%A(k,j) - Pred%A(k-1,j)
Pred%aveA(k,j) = POINT_5 * (Pred%A(k,j) + Pred%A(k-1,j))
END DO
END DO
END SUBROUTINE Compute_IntAbsorber
!--------------------------------------------------------------------------------
!
! NAME:
! Compute_IntAbsorber_TL
!
! PURPOSE:
! Subroutine to compute the tangent-linear integrated absorber profiles.
!
! CALLING SEQUENCE:
! CALL Compute_IntAbsorber_TL( Atmosphere, & ! Input
! Atmosphere_TL, & ! Input
! Predictor_TL ) ! Output
!
! INPUT ARGUMENTS:
! Atmosphere: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Atmosphere_TL: CRTM Atmosphere structure containing the tangent-linear
! atmospheric state data, i.e. the perturbations.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
!
! OUTPUT ARGUMENTS:
! Predictor_TL: Predictor structure containing the calculated
! tangent-linear integrated absorber profiles
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!--------------------------------------------------------------------------------
SUBROUTINE Compute_IntAbsorber_TL( Atm, & ! Input
Atm_TL, & ! Input
Pred_TL ) ! Output
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm_TL
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Pred_TL
! Local variables
INTEGER :: k, j
REAL(fp) :: dPonG
REAL(fp) :: dPonG_TL
INTEGER :: H2O_Idx
INTEGER :: O3_Idx
! Initalise 0'th level amounts
Pred_TL%A(0,:) = ZERO
! Get the atmosphere gaseous absorber indices
H2O_Idx = CRTM_Get_AbsorberIdx(Atm,H2O_ID)
O3_Idx = CRTM_Get_AbsorberIdx(Atm, O3_ID)
! Loop over layers, TOA -> SFC
DO k = 1, Atm_TL%n_Layers
! Compute dP/g for the current layer
dPonG = RECIPROCAL_GRAVITY * (Atm%Level_Pressure(k) - Atm%Level_Pressure(k-1))
dPonG_TL = RECIPROCAL_GRAVITY * (Atm_TL%Level_Pressure(k) - Atm_TL%Level_Pressure(k-1))
! Compute and accumulate the sum for the
! layer absorber amounts for each absorber
Pred_TL%A(k,WET_ABSORBER_INDEX) = Pred_TL%A(k-1,WET_ABSORBER_INDEX) + &
(dPonG * Atm_TL%Absorber(k,H2O_Idx)) + &
(dPonG_TL * Atm%Absorber(k,H2O_Idx))
Pred_TL%A(k,DRY_ABSORBER_INDEX) = Atm_TL%Level_Pressure(k)
Pred_TL%A(k,OZO_ABSORBER_INDEX) = Pred_TL%A(k-1,OZO_ABSORBER_INDEX) + &
(dPonG * Atm_TL%Absorber(k,O3_Idx)) + &
(dPonG_TL * Atm%Absorber(k,O3_Idx))
END DO
! Modify absorber quantities by the angle secant
Pred_TL%A = Pred_TL%Secant_Sensor_Zenith * Pred_TL%A
! Compute the tangent-linear integrated absorber level
! differences and average layer amount
DO j = 1, Pred_TL%n_Absorbers
DO k = 1, Pred_TL%n_Layers
Pred_TL%dA(k,j) = Pred_TL%A(k,j) - Pred_TL%A(k-1,j)
Pred_TL%aveA(k,j) = POINT_5 * (Pred_TL%A(k,j) + Pred_TL%A(k-1,j))
END DO
END DO
END SUBROUTINE Compute_IntAbsorber_TL
!--------------------------------------------------------------------------------
!
! NAME:
! Compute_IntAbsorber_AD
!
! PURPOSE:
! Subroutine to compute the adjoint of the integrated absorber profiles.
!
! CALLING SEQUENCE:
! CALL Compute_IntAbsorber_AD( Atmosphere, & ! Input
! Predictor_AD, & ! Input
! Atmosphere_AD ) ! Output
!
! INPUT ARGUMENTS:
! Atmosphere: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_AD: Predictor structure that, on input, contains the
! calculated adjoint integrated absorber profiles.
! These values are set to zero on output.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! OUTPUT ARGUMENTS:
! Atmosphere_AD: CRTM Atmosphere structure containing the adjoint
! atmospheric state data, i.e. the Jacobians.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! SIDE EFFECTS:
! Components of the input structure, Predictor_AD, are set to zero
! on output.
!
!--------------------------------------------------------------------------------
SUBROUTINE Compute_IntAbsorber_AD( Atm, & ! Input
Pred_AD, & ! Input
Atm_AD ) ! Output
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Pred_AD
TYPE(CRTM_Atmosphere_type), INTENT(IN OUT) :: Atm_AD
! Local variables
INTEGER :: k, j
REAL(fp) :: dPonG
REAL(fp) :: dPonG_AD
INTEGER :: H2O_Idx
INTEGER :: O3_Idx
! Get the atmosphere gaseous absorber indices
H2O_Idx = CRTM_Get_AbsorberIdx(Atm,H2O_ID)
O3_Idx = CRTM_Get_AbsorberIdx(Atm, O3_ID)
! Compute the adjoint integrated absorber level
! differences and average layer amount
DO j = 1, Pred_AD%n_Absorbers
DO k = Pred_AD%n_Layers, 1, -1
Pred_AD%A(k-1,j) = Pred_AD%A(k-1,j) + (POINT_5*Pred_AD%aveA(k,j))
Pred_AD%A(k-1,j) = Pred_AD%A(k-1,j) - Pred_AD%dA(k,j)
Pred_AD%A(k ,j) = Pred_AD%A(k ,j) + (POINT_5*Pred_AD%aveA(k,j))
Pred_AD%A(k ,j) = Pred_AD%A(k ,j) + Pred_AD%dA(k,j)
Pred_AD%dA( k,j) = ZERO
Pred_AD%aveA(k,j) = ZERO
END DO
END DO
! Modify absorber quantities by the angle secant
Pred_AD%A = Pred_AD%Secant_Sensor_Zenith * Pred_AD%A
! Loop over layers, SFC -> TOA
DO k = Atm_AD%n_Layers, 1, -1
! Compute dP/g for the current layer
dPonG = RECIPROCAL_GRAVITY * (Atm%Level_Pressure(k) - Atm%Level_Pressure(k-1))
! Ozone amount adjoint
Atm_AD%Absorber(k,O3_Idx) = Atm_AD%Absorber(k,O3_Idx) + &
(dPonG * Pred_AD%A(k,OZO_ABSORBER_INDEX))
! Pressure adjoint
Atm_AD%Level_Pressure(k) = Atm_AD%Level_Pressure(k) + Pred_AD%A(k,DRY_ABSORBER_INDEX)
! Water vapor amount adjoint
Atm_AD%Absorber(k,H2O_Idx) = Atm_AD%Absorber(k,H2O_Idx) + &
(dPonG * Pred_AD%A(k,WET_ABSORBER_INDEX))
! dP/g adjoint
dPonG_AD = ( Atm%Absorber(k, O3_Idx) * Pred_AD%A(k,OZO_ABSORBER_INDEX)) + &
( Atm%Absorber(k,H2O_Idx) * Pred_AD%A(k,WET_ABSORBER_INDEX))
Atm_AD%Level_Pressure(k-1) = Atm_AD%Level_Pressure(k-1) - (RECIPROCAL_GRAVITY * dPonG_AD)
Atm_AD%Level_Pressure( k ) = Atm_AD%Level_Pressure( k ) + (RECIPROCAL_GRAVITY * dPonG_AD)
! Previous layer absorber amounts
Pred_AD%A(k-1,OZO_ABSORBER_INDEX) = Pred_AD%A(k-1,OZO_ABSORBER_INDEX) + &
Pred_AD%A( k, OZO_ABSORBER_INDEX)
Pred_AD%A( k, OZO_ABSORBER_INDEX) = ZERO
Pred_AD%A( k, DRY_ABSORBER_INDEX) = ZERO
Pred_AD%A(k-1,WET_ABSORBER_INDEX) = Pred_AD%A(k-1,WET_ABSORBER_INDEX) + &
Pred_AD%A( k, WET_ABSORBER_INDEX)
Pred_AD%A( k, WET_ABSORBER_INDEX) = ZERO
END DO
END SUBROUTINE Compute_IntAbsorber_AD
!================================================================================
! -- PREDICTOR COMPUTATION ROUTINES --
!================================================================================
!--------------------------------------------------------------------------------
!
! NAME:
! Standard_Predictors
!
! PURPOSE:
! Subroutine to compute the integrated absorber INDEPENDENT
! predictors for the gas absorption model.
!
! CALLING SEQUENCE:
! CALL Standard_Predictors( Atmosphere, & ! Input
! Predictor ) ! Output
!
! INPUT ARGUMENTS:
! Atmosphere: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
! Predictor: Predictor structure containing the calculated
! standard predictors.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!--------------------------------------------------------------------------------
SUBROUTINE Standard_Predictors( Atm, & ! Input
Pred ) ! Output, Istd x K
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Pred
! Local variables
INTEGER :: k
REAL(fp) :: p2
REAL(fp) :: t2
INTEGER :: H2O_Idx
! Get the H2O absorber index
H2O_Idx = CRTM_Get_AbsorberIdx(Atm,H2O_ID)
! Compute the standard predictor set
Layer_Loop: DO k = 1, Atm%n_Layers
! Precalculate the squared terms
p2 = Atm%Pressure(k) * Atm%Pressure(k)
t2 = Atm%Temperature(k) * Atm%Temperature(k)
! Calculate the standard predictors
Pred%X(k, 1) = Atm%Temperature(k)
Pred%X(k, 2) = Atm%Pressure(k)
Pred%X(k, 3) = t2
Pred%X(k, 4) = p2
Pred%X(k, 5) = Atm%Temperature(k) * Atm%Pressure(k)
Pred%X(k, 6) = t2 * Atm%Pressure(k)
Pred%X(k, 7) = Atm%Temperature(k) * p2
Pred%X(k, 8) = t2 * p2
Pred%X(k, 9) = Atm%Pressure(k)**POINT_25
Pred%X(k,10) = Atm%Absorber(k,H2O_Idx)
Pred%X(k,11) = Atm%Absorber(k,H2O_Idx) / t2
END DO Layer_Loop
END SUBROUTINE Standard_Predictors
!--------------------------------------------------------------------------------
!
! NAME:
! Integrated_Predictors
!
! PURPOSE:
! Subroutine to compute the integrated absorber DEPENDENT
! predictors for the gas absorption model.
!
! CALLING SEQUENCE:
! CALL Integrated_Predictors( Atmosphere, & ! Input
! Predictor, & ! In/Output
! iVar ) ! Internal variable output
!
! INPUT ARGUMENTS:
! Atmosphere: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
! Predictor: Predictor structure containing the calculated
! integrated predictors.
! UNITS: N/A
! TYPE: ODAS_Predictor_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 the ODAS_Predictor module.
! UNITS: N/A
! TYPE: iVar_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT)
!--------------------------------------------------------------------------------
SUBROUTINE Integrated_Predictors( Atm, & ! Input
Pred, & ! Input/output
iVar ) ! Internal variable output
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Pred
TYPE(iVar_type), INTENT(OUT) :: iVar
! Local variables
INTEGER :: i, i1, j, k
REAL(fp) :: Inverse_1
REAL(fp) :: Inverse_2
REAL(fp) :: Inverse_3
! LEVEL Predictor, Iint x 0:K
REAL(fp), DIMENSION(MAX_N_INTEGRATED_PREDICTORS,0:Atm%n_Layers) :: xL
! Begin absorber loop
Absorber_Loop: DO j = 1, Pred%n_Absorbers
! Determine being index of current absorber predictors
i1 = MAX_N_STANDARD_PREDICTORS + ((j-1) * MAX_N_INTEGRATED_PREDICTORS) + 1
! Initialise values
iVar%A_2(0,j) = Pred%A(0,j) * Pred%A(0,j)
iVar%s(:,0,j) = ZERO
xL(:,0) = ZERO
! Compute the integrated predictor set
Layer_Loop: DO k = 1, Pred%n_Layers
! Calculate Absorber multiplicative Factors
iVar%A_2(k,j) = Pred%A(k,j)*Pred%A(k,j)
iVar%Factor_1(k,j) = (Pred%A(k,j) + Pred%A(k-1,j) ) * Pred%dA(k,j) ! For ** terms
iVar%Factor_2(k,j) = (iVar%A_2(k,j) + iVar%A_2(k-1,j)) * Pred%dA(k,j) ! For *** terms
! Calculate the intermediate sums
iVar%s(1,k,j) = iVar%s(1,k-1,j) + ( Atm%Temperature(k) * Pred%dA(k,j) ) ! T*
iVar%s(2,k,j) = iVar%s(2,k-1,j) + ( Atm%Pressure(k) * Pred%dA(k,j) ) ! P*
iVar%s(3,k,j) = iVar%s(3,k-1,j) + ( Atm%Temperature(k) * iVar%Factor_1(k,j) ) ! T**
iVar%s(4,k,j) = iVar%s(4,k-1,j) + ( Atm%Pressure(k) * iVar%Factor_1(k,j) ) ! P**
iVar%s(5,k,j) = iVar%s(5,k-1,j) + ( Atm%Temperature(k) * iVar%Factor_2(k,j) ) ! T***
iVar%s(6,k,j) = iVar%s(6,k-1,j) + ( Atm%Pressure(k) * iVar%Factor_2(k,j) ) ! P***
! Calculate the normalising factors
! for the integrated predictors
IF ( Pred%A(k,j) > MINIMUM_ABSORBER_AMOUNT ) THEN
Inverse_1 = ONE / Pred%A(k,j)
ELSE
Inverse_1 = ZERO
END IF
Inverse_2 = Inverse_1 * Inverse_1
Inverse_3 = Inverse_2 * Inverse_1
! Compute the LEVEL integrated predictors
xL(1,k) = POINT_5 * iVar%s(1,k,j) * Inverse_1 ! T*
xL(2,k) = POINT_5 * iVar%s(2,k,j) * Inverse_1 ! P*
xL(3,k) = POINT_5 * iVar%s(3,k,j) * Inverse_2 ! T**
xL(4,k) = POINT_5 * iVar%s(4,k,j) * Inverse_2 ! P**
xL(5,k) = POINT_75 * iVar%s(5,k,j) * Inverse_3 ! T***
xL(6,k) = POINT_75 * iVar%s(6,k,j) * Inverse_3 ! P***
! Sum predictors for current absorber across layers
DO i = 1, MAX_N_INTEGRATED_PREDICTORS
Pred%X(k,i1+i-1) = xL(i,k) + xL(i,k-1)
END DO
END DO Layer_Loop
END DO Absorber_Loop
END SUBROUTINE Integrated_Predictors
!--------------------------------------------------------------------------------
!
! NAME:
! Standard_Predictors_TL
!
! PURPOSE:
! Subroutine to compute the integrated absorber INDEPENDENT
! tangent-linear predictors for the gas absorption model.
!
! CALLING SEQUENCE:
! CALL Standard_Predictors_TL( Atmosphere, & ! Input
! Atmosphere_TL, & ! Input
! Predictor_TL ) ! Output
!
! INPUT ARGUMENTS:
! Atmosphere: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Atmosphere_TL: CRTM Atmosphere structure containing the tangent-linear
! atmospheric state data, i.e. the perturbations.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
! Predictor_TL: Predictor structure containing the calculated
! tangent-linear standard predictors.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!--------------------------------------------------------------------------------
SUBROUTINE Standard_Predictors_TL( Atm, & ! Input
Atm_TL, & ! Input
Pred_TL ) ! Output
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm_TL
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Pred_TL
! Local variables
INTEGER :: k
REAL(fp) :: p2, p2_TL
REAL(fp) :: t2, t2_TL
INTEGER :: H2O_Idx
! Get the H2O absorber index
H2O_Idx = CRTM_Get_AbsorberIdx(Atm,H2O_ID)
! Compute the tangent-linear standard predictor set
Layer_loop: DO k = 1, Atm%n_Layers
! Precalculate the squared terms
p2 = Atm%Pressure(k) * Atm%Pressure(k)
t2 = Atm%Temperature(k) * Atm%Temperature(k)
! Tangent-linear of squared terms
p2_TL = TWO * Atm%Pressure(k) * Atm_TL%Pressure(k)
t2_TL = TWO * Atm%Temperature(k) * Atm_TL%Temperature(k)
! Calculate and assign the integrated absorber independent predictors
Pred_TL%X(k, 1) = Atm_TL%Temperature(k)
Pred_TL%X(k, 2) = Atm_TL%Pressure(k)
Pred_TL%X(k, 3) = t2_TL
Pred_TL%X(k, 4) = p2_TL
Pred_TL%X(k, 5) = ( Atm%Temperature(k) * Atm_TL%Pressure(k) ) + &
( Atm%Pressure(k) * Atm_TL%Temperature(k) )
Pred_TL%X(k, 6) = ( Atm%Pressure(k) * t2_TL ) + &
( t2 * Atm_TL%Pressure(k) )
Pred_TL%X(k, 7) = ( Atm%Temperature(k) * p2_TL ) + &
( p2 * Atm_TL%Temperature(k) )
Pred_TL%X(k, 8) = ( t2 * p2_TL ) + &
( p2 * t2_TL )
Pred_TL%X(k, 9) = POINT_25 * (Atm%Pressure(k)**(-POINT_75)) * Atm_TL%Pressure(k)
Pred_TL%X(k,10) = Atm_TL%Absorber(k,H2O_Idx)
Pred_TL%X(k,11) = ( Atm_TL%Absorber(k,H2O_Idx) - &
( Atm%Absorber(k,H2O_Idx) * t2_TL / t2 ) ) / t2
END DO Layer_loop
END SUBROUTINE Standard_Predictors_TL
!--------------------------------------------------------------------------------
!
! NAME:
! Integrated_Predictors_TL
!
! PURPOSE:
! Subroutine to compute the integrated absorber amount DEPENDENT
! tangent-linear predictors for the gas absorption model.
!
! CALLING SEQUENCE:
! CALL Integrated_Predictors_TL( Atmosphere, & ! Input
! Predictor, & ! Input
! Atmosphere_TL, & ! Input
! Predictor_TL, & ! In/Output
! iVar ) ! Internal variable input
!
! INPUT ARGUMENTS:
! Atmosphere: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the calculated
! integrated predictors.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Atmosphere_TL: CRTM Atmosphere structure containing the tangent-linear
! atmospheric state data, i.e. the perturbations.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_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 the Predictor module.
! UNITS: N/A
! TYPE: iVar_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
! OUTPUT ARGUMENTS:
! Predictor_TL: Predictor structure containing the calculated
! tangent-linear integrated predictors.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!--------------------------------------------------------------------------------
SUBROUTINE Integrated_Predictors_TL( Atm, & ! Input
Pred, & ! Input
Atm_TL, & ! Input
Pred_TL, & ! Output
iVar ) ! Internal variable input
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
TYPE(ODAS_Predictor_type), INTENT(IN) :: Pred
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm_TL
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Pred_TL
TYPE(iVar_type), INTENT(IN) :: iVar
! Local variables
INTEGER :: i, i1, j, k
REAL(fp) :: Factor_1_TL
REAL(fp) :: Factor_2_TL
REAL(fp) :: Inverse_1
REAL(fp) :: Inverse_2
REAL(fp) :: Inverse_3
REAL(fp) :: Inverse_4
REAL(fp) :: Inverse_1_TL
REAL(fp) :: Inverse_2_TL
REAL(fp) :: Inverse_3_TL
! Square of the Absorber amount. 0:K
REAL(fp), DIMENSION(0:Atm%n_Layers) :: A_2_TL
! Intermediate summation arrays. Iint
REAL(fp), DIMENSION(MAX_N_INTEGRATED_PREDICTORS) :: s_TL
! LEVEL Predictor, Iint x 0:K
REAL(fp), DIMENSION(MAX_N_INTEGRATED_PREDICTORS,0:Atm%n_Layers) :: xL_TL
! Begin absorber loop
Absorber_Loop: DO j = 1, Pred_TL%n_Absorbers
! Determine being index of current absorber predictors
i1 = MAX_N_STANDARD_PREDICTORS + ((j-1) * MAX_N_INTEGRATED_PREDICTORS) + 1
! Initialise values
A_2_TL(0) = TWO * Pred%A(0,j) * Pred_TL%A(0,j)
s_TL(:) = ZERO
xL_TL(:,0) = ZERO
! Compute the integrated predictor set
Layer_loop: DO k = 1, Atm%n_Layers
! Calculate absorber multiplicative Factors
A_2_TL(k) = TWO * Pred%A(k,j) * Pred_TL%A(k,j)
! For the ** terms
Factor_1_TL = ( ( Pred%A(k,j) + Pred%A(k-1,j) ) * Pred_TL%dA(k,j) ) + &
( ( Pred_TL%A(k,j) + Pred_TL%A(k-1,j) ) * Pred%dA(k,j) )
! For the *** terms
Factor_2_TL = ( ( iVar%A_2(k,j) + iVar%A_2(k-1,j)) * Pred_TL%dA(k,j) ) + &
( ( A_2_TL(k) + A_2_TL(k-1) ) * Pred%dA(k,j) )
! Calculate the intermediate sums
s_TL(1) = s_TL(1) + ( Atm_TL%Temperature(k) * Pred%dA(k,j)) + & ! T*
( Atm%Temperature(k) * Pred_TL%dA(k,j))
s_TL(2) = s_TL(2) + ( Atm_TL%Pressure(k) * Pred%dA(k,j)) + & ! P*
( Atm%Pressure(k) * Pred_TL%dA(k,j))
s_TL(3) = s_TL(3) + ( Atm_TL%Temperature(k) * iVar%Factor_1(k,j)) + & ! T**
( Atm%Temperature(k) * Factor_1_TL )
s_TL(4) = s_TL(4) + ( Atm_TL%Pressure(k) * iVar%Factor_1(k,j)) + & ! P**
( Atm%Pressure(k) * Factor_1_TL )
s_TL(5) = s_TL(5) + ( Atm_TL%Temperature(k) * iVar%Factor_2(k,j)) + & ! T***
( Atm%Temperature(k) * Factor_2_TL )
s_TL(6) = s_TL(6) + ( Atm_TL%Pressure(k) * iVar%Factor_2(k,j)) + & ! P***
( Atm%Pressure(k) * Factor_2_TL )
! Calculate the normalising factors
! for the integrated predictors
IF ( Pred%A(k,j) > MINIMUM_ABSORBER_AMOUNT ) THEN
Inverse_1 = ONE / Pred%A(k,j)
ELSE
Inverse_1 = ZERO
END IF
Inverse_2 = Inverse_1 * Inverse_1
Inverse_3 = Inverse_2 * Inverse_1
Inverse_4 = Inverse_3 * Inverse_1
Inverse_1_TL = -Inverse_2 * Pred_TL%A(k,j)
Inverse_2_TL = -Inverse_3 * Pred_TL%A(k,j) * TWO
Inverse_3_TL = -Inverse_4 * Pred_TL%A(k,j) * THREE
! Compute the tangent-linear LEVEL integrated predictors
xL_TL(1,k) = POINT_5 * ( ( s_TL(1) * Inverse_1 ) + & ! T*
( iVar%s(1,k,j) * Inverse_1_TL ) )
xL_TL(2,k) = POINT_5 * ( ( s_TL(2) * Inverse_1 ) + & ! P*
( iVar%s(2,k,j) * Inverse_1_TL ) )
xL_TL(3,k) = POINT_5 * ( ( s_TL(3) * Inverse_2 ) + & ! T**
( iVar%s(3,k,j) * Inverse_2_TL ) )
xL_TL(4,k) = POINT_5 * ( ( s_TL(4) * Inverse_2 ) + & ! P**
( iVar%s(4,k,j) * Inverse_2_TL ) )
xL_TL(5,k) = POINT_75 * ( ( s_TL(5) * Inverse_3 ) + & ! T***
( iVar%s(5,k,j) * Inverse_3_TL ) )
xL_TL(6,k) = POINT_75 * ( ( s_TL(6) * Inverse_3 ) + & ! P***
( iVar%s(6,k,j) * Inverse_3_TL ) )
! Sum predictors across layers
DO i = 1, MAX_N_INTEGRATED_PREDICTORS
Pred_TL%X(k,i1+i-1) = xL_TL(i,k) + xL_TL(i,k-1)
END DO
END DO Layer_loop
END DO Absorber_Loop
END SUBROUTINE Integrated_Predictors_TL
!--------------------------------------------------------------------------------
!
! NAME:
! Standard_Predictors_AD
!
! PURPOSE:
! Subroutine to compute the integrated absorber amount INDEPENDENT
! predictors for the adjoint gas absorption model.
!
! CALLING SEQUENCE:
! CALL Standard_Predictors_AD( Atmosphere, & ! Input
! Predictor_AD, & ! Input
! Atmosphere_AD ) ! Output
!
!
! INPUT ARGUMENTS:
! Atmosphere: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_AD: Predictor structure containing the calculated
! adjoint integrated predictors.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! OUTPUT ARGUMENTS:
! Atmosphere_AD: CRTM Atmosphere structure containing the adjoints of
! the standard predictors.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! COMMENTS:
! Note that the output adjoint argument, Atmosphere_AD, has INTENT of
! IN OUT. This is because the pressure, temperature, and absorber
! components of the Atmosphere_AD structure are assumed to have some
! initial value (which could simply be zero) that is added to when
! contructing the pressure, temperature and absorber adjoints.
!
!--------------------------------------------------------------------------------
SUBROUTINE Standard_Predictors_AD( Atm, & ! Input
Pred_AD, & ! Input
Atm_AD ) ! Output
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Pred_AD
TYPE(CRTM_Atmosphere_type), INTENT(IN OUT) :: Atm_AD
! Local variables
INTEGER :: k
REAL(fp) :: p2, p2_AD
REAL(fp) :: t2, t2_AD
REAL(fp) :: t4
INTEGER :: H2O_Idx
! Get the H2O absorber index
H2O_Idx = CRTM_Get_AbsorberIdx(Atm,H2O_ID)
! Compute the standard predictor set
! Don't have to loop backwards here as this is a parallel loop
Layer_loop: DO k = 1, Atm%n_Layers
! Precalculate the squared terms
p2 = Atm%Pressure(k) * Atm%Pressure(k)
t2 = Atm%Temperature(k) * Atm%Temperature(k)
t4 = t2 * t2
! Pressure squared adjoint
p2_AD = Pred_AD%X(k,4) + & ! Predictor #4, P^2
( Atm%Temperature(k) * Pred_AD%X(k,7) ) + & ! Predictor #7, T.P^2
( t2 * Pred_AD%X(k,8) ) ! Predictor #8, T^2.P^2
! Temperature squared adjoint
t2_AD = Pred_AD%X(k,3) + & ! Predictor #3, T^2
( Atm%Pressure(k) * Pred_AD%X(k,6) ) + & ! Predictor #6, T^2.P
( p2 * Pred_AD%X(k,8) ) + & ! Predictor #8, T^2.P^2
(-Atm%Absorber(k,H2O_Idx) * Pred_AD%X(k,11) / t4 ) ! Predictor #11, W/T^2
! Water vapor adjoint
Atm_AD%Absorber(k,H2O_Idx) = Atm_AD%Absorber(k,H2O_Idx) + &
Pred_AD%X(k,10) + & ! Predictor #10, W
( Pred_AD%X(k,11) / t2 ) ! Predictor #11, W/T^2
! Temperature adjoint
Atm_AD%Temperature(k) = Atm_AD%Temperature(k) + &
( TWO * Atm%Temperature(k) * t2_AD ) + & ! T^2 term
Pred_AD%X(k,1) + & ! Predictor #1, T
( Atm%Pressure(k) * Pred_AD%X(k,5) ) + & ! Predictor #5, T.P
( p2 * Pred_AD%X(k,7) ) ! Predictor #7, T.P^2
! Pressure adjoint
Atm_AD%Pressure(k) = Atm_AD%Pressure(k) + &
( TWO * Atm%Pressure(k) * p2_AD ) + & ! P^2 term
Pred_AD%X(k,2) + & ! Predictor #2, P
( Atm%Temperature(k) * Pred_AD%X(k,5) ) + & ! Predictor #5, T.P
( t2 * Pred_AD%X(k,6) ) + & ! Predictor #6, T^2.P
( POINT_25 * (Atm%Pressure(k)**(-POINT_75)) * Pred_AD%X(k,9) ) ! Predictor #9, P^1/4
END DO Layer_loop
END SUBROUTINE Standard_Predictors_AD
!--------------------------------------------------------------------------------
!
! NAME:
! Integrated_Predictors_AD
!
! PURPOSE:
! Subroutine to compute the integrated absorber amount DEPENDENT
! predictors for the adjoint gas absorption model.
!
! CALLING SEQUENCE:
! CALL Integrated_Predictors_AD( Atmosphere, & ! Input
! Predictor, & ! Input
! Predictor_AD, & ! In/Output
! Atmosphere_AD, & ! Output
! iVar ) ! Internal variable input
!
! INPUT ARGUMENTS:
! Atmosphere: CRTM Atmosphere structure containing the atmospheric
! state data.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor: Predictor structure containing the calculated
! integrated predictors.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! Predictor_AD: Predictor structure that, on input, contains
! the adjoint integrated predictors.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! OUTPUT ARGUMENTS:
! Predictor_AD: Predictor structure that, on output, contains
! the adjoint integrated absorber amounts.
! UNITS: N/A
! TYPE: ODAS_Predictor_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! Atmosphere_AD: CRTM Atmosphere structure containing the adjoints of
! the integrated predictors.
! UNITS: N/A
! TYPE: CRTM_Atmosphere_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! COMMENTS:
! Note that all the adjoint arguments have INTENTs of IN OUT. This is
! because they are assumed to have some value upon entry even if they
! are labeled as output arguments.
!
!--------------------------------------------------------------------------------
SUBROUTINE Integrated_Predictors_AD( Atm, & ! Input
Pred, & ! Input
Pred_AD, & ! In/Output
Atm_AD, & ! Output
iVar ) ! Internal variable input
! Arguments
TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
TYPE(ODAS_Predictor_type), INTENT(IN) :: Pred
TYPE(ODAS_Predictor_type), INTENT(IN OUT) :: Pred_AD
TYPE(CRTM_Atmosphere_type), INTENT(IN OUT) :: Atm_AD
TYPE(iVar_type), INTENT(IN) :: iVar
! Local variables
INTEGER :: i, i1, j, k
REAL(fp) :: d_A_AD
REAL(fp) :: Factor_1_AD
REAL(fp) :: Factor_2_AD
REAL(fp) :: Inverse_1
REAL(fp) :: Inverse_2
REAL(fp) :: Inverse_3
REAL(fp) :: Inverse_4
REAL(fp) :: Inverse_1_AD
REAL(fp) :: Inverse_2_AD
REAL(fp) :: Inverse_3_AD
REAL(fp) :: Multiplier
REAL(fp) :: Add_Factor
! Square of the absorber amount. 0:K
REAL(fp), DIMENSION(0:Atm%n_Layers) :: A_2_AD
! Intermediate summation array, Iint x 0:K and Iint
REAL(fp), DIMENSION(MAX_N_INTEGRATED_PREDICTORS) :: s_AD
! LEVEL predictor, Iint x 0:K
REAL(fp), DIMENSION(MAX_N_INTEGRATED_PREDICTORS,0:Atm%n_Layers ) :: xL_AD
! Begin absorber loop
Absorber_Loop: DO j = 1, Pred_AD%n_Absorbers
! Determine being index of current absorber predictors
i1 = MAX_N_STANDARD_PREDICTORS + ((j-1) * MAX_N_INTEGRATED_PREDICTORS) + 1
! Initialise values
xL_AD(:,Atm%n_Layers) = ZERO
s_AD(:) = ZERO
A_2_AD(Atm%n_Layers) = ZERO
! Compute the integrated predictor set adjoints
Layer_Loop: DO k = Atm%n_Layers, 1, -1
! Calculate the normalising factors
! for the integrated predictors
IF ( Pred%A(k,j) > MINIMUM_ABSORBER_AMOUNT ) THEN
Inverse_1 = ONE / Pred%A(k,j)
ELSE
Inverse_1 = ZERO
END IF
Inverse_2 = Inverse_1 * Inverse_1
Inverse_3 = Inverse_2 * Inverse_1
Inverse_4 = Inverse_3 * Inverse_1
! Adjoint of predictor summation across layers
DO i = 1, MAX_N_INTEGRATED_PREDICTORS
xL_AD(i,k) = xL_AD(i,k) + Pred_AD%X(k,i1+i-1)
xL_AD(i,k-1) = Pred_AD%X(k,i1+i-1)
END DO
! Adjoint of the LEVEL integrated predictors intermediate sums
!
! Note that the adjoint variables Inverse_X_AD are local to this
! loop iteration so they are simply assigned when they are first
! used.
!
! P* and T*, Predictor indices #2 and 1
! Simply assign a value for Inverse_1_AD
Multiplier = POINT_5 * Inverse_1
s_AD(1) = s_AD(1) + ( Multiplier * xL_AD(1,k) )
s_AD(2) = s_AD(2) + ( Multiplier * xL_AD(2,k) )
Inverse_1_AD = POINT_5 * ( ( iVar%s(1,k,j) * xL_AD(1,k) ) + &
( iVar%s(2,k,j) * xL_AD(2,k) ) )
! P** and T**, Predictor indices #4 and 3
Multiplier = POINT_5 * Inverse_2
s_AD(3) = s_AD(3) + ( Multiplier * xL_AD(3,k) )
s_AD(4) = s_AD(4) + ( Multiplier * xL_AD(4,k) )
Inverse_2_AD = POINT_5 * ( ( iVar%s(3,k,j) * xL_AD(3,k) ) + &
( iVar%s(4,k,j) * xL_AD(4,k) ) )
! P*** and T***, Predictor indices #6 and 5
Multiplier = POINT_75 * Inverse_3
s_AD(5) = s_AD(5) + ( Multiplier * xL_AD(5,k) )
s_AD(6) = s_AD(6) + ( Multiplier * xL_AD(6,k) )
Inverse_3_AD = POINT_75 * ( ( iVar%s(5,k,j) * xL_AD(5,k) ) + &
( iVar%s(6,k,j) * xL_AD(6,k) ) )
! Adjoint of Inverse terms. Note that the Inverse_X_AD
! terms are *not* zeroed out as they are re-assigned values
! each loop iteration above.
Pred_AD%A(k,j) = Pred_AD%A(k,j) - (Inverse_2 * Inverse_1_AD ) - &
(TWO * Inverse_3 * Inverse_2_AD ) - &
(THREE * Inverse_4 * Inverse_3_AD )
! Pressure adjoint
Atm_AD%Pressure(k) = Atm_AD%Pressure(k) + &
( Pred%dA(k,j) * s_AD(2) ) + & ! P*
( iVar%Factor_1(k,j) * s_AD(4) ) + & ! P**
( iVar%Factor_2(k,j) * s_AD(6) ) ! P***
! Temperature adjoint
Atm_AD%Temperature(k) = Atm_AD%Temperature(k) + &
( Pred%dA(k,j) * s_AD(1) ) + & ! T*
( iVar%Factor_1(k,j) * s_AD(3) ) + & ! T**
( iVar%Factor_2(k,j) * s_AD(5) ) ! T***
! Adjoint of the absorber amount
!
! Note that the adjoint variables Factor_X_AD and
! d_A_AD are local to this loop iteration
! so they are simply assigned when they are first
! used (and thus not zeroed out at the end of each
! iteration)
!
! Note there are no
! s_AD() = 0
! because all the tangent-linear forms are
! s_TL() = s_TL() + (...)
! summing from the previous Layer.
!
! Multiplicative factors
Factor_1_AD = ( Atm%Temperature(k) * s_AD(3) ) + &
( Atm%Pressure(k) * s_AD(4) )
Factor_2_AD = ( Atm%Temperature(k) * s_AD(5) ) + &
( Atm%Pressure(k) * s_AD(6) )
! Adjoint of the square integrated absorber amount.
!
! Note that A_2_AD() is a LOCAL adjoint variable,
! so the initialisation of A_2_AD(k-1) here for
! each "k-1" is o.k. rather than
! A_2_AD(k-1) = A_2_AD(k-1) + ( d_A(k) * Factor_2_AD )
! A_2_AD( k ) = A_2_AD( k ) + ( d_A(k) * Factor_2_AD )
! since only A_2_AD( n_Layers ) is initialised outside the
! current layer loop.
A_2_AD(k-1) = Pred%dA(k,j) * Factor_2_AD
A_2_AD( k ) = A_2_AD( k ) + A_2_AD(k-1)
! Adjoint of A(). Here, since Pred_AD%A() is NOT a local adjoint
! variable, we can't use the same form as for A_2_AD() above.
d_A_AD = ( Atm%Temperature(k) * s_AD(1) ) + &
( Atm%Pressure(k) * s_AD(2) ) + &
( ( Pred%A(k,j) + Pred%A(k-1,j) ) * Factor_1_AD ) + &
( ( iVar%A_2(k,j) + iVar%A_2(k-1,j) ) * Factor_2_AD )
Add_Factor = Pred%dA(k,j) * Factor_1_AD
Pred_AD%A(k-1,j) = Pred_AD%A(k-1,j) + Add_Factor - d_A_AD
Pred_AD%A( k ,j) = Pred_AD%A( k ,j) + Add_Factor + d_A_AD + &
( TWO * Pred%A(k,j) * A_2_AD(k) )
A_2_AD(k) = ZERO
END DO Layer_Loop
! Adjoint of level 0 A
Pred_AD%A(0,j) = Pred_AD%A(0,j) + ( TWO * Pred%A(0,j) * A_2_AD(0) )
A_2_AD(0) = ZERO
END DO Absorber_Loop
END SUBROUTINE Integrated_Predictors_AD
END MODULE ODAS_Predictor