ODSSU_Define.f90

Go to the documentation of this file.

!
! ODSSU_Define
!
! Module defining the ODSSU (Tau coefficient data structure for the SSU sensors).
!
!
! CREATION HISTORY:
!       Written by:     Yong Han, NOAA/NESDIS, Oct. 6, 2009
!
!                       Yong Chen, NOAA/NESDIS, 06-Nov-2009
!                       yong.chen@noaa.gov
!

MODULE odssu_define

  ! ------------------
  ! Environment set up
  ! ------------------
  ! Module use
  USE type_kinds,            ONLY: long, double
  USE message_handler,       ONLY: success, failure, warning, display_message
  USE odas_define,           ONLY: odas_type   , &
                                   destroy_odas, &
                                   associated_odas, odas_algorithm
  USE odps_define,           ONLY: odps_type   , &
                                   destroy_odps, &
                                   associated_odps, odps_algorithm
  USE crtm_parameters,       ONLY: odssu_algorithm
  
  ! Disable implicit typing
  IMPLICIT NONE


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

  ! Public types
  ! ------------
  PUBLIC :: odssu_type
  ! The Global unique algorithm ID
  PUBLIC :: odssu_algorithm
  ! public routines
  PUBLIC :: associated_odssu
  PUBLIC :: destroy_odssu
  PUBLIC :: allocate_odssu
  PUBLIC :: checkrelease_odssu
  PUBLIC :: checkalgorithm_odssu
  PUBLIC :: info_odssu
  
  PUBLIC :: odas_algorithm 
  PUBLIC :: odps_algorithm 

  ! -----------------
  ! Module parameters
  ! -----------------
  ! RCS Id for the module
  CHARACTER(*), PARAMETER :: module_rcs_id = &
  '$Id: ODSSU_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! ODSSU invalid values
  INTEGER,      PARAMETER :: ip_invalid = -1
  REAL(Double), PARAMETER :: fp_invalid = -1.0_double
  ! Keyword set value
  INTEGER, PARAMETER :: set = 1
  ! String lengths
  INTEGER, PARAMETER :: sl = 20   ! Sensor Id
  INTEGER, PARAMETER :: ml = 256  ! Messages
  ! Current valid release and version numbers
  INTEGER, PARAMETER :: odssu_release = 6  ! This determines structure and file formats.
  INTEGER, PARAMETER :: odssu_version = 4  ! This is just the data version.
  ! The optical depth algorithm name
  CHARACTER(*), PARAMETER :: odssu_algorithm_name = 'ODSSU'
  ! ASCII codes for Version routine
  INTEGER, PARAMETER :: carriage_return = 13
  INTEGER, PARAMETER :: linefeed = 10
  ! Invalid sensor ids
  INTEGER, PARAMETER :: invalid_wmo_satellite_id = 1023
  INTEGER, PARAMETER :: invalid_wmo_sensor_id    = 2047
  ! The instrument types
  INTEGER, PARAMETER :: invalid_sensor     = 0
  ! instrument type
  INTEGER, PARAMETER :: infrared_sensor    = 2

  ! -------------------------
  ! ODSSU data type definition
  ! -------------------------
  TYPE :: odssu_type

    ! This structure is specific for the Stratospheric Sensor Unit (SSU). To consider
    ! the variation of cell CO2 pressure, a set of absorption coefficients are derived
    ! corresponding a set of cell CO2 pressures. 
    ! The simultaneous cell CO2 pressure can be interpolated from the array data
    ! Ref_Time and Ref_CellPressure. 
    INTEGER :: n_allocates = 0
    ! Release and version information
    INTEGER(Long) :: release = odssu_release
    INTEGER(Long) :: version = odssu_version

    INTEGER(Long) :: algorithm = odssu_algorithm
    INTEGER(Long) :: subalgorithm = 0  ! refer to the series algorithm ID 1 for ODAS, 2 for ODPS
    ! Array dimensions
    INTEGER(Long) :: n_channels          = 0  ! L
    INTEGER(Long) :: n_absorbers         = 0  ! J
    INTEGER(Long) :: n_tc_cellpressures  = 0  ! M
    INTEGER(Long) :: n_ref_cellpressures = 0  ! N
    ! Scalar components
    CHARACTER(SL) :: sensor_id        = ' '
    INTEGER(Long) :: wmo_satellite_id = invalid_wmo_satellite_id
    INTEGER(Long) :: wmo_sensor_id    = invalid_wmo_sensor_id
    INTEGER(Long) :: sensor_type      = infrared_sensor  ! fixed for SSUs
    ! The actual sensor channel numbers
    INTEGER(Long), POINTER, DIMENSION(:)   :: sensor_channel     => null()  ! L           
    ! The absorber ID and absorber space values
    INTEGER(Long), POINTER, DIMENSION(:)   :: absorber_id        => null()  ! J           

    ! cell CO2 pressures used in training coefficients, part of TauCoefficients file
    REAL(Double),  POINTER, DIMENSION(:,:) :: tc_cellpressure    => null()  ! M x L
    REAL(Double),  POINTER, DIMENSION(:)   :: ref_time           => null()  ! N
    REAL(Double),  POINTER, DIMENSION(:,:) :: ref_cellpressure   => null()  ! N x L

    ! Tau coefficient series at different cell pressures    
    TYPE(odas_type), POINTER, DIMENSION(:) :: odas                 => null()  ! M  
    TYPE(odps_type), POINTER, DIMENSION(:) :: odps                 => null()  ! M  
    
  END TYPE odssu_type   

