CRTM_Predictor_Define.f90

Go to the documentation of this file.

!
! CRTM_Predictor_Define
!
! Module containing the definition of the container predictor structure for
! the gaseous absorption transmittance models
!


MODULE crtm_predictor_define

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds,                 ONLY: fp
  USE message_handler,            ONLY: success, failure, display_message
  USE crtm_parameters,            ONLY: odas_algorithm,  odps_algorithm, odssu_algorithm
  USE crtm_taucoeff,              ONLY: tc
  ! ODAS modules
  USE odas_predictor_define,      ONLY: odas_predictor_type      , &
                                        odas_predictor_associated, &
                                        odas_predictor_create    , &
                                        odas_predictor_destroy   , &
                                        odas_predictor_inspect
  USE odas_predictor,             ONLY: 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    , &
                                        odps_predictor_inspect   , &
                                        pafv_associated          , &
                                        pafv_destroy             , &
                                        pafv_create
  USE odps_predictor,             ONLY: odps_get_n_components    , &
                                        odps_get_max_n_predictors, &
                                        odps_get_n_absorbers     , &
                                        odps_get_savefwvflag     , &
                                        allow_optran
  ! ODZeeman modules
  USE odzeeman_atmabsorption,     ONLY: get_numofzcomponents, &
                                        get_numofzabsorbers,  &
                                        get_numofzpredictors
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Datatypes
  PUBLIC :: crtm_predictor_type
  ! Procedures
  PUBLIC :: crtm_predictor_associated
  PUBLIC :: crtm_predictor_destroy
  PUBLIC :: crtm_predictor_create
  PUBLIC :: crtm_predictor_inspect


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: CRTM_Predictor_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Message string length
  INTEGER, PARAMETER :: ml = 256


  ! ---------------------
  ! Structure definitions
  ! ---------------------
  ! Predictor container structure definition
  TYPE :: crtm_predictor_type
    ! Allocation indicator
    LOGICAL :: is_allocated = .false.
    ! The predictor sub-objects
    TYPE(odas_predictor_type) :: odas
    TYPE(odps_predictor_type) :: odps
    TYPE(odps_predictor_type) :: odzeeman
  END TYPE crtm_predictor_type


CONTAINS


