ODPS_Predictor_Define.f90

Go to the documentation of this file.

!
! ODPS_Predictor_Define
!
! Module defining the Predictor object for the ODPS algorithm and
! containing routines to manipulate it.
!
! CREATION HISTORY:
!       Written by:     Yong Han, JCSDA, NOAA/NESDIS 20-Jun-2008
!                       based on the content of CRTM_Predictor_Define.f90
!
!       Refactored:     Paul van Delst, 27-Mar-2012
!                       paul.vandelst@noaa.gov
!

MODULE odps_predictor_define

  ! ------------------
  ! Environment set up
  ! ------------------
  ! Module use
  USE type_kinds           , ONLY: fp
  USE message_handler      , ONLY: success, failure, information, display_message
  USE compare_float_numbers, ONLY: OPERATOR(.equalto.)
  USE file_utility         , ONLY: file_open, file_exists
  USE binary_file_utility  , ONLY: open_binary_file      , &
                                   writegatts_binary_file, &
                                   readgatts_binary_file
  USE pafv_define          , ONLY: pafv_type      , &
                                   pafv_associated, &
                                   pafv_destroy   , &
                                   pafv_create
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE

  ! Local entities
  ! ...Datatypes
  PUBLIC :: odps_predictor_type
!  ! ...Operators
!  PUBLIC :: OPERATOR(==)
  ! ...Procedures
  PUBLIC :: odps_predictor_associated
  PUBLIC :: odps_predictor_destroy
  PUBLIC :: odps_predictor_create
  PUBLIC :: odps_predictor_inspect
  PUBLIC :: odps_predictor_zero
!  PUBLIC :: ODPS_Predictor_ValidRelease
!  PUBLIC :: ODPS_Predictor_Info
!  PUBLIC :: ODPS_Predictor_DefineVersion
!  PUBLIC :: ODPS_Predictor_InquireFile
!  PUBLIC :: ODPS_Predictor_ReadFile
!  PUBLIC :: ODPS_Predictor_WriteFile
  ! ...Parameter
  PUBLIC :: max_optran_order
  PUBLIC :: max_optran_predictors
  PUBLIC :: max_optran_used_predictors

  ! USE-associated entities to pass through
  ! ...Datatypes
  PUBLIC :: pafv_type
  ! ...Procedures
  PUBLIC :: pafv_associated
  PUBLIC :: pafv_destroy
  PUBLIC :: pafv_create


  ! ---------------------
  ! Procedure overloading
  ! ---------------------