CONTAINS

!--------------------------------------------------------------------------------
!
! NAME:
!       Associated_ODSSU
!
! PURPOSE:
!       Function to test the association status of the pointer members of a
!       ODSSU structure.
!
! CALLING SEQUENCE:
!       Association_Status = Associated_ODSSU(ODSSU             ,&  ! Input
!                                             ANY_Test=Any_Test )  ! Optional input
!
! INPUT ARGUMENTS:
!       ODSSU:       ODSSU structure which is to have its pointer
!                    member's association status tested.
!                    UNITS:      N/A
!                    TYPE:       ODSSU_type
!                    DIMENSION:  Scalar
!                    ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUT ARGUMENTS:
!       ANY_Test:    Set this argument to test if ANY of the
!                    ODSSU structure pointer members are associated.
!                    The default is to test if ALL the pointer members
!                    are associated.
!                    If ANY_Test = 0, test if ALL the pointer members
!                                     are associated.  (DEFAULT)
!                       ANY_Test = 1, test if ANY of the pointer members
!                                     are associated.
!
! FUNCTION RESULT:
!       Association_Status:  The return value is a logical value indicating the
!                            association status of the ODSSU pointer members.
!                            .TRUE.  - if ALL the ODSSU pointer members are
!                                      associated, or if the ANY_Test argument
!                                      is set and ANY of the ODSSU pointer
!                                      members are associated.
!                            .FALSE. - some or all of the ODSSU pointer
!                                      members are NOT associated.
!                            UNITS:      N/A
!                            TYPE:       LOGICAL
!                            DIMENSION:  Scalar
!
!--------------------------------------------------------------------------------

  FUNCTION associated_odssu(ODSSU   , & ! Input
                            ANY_Test) & ! Optional input
                          result( association_status )
    ! Arguments
    TYPE(odssu_type) , INTENT(IN) :: odssu
    INTEGER, OPTIONAL, INTENT(IN) :: any_test
    ! Function result
    LOGICAL :: association_status
    ! Local variables
    LOGICAL :: all_test
    INTEGER :: i

    ! Set up
    ! ------
    ! Default is to test ALL the pointer members
    ! for a true association status....
    all_test = .true.
    ! ...unless the ANY_Test argument is set.
    IF ( PRESENT( any_test ) ) THEN
      IF ( any_test == set ) all_test = .false.
    END IF

    ! Test the members that MUST be associated
    ! ----------------------------------------
    association_status = .false.
    IF ( all_test ) THEN
      IF ( ASSOCIATED( odssu%Sensor_Channel    ) .AND. &
           ASSOCIATED( odssu%Absorber_ID       ) .AND. &
           ASSOCIATED( odssu%TC_CellPressure   ) .AND. &
           ASSOCIATED( odssu%Ref_Time          ) .AND. &
           ASSOCIATED( odssu%Ref_CellPressure  ) ) THEN
         association_status = .true.  
      ENDIF                                                                             
      IF(odssu%subAlgorithm == odas_algorithm) THEN                                     
        association_status = association_status .AND. ASSOCIATED( odssu%ODAS )          
        DO i = 1, odssu%n_TC_CellPressures                                              
         association_status = association_status .AND. associated_odas( odssu%ODAS(i) ) 
        END DO                                                                          
      ENDIF                                                                             

      IF(odssu%subAlgorithm == odps_algorithm) THEN                                     
        association_status = association_status .AND. ASSOCIATED( odssu%ODPS )          
        DO i = 1, odssu%n_TC_CellPressures                                              
         association_status = association_status .AND. associated_odps( odssu%ODPS(i) ) 
        END DO                                                                          
      ENDIF                                                                             
    ELSE
      IF ( ASSOCIATED( odssu%Sensor_Channel    ) .OR. &
           ASSOCIATED( odssu%Absorber_ID       ) .OR. &
           ASSOCIATED( odssu%TC_CellPressure   ) .OR. &
           ASSOCIATED( odssu%Ref_Time          ) .OR. &
           ASSOCIATED( odssu%Ref_CellPressure  ) ) THEN
         association_status = .true.
      END IF
      IF(odssu%subAlgorithm == odas_algorithm) THEN                                     
        association_status = association_status .OR. ASSOCIATED( odssu%ODAS )          
        DO i = 1, odssu%n_TC_CellPressures                                              
         association_status = association_status .OR. associated_odas( odssu%ODAS(i) ) 
        END DO                                                                          
      ENDIF                                                                             

      IF(odssu%subAlgorithm == odps_algorithm) THEN                                     
        association_status = association_status .OR. ASSOCIATED( odssu%ODPS )          
        DO i = 1, odssu%n_TC_CellPressures                                              
         association_status = association_status .OR. associated_odps( odssu%ODPS(i) ) 
        END DO                                                                          
      ENDIF                                                                             
    END IF

  END FUNCTION associated_odssu
     
