CRTM_Predictor.f90

Go to the documentation of this file.

!
! 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 60152 2015-08-13 19:19:13Z paul.vandelst@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