SSU_Input_Define.f90

Go to the documentation of this file.

!
! SSU_Input_Define
!
! Module containing the structure definition and associated routines
! for CRTM inputs specific to SSU
!
!
! CREATION HISTORY:
!       Written by:     Yong Han, NOAA/NESDIS, Oct 6, 2009
!                       yong.han@noaa.gov
!
!                       Paul van Delst, 20-Oct-2009
!                       paul.vandelst@noaa.gov
!

MODULE ssu_input_define

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds           , ONLY: fp, long, double
  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
  ! ------------
  ! Visibilities
  ! ------------
  PRIVATE
  ! Datatypes
  PUBLIC :: ssu_input_type
  ! Operators
  PUBLIC :: OPERATOR(==)
  ! Procedures
  PUBLIC :: ssu_input_isvalid
  PUBLIC :: ssu_input_inspect
  PUBLIC :: ssu_input_validrelease
  PUBLIC :: ssu_input_defineversion
  PUBLIC :: ssu_input_getvalue
  PUBLIC :: ssu_input_setvalue
  PUBLIC :: ssu_input_cellpressureisset
  PUBLIC :: ssu_input_readfile
  PUBLIC :: ssu_input_writefile


  ! -------------------
  ! Procedure overloads
  ! -------------------
  INTERFACE OPERATOR(==)
    MODULE PROCEDURE ssu_input_equal
  END INTERFACE OPERATOR(==)


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: SSU_Input_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Release and version
  INTEGER, PARAMETER :: ssu_input_release = 1  ! This determines structure and file formats.
  INTEGER, PARAMETER :: ssu_input_version = 1  ! This is just the default data version.
  ! Close status for write errors
  CHARACTER(*), PARAMETER :: write_error_status = 'DELETE'
  ! Literal constants
  REAL(Double), PARAMETER :: zero = 0.0_double
  ! Message length
  INTEGER,  PARAMETER :: ml = 256
  ! SSU instrument specific data
  INTEGER,  PARAMETER :: max_n_channels = 3


  !--------------------
  ! Structure defintion
  !--------------------
  !:tdoc+:
  TYPE :: ssu_input_type
    PRIVATE
    ! Release and version information
    INTEGER(Long) :: release = ssu_input_release
    INTEGER(Long) :: version = ssu_input_version
    ! Time in decimal year (e.g. 2009.08892694 corresponds to 11:00 Feb. 2, 2009)
    REAL(Double) :: time = zero
    ! SSU CO2 cell pressures (hPa)
    REAL(Double) :: cell_pressure(max_n_channels) = zero
  END TYPE ssu_input_type
  !:tdoc-:


CONTAINS


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

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SSU_Input_IsValid
!
! PURPOSE:
!       Non-pure function to perform some simple validity checks on a
!       SSU_Input object.
!
!       If invalid data is found, a message is printed to stdout.
!
! CALLING SEQUENCE:
!       result = SSU_Input_IsValid( ssu )
!
!         or
!
!       IF ( SSU_Input_IsValid( ssu ) ) THEN....
!
! OBJECTS:
!       ssu:       SSU_Input object which is to have its
!                  contents checked.
!                  UNITS:      N/A
!                  TYPE:       SSU_Input_type
!                  DIMENSION:  Scalar
!                  ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       result:    Logical variable indicating whether or not the input
!                  passed the check.
!                  If == .FALSE., object is unused or contains
!                                 invalid data.
!                     == .TRUE.,  object can be used.
!                  UNITS:      N/A
!                  TYPE:       LOGICAL
!                  DIMENSION:  Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------

  FUNCTION ssu_input_isvalid( ssu ) RESULT( IsValid )
    TYPE(ssu_input_type), INTENT(IN) :: ssu
    LOGICAL :: isvalid
    CHARACTER(*), PARAMETER :: routine_name = 'SSU_Input_IsValid'
    CHARACTER(ML) :: msg

    ! Setup
    isvalid = .true.

    ! Check time
    IF ( ssu%Time < zero ) THEN
      msg = 'Invalid mission time'
      CALL display_message( routine_name, trim(msg), information )
      isvalid = .false.
    END IF

    ! Check cell pressures
    IF ( any(ssu%Cell_Pressure < zero) ) THEN
      msg = 'Invalid cell pressures'
      CALL display_message( routine_name, trim(msg), information )
      isvalid = .false.
    END IF

  END FUNCTION ssu_input_isvalid


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SSU_Input_Inspect
!
! PURPOSE:
!       Subroutine to print the contents of an SSU_Input object to stdout.
!
! CALLING SEQUENCE:
!       CALL SSU_Input_Inspect( ssu )
!
! INPUTS:
!       ssu:           SSU_Input object to display.
!                      UNITS:      N/A
!                      TYPE:       SSU_Input_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE ssu_input_inspect(ssu)
    TYPE(ssu_input_type), INTENT(IN) :: ssu
    WRITE(*,'(3x,"SSU_Input OBJECT")')
    WRITE(*,'(5x,"Mission time:",1x,es22.15)') ssu%Time
    WRITE(*,'(5x,"Channel cell pressures:",10(1x,es22.15,:))') ssu%Cell_Pressure
  END SUBROUTINE ssu_input_inspect