!------------------------------------------------------------------------------
!
! NAME:
!       Destroy_ODSSU
! 
! PURPOSE:
!       Function to re-initialize the scalar and pointer members of ODSSU
!       data structures.
!
! CALLING SEQUENCE:
!       Error_Status = Destroy_ODSSU(ODSSU                  , &  ! Output
!                                    RCS_Id     =RCS_Id     , &  ! Revision control
!                                    Message_Log=Message_Log  )  ! Error messaging
!
! OUTPUT ARGUMENTS:
!       ODSSU:        Re-initialized ODSSU structure.
!                     UNITS:      N/A
!                     TYPE:       ODSSU_type
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUT ARGUMENTS:
!       Message_Log:  Character string specifying a filename in which any
!                     messages will be logged. If not specified, or if an
!                     error occurs opening the log file, the default action
!                     is to output messages to standard output.
!                     UNITS:      N/A
!                     TYPE:       CHARACTER(*)
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: OPTIONAL, INTENT(IN)
!
! OPTIONAL OUTPUT ARGUMENTS:
!       RCS_Id:       Character string containing the Revision Control
!                     System Id field for the module.
!                     UNITS:      N/A
!                     TYPE:       CHARACTER(*)
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status: The return value is an integer defining the error status.
!                     The error codes are defined in the Message_Handler module.
!                     If == SUCCESS the structure re-initialisation was successful
!                        == FAILURE - an error occurred, or
!                                   - the structure internal allocation counter
!                                     is not equal to zero (0) upon exiting this
!                                     function. This value is incremented and
!                                     decremented for every structure allocation
!                                     and deallocation respectively.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on the output ODSSU argument is IN OUT rather than
!       just OUT. This is necessary because the argument may be defined upon
!       input. To prevent memory leaks, the IN OUT INTENT is a must.
!
!------------------------------------------------------------------------------

  FUNCTION destroy_odssu(ODSSU      , &  ! Output
                         No_Clear   , &  ! Optional input
                         RCS_Id     , &  ! Revision control
                         Message_Log) &  ! Error messaging
                       result( error_status )
    ! Arguments
    TYPE(odssu_type)      , INTENT(IN OUT) :: odssu
    INTEGER,      OPTIONAL, INTENT(IN)     :: no_clear
    CHARACTER(*), OPTIONAL, INTENT(OUT)    :: rcs_id
    CHARACTER(*), OPTIONAL, INTENT(IN)     :: message_log
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Destroy_ODSSU'
    ! Local variables
    CHARACTER(ML) :: message
    LOGICAL :: clear
    INTEGER :: allocate_status1, allocate_status2
    INTEGER :: i

    ! Set up
    ! ------
    error_status = success
    IF ( PRESENT( rcs_id ) ) rcs_id = module_rcs_id
    ! Default is to clear scalar members...
    clear = .true.
    ! ....unless the No_Clear argument is set
    IF ( PRESENT( no_clear ) ) THEN
      IF ( no_clear == set ) clear = .false.
    END IF

    ! If ALL components are NOT associated, do nothing
    IF ( .NOT. associated_odssu( odssu ) ) RETURN

    ! Destroy ODx 
    IF(odssu%subAlgorithm == odas_algorithm) THEN  
     DO i = 1, odssu%n_TC_CellPressures
       error_status = destroy_odas( odssu%ODAS(i), &
                                    message_log = message_log)
       IF( error_status /= success )THEN
         CALL display_message( routine_name,    &
                               "Error deallocating ODAS for ODSSU", &
                               error_status,    &
                               message_log=message_log )
         RETURN
       END IF
     END DO
    ENDIF
    IF(odssu%subAlgorithm == odps_algorithm) THEN  
     DO i = 1, odssu%n_TC_CellPressures
       error_status = destroy_odps( odssu%ODPS(i), &
                                    message_log = message_log)
       IF( error_status /= success )THEN
         CALL display_message( routine_name,    &
                               "Error deallocating ODPS for ODSSU", &
                               error_status,    &
                               message_log=message_log )
         RETURN
       END IF
     END DO
    ENDIF
                       
    ! Deallocate the regular arrays components
    ! ----------------------------------------
    DEALLOCATE( odssu%Sensor_Channel  , &
                odssu%Absorber_ID     , &
                odssu%TC_CellPressure , &
                odssu%Ref_Time        , &
                odssu%Ref_CellPressure, &
                stat=allocate_status1 )

    IF(odssu%subAlgorithm == odas_algorithm) THEN  
       DEALLOCATE(odssu%ODAS,  stat=allocate_status2) 
    ENDIF
    IF(odssu%subAlgorithm == odps_algorithm) THEN  
       DEALLOCATE(odssu%ODPS,  stat=allocate_status2) 
    ENDIF

    IF ( allocate_status1 /= 0 ) THEN
      error_status = failure
      WRITE( message,'("Error deallocating ODSSU components 1. STAT = ",i0)' ) &
                     allocate_status1
      CALL display_message( routine_name,    &
                            trim(message), &
                            error_status,    &
                            message_log=message_log )
    END IF
    IF ( allocate_status2 /= 0 ) THEN
      error_status = failure
      WRITE( message,'("Error deallocating ODSSU components 2. STAT = ",i0)' ) &
                     allocate_status2
      CALL display_message( routine_name,    &
                            trim(message), &
                            error_status,    &
                            message_log=message_log )
    END IF

    ! Clear the scalar members
    IF ( clear ) CALL clear_odssu( odssu )

    ! Reinitialise the dimensions
    odssu%n_Channels          = 0
    odssu%n_TC_CellPressures  = 0
    odssu%n_Ref_CellPressures = 0


    ! Decrement and test allocation counter
    ! -------------------------------------
    odssu%n_Allocates = odssu%n_Allocates - 1
    IF ( odssu%n_Allocates /= 0 ) THEN
      error_status = failure
      WRITE( message,'("Allocation counter /= 0, Value = ",i0)' ) &
                      odssu%n_Allocates
      CALL display_message( routine_name,    &
                            trim(message), &
                            error_status,    &
                            message_log=message_log )
    END IF
  END FUNCTION destroy_odssu

