ODAS_Predictor_Define.f90

Go to the documentation of this file.

!
! ODAS_Predictor_Define
!
! Module defining the Predictor object for the Optical Depth in
! Absorber Space (ODAS) algorithm and containing routines to
! manipulate it.
!
! CREATION HISTORY:
!       Written by:    Paul van Delst, 22-Dec-2006
!                      paul.vandelst@noaa.gov
!
!       Modifed by:    Yong Han, 25-June-2008
!                      yong.han@noaa.gov
!

MODULE odas_predictor_define

  ! ------------------
  ! Environment set up
  ! ------------------
  ! Module use
  USE type_kinds, ONLY: fp
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Datatypes
  PUBLIC :: odas_predictor_type
!  ! Operators
!  PUBLIC :: OPERATOR(==)
  ! Procedures
  PUBLIC :: odas_predictor_associated
  PUBLIC :: odas_predictor_destroy
  PUBLIC :: odas_predictor_create
  PUBLIC :: odas_predictor_inspect
  PUBLIC :: odas_predictor_zero
!  PUBLIC :: ODAS_Predictor_ValidRelease
!  PUBLIC :: ODAS_Predictor_Info
!  PUBLIC :: ODAS_Predictor_DefineVersion
!  PUBLIC :: ODAS_Predictor_InquireFile
!  PUBLIC :: ODAS_Predictor_ReadFile
!  PUBLIC :: ODAS_Predictor_WriteFile


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


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: ODAS_Predictor_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Release and version
  INTEGER, PARAMETER :: odas_predictor_release = 3  ! This determines structure and file formats.
  INTEGER, PARAMETER :: odas_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
  ! Message string length
  INTEGER, PARAMETER :: ml = 256


  ! -----------------------
  ! Derived type definition
  ! -----------------------
  !:tdoc+:
  TYPE :: odas_predictor_type
    ! Allocation indicator
    LOGICAL :: is_allocated = .false.
    ! Release and version information
    INTEGER :: release = odas_predictor_release
    INTEGER :: version = odas_predictor_version
    ! Dimension variables
    INTEGER :: n_layers     = 0  ! K
    INTEGER :: n_predictors = 0  ! I
    INTEGER :: n_absorbers  = 0  ! J
    INTEGER :: n_orders     = 0  ! IO
    ! Scalars
    REAL(fp) :: secant_sensor_zenith = zero
    ! Arrays
    REAL(fp), ALLOCATABLE :: a(:,:)     ! 0:K x J, Integrated absorber
    REAL(fp), ALLOCATABLE :: da(:,:)    !   K x J, Integrated absorber level difference
    REAL(fp), ALLOCATABLE :: avea(:,:)  !   K x J, Integrated absorber layer average
    REAL(fp), ALLOCATABLE :: ap(:,:,:)  !   K x IO x J, Power of absorber level
    REAL(fp), ALLOCATABLE :: x(:,:)     !   K x I, Predictors
  END TYPE odas_predictor_type
  !:tdoc-:


CONTAINS


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

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

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


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

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


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       ODAS_Predictor_Create
!
! PURPOSE:
!       Elemental subroutine to create an instance of an ODAS_Predictor object.
!
! CALLING SEQUENCE:
!       CALL ODAS_Predictor_Create( &
!              ODAS_Predictor, &
!              n_Layers      , &
!              n_Predictors  , &
!              n_Absorbers   , &
!              n_Orders        )
!
! OBJECTS:
!       ODAS_Predictor:
!         ODAS_Predictor object structure.
!         UNITS:      N/A
!         TYPE:       ODAS_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 ODAS_Predictor object
!         ATTRIBUTES: INTENT(IN)
!
!       n_Predictors:
!         Number of absorption predictors.
!         Must be > 0.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Conformable with the ODAS_Predictor object
!         ATTRIBUTES: INTENT(IN)
!
!       n_Absorbers:
!         Number of atmospheric absorbers.
!         Must be > 0.
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Conformable with the ODAS_Predictor object
!         ATTRIBUTES: INTENT(IN)
!
!       n_Orders:
!         The polynormial function order for all absorbers
!         Must be > 0
!         UNITS:      N/A
!         TYPE:       INTEGER
!         DIMENSION:  Conformable with the ODAS_Predictor object
!         ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE odas_predictor_create( &
    self         , &  ! Output
    n_Layers     , &  ! Input
    n_Predictors , &  ! Input
    n_Absorbers  , &  ! Input
    n_Orders       )  ! Input
    ! Arguments
    TYPE(odas_predictor_type), INTENT(OUT) :: self
    INTEGER,                   INTENT(IN)  :: n_layers
    INTEGER,                   INTENT(IN)  :: n_predictors
    INTEGER,                   INTENT(IN)  :: n_absorbers
    INTEGER,                   INTENT(IN)  :: n_orders
    ! Local variables
    INTEGER :: alloc_stat

    ! Check input
    IF ( n_layers     < 1 .OR. &
         n_predictors < 1 .OR. &
         n_absorbers  < 1 .OR. &
         n_orders     < 1 ) RETURN


    ! Perform the allocation
    ALLOCATE( self%A(0:n_layers,n_absorbers), &
              self%dA(n_layers,n_absorbers), &
              self%aveA(n_layers,n_absorbers), &
              self%Ap(n_layers,n_orders,n_absorbers), &
              self%X(n_layers,n_predictors), &
              stat = alloc_stat )
    IF ( alloc_stat /= 0 ) RETURN


    ! Initialise dimensions
    self%n_Layers     = n_layers
    self%n_Predictors = n_predictors
    self%n_Absorbers  = n_absorbers
    self%n_Orders     = n_orders


    ! Set allocation indicator
    self%Is_Allocated = .true.


    ! Initialise array data
    CALL odas_predictor_zero(self)

  END SUBROUTINE odas_predictor_create



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

  SUBROUTINE odas_predictor_inspect(self)
    TYPE(odas_predictor_type), INTENT(IN) :: self
    CHARACTER(*), PARAMETER :: rfmt='es13.6'
    INTEGER :: i, j
    WRITE(*,'(1x,"ODAS_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_Predictors :",1x,i0)') self%n_Predictors
    WRITE(*,'(3x,"n_Absorbers  :",1x,i0)') self%n_Absorbers
    WRITE(*,'(3x,"n_Orders     :",1x,i0)') self%n_Orders
    ! ODAS scalar data
    WRITE(*,'(3x,"ODAS scalar data :")')
    WRITE(*,'(5x,"Secant_Sensor_Zenith :",'//rfmt//')') self%Secant_Sensor_Zenith
    ! ODAS array data
    IF ( .NOT. odas_predictor_associated(self) ) RETURN
    WRITE(*,'(3x,"ODAS data arrays :")')
    WRITE(*,'(5x,"Integrated Absorber :")')
    DO j = 1, self%n_Absorbers
      WRITE(*,'(7x,"Absorber#: ",i0)') j
      WRITE(*,'(5(1x,'//rfmt//',:))') self%A(:,j)
    END DO
    WRITE(*,'(5x,"Integrated Absorber Level Difference:")')
    DO j = 1, self%n_Absorbers
      WRITE(*,'(7x,"Absorber#: ",i0)') j
      WRITE(*,'(5(1x,'//rfmt//',:))') self%dA(:,j)
    END DO
    WRITE(*,'(5x,"Integrated Absorber Layer Average:")')
    DO j = 1, self%n_Absorbers
      WRITE(*,'(7x,"Absorber#: ",i0)') j
      WRITE(*,'(5(1x,'//rfmt//',:))') self%aveA(:,j)
    END DO
    WRITE(*,'(5x,"Exponent Power of Absorber Level :")')
    DO j = 1, self%n_Absorbers
      DO i = 1, self%n_Orders
        WRITE(*,'(7x,"Absorber#: ",i0,"; Order#: ",i0)') j, i
        WRITE(*,'(5(1x,'//rfmt//',:))') self%Ap(:,i,j)
      END DO
      WRITE(*,*)
    END DO
    DO i = 1, self%n_Predictors
      WRITE(*,'(7x,"Predictor#: ",i0)') i
      WRITE(*,'(5(1x,'//rfmt//',:))') self%X(:,i)
    END DO
  END SUBROUTINE odas_predictor_inspect


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       ODAS_Predictor_Zero
!
! PURPOSE:
!       Elemental subroutine to zero-out an instance of an ODAS predictor object.
!
! CALLING SEQUENCE:
!       CALL ODAS_Predictor_Zero( ODAS_Predictor )
!
! OUTPUTS:
!       ODAS_Predictor:
!         ODAS_Predictor object structure.
!         UNITS:      N/A
!         TYPE:       ODAS_Predictor_type
!         DIMENSION:  Scalar or any rank
!         ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE odas_predictor_zero( self )
    TYPE(odas_predictor_type), INTENT(IN OUT) :: self
    IF ( .NOT. odas_predictor_associated(self) ) RETURN
    self%Secant_Sensor_Zenith = zero
    self%A                    = zero
    self%dA                   = zero
    self%aveA                 = zero
    self%Ap                   = zero
    self%X                    = zero
  END SUBROUTINE odas_predictor_zero

END MODULE odas_predictor_define