!  INTERFACE OPERATOR(==)
!    MODULE PROCEDURE ODPS_Predictor_Equal
!  END INTERFACE OPERATOR(==)


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: module_version_id = &
    '$Id: xODPS_Predictor_Define.f90 18500 2012-04-02 11:07:35Z paul.vandelst@noaa.gov $'
  ! Release and version
  INTEGER, PARAMETER :: odps_predictor_release = 2  ! This determines structure and file formats.
  INTEGER, PARAMETER :: odps_predictor_version = 1  ! This is just the default data version.
  ! Close status for write errors
  CHARACTER(*), PARAMETER :: write_error_status = 'DELETE'
  ! Literal constants
  REAL(fp), PARAMETER :: zero = 0.0_fp
  REAL(fp), PARAMETER :: one  = 1.0_fp
  ! String lengths
  INTEGER,  PARAMETER :: ml = 256
  ! C-OPTRAN max. order and number of predictors
  INTEGER, PARAMETER :: max_optran_order = 10
  INTEGER, PARAMETER :: max_optran_predictors = 14
  INTEGER, PARAMETER :: max_optran_used_predictors = 6


  ! -----------------------------------
  ! ODPS_Predictor data type definition
  ! -----------------------------------
  !:tdoc+:
  TYPE :: odps_predictor_type
    ! Allocation indicator
    LOGICAL :: is_allocated = .false.
    ! Release and version information
    INTEGER :: release = odps_predictor_release
    INTEGER :: version = odps_predictor_version
    ! Dimension variables
    INTEGER :: max_n_layers  = 0 ! K   - maximum number of layers
    INTEGER :: n_layers      = 0 ! K   - actual number of layers
    INTEGER :: n_user_layers = 0 ! Ku  - number of layers of user input profile
    INTEGER :: n_components  = 0 ! J   - number of tau components
    INTEGER :: n_predictors  = 0 ! I   - predictor dimension (Maximum)
    ! Scalars
    REAL(fp) :: secant_zenith_surface  ! Secant zenith angle at the surface
    REAL(fp) :: u, v, w                ! Algorithm specific variables
    ! Arrays
    REAL(fp), ALLOCATABLE :: secant_zenith(:)  ! K         ; secant zenith angle
    INTEGER,  ALLOCATABLE :: component_id(:)   ! J         ; Tau component Id
    INTEGER,  ALLOCATABLE :: n_cp(:)           ! J         ; No. of predictors for each component
    REAL(fp), ALLOCATABLE :: x(:,:,:)          ! K x I x J ; Predictor array
    REAL(fp), ALLOCATABLE :: ref_level_lnpressure(:)   ! 0:K ; Pressure arrays used for optical
    REAL(fp), ALLOCATABLE :: user_level_lnpressure(:)  ! 0:Ku;   path profile interpolation
    ! Compact-OPTRAN predictors
    LOGICAL :: optran = .false.
    INTEGER :: n_opredictors  = 0 ! OI
    REAL(fp), ALLOCATABLE ::  ap(:,:)  ! MAX_OPTRAN_ORDER x K; polynomial of the water vapor absorber level
    REAL(fp), ALLOCATABLE ::  da(:)    ! K                   ; slant path layer integrated amount
    REAL(fp), ALLOCATABLE ::  ox(:,:)  ! K x OI              ; Predictor array
    ! Structure variable to hold predictor and absorption
    ! forward variables across FWD, TL and AD calls. It
    ! should be allocated only for the FWD Predictor variable.
    TYPE(pafv_type) :: pafv
  END TYPE odps_predictor_type
  !:tdoc-:


CONTAINS


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       ODPS_Predictor_Associated
!
! PURPOSE:
!       Elemental function to test the status of the allocatable components
!       of the ODPS_Predictor structure.
!
! CALLING SEQUENCE:
!       Status = ODPS_Predictor_Associated( ODPS_Predictor )
!
! OBJECTS:
!       ODPS_Predictor:
!         Structure which is to have its member's
!         status tested.
!         UNITS:      N/A
!         TYPE:       ODPS_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 ODPS_Predictor object has been allocated.
!          .FALSE. - if the ODPS_Predictor object has NOT been allocated.
!         UNITS:      N/A
!         TYPE:       LOGICAL
!         DIMENSION:  Same as input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION odps_predictor_associated( self ) RESULT( Status )
    TYPE(odps_predictor_type), INTENT(IN) :: self
    LOGICAL :: status
    status = self%Is_Allocated
  END FUNCTION odps_predictor_associated


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

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


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       ODPS_Predictor_Create
!
! PURPOSE:
!       Elemental subroutine to create an instance of an ODPS_Predictor object.
!
! CALLING SEQUENCE:
!       CALL ODPS_Predictor_Create( &
!              ODPS_Predictor, &
!              n_Layers      , &
!              n_User_Layers , &
!              n_Components  , &
!              n_Predictors  , &
!              No_OPTRAN = No_OPTRAN )
!
! OBJECTS:
!       ODPS_Predictor:
!         ODPS_Predictor object structure.
!         UNITS:      N/A
!         TYPE:       ODPS_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 ODPS_Predictor object
!         ATTRIBUTES: INTENT(IN)
!
!       n_Components:
!         Number of atmospheric absorption components.
!         Must be > 0.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Conformable with the ODPS_Predictor object
!         ATTRIBUTES: INTENT(IN)
!
!       n_Predictors:
!         Maximum number of absorption predictor.
!         Must be > 0.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Conformable with the ODPS_Predictor object
!         ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       No_OPTRAN:
!         Logical switch to disable allocation of Compact-OPTRAN
!         arrays for use with water vapour absorption.
!         If == .FALSE., arrays are allocated [DEFAULT]
!            == .TRUE.,  arrays are NOT allocated
!         If not specified, arrays are allocated.
!         UNITS:      N/A
!         TYPE:       LOGICAL
!         DIMENSION:  Conformable with the ODPS_Predictor object
!         ATTRIBUTES: INTENT(IN), OPTIONAL
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE odps_predictor_create( &
    self         , &  ! Output
    n_Layers     , &  ! Input
    n_User_Layers, &  ! Input
    n_Components , &  ! Input
    n_Predictors , &  ! Input
    No_OPTRAN      )  ! Optional Input
    ! Arguments
    TYPE(odps_predictor_type), INTENT(OUT) :: self
    INTEGER,                   INTENT(IN)  :: n_layers
    INTEGER,                   INTENT(IN)  :: n_user_layers
    INTEGER,                   INTENT(IN)  :: n_components
    INTEGER,                   INTENT(IN)  :: n_predictors
    LOGICAL,         OPTIONAL, INTENT(IN)  :: no_optran
    ! Local variables
    LOGICAL :: use_optran
    INTEGER :: alloc_stat

    ! Check input
    IF ( n_layers      < 1 .OR. &
         n_user_layers < 1 .OR. &
         n_components  < 1 .OR. &
         n_predictors  < 1 ) RETURN
    ! ...Process options
    use_optran = .true.
    IF ( PRESENT(no_optran) ) use_optran = .NOT. no_optran

    ! Perform the allocation
    ALLOCATE( self%Secant_Zenith(n_layers), &
              self%Component_ID(n_components), &
              self%n_CP(n_components), &
              self%X(n_layers, n_predictors, n_components), &
              self%Ref_Level_LnPressure(0:n_layers), &
              self%User_Level_LnPressure(0:n_user_layers), &
              stat = alloc_stat )
    IF ( alloc_stat /= 0 ) RETURN


    ! Initialise dimensions
    self%Max_n_Layers  = n_layers
    self%n_Layers      = n_layers
    self%n_User_Layers = n_user_layers
    self%n_Components  = n_components
    self%n_Predictors  = n_predictors


    ! Allocate OPTRAN if required
    IF ( use_optran ) THEN
      ALLOCATE( self%OX(n_layers, max_optran_predictors), &
                self%Ap(n_layers, max_optran_order), &
                self%dA(n_layers), &
                stat = alloc_stat )
      IF ( alloc_stat /= 0 ) RETURN
      ! Initialise dimensions
      self%n_OPredictors = max_optran_predictors
      ! ...Flag OPTRAN section as usuable
      self%OPTRAN = .true.
    END IF


    ! Set allocation indicator
    self%Is_Allocated = .true.


    ! Initialise array data
    CALL odps_predictor_zero(self)

  END SUBROUTINE odps_predictor_create


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       ODPS_Predictor_Inspect
!
! PURPOSE:
!       Subroutine to print the contents of a ODPS_Predictor object to stdout.
!
! CALLING SEQUENCE:
!       CALL ODPS_Predictor_Inspect( ODPS_Predictor )
!
! OBJECTS:
!       ODPS_Predictor:
!         ODPS_Predictor object to display.
!         UNITS:      N/A
!         TYPE:       ODPS_Predictor_type
!         DIMENSION:  Scalar
!         ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE odps_predictor_inspect(self)
    TYPE(odps_predictor_type), INTENT(IN) :: self
    INTEGER :: i, j
    WRITE(*,'(1x,"ODPS_Predictor OBJECT")')
    ! Release/version info
    WRITE(*,'(3x,"Release.Version :",1x,i0,".",i0)') self%Release, self%Version
    ! Dimensions
    WRITE(*,'(3x,"n_Layers      :",1x,i0)') self%n_Layers
    WRITE(*,'(3x,"n_User_Layers :",1x,i0)') self%n_User_Layers
    WRITE(*,'(3x,"n_Components  :",1x,i0)') self%n_Components
    WRITE(*,'(3x,"n_Predictors  :",1x,i0)') self%n_Predictors
    IF ( .NOT. odps_predictor_associated(self) ) RETURN
    ! ODPS data arrays
    WRITE(*,'(3x,"ODPS data arrays :")')
    ! ...ODPS Forward variables
    WRITE(*,'(5x,"Secant_Zenith :")')
    WRITE(*,'(5(1x,es23.15e3,:))') self%Secant_Zenith(1:self%n_Layers)
    WRITE(*,'(5x,"Component_ID :")')
    WRITE(*,'(10(1x,i0,:))') self%Component_ID(1:self%n_Components)
    WRITE(*,'(5x,"n_CP :")')
    WRITE(*,'(10(1x,i0,:))') self%n_CP(1:self%n_Components)
    WRITE(*,'(5x,"X (predictor array) :")')
    DO j = 1, self%n_Components
      DO i = 1, self%n_Predictors
        WRITE(*,'(7x,"Component#: ",i0,"; Predictor#: ",i0)') j, i
        WRITE(*,'(5(1x,es23.15e3,:))') self%X(1:self%n_Layers,i,j)
      END DO
      WRITE(*,*)
    END DO
    ! ...Pressure profiles for interpolations
    WRITE(*,'(5x,"Ref_Level_LnPressure  :")')
    WRITE(*,'(5(1x,es13.6,:))') self%Ref_Level_LnPressure
    WRITE(*,'(5x,"User_Level_LnPressure :")')
    WRITE(*,'(5(1x,es13.6,:))') self%User_Level_LnPressure
    ! Compact-OPTRAN Forward variables
    IF ( self%OPTRAN ) THEN
      WRITE(*,'(3x,"n_OPredictors :",1x,i0)') self%n_OPredictors
      WRITE(*,'(5x,"OX :")'); WRITE(*,'(5(1x,es13.6,:))') self%OX
      WRITE(*,'(5x,"Ap :")'); WRITE(*,'(5(1x,es13.6,:))') self%Ap
      WRITE(*,'(5x,"dA :")'); WRITE(*,'(5(1x,es13.6,:))') self%dA
    END IF
  END SUBROUTINE odps_predictor_inspect


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       ODPS_Predictor_Zero
!
! PURPOSE:
!       Elementl subroutine to zero-out an instance of an ODPS predictor object.
!
! CALLING SEQUENCE:
!       CALL ODPS_Predictor_Zero( ODPS_Predictor )
!
! OUTPUTS:
!       ODPS_Predictor:
!         ODPS_Predictor object structure.
!         UNITS:      N/A
!         TYPE:       ODPS_Predictor_type
!         DIMENSION:  Scalar or any rank
!         ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE odps_predictor_zero( self )
    TYPE(odps_predictor_type),  INTENT(IN OUT) :: self
    IF ( .NOT. odps_predictor_associated(self) ) RETURN
    self%Secant_Zenith = zero
    self%Component_ID  = 0
    self%n_CP          = self%n_Predictors
    self%X             = zero
    self%Ref_Level_LnPressure  = zero
    self%User_Level_LnPressure = zero
    IF ( self%OPTRAN ) THEN
      self%OX = zero
      self%Ap = zero
      self%dA = zero
    END IF
  END SUBROUTINE odps_predictor_zero

END MODULE odps_predictor_define