!------------------------------------------------------------------------------
!
! NAME:
!       Allocate_ODSSU
! 
! PURPOSE:
!       Function to allocate the pointer members of the ODSSU
!       data structure.
!
! CALLING SEQUENCE:
!       Error_Status = Allocate_ODSSU(n_Absorbers            , &  ! Input
!                                     n_Channels             , &  ! Input
!                                     n_TC_CellPressures     , &  ! Input
!                                     n_Ref_CellPressures    , &  ! Input
!                                     ODSSU                  , &  ! Output
!                                     RCS_Id     =RCS_Id     , &  ! Revision control
!                                     Message_Log=Message_Log  )  ! Error messaging
!
! INPUT ARGUMENTS:
!
!       n_Absorbers:  Number of absorbers dimension.
!                     Must be > 0.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN)
!
!       n_Channels:   Number of channels dimension.
!                     Must be > 0.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN)
!
! n_TC_CellPressures: Number of TC cell pressure dimension.
!                     Must be > 0.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN)
!
! n_Ref_CellPressures: Number of refference cell pressure dimension.
!                     Must be > 0.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       ODSSU:        ODSSU structure with allocated
!                     pointer members
!                     UNITS:      N/A
!                     TYPE:       ODSSU_type
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(OUT)
!
! OPTIONAL INPUT ARGUMENTS:
!       Message_Log:  Character string specifying a filename in
!                     which any messages will be logged. If not
!                     specified, or if an error occurs opening
!                     the log file, the default action is to
!                     output messages to standard output.
!                     UNITS:      N/A
!                     TYPE:       CHARACTER(*)
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: OPTIONAL, INTENT(IN)
!
! OPTIONAL OUTPUT ARGUMENTS:
!       RCS_Id:       Character string containing the Revision Control
!                     System Id field for the module.
!                     UNITS:      N/A
!                     TYPE:       CHARACTER(*)
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status: The return value is an integer defining the error status.
!                     The error codes are defined in the Message_Handler module.
!                     If == SUCCESS the structure re-initialisation was successful
!                        == FAILURE - an error occurred, or
!                                   - the structure internal allocation counter
!                                     is not equal to one (1) upon exiting this
!                                     function. This value is incremented and
!                                     decremented for every structure allocation
!                                     and deallocation respectively.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar
!
! COMMENTS:
!       The pointer members of the ODSSU structure in the ODSSU structure will not be
!       allocated in this routine.
!
!       Note the INTENT on the output ODSSU argument is IN OUT rather than
!       just OUT. This is necessary because the argument may be defined upon
!       input. To prevent memory leaks, the IN OUT INTENT is a must.
!
!------------------------------------------------------------------------------

  FUNCTION allocate_odssu(n_Absorbers        , &  ! Input
                          n_Channels         , &  ! Input
                          n_TC_CellPressures , &  ! Input 
                          n_Ref_CellPressures, &  ! Input 
                          ODSSU              , &  ! Output           
                          RCS_Id             , &  ! Revision control 
                          Message_Log ) &         ! Error messaging  
                        result( error_status )
    ! Arguments
    INTEGER               , INTENT(IN)     :: n_absorbers
    INTEGER               , INTENT(IN)     :: n_channels
    INTEGER               , INTENT(IN)     :: n_tc_cellpressures
    INTEGER               , INTENT(IN)     :: n_ref_cellpressures
    TYPE(odssu_type)      , INTENT(IN OUT) :: odssu
    CHARACTER(*), OPTIONAL, INTENT(OUT)    :: rcs_id
    CHARACTER(*), OPTIONAL, INTENT(IN)     :: message_log
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Allocate_ODSSU'
    ! Local variables
    CHARACTER(ML) :: message
    INTEGER :: allocate_status1, allocate_status2

    ! Set up
    ! ------
    error_status = success
    IF ( PRESENT( rcs_id ) ) rcs_id = module_rcs_id

    ! Check dimension input
    IF ( n_absorbers          < 1 .OR. &
         n_channels           < 1 .OR. &
         n_tc_cellpressures   < 1 .OR. &
         n_ref_cellpressures  < 1    ) THEN
      error_status = failure
      CALL display_message( routine_name, &
                            'Input ODSSU dimensions must all be > 0.', &
                            error_status, &
                            message_log=message_log )
      RETURN
    END IF

    ! Check if ANY pointers are already associated.
    ! If they are, deallocate them but leave scalars.
    IF ( associated_odssu( odssu, any_test=set ) ) THEN
      error_status = destroy_odssu(odssu, &
                                   no_clear=set, &
                                   message_log=message_log )
      IF ( error_status /= success ) THEN
        CALL display_message( routine_name,    &
                              'Error deallocating ODSSU prior to reallocation.', &
                              error_status,    &
                              message_log=message_log )
        RETURN
      END IF
    END IF

    ! Allocate the data arrays
    ! ------------------------
    ALLOCATE( odssu%TC_CellPressure( n_tc_cellpressures, n_channels)  , &
              odssu%Ref_Time( n_ref_cellpressures )                   , &
              odssu%Ref_CellPressure( n_ref_cellpressures, n_channels), &
              odssu%Sensor_Channel( n_channels )                      , &
              odssu%Absorber_ID( n_absorbers )                        , &
              stat = allocate_status1 )
    IF(odssu%subAlgorithm == odas_algorithm) THEN  
       ALLOCATE(odssu%ODAS( n_tc_cellpressures ),  stat=allocate_status2) 
    ENDIF
    IF(odssu%subAlgorithm == odps_algorithm) THEN  
       ALLOCATE(odssu%ODPS( n_tc_cellpressures ),  stat=allocate_status2) 
    ENDIF

    IF ( allocate_status1 /= 0 .OR. allocate_status2 /= 0) THEN
      error_status = failure
      WRITE( message,'("Error allocating ODSSU data arrays. STAT = ",i0)' ) &
                     allocate_status1
      CALL display_message( routine_name, &
                            trim(message), &
                            error_status, &
                            message_log=message_log )
      RETURN
    END IF

    ! Assign the dimensions and initialise arrays
    odssu%n_Absorbers         = n_absorbers
    odssu%n_Channels          = n_channels
    odssu%n_TC_CellPressures  = n_tc_cellpressures
    odssu%n_Ref_CellPressures = n_ref_cellpressures

    odssu%Sensor_Channel    = 0
    odssu%Absorber_ID       = ip_invalid
    odssu%TC_CellPressure   = fp_invalid
    odssu%Ref_Time          = fp_invalid
    odssu%Ref_CellPressure  = fp_invalid


    ! Increment and test allocation counter
    ! -------------------------------------
    odssu%n_Allocates = odssu%n_Allocates + 1
    IF ( odssu%n_Allocates /= 1 ) THEN
      error_status = failure
      WRITE( message,'("Allocation counter /= 1, Value = ",i0)' ) &
                     odssu%n_Allocates
      CALL display_message( routine_name, &
                            trim(message), &
                            error_status, &
                            message_log=message_log )
      RETURN
    END IF

  END FUNCTION allocate_odssu
     

