! ! CRTM_Predictor ! ! Module containing routines to compute the predictors for the regression ! model algorithms that compute the optical depth profile due to gaseous ! absorption. ! MODULE CRTM_Predictor ! ----------------- ! Environment setup ! ----------------- ! Module use USE Type_Kinds, ONLY: fp USE Message_Handler, ONLY: SUCCESS, FAILURE, Display_Message USE CRTM_Parameters, ONLY: ZERO, & ODAS_ALGORITHM, ODPS_ALGORITHM, ODSSU_ALGORITHM USE CRTM_Atmosphere_Define, ONLY: CRTM_Atmosphere_type USE CRTM_TauCoeff, ONLY: TC USE CRTM_AncillaryInput_Define, ONLY: CRTM_AncillaryInput_type USE CRTM_GeometryInfo_Define, ONLY: CRTM_GeometryInfo_type, & CRTM_GeometryInfo_GetValue USE CRTM_AtmOptics_Define, ONLY: CRTM_AtmOptics_type USE CRTM_Predictor_Define, ONLY: CRTM_Predictor_type ! ODAS modules USE ODAS_Predictor_Define, ONLY: ODAS_Predictor_type , & ODAS_Predictor_Associated, & ODAS_Predictor_Create , & ODAS_Predictor_Destroy USE ODAS_Predictor, ONLY: ODAS_APVar_type => iVar_type, & ODAS_Assemble_Predictors , & ODAS_Assemble_Predictors_TL , & ODAS_Assemble_Predictors_AD , & ODAS_MAX_N_PREDICTORS => MAX_N_PREDICTORS, & ODAS_MAX_N_ABSORBERS => MAX_N_ABSORBERS , & ODAS_MAX_N_ORDERS => MAX_N_ORDERS ! ODPS modules USE ODPS_Predictor_Define, ONLY: ODPS_Predictor_type , & ODPS_Predictor_Associated, & ODPS_Predictor_Destroy , & ODPS_Predictor_Create , & PAFV_Associated , & PAFV_Destroy , & PAFV_Create USE ODPS_Predictor, ONLY: ODPS_APVar_type => iVar_type, & ODPS_Get_n_Components , & ODPS_Get_max_n_Predictors, & ODPS_Get_n_Absorbers , & ODPS_Get_SaveFWVFlag , & ODPS_Assemble_Predictors , & ODPS_Assemble_Predictors_TL, & ODPS_Assemble_Predictors_AD, & ALLOW_OPTRAN ! ODZeeman modules USE ODZeeman_AtmAbsorption, ONLY: Zeeman_Compute_Predictors, & Zeeman_Compute_Predictors_TL, & Zeeman_Compute_Predictors_AD, & Is_ODZeeman ! Disable implicit typing IMPLICIT NONE ! ------------ ! Visibilities ! ------------ ! Everything private by default PRIVATE ! Datatypes PUBLIC :: iVar_type ! Procedures PUBLIC :: CRTM_Compute_Predictors PUBLIC :: CRTM_Compute_Predictors_TL PUBLIC :: CRTM_Compute_Predictors_AD ! ----------------- ! Module parameters ! ----------------- CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & '$Id: CRTM_Predictor.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $' ! Message string length INTEGER, PARAMETER :: ML = 256 ! ----------------------------------------- ! Structure to hold Predictor forward model ! variables across FWD, TL, and AD calls ! ----------------------------------------- TYPE :: iVar_type PRIVATE TYPE(ODAS_APVar_type) :: ODAS TYPE(ODPS_APVar_type) :: ODPS END TYPE iVar_type CONTAINS !################################################################################ !################################################################################ !## ## !## ## PUBLIC MODULE ROUTINES ## ## !## ## !################################################################################ !################################################################################ !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CRTM_Compute_Predictors ! ! PURPOSE: ! Subroutine to calculate the gas absorption model predictors. ! It is a wrapper which calls the algorithm specific routine. ! ! CALLING SEQUENCE: ! CALL CRTM_Compute_Predictors( & ! SensorIndex , & ! Input ! Atmosphere , & ! Input ! GeometryInfo , & ! Input ! AncillaryInput, & ! Input ! Predictor , & ! Output ! iVar ) ! Internal variable output ! ! INPUT ARGUMENTS: ! SensorIndex: ! Sensor index id. This is a unique index associated ! with a (supported) sensor used to access the ! shared coefficient data for a particular sensor. ! See the ChannelIndex argument. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! 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) ! ! AncillaryInput: ! Structure holding ancillary inputs ! UNITS: N/A ! TYPE: AncillaryInput_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OUTPUT ARGUMENTS: ! Predictor: ! Structure containing the integrated absorber and predictor profiles. ! UNITS: N/A ! TYPE: CRTM_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(IN OUT) ! !-------------------------------------------------------------------------------- SUBROUTINE CRTM_Compute_Predictors( & SensorIndex , & ! Input Atmosphere , & ! Input GeometryInfo , & ! Input AncillaryInput, & ! Input Predictor , & ! Output iVar ) ! Internal variable output ! Arguments INTEGER , INTENT(IN) :: SensorIndex TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: Atmosphere TYPE(CRTM_GeometryInfo_type) , INTENT(IN) :: GeometryInfo TYPE(CRTM_AncillaryInput_type), INTENT(IN) :: AncillaryInput TYPE(CRTM_Predictor_type) , INTENT(IN OUT) :: Predictor TYPE(iVar_type) , INTENT(IN OUT) :: iVar ! Local variables INTEGER :: idx, n ! Call required model idx = TC%Sensor_LoIndex(SensorIndex) SELECT CASE( TC%Algorithm_ID(SensorIndex) ) ! Predictors for ODAS transmittance model CASE( ODAS_ALGORITHM ) CALL ODAS_Assemble_Predictors( & Atmosphere , & ! Input GeometryInfo , & ! Input TC%ODAS(idx)%Max_Order, & ! Input TC%ODAS(idx)%Alpha , & ! Input Predictor%ODAS , & ! Output iVar%ODAS ) ! Output ! Predictors for ODPS transmittance model CASE( ODPS_ALGORITHM ) CALL ODPS_Assemble_Predictors( & TC%ODPS(idx) , & ! Input Atmosphere , & ! Input GeometryInfo , & ! Input Predictor%ODPS ) ! Output ! Predictors for SSU instrument specific model CASE( ODSSU_ALGORITHM ) ! ...Select particular transmittance algorithm for this instrument SELECT CASE( TC%ODSSU(idx)%subAlgorithm ) CASE( ODAS_ALGORITHM ) ! ...Assumes the same alphas for all TCs n = TC%ODSSU(idx)%n_Absorbers CALL ODAS_Assemble_Predictors( & Atmosphere , & ! Input GeometryInfo , & ! Input SPREAD(ODAS_MAX_N_ORDERS,DIM=1,NCOPIES=n), & ! Input TC%ODSSU(idx)%ODAS(1)%Alpha , & ! Input Predictor%ODAS , & ! Output iVar%ODAS ) ! Output CASE( ODPS_ALGORITHM ) CALL ODPS_Assemble_Predictors( & TC%ODSSU(idx)%ODPS(1), & ! Input Atmosphere , & ! Input GeometryInfo , & ! Input Predictor%ODPS ) ! Output END SELECT END SELECT ! Is this a Zeeman channel? idx = TC%ZSensor_LoIndex(SensorIndex) IF( idx > 0 )THEN IF( Is_ODZeeman(TC%ODZeeman(idx)) )THEN CALL Zeeman_Compute_Predictors( & AncillaryInput%Zeeman, & ! Input TC%ODZeeman(idx) , & ! Input Atmosphere , & ! Input GeometryInfo , & ! Input Predictor%ODZeeman ) ! Output END IF END IF END SUBROUTINE CRTM_Compute_Predictors !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CRTM_Compute_Predictors_TL ! ! PURPOSE: ! Subroutine to calculate the gas absorption model tangent-linear ! predictors. It is a wrapper which calls the algorithm specific routine. ! ! CALLING SEQUENCE: ! CALL CRTM_Compute_Predictors_TL( & ! SensorIndex , & ! Input ! Atmosphere , & ! FWD Input ! Predictor , & ! FWD Input ! Atmosphere_TL , & ! TL Input ! AncillaryInput, & ! Input ! Predictor_TL , & ! TL Output ! iVar ) ! Internal variable input ! ! INPUTS: ! SensorIndex: ! Sensor index id. This is a unique index associated ! with a (supported) sensor used to access the ! shared coefficient data for a particular sensor. ! See the ChannelIndex argument. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! 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: CRTM_Predictor_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! Atmosphere_TL: ! Structure containing the tangent-linear atmospheric state data. ! UNITS: N/A ! TYPE: CRTM_Atmosphere_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! AncillaryInput: ! Structure holding ancillary inputs ! UNITS: N/A ! TYPE: AncillaryInput_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! iVar: ! Structure containing internal variables required for ! subsequent tangent-linear or adjoint model calls. ! The contents of this structure are NOT accessible ! outside of this module. ! UNITS: N/A ! TYPE: iVar_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! ! OUTPUTS: ! Predictor_TL: ! Structure containing the tangent-linear integrated absorber and ! predictor profiles. ! UNITS: N/A ! TYPE: CRTM_Predictor_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE CRTM_Compute_Predictors_TL( & SensorIndex , & ! Input Atmosphere , & ! FWD Input Predictor , & ! FWD Input Atmosphere_TL , & ! TL Input AncillaryInput, & ! Input Predictor_TL , & ! TL Output iVar ) ! Internal variable input ! Arguments INTEGER , INTENT(IN) :: SensorIndex TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: Atmosphere TYPE(CRTM_Predictor_type) , INTENT(IN) :: Predictor TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: Atmosphere_TL TYPE(CRTM_AncillaryInput_type), INTENT(IN) :: AncillaryInput TYPE(CRTM_Predictor_type) , INTENT(IN OUT) :: Predictor_TL TYPE(iVar_type) , INTENT(IN) :: iVar ! Local variables INTEGER :: idx, n ! Call required model idx = TC%Sensor_LoIndex(SensorIndex) SELECT CASE( TC%Algorithm_ID(SensorIndex) ) ! Predictors for ODAS transmittance model CASE( ODAS_ALGORITHM ) CALL ODAS_Assemble_Predictors_TL( & Atmosphere , & ! FWD Input Predictor%ODAS , & ! FWD Input Atmosphere_TL , & ! TL Input TC%ODAS(idx)%Max_Order, & ! Input TC%ODAS(idx)%Alpha , & ! Input Predictor_TL%ODAS , & ! TL Output iVar%ODAS ) ! Internal variable input ! Predictors for ODPS transmittance model CASE( ODPS_ALGORITHM ) CALL ODPS_Assemble_Predictors_TL( & TC%ODPS(idx) , & ! Input Predictor%ODPS , & ! FWD Input Atmosphere_TL , & ! TL Input Predictor_TL%ODPS ) ! TL Output ! Predictors for SSU instrument specific model CASE( ODSSU_ALGORITHM ) ! ...Select particular transmittance algorithm for this instrument SELECT CASE( TC%ODSSU(idx)%subAlgorithm ) CASE( ODAS_ALGORITHM ) ! ...Assumes the same alphas for all TCs n = TC%ODSSU(idx)%n_Absorbers CALL ODAS_Assemble_Predictors_TL( & Atmosphere , & ! FWD Input Predictor%ODAS , & ! FWD Input Atmosphere_TL , & ! TL Input SPREAD(ODAS_MAX_N_ORDERS,DIM=1,NCOPIES=n), & ! Input TC%ODSSU(idx)%ODAS(1)%Alpha , & ! Input, Predictor_TL%ODAS , & ! TL Output iVar%ODAS ) ! Internal variable input CASE( ODPS_ALGORITHM ) CALL ODPS_Assemble_Predictors_TL( & TC%ODSSU(idx)%ODPS(1), & ! Input Predictor%ODPS , & ! FWD Input Atmosphere_TL , & ! TL Input Predictor_TL%ODPS ) ! TL Output END SELECT END SELECT ! Is this a Zeeman channel? idx = TC%ZSensor_LoIndex(SensorIndex) IF( idx > 0 )THEN IF( Is_ODZeeman(TC%ODZeeman(idx)) )THEN CALL Zeeman_Compute_Predictors_TL( & AncillaryInput%Zeeman, & ! Input TC%ODZeeman(idx) , & ! Input Predictor%ODZeeman , & ! FWD Input Atmosphere_TL , & ! TL Input Predictor_TL%ODZeeman ) ! TL Output END IF END IF END SUBROUTINE CRTM_Compute_Predictors_TL !-------------------------------------------------------------------------------- ! ! NAME: ! CRTM_Compute_Predictors_AD ! ! PURPOSE: ! Subroutine to calculate the adjoint gas absorption model predictors. ! It is a wrapper which calls the algorithm specific routine. ! ! CALLING SEQUENCE: ! CALL CRTM_Compute_Predictors_AD ( & ! SensorIndex , & ! Input ! Atmosphere , & ! FWD Input ! Predictor , & ! FWD Input ! Predictor_AD , & ! AD Input ! AncillaryInput, & ! Input ! Atmosphere_AD , & ! AD Output ! iVar ) ! Internal variable input ! ! INPUTS: ! SensorIndex: ! Sensor index id. This is a unique index associated ! with a (supported) sensor used to access the ! shared coefficient data for a particular sensor. ! See the ChannelIndex argument. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! 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: CRTM_Predictor_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! Predictor_AD: ! Structure containing the adjoint integrated absorber and ! predictor profiles. ! UNITS: N/A ! TYPE: CRTM_Predictor_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! ! AncillaryInput: ! Structure holding ancillary inputs ! UNITS: N/A ! TYPE: AncillaryInput_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! iVar: ! Structure containing internal variables required for ! subsequent tangent-linear or adjoint model calls. ! The contents of this structure are NOT accessible ! outside of this module. ! UNITS: N/A ! TYPE: iVar_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OUTPUTS: ! Atmosphere_AD: ! Structure containing the adjoint atmospheric state data. ! UNITS: N/A ! TYPE: CRTM_Atmosphere_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! ! SIDE EFFECTS: ! Components of the Predictor_AD structure argument are modified ! in this function. ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE CRTM_Compute_Predictors_AD( & SensorIndex , & ! Input Atmosphere , & ! FWD Input Predictor , & ! FWD Input Predictor_AD , & ! AD Input AncillaryInput, & ! Input Atmosphere_AD , & ! AD Output iVar ) ! Internal variable input ! Arguments INTEGER , INTENT(IN) :: SensorIndex TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: Atmosphere TYPE(CRTM_Predictor_type) , INTENT(IN) :: Predictor TYPE(CRTM_Predictor_type) , INTENT(IN OUT) :: Predictor_AD TYPE(CRTM_AncillaryInput_type), INTENT(IN) :: AncillaryInput TYPE(CRTM_Atmosphere_type) , INTENT(IN OUT) :: Atmosphere_AD TYPE(iVar_type) , INTENT(IN) :: iVar ! Local variables INTEGER :: idx, n ! Is this a Zeeman channel? idx = TC%ZSensor_LoIndex(SensorIndex) IF( idx > 0 )THEN IF( Is_ODZeeman(TC%ODZeeman(idx)) )THEN CALL Zeeman_Compute_Predictors_AD( & AncillaryInput%Zeeman, & ! Input TC%ODZeeman(idx) , & ! Input Predictor%ODZeeman , & ! FWD Input Predictor_AD%ODZeeman, & ! AD Intput Atmosphere_AD ) ! AD Output END IF END IF ! Call required model idx = TC%Sensor_LoIndex(SensorIndex) SELECT CASE( TC%Algorithm_ID(SensorIndex) ) ! Predictors for ODAS transmittance model CASE( ODAS_ALGORITHM ) CALL ODAS_Assemble_Predictors_AD( & Atmosphere , & ! FWD Input Predictor%ODAS , & ! FWD Input Predictor_AD%ODAS , & ! AD Intput TC%ODAS(idx)%Max_Order, & ! Input TC%ODAS(idx)%Alpha , & ! Input Atmosphere_AD , & ! AD Output iVar%ODAS ) ! Internal variable input ! Predictors for ODPS transmittance model CASE( ODPS_ALGORITHM ) CALL ODPS_Assemble_Predictors_AD( & TC%ODPS(idx) , & ! Input Predictor%ODPS , & ! FWD Input Predictor_AD%ODPS, & ! AD Intput Atmosphere_AD ) ! AD Output ! Predictors for SSU instrument specific model CASE( ODSSU_ALGORITHM ) ! ...Select particular transmittance algorithm for this instrument SELECT CASE( TC%ODSSU(idx)%subAlgorithm ) CASE( ODAS_ALGORITHM ) ! ...Assumes the same alphas for all TCs n = TC%ODSSU(idx)%n_Absorbers CALL ODAS_Assemble_Predictors_AD( & Atmosphere , & ! FWD Input Predictor%ODAS , & ! FWD Input Predictor_AD%ODAS , & ! AD Intput SPREAD(ODAS_MAX_N_ORDERS,DIM=1,NCOPIES=n), & ! Input TC%ODSSU(idx)%ODAS(1)%Alpha , & ! Input, Atmosphere_AD , & ! AD Output iVar%ODAS ) ! Internal variable input CASE( ODPS_ALGORITHM ) CALL ODPS_Assemble_Predictors_AD( & TC%ODSSU(idx)%ODPS(1), & ! Input Predictor%ODPS , & ! FWD Input Predictor_AD%ODPS , & ! AD Intput Atmosphere_AD ) ! AD Output END SELECT END SELECT END SUBROUTINE CRTM_Compute_Predictors_AD END MODULE CRTM_Predictor