!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SSU_Input_ValidRelease
!
! PURPOSE:
!       Function to check the SSU_Input Release value.
!
! CALLING SEQUENCE:
!       IsValid = SSU_Input_ValidRelease( SSU_Input )
!
! INPUTS:
!       SSU_Input:    SSU_Input object for which the Release component
!                      is to be checked.
!                      UNITS:      N/A
!                      TYPE:       SSU_Input_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       IsValid:       Logical value defining the release validity.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Scalar
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION ssu_input_validrelease( self ) RESULT( IsValid )
    ! Arguments
    TYPE(ssu_input_type), INTENT(IN) :: self
    ! Function result
    LOGICAL :: isvalid
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'SSU_Input_ValidRelease'
    ! Local variables
    CHARACTER(ML) :: msg

    ! Set up
    isvalid = .true.


    ! Check release is not too old
    IF ( self%Release < ssu_input_release ) THEN
      isvalid = .false.
      WRITE( msg,'("An SSU_Input data update is needed. ", &
                  &"SSU_Input release is ",i0,". Valid release is ",i0,"." )' ) &
                  self%Release, ssu_input_release
      CALL display_message( routine_name, msg, information ); RETURN
    END IF


    ! Check release is not too new
    IF ( self%Release > ssu_input_release ) THEN
      isvalid = .false.
      WRITE( msg,'("An SSU_Input software update is needed. ", &
                  &"SSU_Input release is ",i0,". Valid release is ",i0,"." )' ) &
                  self%Release, ssu_input_release
      CALL display_message( routine_name, msg, information ); RETURN
    END IF

  END FUNCTION ssu_input_validrelease


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SSU_Input_DefineVersion
!
! PURPOSE:
!       Subroutine to return the module version information.
!
! CALLING SEQUENCE:
!       CALL SSU_Input_DefineVersion( Id )
!
! OUTPUTS:
!       Id:            Character string containing the version Id information
!                      for the module.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE ssu_input_defineversion( Id )
    CHARACTER(*), INTENT(OUT) :: id
    id = module_version_id
  END SUBROUTINE ssu_input_defineversion


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SSU_Input_SetValue
!
! PURPOSE:
!       Elemental subroutine to set the values of SSU_Input
!       object components.
!
! CALLING SEQUENCE:
!       CALL SSU_Input_SetValue( SSU_Input                    , &
!                                Time          = Time         , &
!                                Cell_Pressure = Cell_Pressure, &
!                                Channel       = Channel        )
!
! OBJECTS:
!       SSU_Input:            SSU_Input object for which component values
!                             are to be set.
!                             UNITS:      N/A
!                             TYPE:       SSU_Input_type
!                             DIMENSION:  Scalar or any rank
!                             ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUTS:
!       Time:                 SSU instrument mission time.
!                             UNITS:      decimal year
!                             TYPE:       REAL(fp)
!                             DIMENSION:  Scalar or same as SSU_Input
!                             ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Cell_Pressure:        SSU channel CO2 cell pressure. Must be
!                             specified with the Channel optional dummy
!                             argument.
!                             UNITS:      hPa
!                             TYPE:       REAL(fp)
!                             DIMENSION:  Scalar or same as SSU_Input
!                             ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Channel:              SSU channel for which the CO2 cell pressure
!                             is to be set. Must be specified with the
!                             Cell_Pressure optional dummy argument.
!                             UNITS:      N/A
!                             TYPE:       INTEGER
!                             DIMENSION:  Scalar or same as SSU_Input
!                             ATTRIBUTES: INTENT(IN), OPTIONAL
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE ssu_input_setvalue ( &
    SSU_Input    , &
    Time         , &
    Cell_Pressure, &
    Channel        )
    ! Arguments
    TYPE(ssu_input_type), INTENT(IN OUT) :: ssu_input
    REAL(fp),   OPTIONAL, INTENT(IN)     :: time
    REAL(fp),   OPTIONAL, INTENT(IN)     :: cell_pressure
    INTEGER,    OPTIONAL, INTENT(IN)     :: channel
    ! Variables
    INTEGER :: n

    ! Set values
    IF ( PRESENT(time) ) ssu_input%Time = time
    IF ( PRESENT(channel) .AND. PRESENT(cell_pressure) ) THEN
      n = max(min(channel,max_n_channels),1)
      ssu_input%Cell_Pressure(n) = cell_pressure
    END IF

  END SUBROUTINE ssu_input_setvalue


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SSU_Input_GetValue
!
! PURPOSE:
!       Elemental subroutine to Get the values of SSU_Input
!       object components.
!
! CALLING SEQUENCE:
!       CALL SSU_Input_GetValue( SSU_Input                    , &
!                                Channel       = Channel      , &
!                                Time          = Time         , &
!                                Cell_Pressure = Cell_Pressure, &
!                                n_Channels    = n_Channels     )
!
! OBJECTS:
!       SSU_Input:            SSU_Input object for which component values
!                             are to be set.
!                             UNITS:      N/A
!                             TYPE:       SSU_Input_type
!                             DIMENSION:  Scalar or any rank
!                             ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUTS:
!       Channel:              SSU channel for which the CO2 cell pressure
!                             is required.
!                             UNITS:      N/A
!                             TYPE:       INTEGER
!                             DIMENSION:  Scalar or same as SSU_Input
!                             ATTRIBUTES: INTENT(IN), OPTIONAL
!
! OPTIONAL OUTPUTS:
!       Time:                 SSU instrument mission time.
!                             UNITS:      decimal year
!                             TYPE:       REAL(fp)
!                             DIMENSION:  Scalar or same as SSU_Input
!                             ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Cell_Pressure:        SSU channel CO2 cell pressure. Must be
!                             specified with the Channel optional input
!                             dummy argument.
!                             UNITS:      hPa
!                             TYPE:       REAL(fp)
!                             DIMENSION:  Scalar or same as SSU_Input
!                             ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       n_Channels:           Number of SSU channels..
!                             UNITS:      N/A
!                             TYPE:       INTEGER
!                             DIMENSION:  Scalar or same as SSU_Input
!                             ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE ssu_input_getvalue( &
    SSU_Input    , &
    Channel      , &
    Time         , &
    Cell_Pressure, &
    n_Channels     )
    ! Arguments
    TYPE(ssu_input_type), INTENT(IN)  :: ssu_input
    INTEGER,    OPTIONAL, INTENT(IN)  :: channel
    REAL(fp),   OPTIONAL, INTENT(OUT) :: time
    REAL(fp),   OPTIONAL, INTENT(OUT) :: cell_pressure
    INTEGER,    OPTIONAL, INTENT(OUT) :: n_channels
    ! Variables
    INTEGER :: n

    ! Get values
    IF ( PRESENT(time) ) time = ssu_input%Time
    IF ( PRESENT(channel) .AND. PRESENT(cell_pressure) ) THEN
      n = max(min(channel,max_n_channels),1)
      cell_pressure = ssu_input%Cell_Pressure(n)
    END IF
    IF ( PRESENT(n_channels) ) n_channels = max_n_channels

  END SUBROUTINE ssu_input_getvalue


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SSU_Input_CellPressureIsSet
!
! PURPOSE:
!       Elemental function to determine if SSU_Input object cell pressures
!       are set (i.e. > zero).
!
! CALLING SEQUENCE:
!       result = SSU_Input_CellPressureIsSet( ssu )
!
!         or
!
!       IF ( SSU_Input_CellPressureIsSet( ssu ) ) THEN
!         ...
!       END IF
!
! OBJECTS:
!       ssu:       SSU_Input object for which the cell pressures
!                  are to be tested.
!                  UNITS:      N/A
!                  TYPE:       SSU_Input_type
!                  DIMENSION:  Scalar or any rank
!                  ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       result:    Logical variable indicating whether or not all the
!                  SSU cell pressures are set.
!                  If == .FALSE., cell pressure values are <= 0.0hPa and
!                                 thus are considered to be NOT set or valid.
!                     == .TRUE.,  cell pressure values are > 0.0hPa and
!                                 thus are considered to be set and valid.
!                  UNITS:      N/A
!                  TYPE:       LOGICAL
!                  DIMENSION:  Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION ssu_input_cellpressureisset( ssu ) RESULT( Is_Set )
    TYPE(ssu_input_type), INTENT(IN) :: ssu
    LOGICAL :: is_set
    is_set = all(ssu%Cell_Pressure > zero)
  END FUNCTION ssu_input_cellpressureisset


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SSU_Input_ReadFile
!
! PURPOSE:
!       Function to read SSU_Input object files.
!
! CALLING SEQUENCE:
!       Error_Status = SSU_Input_ReadFile( &
!                        SSU_Input          , &
!                        Filename           , &
!                        No_Close = No_Close, &
!                        Quiet    = Quiet     )
!
! OBJECTS:
!       SSU_Input:      SSU_Input object containing the data read from file.
!                       UNITS:      N/A
!                       TYPE:       SSU_Input_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       Filename:       Character string specifying the name of a
!                       SSU_Input data file to read.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       No_Close:       Set this logical argument to *NOT* close the datafile
!                       upon exiting this routine. This option is required if
!                       the SSU_Input data is embedded within another file.
!                       If == .FALSE., File is closed upon function exit [DEFAULT].
!                          == .TRUE.,  File is NOT closed upon function exit
!                       If not specified, default is .FALSE.
!                       UNITS:      N/A
!                       TYPE:       LOGICAL
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Quiet:          Set this logical argument to suppress INFORMATION
!                       messages being printed to stdout
!                       If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
!                          == .TRUE.,  INFORMATION messages are SUPPRESSED.
!                       If not specified, default is .FALSE.
!                       UNITS:      N/A
!                       TYPE:       LOGICAL
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
! 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 file read was successful
!                          == FAILURE, an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION ssu_input_readfile( &
    SSU_Input, &  ! Output
    Filename , &  ! Input
    No_Close , &  ! Optional input
    Quiet    , &  ! Optional input
    Title    , &  ! Optional output
    History  , &  ! Optional output
    Comment  , &  ! Optional output
    Debug    ) &  ! Optional input (Debug output control)
  result( err_stat )
    ! Arguments
    TYPE(ssu_input_type),   INTENT(OUT) :: ssu_input
    CHARACTER(*),           INTENT(IN)  :: filename
    LOGICAL,      OPTIONAL, INTENT(IN)  :: no_close
    LOGICAL,      OPTIONAL, INTENT(IN)  :: quiet
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: title
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: history
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: comment
    LOGICAL,      OPTIONAL, INTENT(IN)  :: debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'SSU_Input_ReadFile'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: close_file
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: n_channels
    TYPE(ssu_input_type) :: dummy

    ! Setup
    err_stat = success
    ! ...Check No_Close argument
    close_file = .true.
    IF ( PRESENT(no_close) ) close_file = .NOT. no_close
    ! ...Check Quiet argument
    noisy = .true.
    IF ( PRESENT(quiet) ) noisy = .NOT. quiet
    ! ...Override Quiet settings if debug set.
    IF ( PRESENT(debug) ) THEN
      IF ( debug ) noisy = .true.
    END IF


    ! Check if the file is open.
    IF ( file_open( filename ) ) THEN
      ! ...Inquire for the logical unit number
      INQUIRE( file=filename, number=fid )
      ! ...Ensure it's valid
      IF ( fid < 0 ) THEN
        msg = 'Error inquiring '//trim(filename)//' for its FileID'
        CALL read_cleanup(); RETURN
      END IF
    ELSE
      ! ...Open the file if it exists
      IF ( file_exists( filename ) ) THEN
        err_stat = open_binary_file( filename, fid )
        IF ( err_stat /= success ) THEN
          msg = 'Error opening '//trim(filename)
          CALL read_cleanup(); RETURN
        END IF
      ELSE
        msg = 'File '//trim(filename)//' not found.'
        CALL read_cleanup(); RETURN
      END IF
    END IF


    ! Read and check the release and version
    READ( fid, iostat=io_stat, iomsg=io_msg ) &
      dummy%Release, &
      dummy%Version
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading Release/Version - '//trim(io_msg)
      CALL read_cleanup(); RETURN
    END IF
    IF ( .NOT. ssu_input_validrelease( dummy ) ) THEN
      msg = 'SSU_Input Release check failed.'
      CALL read_cleanup(); RETURN
    END IF


    ! Read the dimensions
    READ( fid, iostat=io_stat, iomsg=io_msg ) &
      n_channels
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading data dimensions - '//trim(io_msg)
      CALL read_cleanup(); RETURN
    END IF
    ! ...and check 'em
    IF ( n_channels /= max_n_channels ) THEN
      msg = 'Invalid channel dimension'
      CALL read_cleanup(); RETURN
    END IF
    ! ...Explicitly assign the version number
    ssu_input%Version = dummy%Version


    ! Read the global attributes
    err_stat = readgatts_binary_file( &
                 fid, &
                 title   = title  , &
                 history = history, &
                 comment = comment  )
    IF ( err_stat /= success ) THEN
      msg = 'Error reading global attributes'
      CALL read_cleanup(); RETURN
    END IF


    ! Read the decimal time
    READ( fid, iostat=io_stat, iomsg=io_msg ) &
      ssu_input%Time
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading decimal time - '//trim(io_msg)
      CALL read_cleanup(); RETURN
    END IF


    ! Read the cell pressures
    READ( fid, iostat=io_stat, iomsg=io_msg ) &
      ssu_input%Cell_Pressure
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading CO2 cell pressures - '//trim(io_msg)
      CALL read_cleanup(); RETURN
    END IF


    ! Close the file
    IF ( close_file ) THEN
      CLOSE( fid, iostat=io_stat, iomsg=io_msg )
      IF ( io_stat /= 0 ) THEN
        msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
        CALL read_cleanup(); RETURN
      END IF
    END IF

   CONTAINS

     SUBROUTINE read_cleanup()
       IF ( file_open(filename) ) THEN
         CLOSE( fid, iostat=io_stat, iomsg=io_msg )
         IF ( io_stat /= 0 ) &
           msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
       END IF
       err_stat = failure
       CALL display_message( routine_name, msg, err_stat )
     END SUBROUTINE read_cleanup

  END FUNCTION ssu_input_readfile


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SSU_Input_WriteFile
!
! PURPOSE:
!       Function to write SSU_Input object files.
!
! CALLING SEQUENCE:
!       Error_Status = SSU_Input_WriteFile( &
!                        SSU_Input          , &
!                        Filename           , &
!                        No_Close = No_Close, &
!                        Quiet    = Quiet     )
!
! OBJECTS:
!       SSU_Input:      SSU_Input object containing the data to write to file.
!                       UNITS:      N/A
!                       TYPE:       SSU_Input_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! INPUTS:
!       Filename:       Character string specifying the name of a
!                       SSU_Input format data file to write.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       No_Close:       Set this logical argument to *NOT* close the datafile
!                       upon exiting this routine. This option is required if
!                       the SSU_Input data is to be embedded within another file.
!                       If == .FALSE., File is closed upon function exit [DEFAULT].
!                          == .TRUE.,  File is NOT closed upon function exit
!                       If not specified, default is .FALSE.
!                       UNITS:      N/A
!                       TYPE:       LOGICAL
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Quiet:          Set this logical argument to suppress INFORMATION
!                       messages being printed to stdout
!                       If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
!                          == .TRUE.,  INFORMATION messages are SUPPRESSED.
!                       If not specified, default is .FALSE.
!                       UNITS:      N/A
!                       TYPE:       LOGICAL
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
! 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 file write was successful
!                          == FAILURE, an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION ssu_input_writefile( &
    SSU_Input, &  ! Input
    Filename , &  ! Input
    No_Close , &  ! Optional input
    Quiet    , &  ! Optional input
    Title    , &  ! Optional input
    History  , &  ! Optional input
    Comment  , &  ! Optional input
    Debug    ) &  ! Optional input (Debug output control)
  result( err_stat )
    ! Arguments
    TYPE(ssu_input_type),   INTENT(IN) :: ssu_input
    CHARACTER(*),           INTENT(IN) :: filename
    LOGICAL,      OPTIONAL, INTENT(IN) :: no_close
    LOGICAL,      OPTIONAL, INTENT(IN) :: quiet
    CHARACTER(*), OPTIONAL, INTENT(IN) :: title
    CHARACTER(*), OPTIONAL, INTENT(IN) :: history
    CHARACTER(*), OPTIONAL, INTENT(IN) :: comment
    LOGICAL,      OPTIONAL, INTENT(IN) :: debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'SSU_Input_WriteFile'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: close_file
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: fid


    ! Setup
    err_stat = success
    ! ...Check No_Close argument
    close_file = .true.
    IF ( PRESENT(no_close) ) close_file = .NOT. no_close
    ! ...Check Quiet argument
    noisy = .true.
    IF ( PRESENT(quiet) ) noisy = .NOT. quiet
    ! ...Override Quiet settings if debug set.
    IF ( PRESENT(debug) ) THEN
      IF ( debug ) noisy = .true.
    END IF


    ! Check if the file is open.
    IF ( file_open( filename ) ) THEN
      ! ...Inquire for the logical unit number
      INQUIRE( file=filename, number=fid )
      ! ...Ensure it's valid
      IF ( fid < 0 ) THEN
        msg = 'Error inquiring '//trim(filename)//' for its FileID'
        CALL write_cleanup(); RETURN
      END IF
    ELSE
      ! ...Open the file for output
      err_stat = open_binary_file( filename, fid, for_output=.true. )
      IF ( err_stat /= success ) THEN
        msg = 'Error opening '//trim(filename)
        CALL write_cleanup(); RETURN
      END IF
    END IF


    ! Write the release and version
    WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
      ssu_input%Release, &
      ssu_input%Version
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing Release/Version - '//trim(io_msg)
      CALL write_cleanup(); RETURN
    END IF


    ! Write the dimensions
    WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
      max_n_channels
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing channel dimension - '//trim(io_msg)
      CALL write_cleanup(); RETURN
    END IF


    ! Write the global attributes
    err_stat = writegatts_binary_file( &
                 fid, &
                 write_module = module_version_id, &
                 title        = title  , &
                 history      = history, &
                 comment      = comment  )
    IF ( err_stat /= success ) THEN
      msg = 'Error writing global attributes'
      CALL write_cleanup(); RETURN
    END IF


    ! Write the decimal time
    WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
      ssu_input%Time
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing decimal time - '//trim(io_msg)
      CALL write_cleanup(); RETURN
    END IF


    ! Write the cell_pressures
    WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
      ssu_input%Cell_Pressure
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing cell pressures - '//trim(io_msg)
      CALL write_cleanup(); RETURN
    END IF


    ! Close the file
    IF ( close_file ) THEN
      CLOSE( fid, iostat=io_stat, iomsg=io_msg )
      IF ( io_stat /= 0 ) THEN
        msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
        CALL write_cleanup(); RETURN
      END IF
    END IF

   CONTAINS

     SUBROUTINE write_cleanup()
       IF ( file_open(filename) ) THEN
         CLOSE( fid, iostat=io_stat, iomsg=io_msg )
         IF ( io_stat /= 0 ) &
           msg = trim(msg)//'; Error closing output file during error cleanup - '//trim(io_msg)
       END IF
       err_stat = failure
       CALL display_message( routine_name, msg, err_stat )
     END SUBROUTINE write_cleanup

  END FUNCTION ssu_input_writefile



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

  ELEMENTAL FUNCTION ssu_input_equal(x, y) RESULT(is_equal)
    TYPE(ssu_input_type), INTENT(IN) :: x, y
    LOGICAL :: is_equal
    is_equal = (x%Time .equalto. y%Time) .AND. &
               all(x%Cell_Pressure .equalto. y%Cell_Pressure)
  END FUNCTION ssu_input_equal

END MODULE ssu_input_define