!----------------------------------------------------------------------------------
!
! NAME:
!       CheckRelease_ODSSU
!
! PURPOSE:
!       Function to check the ODSSU Release value.
!
! CALLING SEQUENCE:
!       Error_Status = CheckRelease_ODSSU( ODSSU                  , &  ! Input
!                                          RCS_Id     = RCS_Id    , &  ! Revision control
!                                          Message_Log=Message_Log  )  ! Error messaging
!
! INPUT ARGUMENTS:
!       ODSSU:         ODSSU structure for which the Release member
!                      is to be checked.
!                      UNITS:      N/A
!                      TYPE:       ODSSU_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
! OPTIONAL INPUT ARGUMENTS:
!       Message_Log:   Character string specifying a filename in which any
!                      messages will be logged. If not specified, or if an
!                      error occurs opening the log file, the default action
!                      is to output messages to standard output.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: OPTIONAL, INTENT(IN)
! OPTIONAL OUTPUT ARGUMENTS:
!       RCS_Id:        Character string containing the Revision Control
!                      System Id field for the module.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status:  The return value is an integer defining the error status.
!                      The error codes are defined in the Message_Handler module.
!                      If == SUCCESS the structure Release value is valid.
!                         == FAILURE the structure Release value is NOT valid
!                                    and either a data file file or software
!                                    update is required.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar
!
!----------------------------------------------------------------------------------

  FUNCTION checkrelease_odssu(ODSSU      , &  ! Input
                              RCS_Id     , &  ! Revision control
                              Message_Log) &  ! Error messaging
                            result( error_status )
    ! Arguments
    TYPE(odssu_type)      , INTENT(IN)  :: odssu
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: rcs_id
    CHARACTER(*), OPTIONAL, INTENT(IN)  :: message_log
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CheckRelease_ODSSU'
    ! Local variables
    CHARACTER(ML) :: message

    ! Set up
    ! ------
    error_status = success
    IF ( PRESENT( rcs_id ) ) rcs_id = module_rcs_id


    ! Check the release
    ! -----------------
    ! Check that release is not too old
    IF ( odssu%Release < odssu_release ) THEN
      error_status = failure
      WRITE( message, '( "An ODSSU data update is needed. ", &
                        &"ODSSU release is ", i2, &
                        &". Valid release is ",i2,"." )' ) &
                      odssu%Release, odssu_release
      CALL display_message( routine_name, &
                            trim(message), &
                            error_status, &
                            message_log=message_log )
      RETURN
    END IF

    ! Check that release is not too new
    IF ( odssu%Release > odssu_release ) THEN
      error_status = failure
      WRITE( message, '( "An ODSSU software update is needed. ", &
                        &"ODSSU release is ", i2, &
                        &". Valid release is ",i2,"." )' ) &
                      odssu%Release, odssu_release
      CALL display_message( routine_name, &
                            trim(message), &
                            error_status, &
                            message_log=message_log )
      RETURN
    END IF

  END FUNCTION checkrelease_odssu