!################################################################################
!################################################################################
!##                                                                            ##
!##                         ## PUBLIC MODULE ROUTINES ##                       ##
!##                                                                            ##
!################################################################################
!################################################################################

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Predictor_Associated
!
! PURPOSE:
!       Elemental function to test the association status of the
!       CRTM_Predictor structure.
!
! CALLING SEQUENCE:
!       Status = CRTM_Predictor_Associated( CRTM_Predictor )
!
! OBJECTS:
!       CRTM_Predictor:
!         Structure which is to have its member's
!         status tested.
!         UNITS:      N/A
!         TYPE:       CRTM_Predictor_type
!         DIMENSION:  Scalar or any rank
!         ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:
!         The return value is a logical value indicating the
!         status of the allocated members.
!          .TRUE.  - if the CRTM_Predictor object has been allocated.
!          .FALSE. - if the CRTM_Predictor object has NOT been allocated.
!         UNITS:      N/A
!         TYPE:       LOGICAL
!         DIMENSION:  Same as input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION crtm_predictor_associated(self) RESULT(status)
    TYPE(crtm_predictor_type), INTENT(IN) :: self
    LOGICAL :: status
    status = self%Is_Allocated
  END FUNCTION crtm_predictor_associated


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Predictor_Destroy
!
! PURPOSE:
!       Elemental subroutine to re-initialize CRTM_Predictor container objects.
!
! CALLING SEQUENCE:
!       CALL CRTM_Predictor_Destroy( CRTM_Predictor )
!
! OBJECTS:
!       CRTM_Predictor:
!         Re-initialized CRTM_Predictor structure.
!         UNITS:      N/A
!         TYPE:       CRTM_Predictor_type
!         DIMENSION:  Scalar or any rank
!         ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE crtm_predictor_destroy(self)
    TYPE(crtm_predictor_type), INTENT(OUT) :: self
    self%Is_Allocated =.false.
  END SUBROUTINE crtm_predictor_destroy


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Predictor_Create
!
! PURPOSE:
!       Elemental subroutine to create an instance of a CRTM_Predictor object.
!
! CALLING SEQUENCE:
!       CALL CRTM_Predictor_Create( &
!              CRTM_Predictor, &
!              n_Layers      , &
!              SensorIndex     )
!
! OBJECTS:
!       CRTM_Predictor:
!         CRTM_Predictor object structure.
!         UNITS:      N/A
!         TYPE:       CRTM_Predictor_type
!         DIMENSION:  Scalar or any rank
!         ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       n_Layers:
!         Number of atmospheric layers.
!         Must be > 0.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Conformable with the CRTM_Predictor object
!         ATTRIBUTES: INTENT(IN)
!
!       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:  Conformable with the CRTM_Predictor object
!         ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE crtm_predictor_create( &
    self         , &  ! Output
    n_Layers     , &  ! Input
    SensorIndex  , &  ! Input
    SaveFWV        )  ! Optional Input
    ! Arguments
    TYPE(crtm_predictor_type), INTENT(OUT) :: self
    INTEGER,                   INTENT(IN)  :: n_layers
    INTEGER,                   INTENT(IN)  :: sensorindex
    INTEGER,         OPTIONAL, INTENT(IN)  :: savefwv
    ! Local variables
    INTEGER :: i, idx
    LOGICAL :: no_optran
    LOGICAL :: allocate_success


    ! Check input
    IF ( n_layers < 1 ) RETURN


    ! Call the required procedure
    idx = tc%Sensor_LoIndex(sensorindex)
    SELECT CASE( tc%Algorithm_ID(sensorindex) )


      ! Predictors for ODAS transmittance model
      CASE( odas_algorithm )
         CALL odas_predictor_create( &
                self%ODAS                     , &
                n_layers                      , &
                odas_max_n_predictors         , &
                odas_max_n_absorbers          , &
                maxval(tc%ODAS(idx)%Max_Order)  )
         allocate_success = odas_predictor_associated(self%ODAS)


      ! Predictors for ODPS transmittance model
      CASE( odps_algorithm )
        i = tc%ODPS(idx)%Group_Index
        ! ...Set OPTRAN flag
        no_optran = .NOT. ((tc%ODPS(idx)%n_OCoeffs > 0) .AND. allow_optran)
        ! ...Allocate main structure
        CALL odps_predictor_create( &
               self%ODPS                   , &
               tc%ODPS(idx)%n_Layers       , &
               n_layers                    , &
               odps_get_n_components(i)    , &
               odps_get_max_n_predictors(i), &
               no_optran = no_optran         )
        allocate_success = odps_predictor_associated(self%ODPS)
        ! ...Allocate memory for saved forward variables
        ! *****FLAW*****
        ! MUST CHECK FOR SaveFWV *VALUE* NOT JUST PRESCENCE!
        IF ( PRESENT(savefwv) .AND. odps_get_savefwvflag() ) THEN
        ! *****FLAW*****
          CALL pafv_create( &
                 self%ODPS%PAFV         , &
                 tc%ODPS(idx)%n_Layers  , &
                 n_layers               , &
                 odps_get_n_absorbers(i), &
                 no_optran = no_optran    )
          allocate_success = allocate_success .AND. &
                             pafv_associated(self%ODPS%PAFV)
        END IF


      ! Predictors for SSU instrument specific model
      CASE( odssu_algorithm )

        SELECT CASE( tc%ODSSU(idx)%subAlgorithm )

          ! Predictors for ODAS SSU transmittance model
          CASE( odas_algorithm )
            CALL odas_predictor_create( &
                   self%ODAS            , &
                   n_layers             , &
                   odas_max_n_predictors, &
                   odas_max_n_absorbers , &
                   odas_max_n_orders      )
           allocate_success = odas_predictor_associated(self%ODAS)

          ! Predictors for ODPS SSU transmittance model
          CASE( odps_algorithm )
            i = tc%ODSSU(idx)%ODPS(1)%Group_Index
            ! ...Set OPTRAN flag
            no_optran = .NOT. ((tc%ODSSU(idx)%ODPS(1)%n_OCoeffs > 0) .AND. allow_optran)
            ! ...Allocate main structure
            CALL odps_predictor_create( &
                   self%ODPS                     , &
                   tc%ODSSU(idx)%ODPS(1)%n_Layers, &
                   n_layers                      , &
                   odps_get_n_components(i)      , &
                   odps_get_max_n_predictors(i)  , &
                   no_optran = no_optran           )
            allocate_success = odps_predictor_associated(self%ODPS)
            ! ...Allocate memory for saved forward variables
            ! *****FLAW*****
            ! MUST CHECK FOR SaveFWV *VALUE* NOT JUST PRESCENCE!
            IF ( PRESENT(savefwv) .AND. odps_get_savefwvflag() ) THEN
            ! *****FLAW*****
              CALL pafv_create( &
                     self%ODPS%PAFV                , &
                     tc%ODSSU(idx)%ODPS(1)%n_Layers, &
                     n_layers                      , &
                     odps_get_n_absorbers(i)       , &
                     no_optran = no_optran           )
              allocate_success = allocate_success .AND. &
                                 pafv_associated(self%ODPS%PAFV)
            END IF
        END SELECT
    END SELECT


    ! Check status
    IF ( .NOT. allocate_success ) RETURN


    ! Is this a Zeeman channel?
    idx = tc%ZSensor_LoIndex(sensorindex)
    zeeman_block: IF ( idx > 0 ) THEN
      i = tc%ODZeeman(idx)%Group_index
      ! ...Set OPTRAN flag
      no_optran = .true.
      ! ...Allocate main structure
      CALL odps_predictor_create( &
             self%ODZeeman            , &
             tc%ODZeeman(idx)%n_Layers, &
             n_layers                 , &
             get_numofzcomponents()   , &
             get_numofzpredictors(i)  , &
             no_optran = no_optran      )
      allocate_success = odps_predictor_associated(self%ODZeeman)
      ! ...Allocate memory for saved forward variables
      ! *****FLAW*****
      ! MUST CHECK FOR SaveFWV *VALUE* NOT JUST PRESCENCE!
      IF ( PRESENT(savefwv) ) THEN
      ! *****FLAW*****
        CALL pafv_create( &
               self%ODZeeman%PAFV       , &
               tc%ODZeeman(idx)%n_Layers, &
               n_layers                 , &
               get_numofzabsorbers()    , &
               no_optran = no_optran      )
        allocate_success = allocate_success .AND. &
                           pafv_associated(self%ODZeeman%PAFV)
      END IF
      ! Check status
      IF ( .NOT. allocate_success ) RETURN
    END IF zeeman_block


    ! Explicitly set allocation indicator
    self%Is_Allocated = .true.

  END SUBROUTINE crtm_predictor_create


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Predictor_Inspect
!
! PURPOSE:
!       Subroutine to print the contents of a CRTM_Predictor object to stdout
!
! CALLING SEQUENCE:
!       CALL CRTM_Predictor_Inspect( Predictor )
!
! OBJECTSS:
!       Predictor:
!         Object to display.
!         UNITS:      N/A
!         TYPE:       CRTM_Predictor_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE crtm_predictor_inspect(self)
    TYPE(crtm_predictor_type), INTENT(IN) :: self
    WRITE(*,'(1x,"CRTM_Predictor CONTAINER OBJECT -- BEGIN")')
!    ! Release/version info
!    WRITE(*,'(3x,"Release.Version :",1x,i0,".",i0)') self%Release, self%Version
    ! Container objects
    IF ( crtm_predictor_associated(self) ) THEN
      IF ( odas_predictor_associated(self%ODAS) ) CALL odas_predictor_inspect(self%ODAS)
      IF ( odps_predictor_associated(self%ODPS) ) CALL odps_predictor_inspect(self%ODPS)
      IF ( odps_predictor_associated(self%ODZeeman) ) CALL odps_predictor_inspect(self%ODZeeman)
!      IF ( ODZeeman_Predictor_Associated(self%ODZeeman) ) CALL ODZeeman_Predictor_Inspect(self%ODZeeman)
    END IF
    WRITE(*,'(1x,"CRTM_Predictor CONTAINER OBJECT -- END")')
  END SUBROUTINE crtm_predictor_inspect



END MODULE crtm_predictor_define