!----------------------------------------------------------------------------------
!
! NAME:
!       CheckAlgorithm_ODSSU
!
! PURPOSE:
!       Function to check the ODSSU Algorithm value.
!
! CALLING SEQUENCE:
!       Error_Status = CheckAlgorithm_ODSSU(ODSSU                  , &  ! Input
!                                           RCS_Id     = RCS_Id    , &  ! Revision control
!                                           Message_Log=Message_Log  )  ! Error messaging
!
! INPUT ARGUMENTS:
!       ODSSU:         ODSSU structure for which the Algorithm member
!                      is to be checked.
!                      UNITS:      N/A
!                      TYPE:       ODSSU_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
! OPTIONAL INPUT ARGUMENTS:
!       Message_Log:   Character string specifying a filename in which any
!                      messages will be logged. If not specified, or if an
!                      error occurs opening the log file, the default action
!                      is to output messages to standard output.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: OPTIONAL, INTENT(IN)
! OPTIONAL OUTPUT ARGUMENTS:
!       RCS_Id:        Character string containing the Revision Control
!                      System Id field for the module.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status:  The return value is an integer defining the error status.
!                      The error codes are defined in the Message_Handler module.
!                      If == SUCCESS the structure Algorithm value is valid.
!                         == FAILURE the structure Algorithm value is NOT valid.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar
!
!----------------------------------------------------------------------------------

  FUNCTION checkalgorithm_odssu(ODSSU      , &  ! Input
                                RCS_Id     , &  ! Revision control
                                Message_Log) &  ! Error messaging
                              result( error_status )
    ! Arguments
    TYPE(odssu_type)      , INTENT(IN)  :: odssu
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: rcs_id
    CHARACTER(*), OPTIONAL, INTENT(IN)  :: message_log
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CheckAlgorithm_ODSSU'

    ! Set up
    ! ------
    error_status = success
    IF ( PRESENT(rcs_id) ) rcs_id = module_rcs_id


    ! Check the algorithm ID
    ! ----------------------
    IF ( odssu%Algorithm /= odssu_algorithm ) THEN
      error_status = failure
      CALL display_message( routine_name, &
                            'The ODSSU Algorithm ID check failed. '//&
                            'The data structure is not an ODSSU structure', &
                            error_status, &
                            message_log=message_log )
      RETURN
    END IF

  END FUNCTION checkalgorithm_odssu

!------------------------------------------------------------------------------
!
! NAME:
!       Info_ODSSU
!
! PURPOSE:
!       Subroutine to return a string containing version and dimension
!       information about the ODSSU data structure.
!
! CALLING SEQUENCE:
!       CALL Info_ODSSU(ODSSU        , &  ! Input
!                       Info         , &  ! Output
!                       RCS_Id=RCS_Id  )  ! Revision control
!
! INPUT ARGUMENTS:
!       ODSSU:         Filled ODSSU structure.
!                      UNITS:      N/A
!                      TYPE:       ODSSU_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       Info:          String containing version and dimension information
!                      about the passed ODSSU data structure.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
! OPTIONAL OUTPUT ARGUMENTS:
!       RCS_Id:        Character string containing the Revision Control
!                      System Id field for the module.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
!------------------------------------------------------------------------------

  SUBROUTINE info_odssu( ODSSU , &  ! Input
                         Info  , &  ! Output
                         RCS_Id  )  ! Revision control
    ! Arguments
    TYPE(odssu_type)      , INTENT(IN)  :: odssu
    CHARACTER(*),           INTENT(OUT) :: info
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: rcs_id
    ! Local variables
    CHARACTER(2000) :: longstring

    ! Set up
    ! ------
    IF ( PRESENT( rcs_id ) ) rcs_id = module_rcs_id

    ! Write the required data to the local string
    ! -------------------------------------------
    WRITE( longstring,'( a,3x,"ODSSU RELEASE.VERSION: ",i2,".",i2.2,2x,&
                      &"SUBALGORITHM=",i2,2x,&
                      &"N_ABSORBERS=",i2,2x,&
                      &"N_CHANNELS=",i0,2x, &
                      &"N_TC_CELLPRESSURES=",i2,2x, &
                      &"N_REF_CELLPRESSURES=",i0)' ) &
                      achar(carriage_return)//achar(linefeed), &
                      odssu%Release, odssu%Version, &
                      odssu%subAlgorithm, &
                      odssu%n_Absorbers, &
                      odssu%n_Channels, &
                      odssu%n_TC_CellPressures, &
                      odssu%n_Ref_CellPressures

    ! Trim the output based on the
    ! dummy argument string length
    ! ----------------------------
    info = longstring(1:min( len(info), len_trim(longstring) ))

  END SUBROUTINE info_odssu
  


!##################################################################################
!##################################################################################
!##                                                                              ##
!##                          ## PRIVATE MODULE ROUTINES ##                       ##
!##                                                                              ##
!##################################################################################
!##################################################################################

!----------------------------------------------------------------------------------
!
! NAME:
!       Clear_ODSSU
!
! PURPOSE:
!       Subroutine to clear the scalar members of a ODSSU structure.
!
! CALLING SEQUENCE:
!       CALL Clear_ODSSU( ODSSU ) ! Output
!
! OUTPUT ARGUMENTS:
!       ODSSU:       ODSSU structure for which the scalar members have
!                    been cleared.
!                    UNITS:      N/A
!                    TYPE:       ODSSU_type
!                    DIMENSION:  Scalar
!                    ATTRIBUTES: INTENT(IN OUT)
!
!
!----------------------------------------------------------------------------------

  SUBROUTINE clear_odssu( ODSSU )
    TYPE(ODSSU_type), INTENT(IN OUT) :: ODSSU
    odssu%Release   = odssu_release
    odssu%Version   = odssu_version
    odssu%Algorithm = odssu_algorithm
    odssu%subAlgorithm = 0
    odssu%Sensor_Id        = ' '
    odssu%Sensor_Type      = invalid_sensor
    odssu%WMO_Satellite_ID = invalid_wmo_satellite_id
    odssu%WMO_Sensor_ID    = invalid_wmo_sensor_id
  END SUBROUTINE clear_odssu

END MODULE odssu_define